/* sim.c

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

   -- Revisions -----
     Logfile:  SCCS/s.sim.c
    Revision:  1.27
        Date:  23 Jan 1996
     Modtime:  09:13:01
      Author:  @a
   -- SCCS  ---------

   Entry point and main simulation routines for 'sim' program.

   Zeng added lsodes_() in function DoOneExperiment ()

*/

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

#include "yourcode.h"
#include "getopt.h"
#include "gibbs.h"
#include "lexerr.h"
#include "lsodes.h"
#include "mac.h"
#include "sim.h"
#include "simhelp.h"
#include "simi.h"
#include "siminit.h"
#include "simo.h"
#include "simmonte.h"
#include "strutil.h"


static char vszVersion[] = "v3.6"; /* Version of program */


/* -----------------------------------------------------------------------------
   CorrectInputToTransition

   resets the integrator and inputs when an input transition occurs.

   returns the simulation time pexp->dTime and input values to
   the input discontinuity, or transition point *pdTtrans.

   The inputs are updated to reflect their state just after the
   transition.  The integrator is initialized for a new segment.

   This does NOT affect state and output definitions.
*/

void CorrectInputToTransition (PEXPERIMENT pexp, PDOUBLE pdTtrans)
{
  pexp->dTime = *pdTtrans;
  UpdateInputs (&pexp->dTime, pdTtrans);

} /* CorrectInputToTransition */


/* -----------------------------------------------------------------------------
   FreeVarMod

   Callback for FreeList().

   Frees the memory for one parameter modification.  If the parameter
   is an input, the memory allocated for the input function is also
   free'd.  Note that FreeList() will pass the data as a PVOID which
   needs to be re-cast.
*/

void FreeVarMod (PVOID pData)
{
  PVARMOD pvarmod = (PVARMOD) pData;

  if (IsInput (pvarmod->hvar))
    if (pvarmod->uvar.pifn) free (pvarmod->uvar.pifn);

  free (pvarmod);

} /* FreeVarMod */


/* -----------------------------------------------------------------------------
   ModifyOneParm

   Callback function for ModifyParms.
*/

int ModifyOneParm (PVOID pData, PVOID pNullInfo)
{
  PVARMOD pvarmod = (PVARMOD) pData;

  if (IsInput(pvarmod->hvar))
    SetInput (pvarmod->hvar, pvarmod->uvar.pifn);
  else
    SetVar (pvarmod->hvar, pvarmod->uvar.dVal);

  return 0;

} /* ModifyOneParm */


/* -----------------------------------------------------------------------------
   ModifyParms

   Modifies the parameters in the plistParmMods LIST of the experiment
   spec by call ForAllList to increment through the list.
*/

void ModifyParms (PLIST plistParmMods)
{

  assert (plistParmMods);
  ForAllList (plistParmMods, &ModifyOneParm, NULL);

} /* ModifyParms */


/* -----------------------------------------------------------------------------
   DoOneExperiment

   Runs one experiment
*/

