/* yourcode.c

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

   -- Revisions -----
     Logfile:  SCCS/s.yourcode.c
    Revision:  1.11
        Date:  18 Jan 1996
     Modtime:  10:21:46
      Author:  @a
   -- SCCS  ---------

   Contains the routines most susceptible to be modified by the user.
   
*/

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

#include "gibbs.h"
#include "lexerr.h"
#include "mac.h" /* _MACOS_ */
#include "simmonte.h"
#include "yourcode.h"


/* -----------------------------------------------------------------------------
   DoStep_by_Step 
   
   routine called after each successful step of the integrator. 
   It can be used for interupts management, for step by step
   printing or operations such as finding a maximum etc.
*/

void DoStep_by_Step (/* double t, long *neq, double *y */)
{
  /*
  
  static FILE *fout;
  int i;

  if (!fout) fout = fopen("step.out", "w");
  
  fprintf(fout, "%g\t", t);
  for (i = 1; i <= *neq; i++) fprintf(fout, "%g\t", y[i]);
  fprintf(fout, "\n");
  
  */

#ifdef _MACOS_

  /* this allows background processing on the Macintosh */
  HandleEvent();

#endif

} /* DoStep_by_Step */


/* -----------------------------------------------------------------------------
   TransformPred

   At least flattens the model predictions in a simple array after a 
   Monte Carlo or a SetPoint simulation.

   Changing this routine should be avoided and using output variables 
   defined through the model specification file should be preferred.
   
   If you change it make sure that you allocate the data array of the 
   pMCPredOut structure and specify its length. See the routine
   OutspecToLinearArray for exemple.

   At most it allows the user to manipulate the data output 
   for creating summaries (e.g. sums of variables) which
   better relate to the experimental data simulated. Those summaries 
   are placed in the pMCPredOut structure and will be used and printed.
*/
   
void TransformPred (PANALYSIS panal, PMCPREDOUT pMCPredOut)
{

  OutspecToLinearArray (panal, pMCPredOut);

} /* TransformPred */


/* -----------------------------------------------------------------------------
   OutspecToLinearArray

   Flattens the panal nested output arrays on a single array.
   Allocate the data array of the pMCPredOut structure and sets the
   dimension pMCPredOut->nbrdy to the length of the data array.
*/

void OutspecToLinearArray (PANALYSIS panal, PMCPREDOUT pMCPredOut)
{
  POUTSPEC pos;
  long i, j, k;

  pMCPredOut->nbrdy = 0;

  /* get the size needed for the data array of pMCPredOut
     there should be one cell for each experiment, variable, 
     and output time
  */
  for (i = 0; i < panal->expGlobal.iExp; i++)
    for (j = 0, pos = &panal->rgpExps[i]->os; j < pos->nOutputs; j++)
      for (k = 0; k < pos->pcOutputTimes[j]; k++)
            pMCPredOut->nbrdy++;

  /* allocate data */

  if (!(pMCPredOut->pred))
    if ( !(pMCPredOut->pred = InitdVector (pMCPredOut->nbrdy)))
      ReportError (NULL, RE_OUTOFMEM | RE_FATAL, "OutspecToLinearArray", NULL);

  pMCPredOut->nbrdy = 0;
  /* fill in pred array */
  for (i = 0; i < panal->expGlobal.iExp; i++)
    for (j = 0, pos = &panal->rgpExps[i]->os; j < pos->nOutputs; j++)
      for (k = 0; k < pos->pcOutputTimes[j]; k++)
            pMCPredOut->pred[pMCPredOut->nbrdy++] = pos->prgdOutputVals[j][k];

} /* OutspecToLinearArray */


/* -----------------------------------------------------------------------------
   The following routines are for Markov sampling. */


/* -----------------------------------------------------------------------------
   Init_mu

   Inits the pdMu vector, the population means of the theta parameters.
   They are sampled out of the distributions given in the input file.
   This is done even if there is one subject (mu needs to be initialized).

   Inputs (unmodified):
   pmc:       distribution specifications
   nParms:    number of parameters 
   nSubjects: number of subjects

   Outputs:
   pdMu:      pointer to the array of means
*/

