Diff for /imach/src/imach.c between versions 1.93 and 1.94

version 1.93, 2003/06/25 16:33:55 version 1.94, 2003/06/27 13:00:02
Line 1 Line 1
 /* $Id$  /* $Id$
   $State$    $State$
   $Log$    $Log$
     Revision 1.94  2003/06/27 13:00:02  brouard
     Just cleaning
   
   Revision 1.93  2003/06/25 16:33:55  brouard    Revision 1.93  2003/06/25 16:33:55  brouard
   (Module): On windows (cygwin) function asctime_r doesn't    (Module): On windows (cygwin) function asctime_r doesn't
   exist so I changed back to asctime which exists.    exist so I changed back to asctime which exists.
Line 242  char command[FILENAMELENGTH]; Line 245  char command[FILENAMELENGTH];
 int  outcmd=0;  int  outcmd=0;
   
 char fileres[FILENAMELENGTH], filerespij[FILENAMELENGTH], filereso[FILENAMELENGTH], rfileres[FILENAMELENGTH];  char fileres[FILENAMELENGTH], filerespij[FILENAMELENGTH], filereso[FILENAMELENGTH], rfileres[FILENAMELENGTH];
 char lfileres[FILENAMELENGTH];  
 char filelog[FILENAMELENGTH]; /* Log file */  char filelog[FILENAMELENGTH]; /* Log file */
 char filerest[FILENAMELENGTH];  char filerest[FILENAMELENGTH];
 char fileregp[FILENAMELENGTH];  char fileregp[FILENAMELENGTH];
Line 562  void free_ma3x(double ***m, long nrl, lo Line 565  void free_ma3x(double ***m, long nrl, lo
   free((FREE_ARG)(m+nrl-NR_END));    free((FREE_ARG)(m+nrl-NR_END));
 }  }
   
   /*************** function subdirf ***********/
   char *subdirf(char fileres[])
   {
     /* Caution optionfilefiname is hidden */
     strcpy(tmpout,optionfilefiname);
     strcat(tmpout,"/"); /* Add to the right */
     strcat(tmpout,fileres);
     return tmpout;
   }
   
   /*************** function subdirf2 ***********/
   char *subdirf2(char fileres[], char *preop)
   {
     
     /* Caution optionfilefiname is hidden */
     strcpy(tmpout,optionfilefiname);
     strcat(tmpout,"/");
     strcat(tmpout,preop);
     strcat(tmpout,fileres);
     return tmpout;
   }
   
   /*************** function subdirf3 ***********/
   char *subdirf3(char fileres[], char *preop, char *preop2)
   {
     
     /* Caution optionfilefiname is hidden */
     strcpy(tmpout,optionfilefiname);
     strcat(tmpout,"/");
     strcat(tmpout,preop);
     strcat(tmpout,preop2);
     strcat(tmpout,fileres);
     return tmpout;
   }
   
 /***************** f1dim *************************/  /***************** f1dim *************************/
 extern int ncom;   extern int ncom; 
 extern double *pcom,*xicom;  extern double *pcom,*xicom;
Line 1219  double func( double *x) Line 1257  double func( double *x)
           oldm=newm;            oldm=newm;
         } /* end mult */          } /* end mult */
               
         /*lli=log(out[s[mw[mi][i]][i]][s[mw[mi+1][i]][i]]);*/ /* Original formula */  
         /* But now since version 0.9 we anticipate for bias and large stepm.  
          * If stepm is larger than one month (smallest stepm) and if the exact delay   
          * (in months) between two waves is not a multiple of stepm, we rounded to   
          * the nearest (and in case of equal distance, to the lowest) interval but now  
          * we keep into memory the bias bh[mi][i] and also the previous matrix product  
          * (i.e to dh[mi][i]-1) saved in 'savm'. The we inter(extra)polate the  
          * probability in order to take into account the bias as a fraction of the way  
          * from savm to out if bh is neagtive or even beyond if bh is positive. bh varies  
          * -stepm/2 to stepm/2 .  
          * For stepm=1 the results are the same as for previous versions of Imach.  
          * For stepm > 1 the results are less biased than in previous versions.   
          */  
         s1=s[mw[mi][i]][i];          s1=s[mw[mi][i]][i];
         s2=s[mw[mi+1][i]][i];          s2=s[mw[mi+1][i]][i];
         bbh=(double)bh[mi][i]/(double)stepm;           bbh=(double)bh[mi][i]/(double)stepm; 
         /* bias is positive if real duration  
          * is higher than the multiple of stepm and negative otherwise.  
          */  
         lli= (savm[s1][s2]>(double)1.e-8 ?log((1.+bbh)*out[s1][s2]- bbh*(savm[s1][s2])):log((1.+bbh)*out[s1][s2])); /* linear interpolation */          lli= (savm[s1][s2]>(double)1.e-8 ?log((1.+bbh)*out[s1][s2]- bbh*(savm[s1][s2])):log((1.+bbh)*out[s1][s2])); /* linear interpolation */
         /* lli= (savm[s1][s2]>1.e-8 ?(1.+bbh)*log(out[s1][s2])- bbh*log(savm[s1][s2]):log((1.+bbh)*out[s1][s2]));*/  
         /*lli= (savm[s1][s2]>1.e-8 ?(1.+bbh)*log(out[s1][s2])- bbh*log(savm[s1][s2]):log((1.-+bh)*out[s1][s2])); */ /* exponential interpolation */  
         /*lli=(1.+bbh)*log(out[s1][s2])- bbh*log(savm[s1][s2]);*/  
         /*if(lli ==000.0)*/  
         /*printf("bbh= %f lli=%f savm=%f out=%f %d\n",bbh,lli,savm[s1][s2], out[s[mw[mi][i]][i]][s[mw[mi+1][i]][i]],i); */  
         ipmx +=1;          ipmx +=1;
         sw += weight[i];          sw += weight[i];
         ll[s[mw[mi][i]][i]] += 2*weight[i]*lli;          ll[s[mw[mi][i]][i]] += 2*weight[i]*lli;