int DoOneExperiment (PEXPERIMENT pexp)
{

  double dTout;     /* next output time */
  double dTtrans;   /* next exposure transition time */
  double dTup;      /* the smaller one of dTout or dTtrans*/
  int    iOut;      /* index to next output time */
  PMODELINFO pmod;  /* pointer to the current model info */
  PINTSPEC   pis;   /* pointer to the integrator specs */

  if (!pexp) return 1;

  pmod = pexp->pmodelinfo;
  pis  = &(pexp->is);

  if (!InitOutputs (pexp, &iOut, &dTout)) return 1;

  UpdateInputs (&pexp->dT0, &dTtrans); /* Resolve dependent inputs */

  pexp->dTime = pexp->dT0;

  /* set lsodes flag to 1 for first call */
  pexp->is.iDSFlag = 1;

  while (pexp->dTime < pexp->dTfinal) {

    /* Iterate to final time */

    if(pis->iAlgo == IAL_LSODES ) { /* Lsodes is chosen */

      /* the upper limit of integration dTup should be either dTout
         or dTtrans, whichever is smaller */
      dTup = (dTout < dTtrans) ? dTout : dTtrans;

      lsodes_(&pmod->nStates, pmod->pdModelVars, &(pexp)->dTime,
              &dTup, &pis->itol, &pis->dRtol, &pis->dAtol,
              &pis->itask, &pis->iDSFlag, &pis->iopt, pis->rwork,
              &pis->lrw, pis->iwork, &pis->liw, &pis->iMf);

      /* try to correct if bad return flag - FB 17 oct 96, 20 nov 96 */
      if (pis->iDSFlag < 0) {
          /* error conditions returned by lsodes - 
             we cannot guarantee the accuracy of the results */
          return (1);
      }
    }

    if (dTtrans <= dTout) {
      /* dTime == dTtrans <= dTout: we are at a discontinuity.
         This point belongs to the NEW period UNLESS we are at
         the final time */
      if (dTtrans < dTout) {
        if (dTtrans < pexp->dTfinal) {
          CorrectInputToTransition (pexp, &dTtrans);
          pis->iDSFlag = 1;
        }
      }
      else { 
        /* dTtrans == dTout */
        if (dTtrans < pexp->dTfinal) {
          CorrectInputToTransition (pexp, &dTtrans);
          pis->iDSFlag = 1;
        }
        SaveOutputs (pexp, &dTout);
        NextOutputTime (pexp, &dTout, &iOut);
      }
    }
    else {
      /* dTime == dTout < dTtrans: */
      SaveOutputs (pexp, &dTout);
      NextOutputTime (pexp, &dTout, &iOut);
    }

  } /* while dTime < final time */

  if( !(pis->iAlgo == IAL_LSODES) ) {
    printf ("Accessing disabled Gear-related code in sim.c - Exiting 4...\n");
    exit (0);
  }

  return 0;

} /* DoOneExperiment */


/* -----------------------------------------------------------------------------
   DoOneNormalExp

   Does one AT_DEFAULTSIM simulation.
*/

void DoOneNormalExp (PANALYSIS panal, PEXPERIMENT pexp)
{
  printf (" %d", pexp->iExp); /* Show what experiment it is */

  InitModel ();
  ModifyParms (panal->expGlobal.plistParmMods); /* Global modifications */
  ModifyParms (pexp->plistParmMods); /* Mods for this experiment */
  DoOneExperiment (pexp);

  printf ("\n");

} /* DoOneNormalExp */


/* -----------------------------------------------------------------------------
   DoOneMCExp

   Does one AT_MONTECARLO simulation.

   Can maybe merge this with DoOneNormalExp() in the future.

   The major issue is the order of setting parameters.  For each
   experiment in a Monte Carlo run of an analysis, the order must be
   as follows:

   Each Run
    calc mc mods

     Each Experiment
     1)  Init the model
     2)  Global parm mods
     3)  Monte Carlo mods
     4)  Local mods override everything

   The problem becomes that for the simulation to be started over
   again, the inputs have to be told to initialize and parm mods for
   the current experiment must be made (body weight, etc).  This
   currently won't happen unless the model is init'd.  Maybe create a
   ResetInputs() with starting time which will do the funky stuff
   done by the global variable right now.
*/

void DoOneMCExp (PANALYSIS panal, PEXPERIMENT pexp)
{
  register MONTECARLO *pmc = &panal->mc;

  InitModel ();
  ModifyParms (panal->expGlobal.plistParmMods); /* Global modifications */
  SetParms (pmc->nParms, pmc->rghvar, pmc->rgdParms); /* MC mods */
  ModifyParms (pexp->plistParmMods); /* Mods for this experiment */
  DoOneExperiment (pexp);

} /* DoOneMCExp */


/* -----------------------------------------------------------------------------
   DoNormal

   Does a normal analysis
*/

void DoNormal (PANALYSIS panal)
{
  int nExps = panal->expGlobal.iExp;
  int i;

  printf ("\nDoing analysis - %d normal experiment%c\n", nExps,
       (nExps > 1 ? 's' : ' '));

  for (i = 0; i < nExps; i++) {
    DoOneNormalExp (panal, panal->rgpExps[i]);
    WriteNormalOutput (panal, panal->rgpExps[i]);
  }

} /* DoNormal */