void Init_mu (PMONTECARLO pmc, long nParms, long nSubjects, double **pdMu)
{
  int i;

  if ( !(*pdMu = InitdVector (nParms)))
    ReportError (NULL, RE_OUTOFMEM | RE_FATAL, "Init_mu", NULL);

  for (i = 0; i < nParms; i++) {
    CalculateOneMCParm (pmc->rgpMCVar[i], pmc);
    (*pdMu)[i] = pmc->rgpMCVar[i]->dVal;
  }

} /* Init_mu */


/* -----------------------------------------------------------------------------
   Init_ksi

   Inits the pdKsi_prior vector, the prior values for the population SDs of 
   the theta parameters. Inits also pdKsi, the SDs themselves, by sampling 
   out of an inverse gamma distribution.
   Ideally should be a covariance matrix. 
   If only one subject is specified the initialization is needed but not
   used.

   Inputs (unmodified):
   nParms:    number of parameters 
   nSubjects: number of subjects

   Outputs:
   pdKsi_prior: pointer to the array of prior SDs
   pdKsi:       pointer to the array of SDs
*/

void Init_ksi (long nParms, long nSubjects, double **pdKsi_prior, 
               double **pdKsi)
{
  int i = 0;

  if ( !(*pdKsi_prior = InitdVector (nParms)) || 
       !(*pdKsi = InitdVector (nParms)))
    ReportError (NULL, RE_OUTOFMEM | RE_FATAL, "Init_ksi", NULL);

  if (nSubjects > 1) {

    printf ("Init_ksi: Check preliminary values.\n");

    /* these should be in log if the priors are lognormals */
    for (i = 0; i < nParms; i++) {
      (*pdKsi_prior)[i] = log (2);
      printf ("Prior on Ksi[%d]: %g\n", i, (*pdKsi_prior)[i]);
    }
    
    if (i != nParms) {
      printf ("Error: wrong number of ksis in Init_ksi - Exiting\n");
      exit (0);
    }

  } /* if */
  else
    for (i = 0; i < nParms; i++) (*pdKsi_prior)[i] = 1.0; /* dummy */

  for (i = 0; i < nParms; i++)
    (*pdKsi)[i] = sqrt(2 * (*pdKsi_prior)[i] * (*pdKsi_prior)[i] / 
                  Chi2Random(nSubjects + 2));

} /* Init_ksi */


/* -----------------------------------------------------------------------------
   Init_sigma

   inits the pdSigma vector, the experimental standard deviations.
   By default it assigns one SD per separate data statement.
   
   Inputs (unmodified):
   panal         analysis specifications. Used to find how many 
                 experiments are simulated etc.
   nData         total number of data points used to construct the
                 likelihood. Should be > 0.

   Outputs:
   pdSigma:      array of SDs. It is allocated and filled with starting values.
   pnSigma:      number of pdSigma SDs.
   plSigmaIndex: array of size nData which is allocated and holds 
                 the index of the pdSigma attributed to each data point.

   Don't hesitate to tailor this routine to your needs.
   This, in particular, will not work is a data file is used 
   instead of data statements.
   The choice of starting values used should be inconsequential 
   as they are immediately overwritten.
*/

