/* simmonte.c

   written by 
   28 October 1991
   
   Copyright (c) 1993.  Don Maszle, Frederic Bois.  All rights reserved.

   -- Revisions -----
     Logfile:  SCCS/s.simmonte.c
    Revision:  1.3
        Date:  8/7/93
     Modtime:  21:29:53
      Author:  @a
   -- SCCS  ---------

   Handles functions related to Monte Carlo analysis.
*/

#ifdef __LOCAL_HDR__
#include "stdlib.h"
#include "math.h"
#include "ctype.h"
#include "string.h"
#include "assert.h"
#include "float.h"

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

#include "sim.h"
#include "lex.h"
#include "_string.h"


/* ModifyOneMCParm
   
   Callback function for ModifyMCParms.
*/

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

/*. fprintf (stderr, "%#0x = %lg", pMCVar->hvar, GetVarValue(pMCVar->hvar));   */

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

/*. fprintf (stderr, "  set[%lg]-> %lg\n", pMCVar->dVal, GetVarValue(pMCVar->hvar));   */
  
  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;

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

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

	/* Set variable randomly according to selected distribution */
	
  switch (pMCVar->iType) {

    default:
    case MCV_UNIFORM:		/*----- Uniform distribution */
      pMCVar->dVal = dRand * (pMCVar->dMax - pMCVar->dMin) + pMCVar->dMin;
      break;
      
    case MCV_LOGUNIFORM:	/*----- Log uniform distribution */
      pMCVar->dVal = pMCVar->dMin * pow (pMCVar->dMax / pMCVar->dMin, dRand);
      break;

    case MCV_NORMAL:			/*-- Normal distrib, mean, stdev */
      pMCVar->dVal = _NormalRandom (pMCVar->dParm1, pMCVar->dParm2);
      break;
      
    case MCV_LOGNORMAL:			/*-- Log normal distrib, mean, stdev */
      pMCVar->dVal = LogNormalRandom (pMCVar->dParm1, pMCVar->dParm2);
      break;
      
    case MCV_BETA:              /*----- Beta distribution */
      pMCVar->dVal = BetaRandom (pMCVar->dMin, pMCVar->dMax,
				 pMCVar->dParm1, pMCVar->dParm2);
      break;
      
    case MCV_TRUNCNORMAL:
      pMCVar->dVal = TruncNormalRandom (pMCVar->dParm1, pMCVar->dParm2,
					  pMCVar->dMin, pMCVar->dMax);
      break;

    case MCV_TRUNCLOGNORMAL:
      pMCVar->dVal = TruncLogNormalRandom (pMCVar->dParm1, pMCVar->dParm2,
					     pMCVar->dMin, pMCVar->dMax);
      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.
*/

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

  if (!rgParms)
    rgParms = pMC->rgdParms;	/*-- Put them in the usual place */
  
  if (!pMC->bIndependent)	            /* If not independent, use one */
    pMC->dRandTemp = Random();  /* draw for all parameters.    */

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



/* ReadOneSetPoint
   
   Callback function for ReadSetPoints.
   
   Returns 1 if a set point is read.  If end of file is reached,
   returns 0.  Issues an error message only if the nRuns in the Monte
   Carlo spec is not zero.  If nRuns == 0, the end of file flag 0 is
   returned.  This will cause the sum of ForAllList() to be smaller
   than the list length.  ReadSetPoints() will convert this to a
   boolean status for the entire read. 
*/
#ifdef ndef
int ReadOneSetPoint (PVOID pData, PVOID pInfo)
{
  PMCVAR  pMCVar = (PMCVAR) pData;		/* Current parm to vary */
  PMONTECARLO pMC = (PMONTECARLO) pInfo;	/* Monte Carlo spec */

  if (feof(pMC->pfileSetPoints)
      || fscanf(pMC->pfileSetPoints, "%lg", &pMCVar->dVal) == EOF) {

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

    return (0);		/* If nRuns == 0, flag that end of file reached */
  }  /* if */
  else
    return (1);		/* Status ok, one point read */

}  /* ReadOneSetPoint */
#endif


/* 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 parms list */
  
  for (i = 0; i < pMC->nParms; 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) {
    CalcMCParms (&panal->mc, rgParms);	/* Random Monte Carlo mods */
    return TRUE;
  }  /* if */

  else if (panal->iType == AT_SETPOINTS)
    return ReadSetPoints (&panal->mc, rgParms); /* New set point mods */ 

  return (FALSE);
}  /* GetMCMods */


BOOL ReadExtData (PMONTECARLO pMC)
{
  PFILE pfile;
  long i;
  
  if (!(pfile = fopen(pMC->szExtDataFilename, "r")))
    ReportError(NULL, RE_CANNOTOPEN | RE_FATAL, pMC->szExtDataFilename, NULL);

  fscanf(pfile, "%*[^\n]"); getc(pfile);    /* Throw away line */
  fscanf(pfile, "%ld%*[^\n]", &pMC->mcextdata.nbrdy); getc(pfile);

  for (i = 0; i < pMC->mcextdata.nbrdy; i++) {

            /*-- Read three statistics -- skip any whitespace before */

    fscanf(pfile, "%lg%lg%ld", &pMC->mcextdata.ybar[i],
	   &pMC->mcextdata.ssqr[i], &pMC->mcextdata.n[i]);

            /*-- Throw away comment after statistics */

    fscanf(pfile, "%*[^\n]");  getc(pfile);

            /*-- Sum of squares of differences calc'd from std.dev. */
            /*--SAVE as the std dev. for now */
/*.     pMC->mcextdata.ssqr[i] *= pMC->mcextdata.ssqr[i] */
/*.                               * (pMC->mcextdata.n[i] - 1); */
  }  /* for */
  
  fclose(pfile);
  return (!pfile);

}  /* ReadExtData */



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

  pMC->pfileSetPoints = pfile;

  return (!pfile);

}  /* ReadSetPointData */