/* -----------------------------------------------------------------------------
   DoMonteCarlo

   Does a Monte Carlo analysis or a Set Points analysis.  The latter is
   handled here because the looping is basically the same, with one
   difference.

   If the number of runs (nRuns) for SetPoints() analysis is
   specified to be zero, set points are read from the set points file
   until end of file is reached.  Otherwise, the number of runs
   explicity stated are read.  Not having enough points in the file
   in this latter case yields an error.

   If nRuns == 0, the test at the end of the while{} loop is not
   used, and the decision to continue is made by the return value of
   GetMCMods().  Since for MonteCarlo analyses, this return value is
   always TRUE (i.e. you can always pick another random number),
   nRuns is locally modified to 1, if it has been spec'd to zero,
   thus preventing the the Monte Carlo's from accidentaly running
   forever.
*/

void DoMonteCarlo (PANALYSIS panal)
{
  int nExps = panal->expGlobal.iExp;
  int nRuns = panal->mc.nRuns;
  MCPREDOUT mcpredout;
  BOOL bNotDone; /* Not finished with analysis */
  int i;

  mcpredout.pred = NULL;
  InitRandom (panal->dSeed, TRUE);
  if (panal->iType == AT_MONTECARLO && nRuns <= 0)
    nRuns = 1; /* Don't let MonteCarlo run forever */

  /* if cannot open files, Abort */
  if (OpenMCFiles (panal)) exit(0);

  printf ("\nDoing analysis - %d %s run%c... %d experiment%c%s\n",
          nRuns,
          (panal->iType == AT_MONTECARLO ? "Monte Carlo" : "Set point"),
          (nRuns != 1 ? 's' : ' '),
          nExps, (nExps > 1 ? 's' : ' '),
          (nRuns != 1 ? " each" : " "));

  if (!nRuns)
    printf ("0 runs specified for SetPoint().  Reading entire file.\n\n");

  panal->mc.lRun = 0; /* First run */
  bNotDone = TRUE;

  while (bNotDone) {

    bNotDone = GetMCMods (panal, NULL); /* Mods for this run */

    if (bNotDone) {
      /* Do analysis if not finished */
      for (i = 0; i < nExps; i++)  /* Do all experiments */
        DoOneMCExp (panal, panal->rgpExps[i]);

      TransformPred (panal, &mcpredout); /* transform output run */
      WriteMCOutput (panal, &mcpredout);
    } /* if */

    panal->mc.lRun++; /* Next run */
    if (nRuns) /* If a number of runs spec'd... */
      bNotDone = (panal->mc.lRun < nRuns);
  } /* while */

  CloseMCFiles (panal);

} /* DoMonteCarlo */


/* -----------------------------------------------------------------------------
   DoAnalysis

   Does the analysis in the given specification.
*/

void DoAnalysis (PANALYSIS panal)
{

  switch (panal->iType) {

    default:
    case AT_DEFAULTSIM:
      DoNormal (panal);
      break;

    case AT_SETPOINTS: /* Not really Monte Carlo */
    case AT_MONTECARLO:
      DoMonteCarlo (panal);
      break;

    case AT_GIBBS:
      DoMarkov (panal);
      break;

  } /* switch */

  if (panal->expGlobal.os.pfileOut) {
    fclose (panal->expGlobal.os.pfileOut);
    printf ("Wrote output file \"%s\"\n", panal->expGlobal.os.szOutfilename);
  }

} /* DoAnalysis */


/* -----------------------------------------------------------------------------
   MCVarListToArray

   converts a list of MCVAR to an array.  This must be a callback for
   ForAllList() since we are making the change here that will let us
   not to be forced to use list traversal in the future.
*/

MCVAR **vrgpMCVar; /* Avoid hairy pointers in here */
int   viMCVar;     /* Index to the array */

int MCVarListToArray (PVOID pv_pMCVar, PVOID pv_Null)
{

  vrgpMCVar[viMCVar] = (MCVAR *) pv_pMCVar; /* Copy the pointer and.. */
  viMCVar++; /* Advance to next element of array */
  return 1;

} /* MCVarListToArray */


/* ----------------------------------------------------------------------------
   PrepAnalysis

   makes the ANALYSIS structure easier to work with in the simulation
   code.  Specifically, changes lists to arrays.
*/