Line 1270  double func( double *x) Line 1287  double func( double *x)
           oldm=newm;            oldm=newm;
         } /* end mult */          } /* end mult */
               
         /*lli=log(out[s[mw[mi][i]][i]][s[mw[mi+1][i]][i]]);*/ /* Original formula */  
         /* But now since version 0.9 we anticipate for bias and large stepm.  
          * If stepm is larger than one month (smallest stepm) and if the exact delay   
          * (in months) between two waves is not a multiple of stepm, we rounded to   
          * the nearest (and in case of equal distance, to the lowest) interval but now  
          * we keep into memory the bias bh[mi][i] and also the previous matrix product  
          * (i.e to dh[mi][i]-1) saved in 'savm'. The we inter(extra)polate the  
          * probability in order to take into account the bias as a fraction of the way  
          * from savm to out if bh is neagtive or even beyond if bh is positive. bh varies  
          * -stepm/2 to stepm/2 .  
          * For stepm=1 the results are the same as for previous versions of Imach.  
          * For stepm > 1 the results are less biased than in previous versions.   
          */  
         s1=s[mw[mi][i]][i];          s1=s[mw[mi][i]][i];
         s2=s[mw[mi+1][i]][i];          s2=s[mw[mi+1][i]][i];
         bbh=(double)bh[mi][i]/(double)stepm;           bbh=(double)bh[mi][i]/(double)stepm; 
         /* bias is positive if real duration  
          * is higher than the multiple of stepm and negative otherwise.  
          */  
         /* lli= (savm[s1][s2]>(double)1.e-8 ?log((1.+bbh)*out[s1][s2]- bbh*(savm[s1][s2])):log((1.+bbh)*out[s1][s2])); */ /* linear interpolation */  
         lli= (savm[s1][s2]>1.e-8 ?(1.+bbh)*log(out[s1][s2])- bbh*log(savm[s1][s2]):log((1.+bbh)*out[s1][s2])); /* exponential inter-extrapolation */          lli= (savm[s1][s2]>1.e-8 ?(1.+bbh)*log(out[s1][s2])- bbh*log(savm[s1][s2]):log((1.+bbh)*out[s1][s2])); /* exponential inter-extrapolation */
         /*lli=(1.+bbh)*log(out[s1][s2])- bbh*log(savm[s1][s2]);*/  
         /*if(lli ==000.0)*/  
         /*printf("bbh= %f lli=%f savm=%f out=%f %d\n",bbh,lli,savm[s1][s2], out[s[mw[mi][i]][i]][s[mw[mi+1][i]][i]],i); */  
         ipmx +=1;          ipmx +=1;
         sw += weight[i];          sw += weight[i];
         ll[s[mw[mi][i]][i]] += 2*weight[i]*lli;          ll[s[mw[mi][i]][i]] += 2*weight[i]*lli;
