/* simmonte.c

   Copyright (c) 1993.  Don Maszle, Frederic Bois.  All rights reserved.

   -- Revisions -----
     Logfile:  SCCS/s.simmonte.c
    Revision:  1.15
        Date:  13 Jan 1996
     Modtime:  15:55:36
      Author:  @a
   -- SCCS  ---------

   Handles functions related to Monte Carlo analysis.
*/

#include <assert.h>
#include <ctype.h>
#include <float.h>
#include <math.h>
#include <stdlib.h>
#include <string.h>

#include "sim.h"
#include "lex.h"
#include "lexerr.h"
#include "strutil.h"
#include "simmonte.h"

/* -----------------------------------------------------------------------------
   ModifyOneMCParm

   Callback function for ModifyMCParms.
*/

int ModifyOneMCParm (PVOID pData, PVOID pInfo)
{
  PMCVAR  pMCVar = (PMCVAR) pData; /* Current parm variation */

  SetVar (pMCVar->hvar, pMCVar->dVal);

  return 0;

} /* ModifyOneMCParm */


/* -----------------------------------------------------------------------------
   ModifyMCParms

   Make Monte Carlo modifications defined in pMC->plistMCVars using a
   callback function to traverse the list.
*/

void ModifyMCParms (PMONTECARLO pMC)
{
  assert (pMC->plistMCVars);
  ForAllList (pMC->plistMCVars, ModifyOneMCParm, NULL);

} /* ModifyMCParms */


/* -----------------------------------------------------------------------------
   SetParms

   sets the parameters in the rghvar array to the values in the rgdParm
   array.
*/

void SetParms (long cParms, HVAR *rghvar, double *rgdParm)
{
  long i;

  for (i = 0; i < cParms; i++)
    SetVar (rghvar[i], rgdParm[i]);

} /* SetParms */


/* -----------------------------------------------------------------------------
   SetParmsLog

   sets the parameters in the rghvar array to the log-transformed
   values in the rgdParm array.
*/

void SetParmsLog (long cParms, HVAR *rghvar, double *rgdParm)
{
  long i;

  for (i = 0; i < cParms; i++)
    SetVar (rghvar[i], exp(rgdParm[i]));

} /* SetParmsLog */


/* -----------------------------------------------------------------------------
   CalculateOneMCParm

   Callback function for CalculateMCParms.
*/

int CalculateOneMCParm (PMCVAR pMCVar, PMONTECARLO pMC)
{
  double  dRand = 0.0;

  if (pMC && !pMC->bIndependent)
    dRand = pMC->dRandTemp; /* Use same value for each parm */

  else if (pMCVar->iType == MCV_UNIFORM || pMCVar->iType == MCV_LOGUNIFORM)
    dRand = Randoms(); /* Randomize for each parameter */

    /* Set variable randomly according to selected distribution */

  switch (pMCVar->iType) {

    default:
    case MCV_UNIFORM: /* Uniform distribution */
      pMCVar->dVal = dRand * (pMCVar->uMax.dval - pMCVar->uMin.dval) +
                     pMCVar->uMin.dval;
      break;

    case MCV_LOGUNIFORM: /* Log uniform distribution */
      pMCVar->dVal = pMCVar->uMin.dval *
                     pow (pMCVar->uMax.dval / pMCVar->uMin.dval, dRand);
      break;

    case MCV_NORMAL: /* Normal distrib, mean, stdev */
      pMCVar->dVal = NormalRandom (pMCVar->uParm1.dval, pMCVar->uParm2.dval);
      break;

    case MCV_LOGNORMAL: /* Log normal distrib, mean, stdev */
      pMCVar->dVal = LogNormalRandom (pMCVar->uParm1.dval,
                                      pMCVar->uParm2.dval);
      break;

    case MCV_PIECEWISE: /* Piecewise distrib, min, max, val1, val2 */
      pMCVar->dVal = PiecewiseRandom (pMCVar->uMin.dval, pMCVar->uParm1.dval,
                                      pMCVar->uParm2.dval, pMCVar->uMax.dval);
      break;

    case MCV_BETA: /* Beta distribution */
      pMCVar->dVal = BetaRandom (pMCVar->uMin.dval, pMCVar->uMax.dval,
                                 pMCVar->uParm1.dval, pMCVar->uParm2.dval);
      break;

    case MCV_TRUNCNORMAL:
      pMCVar->dVal = TruncNormalRandom (pMCVar->uParm1.dval,
                                        pMCVar->uParm2.dval,
                                        pMCVar->uMin.dval, pMCVar->uMax.dval);
      break;

    case MCV_TRUNCLOGNORMAL:
      pMCVar->dVal = TruncLogNormalRandom (pMCVar->uParm1.dval,
                                           pMCVar->uParm2.dval,
                                           pMCVar->uMin.dval,
                                           pMCVar->uMax.dval);
      break;

  } /* switch */

  return 0;

} /* CalculateOneMCParm */