void PrepAnalysis (PANALYSIS panal)
{
  register MONTECARLO *pmc = &panal->mc;
  register int l;

  pmc->nParms = ListLength (pmc->plistMCVars);
  /* avoid zero pmc->nParms which can confuse some implementations of
     malloc. If pmc->nParms is zero  no use is going to be made of these
     arrays anyway */
  if (pmc->nParms == 0) return;
  
  pmc->rgdParms = (double *) malloc((pmc->nParms)*sizeof(double));
  pmc->rgpMCVar = (MCVAR **) malloc((pmc->nParms)*sizeof(MCVAR *));
  if (!(pmc->rgdParms && pmc->rgpMCVar))
    ReportError (NULL, RE_OUTOFMEM | RE_FATAL, "PrepAnalysis", NULL);

  /* Address of the first pointer */
  vrgpMCVar = &pmc->rgpMCVar[0];

  /* Initialize global array index */
  viMCVar = 0;
  ForAllList (pmc->plistMCVars, MCVarListToArray, (PVOID) NULL);
  FreeList (&pmc->plistMCVars, NULL, FALSE);

  /* Make a handle vector for theta */
  pmc->rghvar = (HVAR *) malloc((pmc->nParms)*sizeof(HVAR));
  if (pmc->rghvar) {
    for (l = 0; l < pmc->nParms; l++)
      pmc->rghvar[l] = pmc->rgpMCVar[l]->hvar;
  }
  else
    ReportError (NULL, RE_OUTOFMEM | RE_FATAL, "PrepAnalysis", NULL);

} /* PrepAnalysis */


/* ----------------------------------------------------------------------------
   CheckDependencies

   Sets the dependency level for MC variables
   (those included in `Distrib' statements)
*/

void CheckDependencies (PANALYSIS panal) {
  MONTECARLO *pmc = &panal->mc;
  MCVAR *pmcvar;
  int n, m, l;
  char *level, lv, prevLevel, varParm;
  char s[4];
  BOOL changed;
  for(n = 0; n < MC_DEPLEVELS; ++n) {
    changed = FALSE;
    for(m = 0; m < pmc->nParms; ++m) {
      for(l = 0; l < pmc->nParms; ++l) {
        if(l == m) continue;
        pmcvar = pmc->rgpMCVar[l];
        if((varParm = pmcvar->cVarParm) == 0) continue;
        level = &pmcvar->cLevel;
        if(((varParm & 1) && (pmcvar->uParm1.hvar == pmc->rgpMCVar[m]->hvar)) ||
           ((varParm & 2) && (pmcvar->uParm2.hvar == pmc->rgpMCVar[m]->hvar)) ||
           ((varParm & 4) && (pmcvar->uMin.hvar == pmc->rgpMCVar[m]->hvar)) ||
           ((varParm & 8) && (pmcvar->uMax.hvar == pmc->rgpMCVar[m]->hvar))) {
            prevLevel = *level;
            if((lv = pmc->rgpMCVar[m]->cLevel + 1) == MC_DEPLEVELS) {
              sprintf(s, "%d", lv);
              ReportError(NULL, RE_TOOMANYLEVELS | RE_FATAL, s, NULL);
            }
            if(lv > prevLevel) {
              *level = lv;
              fprintf(stderr, "level of %d changed to %d\n", l, *level);
              changed = TRUE;
            }
        }
      }
    }
    if(!changed) break;
  }
} /* CheckDependencies */

/* Get the command line argument stuff */

/* -----------------------------------------------------------------------------
   SansPath

   returns a pointer to just the filename of a full path.
*/

char *SansPath (char *szFullPathname)
{
  register char *szFile;

  if ((szFile = szFullPathname))
    while (*szFullPathname) {
      if (*szFullPathname == '/')
        szFile = szFullPathname+1;
      szFullPathname++;
    } /* while */

  return szFile;

} /* SansPath */


/* -----------------------------------------------------------------------------
   PromptFilenames

   prompts for both input and output file names.  The space allocated
   for inputting the files is reallocated to their actual size.
*/