void Init_sigma (PANALYSIS panal, long nData, double **pdSigma, 
                 long *pnSigma, long **plSigmaIndex)
{
  long    i, j, k, l, nTmp;
  BOOL    bFound;
  OUTSPEC *pos1, *pos2;
  PINT    piVarIndex;

  /* allocate plSigmaIndex */
  if ( !(*plSigmaIndex = InitlVector (nData)))
    ReportError (NULL, RE_OUTOFMEM | RE_FATAL, "Init_sigma", NULL);

  /* find out how many different output variables there are,
     given that the same output variable can be found in different experiments
   */
  *pnSigma = 0;
  for (i = 0; i < panal->expGlobal.iExp; i++) {
    pos1 = &panal->rgpExps[i]->os;
    for (j = 0; j < pos1->nOutputs; j++) {
      if (pos1->prgdDataVals[j]) { /* if a Data statement exists */

        bFound = FALSE;
        k = 0;
        /* now for the current variable (i,j) we scan previous experiments */
        while ((k < i) && (!bFound)) {
          pos2 = &panal->rgpExps[k]->os;
          l = 0;
          /* for all outputs of pos2 */
          while ((l < pos2->nOutputs) && (!bFound)) {
            bFound = !strcmp (pos1->pszOutputNames[j], pos2->pszOutputNames[l]);
            l = l + 1;
          }
          k = k + 1;
        }
        if (!bFound) {
          /* if that variable has not been found then it is new */        
          *pnSigma = *pnSigma + 1;
        }
      } /* if */
    } /* for j */
  } /* for i */

  if (*pnSigma == 0) 
    printf("Warning: no experimental variance defined - Continuing");

  /* now we know that there are *pnSigma different outputs - we allocate a 
     temporary array to index them 
   */
  if ( !(piVarIndex = InitiVector (*pnSigma)))
    ReportError (NULL, RE_OUTOFMEM | RE_FATAL, "Init_sigma", NULL);

  /* now we redo the previous scanning and remember the various variables */
  *pnSigma = 0;
  for (i = 0; i < panal->expGlobal.iExp; i++) {
    pos1 = &panal->rgpExps[i]->os;
    for (j = 0; j < pos1->nOutputs; j++) {
      if (pos1->prgdDataVals[j]) { /* if a Data statement exists */

        bFound = FALSE;
        k = 0;
        /* now for the current variable (i,j) we scan previous experiments */
        while ((k < i) && (!bFound)) {
          pos2 = &panal->rgpExps[k]->os;
          l = 0;
          /* for all outputs of pos2 */
          while ((l < pos2->nOutputs) && (!bFound)) {
            bFound = !strcmp (pos1->pszOutputNames[j], pos2->pszOutputNames[l]);
            l = l + 1;
          }
          k = k + 1;
        }
        if (!bFound) {
          /* hold its id */
          piVarIndex[*pnSigma] = pos1->phvar[j];
          /* update the counter */        
          *pnSigma = *pnSigma + 1;
        }
      } /* if */
    } /* for j */
  } /* for i */
  
  /* we build the plSigmaIndex to index the pdSigma associated to each 
     data point.
   */
  for (l = 0; l < *pnSigma; l++) { /* clumsy ? */
    nTmp = 0;
    for (i = 0; i < panal->expGlobal.iExp; i++) {
      pos1 = &panal->rgpExps[i]->os;  
      for (j = 0; j < pos1->nOutputs; j++) {
        if (pos1->prgdDataVals[j]) { /* if a Data statement exists */
          for (k = 0; k < pos1->pcOutputTimes[j]; k++) {
            if (piVarIndex[l] == pos1->phvar[j])
              (*plSigmaIndex)[nTmp] = l;
            nTmp = nTmp + 1;
          } /* for k */
        } /* if */
      } /* for j */
    } /* for i */
  } /* for l */

  /* allocate pdSigma */
  if ( !(*pdSigma = InitdVector (*pnSigma)))
    ReportError (NULL, RE_OUTOFMEM | RE_FATAL, "Init_sigma", NULL);

  /* initialize at an arbitrary value */
  for (i = 0; i < *pnSigma; i++) (*pdSigma)[i] = 1.0;

  /* free piVarIndex */
  free (piVarIndex);

} /* Init_sigma */


/* -----------------------------------------------------------------------------
   Sample_ksi

   samples the pdKsi vector, the population variances of the theta parameters.
   If the prior of Mu (the population mean) is in lognormal or loguniform it assumes 
   that the individual parameters are lognormally distributed in the population.
   Otherwise, the individual parameters are assumed to be normally distributed
   in the population.
   
   Inputs (unmodified):
   nParms:    number of parameters 
   nSubjects: number of subjects

   Outputs:
   pdKsi:     pointer to the array of SDs
*/

