/* Sidst modificeret: 09/07/99  udskrivning af mean af lin. pred. */
/* og der forespoerges om program skal terminere efter foerste runde */
/* endvidere er double aendret til double alle steder */
/* 13.07.99: Lidt aendringer i udskrivning af acceptrater  */
/* 19.07.99: nedre graense (alpha_low) for corr. parameter er tilfoejet */
/* 25.07.99: ogsaa naar newrun=0 saettes meanlambda etc. lig nul.  */
/* 26.07.99: %s i scanf og fscanf er aendret til %c ellers skrives et '\0' der kan slette en anden variabel efter answer */ 
/* 10.08.99: seed udskrives og indlaeses hvis newrun=0  og sidste meany, etc. indlaeses i initialize*/
/* 11.08.99: Vi bruger Mersenne twister istedet for drand48(). Udregningerne af meany etc. er ogsaa aendret lidt  */
/* 26.08.99: Vi indfoere trunkering af gradienter  */
/* 01.09.99: Vi beregner ogsaa forv. normerede residualer */
/* 29.10.99: logprior for sigma i MH ratio  */
/* 29.20.99: fejl rettet, vi multiplicerer nu ogsaa komplekse indgange i MT_MALAhelp.c  */
/*03.01.00 Dette program inddrager ogsaa population density  */
/*31.07.02 Bruger nu fft fra sunperf   */
/*31.07.02 introduce cellareas : area of intersection of cell with obs window 
  positive ensb. is_observed =1 */
/* NB:  i sunperf betegner M antal raekker og N antal soejler - vi bruger nu denne  konvention. Og i index(i,j) indicerer i raekker og j soejler og vi lader y-koordinat svare til soejler og x koordinat til raekker  x=i=raekke (M)  y=j=soejle (N)*/
/* bruger _64 bit versionerne af fft-rutinerne - da er det noedvendigt at kompilere med xarch=v9  */
/* NB float eller double har stort set ingen indflydelse paa koerselstid  */
/* 31.07.02 indfoert proc index og index_orig */
/* 20.05.03 raekkefoelge af fft og inv. fft nu som i Oles note  - faktisk har raekkefoelgen ingen betydning for reelle del af output mens im. del blot skifter fortegn. */
/* 21.05.03 rettet fejl i index og index_orig (M->N og Morig->Norig)  */
/* 14.10.05 laver version hvor med generisk fft procedure navne. Procedurerne er saa specificeret i fft.c. Bruger fftw biblioteket */

#include "LH.h"

#define INITZdata 0