void PromptFilenames (PSTR *pszFileIn, PSTR *pszFileOut)
{
  *pszFileIn = (PSTR) calloc (1, 80);
  *pszFileOut = (PSTR) calloc (1, 80);

  printf ("Input filename? ");
  gets (*pszFileIn);
  *pszFileIn = strtok (*pszFileIn, " \t");

  if (!(*pszFileIn)) /* Nothing entered, quit */
    return;

  if ((*pszFileIn)[0]) { /* Input file specified */
    printf ("Output filename? ");
    gets (*pszFileOut);
    *pszFileOut = strtok (*pszFileOut, " \t");
  }

  if (!(*pszFileOut) || !(*pszFileOut)[0]) { /* If no output specified */
    free (*pszFileOut);                      /* .. use default later */
    *pszFileOut = NULL;
  }
  else {
    *pszFileIn = (PSTR) realloc (*pszFileIn, MyStrlen(*pszFileIn) + 1);
    *pszFileOut = (PSTR) realloc (*pszFileOut, MyStrlen(*pszFileOut) + 1);
  }

} /* PromptFilenames */


/* -----------------------------------------------------------------------------
   Command Line Parsing
*/

#define WarnArgumentReqd(szOption, szArg) \
  printf ("* Command-line option \"%s\" requires an argument \"%s\"\n",\
          szOption, szArg);

#define WarnUnknownArg(szOption, szArg) \
  printf ( "* Unknown argument \"%s\" to option \"%s\"\n", szArg, szOption);


void GetOutputFlagOption (PANALYSIS panal, char *optarg)
{
  if (!strcmp (optarg, "MCOutputs"))       panal->fCmdOptions |= OF_MCOUTPUTS;

  else if (!strcmp (optarg,"NoMCOutputs")) panal->fNotOptions |= OF_MCOUTPUTS;

  else if (!strcmp (optarg, "MCResult"))   panal->fCmdOptions |= OF_MCRESULT;

  else if (!strcmp (optarg, "NoMCResult")) panal->fNotOptions |= OF_MCRESULT;

  else if (!strcmp (optarg, "ParmList"))   panal->fCmdOptions |= OF_PARMLIST;

  else if (!strcmp (optarg, "NoParmList")) panal->fNotOptions |= OF_PARMLIST;

  else if (!strcmp (optarg, "VarNames"))   panal->fCmdOptions |= OF_VARNAMES;

  else if (!strcmp (optarg, "NoVarNames")) panal->fNotOptions |= OF_VARNAMES;

  else WarnUnknownArg ("-O", optarg);

} /* GetOutputFlagOption */


/* -----------------------------------------------------------------------------
   GetFilenames

   retrieves the filenames from the command line arguments passed to
   the program.

   The command line syntax is:

     pksim [-options] [input-file [output-file | 4-file-names]]

   If the output filename is not given a poorly chosen default is
   used.  If neither the input, nor output filenames are given, the
   program prompts for them both.

   If the optional four extra filenames are included instead, they are
   interpreted as files for Monte Carlo output in this manner:

     pass-file fail-file behavior-file summary-file

   The options can appear anywhere in the line and in any order.
   Where conflicts occur, the option specified first SHOULD be used,
   but probably the last is used.  Also, inibitory options override
   requested options, e.g. -ONoParmList -OParmList does not print the
   parmlist.  This is considered acceptable because if you are
   braindead enough to put this on the command-line, you lose.

   The options are parsed with _getopt(). After _getopt() is called,
   the args in rgszArg have been permuted so that non-option args are
   first, which in this case means the filenames.

   Uses the following globals:

     char *optarg;    -- Contains the string argument to each option in turn
     int   optind;    -- Index in ARGV of the next elem to be scanned
     char *nextchar;  -- The next char to be scanned in the option-element
     int   opterr;    -- 0 value flags to inhibit GNU error messages
*/

static char vszOptions[] = "h:H:O:D:n:S:";