/* -----------------------------------------------------------------------------
   CalcMCParms

   calculates random parameters for a Monte Carlo variation.

   This routines uses arrays for the MC vars and distributions.
   It replaces the obsolete CalculateMCParms which used lists.

   The calculated parms are stored in the rgParms[] array.  If this
   array is NULL, the parms are stored in the pMC->rgParms[] array.

   The calculation starts at index iStart.
*/

void CalcMCParms (PMONTECARLO pMC, double rgParms[], long iStart)
{
  long i;

  if (!rgParms)
    rgParms = pMC->rgdParms; /* Put them in the usual place */

  if (!pMC->bIndependent) /* If not independent, use one */
    pMC->dRandTemp = Randoms(); /* draw for all parameters.    */

  for (i = iStart; i < pMC->nParms; i++) {
    CalculateOneMCParm (pMC->rgpMCVar[i], pMC);
    rgParms[i] = pMC->rgpMCVar[i]->dVal;
  } /* for */

} /* CalcMCParms */


/* -----------------------------------------------------------------------------
   InitSetPoints

   Openn and reads the header of the SetPoint file containing the
   parameters to be tried.

   Returns the file pointer if everything is ok.
*/

BOOL InitSetPoints (PMONTECARLO pMC)
{
  PFILE pfile;

  if (!(pfile = fopen(pMC->szSetPointsFilename, "r")))
    ReportError (NULL, RE_CANNOTOPEN | RE_FATAL,
             pMC->szSetPointsFilename, NULL);

  pMC->pfileSetPoints = pfile;

  /* Throw away the first line.  This allows a MC output file to be used
     directly as a setpoints file. */
  fscanf (pMC->pfileSetPoints,  "%*[^\n]");  getc(pMC->pfileSetPoints);

  if (feof(pMC->pfileSetPoints))
    ReportError (NULL, RE_INSUF_POINTS | RE_FATAL,
                 pMC->szSetPointsFilename, NULL);

  return (!pfile);

} /* InitSetPoints */


/* -----------------------------------------------------------------------------
   ReadSetPoints

   Reads set points from a file for this run.

   Returns non-zero if a full set of points is read, 0 otherwise.
*/

BOOL ReadSetPoints (PMONTECARLO pMC, double rgParms[])
{
  BOOL bReturn = FALSE; /* Initially, flag no points read */
  long i;

  if (!rgParms)
    rgParms = pMC->rgdParms; /* Put data in the usual place */

  fscanf(pMC->pfileSetPoints, "%*s"); /* Throw away dummy field */

  /* Increment across set point parms list */
  for (i = 0; i < pMC->nSetParms; i++) {

    /* Try to read one data point */

    if (feof(pMC->pfileSetPoints)
    || (fscanf(pMC->pfileSetPoints, "%lg", &pMC->rgpMCVar[i]->dVal)
        == EOF)) {

      if (pMC->nRuns) /* More points expected */
        ReportError (NULL, RE_INSUF_POINTS | RE_FATAL,
                     pMC->szSetPointsFilename, NULL);

      /* If !nRuns, flag that EOF reached without issuing error */

      goto Exit_ReadSetPoints;
    } /* if */

    rgParms[i] = pMC->rgpMCVar[i]->dVal; /* Copy value to user array */
  } /* for */

  bReturn = TRUE; /* Flag that all parms were read */

  /* Throw away remainder of line.  This allows a MC output file to be used
     directly as a setpoints file.  */
  fscanf (pMC->pfileSetPoints,  "%*[^\n]");  getc(pMC->pfileSetPoints);

Exit_ReadSetPoints:
  ;
  return (bReturn);

} /* ReadSetPoints */


/* -----------------------------------------------------------------------------
   GetMCMods

   Calculates random parameter variations or reads a new set of
   modifications from the set points input file.

   Returns TRUE if got modifications.

   FALSE is only returned for a SetPoints analysis where
   the number of runs (nRuns) is set to zero.  In this case the
   simulation continues to set points until end of file is reached,
   and returns FALSE to flag the eof condition.
*/

BOOL GetMCMods (PANALYSIS panal, double rgParms[])
{
  if (panal->iType == AT_MONTECARLO) { /* Random Monte Carlo mods */
    CalcMCParms (&panal->mc, rgParms, 0); /* start at 0, do them all */
    return TRUE;
  } /* if */

  else if (panal->iType == AT_SETPOINTS) {
    /* take care of Distrib specs */
    CalcMCParms (&panal->mc, rgParms, panal->mc.nSetParms);
    /* eventually override with new set point mods */
    return ReadSetPoints (&panal->mc, rgParms);
  } /* else if */

  return (FALSE);

} /* GetMCMods */


/* End */