void Sample_ksi (PMONTECARLO pmc, long nParms, long nSubjects, 
                 double **pdTheta, double *pdMu, double *pdKsi_prior, 
                 double *pdKsi)
{
  int i, j;
  double dSum, dTmp;

  if (nSubjects > 1) {
    
    for (i = 0; i < nParms; i++) {
      dSum = 0.0;

      switch (pmc->rgpMCVar[i]->iType) {

        case MCV_NORMAL:
        case MCV_TRUNCNORMAL:
        case MCV_UNIFORM:
          for (j = 0; j < nSubjects; j++) {
            dTmp = pdTheta[j][i] - pdMu[i];
            dSum = dSum + dTmp * dTmp;
          }
          break;

        case MCV_LOGNORMAL:
        case MCV_TRUNCLOGNORMAL:
        case MCV_LOGUNIFORM:
          for (j = 0; j < nSubjects; j++) {
            dTmp = log(pdTheta[j][i] / pdMu[i]);
            dSum = dSum + dTmp * dTmp;
          }
          break;

        default: 
          printf ("Error: unimplemented prior in Sample_ksi - Exiting\n");
          exit(0);
          break;
      }

      dSum = dSum + 2 * pdKsi_prior[i] * pdKsi_prior[i];

      pdKsi[i] = sqrt (dSum / Chi2Random (nSubjects + 2)); /* pdKsi is SD */;
    } /* for */
  } /* if */

} /* Sample_ksi */


/* -----------------------------------------------------------------------------
   Sample_mu

   samples the pdMu vector, the population means of the theta parameters, from
   a product of normals. If the prior of mu is lognormal or loguniform the lognormal
   distribution is used for (theta | mu). Otherwise normal is used.
   
   Inputs (unmodified):
   nParms:    number of parameters 
   nSubjects: number of subjects

   Outputs:
   pdMu:      pointer to the array of means
*/

void Sample_mu (PMONTECARLO pmc, long nParms, long nSubjects, double **pdTheta, 
                double *pdKsi, double *pdMu)
{
  int i, j;
  double dSum, dSig, M_prior, S_prior, dTmp1, dTmp2, M_post, S_post;

  if (nSubjects > 1) {
    for (i = 0; i < nParms; i++) {

      dSum = 0.0;
      
      /* Accumulate psis_il over i */
      switch (pmc->rgpMCVar[i]->iType) {

        case MCV_NORMAL:
        case MCV_TRUNCNORMAL:
        case MCV_UNIFORM:
          for (j = 0; j < nSubjects; j++) dSum = dSum + pdTheta[j][i];
          break;

        case MCV_LOGNORMAL:
        case MCV_TRUNCLOGNORMAL:
        case MCV_LOGUNIFORM:
          for (j = 0; j < nSubjects; j++) dSum = dSum + log (pdTheta[j][i]);
          break;

        default: 
          printf ("Error: unimplemented prior in Sample_mu - Exiting\n");
          exit(0);
          break;
      }

      dSum = dSum / nSubjects; /* mean of theta[.][i] */

      dSig = pdKsi[i] / sqrt(nSubjects); /* sd of dSum */

      if ((pmc->rgpMCVar[i]->iType != MCV_UNIFORM) &&
          (pmc->rgpMCVar[i]->iType != MCV_LOGUNIFORM)) {
        M_prior = pmc->rgpMCVar[i]->uParm1.dval; /* prior mean on mu */
        S_prior = pmc->rgpMCVar[i]->uParm2.dval; /* prior sd on mu */

        dTmp1 = S_prior * S_prior;
        dTmp2 = dSig * dSig;

        M_post = (dTmp1 * dSum + dTmp2 * M_prior) / (dTmp1 + dTmp2);

        S_post = (S_prior * dSig) / sqrt (dTmp1 + dTmp2);
      }

      switch (pmc->rgpMCVar[i]->iType) {

        case MCV_NORMAL:
          pdMu[i] = NormalRandom (M_post, S_post);
          break;

        case MCV_LOGNORMAL: /* M_post and S_post are in log space */
          pdMu[i] = LogNormalRandom (M_post, S_post);
          break;

        case MCV_TRUNCNORMAL:
          pdMu[i] = TruncNormalRandom (M_post, S_post,
                                       pmc->rgpMCVar[i]->uMin.dval,
                                       pmc->rgpMCVar[i]->uMax.dval);
          break;

        case MCV_TRUNCLOGNORMAL: /* M_post and S_post are in log space */
          pdMu[i] = TruncLogNormalRandom (M_post, S_post,
                                          pmc->rgpMCVar[i]->uMin.dval,
                                          pmc->rgpMCVar[i]->uMax.dval);
          break;

        case MCV_UNIFORM:
          pdMu[i] = TruncNormalRandom (dSum, dSig, pmc->rgpMCVar[i]->uMin.dval,
                                       pmc->rgpMCVar[i]->uMax.dval);
          break;

        case MCV_LOGUNIFORM:
          pdMu[i] = TruncLogNormalRandom (dSum, dSig,
                                          pmc->rgpMCVar[i]->uMin.dval,
                                          pmc->rgpMCVar[i]->uMax.dval);
          break;

        /* no default because screening already done */
      }

    } /* fot i */
  } /* if */

} /* Sample_mu */