Line 1459  double funcone( double *x) Line 1456  double funcone( double *x)
   return -l;    return -l;
 }  }
   
 char *subdirf(char fileres[])  
 {  
   /* Caution optionfilefiname is hidden */  
   strcpy(tmpout,optionfilefiname);  
   strcat(tmpout,"/"); /* Add to the right */  
   strcat(tmpout,fileres);  
   return tmpout;  
 }  
   
 char *subdirf2(char fileres[], char *preop)  
 {  
     
   strcpy(tmpout,optionfilefiname);  
   strcat(tmpout,"/");  
   strcat(tmpout,preop);  
   strcat(tmpout,fileres);  
   return tmpout;  
 }  
 char *subdirf3(char fileres[], char *preop, char *preop2)  
 {  
     
   strcpy(tmpout,optionfilefiname);  
   strcat(tmpout,"/");  
   strcat(tmpout,preop);  
   strcat(tmpout,preop2);  
   strcat(tmpout,fileres);  
   return tmpout;  
 }  
   
   /*************** function likelione ***********/
 void likelione(FILE *ficres,double p[], int npar, int nlstate, int *globpri, long *ipmx, double *sw, double *fretone, double (*funcone)(double []))  void likelione(FILE *ficres,double p[], int npar, int nlstate, int *globpri, long *ipmx, double *sw, double *fretone, double (*funcone)(double []))
 {  {
   /* This routine should help understanding what is done with     /* This routine should help understanding what is done with 
Line 3751  int fileappend(FILE *fichier, char *opti Line 3721  int fileappend(FILE *fichier, char *opti
   fflush(fichier);    fflush(fichier);
   return (1);    return (1);
 }  }
   
   
   /**************** function prwizard **********************/
 void prwizard(int ncovmodel, int nlstate, int ndeath,  char model[], FILE *ficparo)  void prwizard(int ncovmodel, int nlstate, int ndeath,  char model[], FILE *ficparo)
 {  {
   
     /* Wizard to print covariance matrix template */
   
   char ca[32], cb[32], cc[32];    char ca[32], cb[32], cc[32];
   int i,j, k, l, li, lj, lk, ll, jj, npar, itimes;    int i,j, k, l, li, lj, lk, ll, jj, npar, itimes;
   int numlinepar;    int numlinepar;
Line 4009  int main(int argc, char *argv[]) Line 3984  int main(int argc, char *argv[])
  optionfilext=%s\n\   optionfilext=%s\n\
  optionfilefiname=%s\n",pathtot,path,optionfile,optionfilext,optionfilefiname);   optionfilefiname=%s\n",pathtot,path,optionfile,optionfilext,optionfilefiname);
   
   printf("Localtime (at start):%s",strstart);    printf("Local time (at start):%s",strstart);
   fprintf(ficlog,"Localtime (at start): %s",strstart);    fprintf(ficlog,"Local time (at start): %s",strstart);
   fflush(ficlog);    fflush(ficlog);
 /*   (void) gettimeofday(&curr_time,&tzp); */  /*   (void) gettimeofday(&curr_time,&tzp); */
 /*   printf("Elapsed time %d\n", asc_diff_time(curr_time.tv_sec-start_time.tv_sec,tmpout)); */  /*   printf("Elapsed time %d\n", asc_diff_time(curr_time.tv_sec-start_time.tv_sec,tmpout)); */
Line 4586  Title=%s <br>Datafile=%s Firstpass=%d La Line 4561  Title=%s <br>Datafile=%s Firstpass=%d La
   strcpy(pathr,path);    strcpy(pathr,path);
   strcat(pathr,optionfilefiname);    strcat(pathr,optionfilefiname);
   chdir(optionfilefiname); /* Move to directory named optionfile */    chdir(optionfilefiname); /* Move to directory named optionfile */
   strcpy(lfileres,fileres);  
   strcat(lfileres,"/");  
   strcat(lfileres,optionfilefiname);  
       
   /* Calculates basic frequencies. Computes observed prevalence at single age    /* Calculates basic frequencies. Computes observed prevalence at single age
      and prints on file fileres'p'. */       and prints on file fileres'p'. */
Line 5129  ageminpar, agemax, s[lastpass][imx], age Line 5101  ageminpar, agemax, s[lastpass][imx], age
   tm = *localtime(&end_time.tv_sec);    tm = *localtime(&end_time.tv_sec);
   tmg = *gmtime(&end_time.tv_sec);    tmg = *gmtime(&end_time.tv_sec);
   strcpy(strtend,asctime(&tm));    strcpy(strtend,asctime(&tm));
   printf("Localtime at start %s\nLocaltime at end   %s",strstart, strtend);     printf("Local time at start %s\nLocaltime at end   %s",strstart, strtend); 
   fprintf(ficlog,"Localtime at start %s\nLocal time at end   %s\n",strstart, strtend);     fprintf(ficlog,"Local time at start %s\nLocal time at end   %s\n",strstart, strtend); 
   printf("Total time used %s\n", asc_diff_time(end_time.tv_sec -start_time.tv_sec,tmpout));    printf("Total time used %s\n", asc_diff_time(end_time.tv_sec -start_time.tv_sec,tmpout));
   
   printf("Total time was %d Sec.\n", end_time.tv_sec -start_time.tv_sec);    printf("Total time was %d Sec.\n", end_time.tv_sec -start_time.tv_sec);

Removed from v.1.93  
changed lines
  Added in v.1.94


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>