main()
{
  fftstruct *S, *y, *z, *gradz, *gradzprop, *zprop, *yprop, *Sprop, *temp;
  Doublearray expyprop, expy,  meany, meanlambda, ssy, sslambda, obsdata, linpred, linpredprop, X, meanlinpred, residuals, popdensity, temp3, cellareas;
  int *is_observed;
  int i, j, l;
  double sigma, alpha;
  double scale;
  FILE *indfil;
  FILE *timeout;
  char fn[40];
  double logfbet, logfbetprop, ssz, sszprop, qzzprop, qzpropz;
  int itr, newrun;
  int SUBSAMPLE, INTERMED_PRINT;
  double sigmascale, betascale, alphascale;
  double alphaprop, sigmaprop, alpha_up, alpha_low;
  double logqprop, logq;
  double u1, u2;
  int parm_updated;
  int accept, acceptalpha, acceptbeta, acceptsigma;
  Doublearray beta, betaprop; /* indeholder parametre for linear prediktor */
  int no_linpar;
  int dummy;
  int startitr;
  double temp2, lambdasum;
  double Hz, Hbeta; /* truncation constants  */
  


  /* read input parameters */
  parmread(&newrun,&itr,&scale,&betascale,&sigmascale,&alphascale,&SUBSAMPLE,&INTERMED_PRINT,&startitr,&no_linpar,&sigma,&alpha,&alpha_low,&alpha_up,&Hz,&Hbeta);
  
  /* pointers (arrays) are initialized */
  initialize(&y,&z,&gradz,&gradzprop,&zprop,&yprop,&expyprop,&expy,&S,&Sprop,&meany,&meanlambda,&ssy,&sslambda,&obsdata,&linpred,&linpredprop,&meanlinpred,&is_observed,newrun,&X,&beta,&betaprop,no_linpar,&residuals,&cellareas,&popdensity);

  init_print(newrun);
  init_termmode();

  divNM=NM; /* this integer to double conversion actually speeds the program up whent divNM instead of NM is used for divisions below */  
  

  read_points_X_scale(obsdata,X,is_observed,no_linpar,popdensity,cellareas);

  /* calc upper limit for alpha */
  while (sqrteigen_values(S,alpha_up+0.01))
    alpha_up+=0.01;
  
  printf("upper limit for alpha: %f\n",alpha_up);
  
  
  
  /* calculate sqrt of eigenvalues of circulant correlationmatrix */
  if (!sqrteigen_values(S,alpha)){
    printf("negative eigenvalue - exit \n");
    exit(1); 
  } 
  
  calclinpred(beta,X,linpred,no_linpar,is_observed,popdensity);

  if (newrun && INITZdata) /* beregner initielt z udfra obs data */
    initz(z,S,obsdata,linpred,is_observed,sigma,divNM,cellareas);
  
  if (newrun)
    init_genrand(4357);
  else
    read_seed();

  if (newrun){
    sprintf(fn,"timeseries.out"); 
    timeout=fopen(fn,"w"); 
    sprintf(fn,"acceptrates.out");
    acceptrates=fopen(fn,"w");
  } 
  else {
    sprintf(fn,"timeseries.out"); 
    timeout=fopen(fn,"a"); 
    sprintf(fn,"acceptrates.out");
    acceptrates=fopen(fn,"a");
  }

  accept=acceptalpha=acceptbeta=acceptsigma=0; logfbet=0; logfbetprop=0;
 
  
  /* the Markov chain is initialized in the unconditional mean unless you wish
     to specify another initial value than z=0 */
  
  conddensity_grad(y,S,sigma,gradz,&logfbet,&ssz,obsdata,is_observed,z,divNM,linpred,Hz,cellareas);

  
  if (DEBUG)
    printvariables2(sigma,y,linpred);
  
  /* (the conditional density for the initial state is now calculated) */
  

  while (continue_sim()){
    /* The Markov chain iterations begin */
    for (i=startitr; i<itr+startitr; i++){
       if (scale>0){
        /* calculate proposal  */
        for (j=0; j<NM; j++){
	  (*zprop).x[j][0]=(*z).x[j][0]+0.5*(*gradz).x[j][0]*scale;
	  (*zprop).x[j][1]=0;
        }
        addGauss(zprop,scale);
	conddensity_grad(yprop,S,sigma,gradzprop,&logfbetprop,&sszprop,obsdata,is_observed,zprop,divNM,linpred,Hz,cellareas);
	qzzprop=0; qzpropz=0;
      

	for (j=0; j<NM; j++){
	  qzzprop+=pow((*zprop).x[j][0]-((*z).x[j][0]+0.5*(*gradz).x[j][0]*scale),2);
	  qzpropz+=pow((*z).x[j][0]-((*zprop).x[j][0]+0.5*(*gradzprop).x[j][0]*scale),2);
	}
      
	qzzprop*=(-0.5/scale);
	qzpropz*=(-0.5/scale);
	/* 
	   printf("logfbetprop, logfbet, qzpropz, qzzprop %f %f %f %f\n",logfbetprop,logfbet,qzpropz,qzzprop); */
	if (log(ran())<logfbetprop+sszprop+qzpropz-logfbet-ssz-qzzprop){
	  /*accept */
	  logfbet=logfbetprop;
	  ssz=sszprop;
	  temp=gradz;
	  gradz=gradzprop;
	  gradzprop=temp;
	  temp=y;
	  y=yprop;
	  yprop=temp;
	  temp=z;
	  z=zprop;
	  zprop=temp;
	  accept++;
	}
      }

      parm_updated=0;
      
      if (alphascale>0){
	/* opdatering af alpha (her benyttes simple rw-proposal  */
	alphaproposal(alpha,&alphaprop,alphascale,&logqprop,&logq);     
	if ((alphaprop<alpha_up) && (alphaprop>alpha_low)){
	  dummy=sqrteigen_values(Sprop,alphaprop);
	  conddensity_alpha(yprop,Sprop,sigma,&logfbetprop,obsdata,is_observed,z,divNM,linpred,cellareas);
	  /* printf("alpha, alphaprop, diff %f %f %f\n",alpha,alphaprop,alphaprop-alpha);
	     printf("alpha, alphaprop, logfbet logfbetprop logq logqprop: %f %f %f %f %f %f\n",alpha,alphaprop,logfbet,logfbetprop,logq,logqprop); */
	  if (log(ran())<logfbetprop-logfbet+logqprop-logq+logprior(alphaprop,alpha_up)-logprior(alpha,alpha_up)){
	    /*accept */
	    alpha=alphaprop;
	    logfbet=logfbetprop;
	    temp=S;
	    S=Sprop;
	    Sprop=temp;
	    temp=y;
	    y=yprop;
	    yprop=temp;
	    acceptalpha++;
	    parm_updated=1;
	  } /* if accept */
	} /* if within limits */
      }  /* if pos. alphascale */
      
           
      /* opdatering af beta og sigma (her benyttes MALA-update) */

      gauss_sim(&u1,&u2); 

      if (betascale>0){
	betaproposal(beta,betaprop,X,betascale,&logq,&logqprop,linpred,linpredprop,is_observed,&logfbetprop,no_linpar,obsdata,sigma,y,Hbeta,popdensity,cellareas); 
	/* printf("alpha %lf sigma %lf y[0] %lf beta, betaprop, logfbet logfbetprop logq logqprop: %lf %lf %lf %lf %lf %lf\n",alpha,sigma,(*y).x[0][0],beta[0],betaprop[0],logfbet,logfbetprop,logq,logqprop); */
        
	if (log(ran())<logfbetprop-logfbet+logqprop-logq){
	  /*accept */
	  temp3=beta;
	  beta=betaprop;
	  betaprop=temp3;
	  temp3=linpred;
	  linpred=linpredprop;
	  linpredprop=temp3;
	  logfbet=logfbetprop;
	  acceptbeta++;
	  parm_updated=1;
	}
      }

      if (sigmascale>0){
	sigmaproposal_rw(sigma,&sigmaprop,sigmascale,u2,&logq,&logqprop,linpred,is_observed,&logfbetprop,y,obsdata,cellareas);
	/* printf("sigma, sigmprop, logfbet logfbetprop logq logqprop: %f %f %f %f %f %f\n",sigma,sigmaprop,logfbet,logfbetprop,logq,logqprop); */
	if (sigmaprop>0){
	  if (log(ran())<logfbetprop-logfbet+logqprop-logq+logprior_sigma(sigmaprop)-logprior_sigma(sigma)){
	    /*accept */
	    sigma=sigmaprop;
	    logfbet=logfbetprop;
	    acceptsigma++;
	    parm_updated=1;
	  }
	}
      }

      if (parm_updated)
	update_grad(y,gradz,S,z,divNM,obsdata,is_observed,sigma,linpred,Hz,cellareas);

      if ((i+1)%SUBSAMPLE==0){
	partimeprint(beta,no_linpar,sigma,alpha,logfbet,ssz);
        lambdasum=0;
	for (l=0; l<Morig; l++)
	  for (j=0; j<Norig; j++){
	    temp2=sigma*(*y).x[index(l,j)][0];
	    if (l==0 && j==0)
	      printf("temp2: %e %e %e\n",temp2,meany[0],meany[index_orig(l,j)]);
	    meany[index_orig(l,j)]+=temp2;
	    ssy[index_orig(l,j)]+=pow(temp2,2);
	    temp2=exp(linpred[index_orig(l,j)]+sigma*(*y).x[index(l,j)][0]);
            lambdasum+=temp2;
	    meanlambda[index_orig(l,j)]+=temp2;
	    sslambda[index_orig(l,j)]+=pow(temp2,2);
	    meanlinpred[index_orig(l,j)]+=linpred[index_orig(l,j)];
	    residuals[index_orig(l,j)]+=(obsdata[index_orig(l,j)]-temp2)/sqrt(temp2);
	  }
	printf("lambdasum %e\n",lambdasum);
        /* if ((i+1)%(5*SUBSAMPLE)==0) */
	/* ys_print(timeout,y,sigma,lambdasum); */
      }

      if ((i+1)%ACCEPTSAMPLE==0){
	fprintf(acceptrates,"%d %1.2f %1.2f %1.2f %1.2f %f\n",i+1,(double) accept / ACCEPTSAMPLE,(double) acceptbeta/ ACCEPTSAMPLE,(double) acceptsigma/ ACCEPTSAMPLE, (double) acceptalpha/ ACCEPTSAMPLE,alpha);
	/* printf("i: %d rate: %1.2f %1.2f %1.2f %1.2f alpha: %f\n",i+1,(double) accept / ACCEPTSAMPLE,(double) acceptbeta/ ACCEPTSAMPLE,(double) acceptsigma/ ACCEPTSAMPLE, (double) acceptalpha/ ACCEPTSAMPLE,alpha); */
	fflush(acceptrates);
	fflush(timeout);
	accept=acceptalpha=acceptbeta=acceptsigma=0;
      }


      if ((i+1)%INTERMED_PRINT==0)
	print_results(z,meany,meanlambda,ssy,sslambda,meanlinpred,i,no_linpar,sigma,alpha,alpha_low,alpha_up,beta,residuals);

      if ((i+1)%(itr/NOENVE)==0)
	print_y(y,sigma,beta,no_linpar,alpha,linpred);
      
    } /* end of MC */    
    
    continue_wish();
 
    if (continue_sim()){
      sprintf(fn,"LH.in");
      indfil=fopen(fn,"r");
      fscanf(indfil,"%d%d%lf%lf%lf%lf%d%d",&newrun,&itr,&scale,&betascale,&sigmascale,&alphascale,&SUBSAMPLE,&INTERMED_PRINT);
      fclose(indfil);  
    }
  }/* end while */

  fclose(timeout); fclose(acceptrates);
  close_print();
  print_seed();  

  print_results(z,meany,meanlambda,ssy,sslambda,meanlinpred,i,no_linpar,sigma,alpha,alpha_low,alpha_up,beta,residuals); 
 
  return 0;
}