/* -----------------------------------------------------------------------------
   Sample_sigma

   Samples each SD pdSigma from the conditional: 
     P(pdSigma^2 | y, pdTheta) ~ Inverse gamma,
   which implies a uniform prior for ln(pdSigma).

   A lognormal distribution of errors is assumed.
   It always jump, unless numerical error in the model computation.
   
   All that can be changed if different error distributions are specified.
*/

void Sample_sigma (PANALYSIS panal, double *pdData, double *pdPred, 
                   long nSubjects, long *plSubjectsIndex, long *plSigmaIndex, 
                   long nData, long nSigma, double **pdTheta, double *pdSigma)
{
  register long i, j, nObs;
  double dTmp, rgdSum;

  /* Find yhat for all subjects
   */
  if (!bModelComputed) {
    i = 0;
    bModelComputed = Estimate_y (panal, i, plSubjectsIndex, pdTheta[i], pdPred);
    while (bModelComputed && (i < nSubjects)) {
      bModelComputed = Estimate_y (panal, i, plSubjectsIndex, pdTheta[i], 
                                   pdPred);
      i++;
    }
  }

  if (bModelComputed) {
    for (i = 0; i < nSigma; i++) {

      nObs = 0;
      rgdSum = 0.0;
      for (j = 0; j < nData; j++) {
        if (plSigmaIndex[j] == i) {
          if ((pdPred[j] > 0) && (pdData[j] != MISSING_VALUE)) {
            dTmp = log (pdPred[j] / pdData[j]);
            rgdSum = rgdSum + dTmp * dTmp;
            nObs = nObs + 1;
          }
          else {
            if (pdPred[j] <= 0) {
              printf ("Warning: y[%ld] estimate = %g < 0\n", j, pdPred[j]);
              printf ("         coded as missing value - Continuing\n");
            }
          }
        } /* if plSigmaIndex */
      } /* for j */

      if (nObs != 0) pdSigma[i] = sqrt(rgdSum/Chi2Random((double) nObs));
      else {
        printf ("Error: all values missing in Sample_sigma\n");
        printf ("       Exiting.\n");
        exit(0);
      }

    } /* for i */
  } /* if */

  else printf ("pdSigma not updated - Continuing.");

} /* Sample_sigma */


/* ----------------------------------------------------------------------------
   LnLikelihood

   returns the log-likelihood of the data given f(pdTheta) and sigma2.

   Note that this assume a log-normal distribution of experimental
   errors. This is up to a constant (pi factor neglected).

   You should not attempt to access directly the simulation results in the
   structure panal. Use only the pdPred array. You can recover its layout
   through panal information about array length, though.
*/

double LnLikelihood (PANALYSIS panal, double *pdData, double *pdPred, 
                     long *plSigmaIndex, long nData, double *pdSigma, 
                     long nSigma)
{
  long i;
  double dLnLike;
  double dTmp;

  dLnLike = 0.0;

  for (i = 0; i < nData; i++) {
    if ((pdPred[i] > 0) && (pdData[i] != MISSING_VALUE)) {
      dTmp = log (pdPred[i] / pdData[i]) / pdSigma[plSigmaIndex[i]];
      dLnLike = dLnLike - log(pdSigma[plSigmaIndex[i]]) - 0.5 * dTmp * dTmp;
    }
    else {
      if (pdPred[i] <= 0) {
        printf ("Warning: y[%ld] estimate = %g < 0\n", i, pdPred[i]);
        printf ("         coded as missing value - Continuing\n");
      }
    }
  } /* for i */

  return dLnLike;
  
} /* LnLikelihood */


/* End */