BOOL GetCmdLineArgs (int cArg,
                     char *const *rgszArg,
                     PSTR *pszFileIn, PSTR *pszFileOut,
                     PANALYSIS panal)
{
  int c;

  *pszFileIn = *pszFileOut = (PSTR) NULL;

  /* Process command-line arguments */

  if (cArg == 0)
    PromptFilenames (pszFileIn, pszFileOut);
  else {
    while (1) {

      c = _getopt (cArg, rgszArg, vszOptions);
      if (c == EOF) /* Finish with option args */
        break;

      switch (c) {
        case '?':
          optarg = 0;
          /* Fall through! */

        case 'H':
        case 'h':
          if (optarg && *optarg)
            ShowHelp (optarg);
          else
            ShowHelpMessage (SansPath (rgszArg[0]));
          exit (-1);
          break;

        case 'D':
          printf (">> Debug mode: Using option '%s'\n", optarg);
          /* Can setup to run with certain debug flags */
          break;

        case 'n':
          break;

        case 'O':
          if (!optarg) {
            WarnArgumentReqd ("-O", "output format");
            break;
          } /* if */
          GetOutputFlagOption (panal, optarg);
          break;

        case 'S':
          if (optarg) {
            if (!(panal->fCmdOptions & OF_CMDLSEED))
              panal->dSeed = atof (optarg);
            panal->fCmdOptions |= OF_CMDLSEED;
          } /* if */
          else
            WarnArgumentReqd ("-S", "random seed");
          break;

        default:
          printf ("Unknown option in command-line, %c = code 0%o ?\n", c, c);
          break;

      } /* switch */

    } /* while */

    switch (cArg - optind) { /* Remaining args are  filenames */
      default:
        ShowHelp ("Usage");
        exit (-1);
        break;

      case 5: /* Input and 2 output files spec'd */
        *pszFileIn = rgszArg[optind];
        panal->mc.szMCPassFilename = rgszArg[optind + 1];
        panal->mc.szMCFailFilename = rgszArg[optind + 2];
        break;

      case 2: /* Output and input file specificed */
        *pszFileOut = rgszArg[optind + 1];

        /* Fall through! */

      case 1: /* Input file specificed */
        *pszFileIn = rgszArg[optind];
        break;

      case 0: /* No file names specified */
        PromptFilenames (pszFileIn, pszFileOut);
        break;

    } /* switch */

  } /* else */

  while (*pszFileIn && (*pszFileIn)[0]        /* Files specified   */
     && !MyStrcmp(*pszFileIn, *pszFileOut)) { /* and not different */

     printf ("\n** Input and output filename must be different.\n");
    PromptFilenames (pszFileIn, pszFileOut);

  } /* while */

  return (*pszFileIn && (*pszFileIn)[0]); /* Input name given */

} /* GetCmdLineArgs */


/* -----------------------------------------------------------------------------
*/
void AnnounceProgram (void)
{
  printf ("\n________________________________________\n");
  printf ("\nMCSim simulation program: %s\n\n", vszVersion);
  printf ("All rights reserved.\n\n");

  printf ("* Using `%s' model in file \"%s\" created by %s\n\n",
          szModelDescFilename, szModelSourceFilename, szModelGenAndVersion);

} /* AnnounceProgram */


/* -----------------------------------------------------------------------------
   main

   Entry point for simulation and analysis program.
*/

int main (int nArg, char *const *rgszArg)
{
  PSTR szFileIn, szFileOut;
  INPUTBUF ibIn;
  PANALYSIS panal = (PANALYSIS) malloc (sizeof(ANALYSIS));

#ifdef _MACOS_

  InitMacintosh ();
  while (1) HandleEvent();

#endif

  AnnounceProgram ();

  if (!panal)
    ReportError (NULL, RE_OUTOFMEM | RE_FATAL,
                 "ANALYSIS specification too large", NULL);

  InitAnalysis (panal);
  if (!(GetCmdLineArgs (nArg, rgszArg, &szFileIn, &szFileOut, panal)))
    exit (-1);

  /* Define the output file as the global experiment default  */
  panal->expGlobal.os.szOutfilename = szFileOut;
  panal->expGlobal.os.bCommandLineSpec = (BOOL) szFileOut;  /* Flag */

  if (!InitBuffer (&ibIn, szFileIn))
    ReportError (&ibIn, RE_INIT | RE_FATAL, "ReadInput", NULL);

  ibIn.pInfo = (PVOID) panal; /* Attach analysis specification to input */

  if (ReadAnalysis (&ibIn)) {
    SetOptions (panal);
    PrepAnalysis (panal);
    CheckDependencies (panal);
    DoAnalysis (panal);
  } /* if */

#ifdef _MACOS_
  printf ("Done.(Hit Return)\n\n");
#endif

  return 0;

} /* main */
