/* $Id$
$State$
$Log$
+ Revision 1.84 2003/06/13 21:44:43 brouard
+ * imach.c (Repository): Replace "freqsummary" at a correct
+ place. It differs from routine "prevalence" which may be called
+ many times. Probs is memory consuming and must be used with
+ parcimony.
+ Version 0.95a2 (should output exactly the same maximization than 0.8a2)
+
Revision 1.83 2003/06/10 13:39:11 lievre
*** empty log message ***
#define MAXLINE 256
#define GNUPLOTPROGRAM "gnuplot"
/*#define GNUPLOTPROGRAM "..\\gp37mgw\\wgnuplot"*/
-#define FILENAMELENGTH 80
+#define FILENAMELENGTH 132
/*#define DEBUG*/
-#define windows
+/*#define windows*/
#define GLOCK_ERROR_NOPATH -1 /* empty path */
#define GLOCK_ERROR_GETCWD -2 /* cannot get cwd */
#define YEARM 12. /* Number of months per year */
#define AGESUP 130
#define AGEBASE 40
-#ifdef windows
-#define DIRSEPARATOR '\\'
-#define ODIRSEPARATOR '/'
-#else
+#ifdef unix
#define DIRSEPARATOR '/'
#define ODIRSEPARATOR '\\'
+#else
+#define DIRSEPARATOR '\\'
+#define ODIRSEPARATOR '/'
#endif
/* $Id$ */
double **oldms, **newms, **savms; /* Fixed working pointers to matrices */
FILE *fic,*ficpar, *ficparo,*ficres, *ficrespl, *ficrespij, *ficrest,*ficresf,*ficrespop;
FILE *ficlog, *ficrespow;
+int globpr; /* Global variable for printing or not */
+double fretone; /* Only one call to likelihood */
+long ipmx; /* Number of contributions */
+double sw; /* Sum of weights */
+char fileresilk[FILENAMELENGTH]; /* File of individual contributions to the likelihood */
+FILE *ficresilk;
FILE *ficgp,*ficresprob,*ficpop, *ficresprobcov, *ficresprobcor;
FILE *ficresprobmorprev;
FILE *fichtm; /* Html File */
/* Estepm, step in month to interpolate survival function in order to approximate Life Expectancy*/
int m,nb;
-int *num, firstpass=0, lastpass=4,*cod, *ncodemax, *Tage;
+long *num;
+int firstpass=0, lastpass=4,*cod, *ncodemax, *Tage;
double **agev,*moisnais, *annais, *moisdc, *andc,**mint, **anint;
double **pmmij, ***probs;
double dateintmean=0;
dirc[l1-l2] = 0; /* add zero */
}
l1 = strlen( dirc ); /* length of directory */
-#ifdef windows
+ /*#ifdef windows
if ( dirc[l1-1] != '\\' ) { dirc[l1] = '\\'; dirc[l1+1] = 0; }
#else
if ( dirc[l1-1] != '/' ) { dirc[l1] = '/'; dirc[l1+1] = 0; }
#endif
+ */
ss = strrchr( name, '.' ); /* find last / */
ss++;
strcpy(ext,ss); /* save extension */
}
/************************ivector *******************************/
-char *cvector(long nl,long nh)
+int *ivector(long nl,long nh)
{
- char *v;
- v=(char *) malloc((size_t)((nh-nl+1+NR_END)*sizeof(char)));
- if (!v) nrerror("allocation failure in cvector");
+ int *v;
+ v=(int *) malloc((size_t)((nh-nl+1+NR_END)*sizeof(int)));
+ if (!v) nrerror("allocation failure in ivector");
return v-nl+NR_END;
}
/******************free ivector **************************/
-void free_cvector(char *v, long nl, long nh)
+void free_ivector(int *v, long nl, long nh)
{
free((FREE_ARG)(v+nl-NR_END));
}
-/************************ivector *******************************/
-int *ivector(long nl,long nh)
+/************************lvector *******************************/
+long *lvector(long nl,long nh)
{
- int *v;
- v=(int *) malloc((size_t)((nh-nl+1+NR_END)*sizeof(int)));
+ long *v;
+ v=(long *) malloc((size_t)((nh-nl+1+NR_END)*sizeof(long)));
if (!v) nrerror("allocation failure in ivector");
return v-nl+NR_END;
}
-/******************free ivector **************************/
-void free_ivector(int *v, long nl, long nh)
+/******************free lvector **************************/
+void free_lvector(long *v, long nl, long nh)
{
free((FREE_ARG)(v+nl-NR_END));
}
for (i=nrl+1; i<=nrh; i++) m[i]=m[i-1]+ncol;
return m;
- /* print *(*(m+1)+70) ou print m[1][70]; print m+1 or print &(m[1])
+ /* print *(*(m+1)+70) or print m[1][70]; print m+1 or print &(m[1])
*/
}
ipmx +=1;
sw += weight[i];
ll[s[mw[mi][i]][i]] += 2*weight[i]*lli;
- /*printf("i=%6d s1=%1d s2=%1d mi=%1d mw=%1d dh=%3d prob=%10.6f w=%6.4f out=%10.6f sav=%10.6f\n",i,s1,s2,mi,mw[mi][i],dh[mi][i],exp(lli),weight[i],out[s1][s2],savm[s1][s2]);*/
+/* printf("i=%6d s1=%1d s2=%1d mi=%1d mw=%1d dh=%3d prob=%10.6f w=%6.4f out=%10.6f sav=%10.6f\n",i,s1,s2,mi,mw[mi][i],dh[mi][i],exp(lli),weight[i],out[s1][s2],savm[s1][s2]); */
} /* end of wave */
} /* end of individual */
}else{ /* ml=5 no inter-extrapolation no jackson =0.8a */
for(k=1,l=0.; k<=nlstate; k++) l += ll[k];
/* printf("l1=%f l2=%f ",ll[1],ll[2]); */
l= l*ipmx/sw; /* To get the same order of magnitude as if weight=1 for every body */
- /*exit(0); */
return -l;
}
+/*************** log-likelihood *************/
+double funcone( double *x)
+{
+ int i, ii, j, k, mi, d, kk;
+ double l, ll[NLSTATEMAX], cov[NCOVMAX];
+ double **out;
+ double lli; /* Individual log likelihood */
+ int s1, s2;
+ double bbh, survp;
+ /*extern weight */
+ /* We are differentiating ll according to initial status */
+ /* for (i=1;i<=npar;i++) printf("%f ", x[i]);*/
+ /*for(i=1;i<imx;i++)
+ printf(" %d\n",s[4][i]);
+ */
+ cov[1]=1.;
+
+ for(k=1; k<=nlstate; k++) ll[k]=0.;
+
+ for (i=1,ipmx=0, sw=0.; i<=imx; i++){
+ for (k=1; k<=cptcovn;k++) cov[2+k]=covar[Tvar[k]][i];
+ for(mi=1; mi<= wav[i]-1; mi++){
+ for (ii=1;ii<=nlstate+ndeath;ii++)
+ for (j=1;j<=nlstate+ndeath;j++){
+ oldm[ii][j]=(ii==j ? 1.0 : 0.0);
+ savm[ii][j]=(ii==j ? 1.0 : 0.0);
+ }
+ for(d=0; d<dh[mi][i]; d++){
+ newm=savm;
+ cov[2]=agev[mw[mi][i]][i]+d*stepm/YEARM;
+ for (kk=1; kk<=cptcovage;kk++) {
+ cov[Tage[kk]+2]=covar[Tvar[Tage[kk]]][i]*cov[2];
+ }
+ out=matprod2(newm,oldm,1,nlstate+ndeath,1,nlstate+ndeath,
+ 1,nlstate+ndeath,pmij(pmmij,cov,ncovmodel,x,nlstate));
+ savm=oldm;
+ oldm=newm;
+ } /* end mult */
+
+ s1=s[mw[mi][i]][i];
+ s2=s[mw[mi+1][i]][i];
+ bbh=(double)bh[mi][i]/(double)stepm;
+ /* bias is positive if real duration
+ * is higher than the multiple of stepm and negative otherwise.
+ */
+ if( s2 > nlstate && (mle <5) ){ /* Jackson */
+ lli=log(out[s1][s2] - savm[s1][s2]);
+ } else if (mle==1){
+ lli= log((1.+bbh)*out[s1][s2]- bbh*savm[s1][s2]); /* linear interpolation */
+ } else if(mle==2){
+ 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 */
+ } else if(mle==3){ /* exponential inter-extrapolation */
+ lli= (savm[s1][s2]>(double)1.e-8 ?(1.+bbh)*log(out[s1][s2])- bbh*log(savm[s1][s2]):log((1.+bbh)*out[s1][s2])); /* exponential inter-extrapolation */
+ } else if (mle==4){ /* mle=4 no inter-extrapolation */
+ lli=log(out[s1][s2]); /* Original formula */
+ } else{ /* ml>=5 no inter-extrapolation no jackson =0.8a */
+ lli=log(out[s1][s2]); /* Original formula */
+ } /* End of if */
+ ipmx +=1;
+ sw += weight[i];
+ ll[s[mw[mi][i]][i]] += 2*weight[i]*lli;
+/* printf("i=%6d s1=%1d s2=%1d mi=%1d mw=%1d dh=%3d prob=%10.6f w=%6.4f out=%10.6f sav=%10.6f\n",i,s1,s2,mi,mw[mi][i],dh[mi][i],exp(lli),weight[i],out[s1][s2],savm[s1][s2]); */
+ if(globpr){
+ fprintf(ficresilk,"%6d %1d %1d %1d %1d %3d %10.6f %6.4f %10.6f %10.6f %10.6f ", \
+ i,s1,s2,mi,mw[mi][i],dh[mi][i],exp(lli),weight[i],2*weight[i]*lli,out[s1][s2],savm[s1][s2]);
+ for(k=1,l=0.; k<=nlstate; k++)
+ fprintf(ficresilk," %10.6f",ll[k]);
+ fprintf(ficresilk,"\n");
+ }
+ } /* end of wave */
+ } /* end of individual */
+ for(k=1,l=0.; k<=nlstate; k++) l += ll[k];
+ /* printf("l1=%f l2=%f ",ll[1],ll[2]); */
+ l= l*ipmx/sw; /* To get the same order of magnitude as if weight=1 for every body */
+ return -l;
+}
+
+
+void likelione(FILE *ficres,double p[], int npar, int nlstate, int *globpr, long *ipmx, double *sw, double *fretone, double (*funcone)(double []))
+{
+ /* This routine should help understanding what is done with the selection of individuals/waves and
+ to check the exact contribution to the likelihood.
+ Plotting could be done.
+ */
+ int k;
+ if(globpr !=0){ /* Just counts and sums no printings */
+ strcpy(fileresilk,"ilk");
+ strcat(fileresilk,fileres);
+ if((ficresilk=fopen(fileresilk,"w"))==NULL) {
+ printf("Problem with resultfile: %s\n", fileresilk);
+ fprintf(ficlog,"Problem with resultfile: %s\n", fileresilk);
+ }
+ fprintf(ficresilk, "# individual(line's record) s1 s2 wave# effective_wave# number_of_product_matrix pij weight 2ln(pij)*weight 0pij_x 0pij_(x-stepm) cumulating_loglikeli_by_health_state");
+ fprintf(ficresilk, "# i s1 s2 mi mw dh likeli weight out sav ");
+ /* i,s1,s2,mi,mw[mi][i],dh[mi][i],exp(lli),weight[i],2*weight[i]*lli,out[s1][s2],savm[s1][s2]); */
+ for(k=1; k<=nlstate; k++)
+ fprintf(ficresilk," ll[%d]",k);
+ fprintf(ficresilk,"\n");
+ }
+
+ *fretone=(*funcone)(p);
+ if(globpr !=0)
+ fclose(ficresilk);
+ return;
+}
/*********** Maximum Likelihood Estimation ***************/
int i,j, iter;
double **xi;
double fret;
+ double fretone; /* Only one call to likelihood */
char filerespow[FILENAMELENGTH];
xi=matrix(1,npar,1,npar);
for (i=1;i<=npar;i++)
for(j=1;j<=nlstate+ndeath;j++)
if(j!=i)fprintf(ficrespow," p%1d%1d",i,j);
fprintf(ficrespow,"\n");
+
powell(p,xi,npar,ftol,&iter,&fret,func);
fclose(ficrespow);
wav[i]=mi;
if(mi==0){
if(first==0){
- printf("Warning! None valid information for:%d line=%d (skipped) and may be others, see log file\n",num[i],i);
+ printf("Warning! None valid information for:%ld line=%d (skipped) and may be others, see log file\n",num[i],i);
first=1;
}
if(first==1){
- fprintf(ficlog,"Warning! None valid information for:%d line=%d (skipped)\n",num[i],i);
+ fprintf(ficlog,"Warning! None valid information for:%ld line=%d (skipped)\n",num[i],i);
}
} /* end mi==0 */
} /* End individuals */
else{
if (s[mw[mi+1][i]][i] > nlstate) { /* A death */
if (agedc[i] < 2*AGESUP) {
- j= rint(agedc[i]*12-agev[mw[mi][i]][i]*12);
- if(j==0) j=1; /* Survives at least one month after exam */
- k=k+1;
- if (j >= jmax) jmax=j;
- if (j <= jmin) jmin=j;
- sum=sum+j;
- /*if (j<0) printf("j=%d num=%d \n",j,i);*/
- /* printf("%d %d %d %d\n", s[mw[mi][i]][i] ,s[mw[mi+1][i]][i],j,i);*/
- if(j<0)printf("Error! Negative delay (%d to death) between waves %d and %d of individual %d at line %d who is aged %.1f with statuses from %d to %d\n ",j,mw[mi][i],mw[mi+1][i],num[i], i,agev[mw[mi][i]][i],s[mw[mi][i]][i] ,s[mw[mi+1][i]][i]);
+ j= rint(agedc[i]*12-agev[mw[mi][i]][i]*12);
+ if(j==0) j=1; /* Survives at least one month after exam */
+ else if(j<0){
+ printf("Error! Negative delay (%d to death) between waves %d and %d of individual %ld at line %d who is aged %.1f with statuses from %d to %d\n ",j,mw[mi][i],mw[mi+1][i],num[i], i,agev[mw[mi][i]][i],s[mw[mi][i]][i] ,s[mw[mi+1][i]][i]);
+ j=1; /* Careful Patch */
+ printf(" We assumed that the date of interview was correct (and not the date of death) and postponed the death %d month(s) (one stepm) after the interview.\n You MUST fixe the contradiction between dates.\n",stepm);
+ printf("Error! Negative delay (%d to death) between waves %d and %d of individual %ld at line %d who is aged %.1f with statuses from %d to %d\n ",j,mw[mi][i],mw[mi+1][i],num[i], i,agev[mw[mi][i]][i],s[mw[mi][i]][i] ,s[mw[mi+1][i]][i]);
+ fprintf(ficlog," We assumed that the date of interview was correct (and not the date of death) and postponed the death %d month(s) (one stepm) after the interview.\n You MUST fix the contradiction between dates.\n",stepm);
+ }
+ k=k+1;
+ if (j >= jmax) jmax=j;
+ if (j <= jmin) jmin=j;
+ sum=sum+j;
+ /*if (j<0) printf("j=%d num=%d \n",j,i);*/
+ /* printf("%d %d %d %d\n", s[mw[mi][i]][i] ,s[mw[mi+1][i]][i],j,i);*/
}
}
else{
else if (j <= jmin)jmin=j;
/* if (j<10) printf("j=%d jmin=%d num=%d ",j,jmin,i); */
/*printf("%d %lf %d %d %d\n", i,agev[mw[mi][i]][i],j,s[mw[mi][i]][i] ,s[mw[mi+1][i]][i]);*/
- if(j<0)printf("Error! Negative delay (%d) between waves %d and %d of individual %d at line %d who is aged %.1f with statuses from %d to %d\n ",j,mw[mi][i],mw[mi+1][i],num[i], i,agev[mw[mi][i]][i],s[mw[mi][i]][i] ,s[mw[mi+1][i]][i]);
+ if(j<0){
+ printf("Error! Negative delay (%d) between waves %d and %d of individual %ld at line %d who is aged %.1f with statuses from %d to %d\n ",j,mw[mi][i],mw[mi+1][i],num[i], i,agev[mw[mi][i]][i],s[mw[mi][i]][i] ,s[mw[mi+1][i]][i]);
+ fprintf(ficlog,"Error! Negative delay (%d) between waves %d and %d of individual %ld at line %d who is aged %.1f with statuses from %d to %d\n ",j,mw[mi][i],mw[mi+1][i],num[i], i,agev[mw[mi][i]][i],s[mw[mi][i]][i] ,s[mw[mi+1][i]][i]);
+ }
sum=sum+j;
}
jk= j/stepm;
jl= j -jk*stepm;
ju= j -(jk+1)*stepm;
- if(mle <=1){
+ if(mle <=1){ /* only if we use a the linear-interpoloation pseudo-likelihood */
if(jl==0){
dh[mi][i]=jk;
bh[mi][i]=0;
bh[mi][i]=ju; /* At least one step */
/* printf(" bh=%d ju=%d jl=%d dh=%d jk=%d stepm=%d %d\n",bh[mi][i],ju,jl,dh[mi][i],jk,stepm,i);*/
}
- }
- } /* end if mle */
+ } /* end if mle */
+ }
} /* end wave */
}
jmean=sum/k;
fprintf(ficlog,"Problem with %s \n",optionfilehtm), exit(0);
}
- fprintf(fichtm,"<ul><li><h4>Result files (first order: no variance)</h4>\n
- - Observed prevalence in each state (during the period defined between %.lf/%.lf/%.lf and %.lf/%.lf/%.lf): <a href=\"p%s\">p%s</a> <br>\n
- - Estimated transition probabilities over %d (stepm) months: <a href=\"pij%s\">pij%s</a><br>\n
- - Stable prevalence in each health state: <a href=\"pl%s\">pl%s</a> <br>\n
- - Life expectancies by age and initial health status (estepm=%2d months):
+ fprintf(fichtm,"<ul><li><h4>Result files (first order: no variance)</h4>\n \
+ - Observed prevalence in each state (during the period defined between %.lf/%.lf/%.lf and %.lf/%.lf/%.lf): <a href=\"p%s\">p%s</a> <br>\n \
+ - Estimated transition probabilities over %d (stepm) months: <a href=\"pij%s\">pij%s</a><br>\n \
+ - Stable prevalence in each health state: <a href=\"pl%s\">pl%s</a> <br>\n \
+ - Life expectancies by age and initial health status (estepm=%2d months): \
<a href=\"e%s\">e%s</a> <br>\n</li>", \
jprev1, mprev1,anprev1,jprev2, mprev2,anprev2,fileres,fileres,stepm,fileres,fileres,fileres,fileres,estepm,fileres,fileres);
fprintf(fichtm," ************\n<hr size=\"2\" color=\"#EC5E5E\">");
}
/* Pij */
- fprintf(fichtm,"<br>- Pij or Conditional probabilities to be observed in state j being in state i, %d (stepm) months before: pe%s%d1.png<br>
+ fprintf(fichtm,"<br>- Pij or Conditional probabilities to be observed in state j being in state i, %d (stepm) months before: pe%s%d1.png<br> \
<img src=\"pe%s%d1.png\">",stepm,strtok(optionfile, "."),jj1,strtok(optionfile, "."),jj1);
/* Quasi-incidences */
- fprintf(fichtm,"<br>- Pij or Conditional probabilities to be observed in state j being in state i %d (stepm) months before but expressed in per year i.e. quasi incidences if stepm is small and probabilities too: pe%s%d2.png<br>
+ fprintf(fichtm,"<br>- Pij or Conditional probabilities to be observed in state j being in state i %d (stepm) months\
+ before but expressed in per year i.e. quasi incidences if stepm is small and probabilities too: pe%s%d2.png<br> \
<img src=\"pe%s%d2.png\">",stepm,strtok(optionfile, "."),jj1,strtok(optionfile, "."),jj1);
/* Stable prevalence in each health state */
for(cpt=1; cpt<nlstate;cpt++){
- fprintf(fichtm,"<br>- Stable prevalence in each health state : p%s%d%d.png<br>
+ fprintf(fichtm,"<br>- Stable prevalence in each health state : p%s%d%d.png<br> \
<img src=\"p%s%d%d.png\">",strtok(optionfile, "."),cpt,jj1,strtok(optionfile, "."),cpt,jj1);
}
for(cpt=1; cpt<=nlstate;cpt++) {
- fprintf(fichtm,"\n<br>- Health life expectancies by age and initial health state (%d): exp%s%d%d.png <br>
+ fprintf(fichtm,"\n<br>- Health life expectancies by age and initial health state (%d): exp%s%d%d.png <br> \
<img src=\"exp%s%d%d.png\">",cpt,strtok(optionfile, "."),cpt,jj1,strtok(optionfile, "."),cpt,jj1);
}
- fprintf(fichtm,"\n<br>- Total life expectancy by age and
-health expectancies in states (1) and (2): e%s%d.png<br>
+ fprintf(fichtm,"\n<br>- Total life expectancy by age and \
+health expectancies in states (1) and (2): e%s%d.png<br>\
<img src=\"e%s%d.png\">",strtok(optionfile, "."),jj1,strtok(optionfile, "."),jj1);
} /* end i1 */
}/* End k1 */
fprintf(fichtm,"</ul>");
- fprintf(fichtm,"\n<br><li><h4> Result files (second order: variances)</h4>\n
- - Parameter file with estimated parameters and covariance matrix: <a href=\"%s\">%s</a> <br>\n
- - Variance of one-step probabilities: <a href=\"prob%s\">prob%s</a> <br>\n
- - Variance-covariance of one-step probabilities: <a href=\"probcov%s\">probcov%s</a> <br>\n
- - Correlation matrix of one-step probabilities: <a href=\"probcor%s\">probcor%s</a> <br>\n
- - Variances and covariances of life expectancies by age and initial health status (estepm=%d months): <a href=\"v%s\">v%s</a><br>\n
- - Health expectancies with their variances (no covariance): <a href=\"t%s\">t%s</a> <br>\n
+ fprintf(fichtm,"\n<br><li><h4> Result files (second order: variances)</h4>\n\
+ - Parameter file with estimated parameters and covariance matrix: <a href=\"%s\">%s</a> <br>\n\
+ - Variance of one-step probabilities: <a href=\"prob%s\">prob%s</a> <br>\n\
+ - Variance-covariance of one-step probabilities: <a href=\"probcov%s\">probcov%s</a> <br>\n\
+ - Correlation matrix of one-step probabilities: <a href=\"probcor%s\">probcor%s</a> <br>\n\
+ - Variances and covariances of life expectancies by age and initial health status (estepm=%d months): <a href=\"v%s\">v%s</a><br>\n\
+ - Health expectancies with their variances (no covariance): <a href=\"t%s\">t%s</a> <br>\n\
- Standard deviation of stable prevalences: <a href=\"vpl%s\">vpl%s</a> <br>\n",rfileres,rfileres,fileres,fileres,fileres,fileres,fileres,fileres, estepm, fileres,fileres,fileres,fileres,fileres,fileres);
/* if(popforecast==1) fprintf(fichtm,"\n */
fprintf(fichtm," ************\n<hr size=\"2\" color=\"#EC5E5E\">");
}
for(cpt=1; cpt<=nlstate;cpt++) {
- fprintf(fichtm,"<br>- Observed and period prevalence (with confident
-interval) in state (%d): v%s%d%d.png <br>
+ fprintf(fichtm,"<br>- Observed and period prevalence (with confident\
+interval) in state (%d): v%s%d%d.png <br>\
<img src=\"v%s%d%d.png\">",cpt,strtok(optionfile, "."),cpt,jj1,strtok(optionfile, "."),cpt,jj1);
}
} /* end i1 */
{
int movingaverage(double ***probs, double bage,double fage, double ***mobaverage, int mobilav);
int i,j, k, n=MAXN,iter,m,size=100,cptcode, cptcod;
+ int jj;
+ int numlinepar=0; /* Current linenumber of parameter file */
double agedeb, agefin,hf;
double ageminpar=1.e20,agemin=1.e20, agemaxpar=-1.e20, agemax=-1.e20;
double ***mobaverage;
int *indx;
char line[MAXLINE], linepar[MAXLINE];
- char path[80],pathc[80],pathcd[80],pathtot[80],model[80];
+ char path[132],pathc[132],pathcd[132],pathtot[132],model[132];
int firstobs=1, lastobs=10;
int sdeb, sfin; /* Status at beginning and end */
int c, h , cpt,l;
#include <sys/time.h>
#include <time.h>
char stra[80], strb[80], strc[80], strd[80],stre[80],modelsav[80];
+ char *strt, *strtend;
+ char *stratrunc;
+ int lstra;
+
+ long total_usecs;
+ struct timeval start_time, end_time, curr_time;
+ struct timezone tzp;
+ extern int gettimeofday();
+ struct tm tmg, tm, *gmtime(), *localtime();
+ long time_value;
+ extern long time();
- /* long total_usecs;
- struct timeval start_time, end_time;
-
- gettimeofday(&start_time, (struct timezone*)0); */ /* at first time */
+ /* gettimeofday(&start_time, (struct timezone*)0); */ /* at first time */
+ (void) gettimeofday(&start_time,&tzp);
+ tm = *localtime(&start_time.tv_sec);
+ tmg = *gmtime(&start_time.tv_sec);
+ strt=asctime(&tm);
+/* printf("Localtime (at start)=%s",strt); */
+/* tp.tv_sec = tp.tv_sec +86400; */
+/* tm = *localtime(&start_time.tv_sec); */
+/* tmg.tm_year=tmg.tm_year +dsign*dyear; */
+/* tmg.tm_mon=tmg.tm_mon +dsign*dmonth; */
+/* tmg.tm_hour=tmg.tm_hour + 1; */
+/* tp.tv_sec = mktime(&tmg); */
+/* strt=asctime(&tmg); */
+/* printf("Time(after) =%s",strt); */
+/* (void) time (&time_value);
+* printf("time=%d,t-=%d\n",time_value,time_value-86400);
+* tm = *localtime(&time_value);
+* strt=asctime(&tm);
+* printf("tim_value=%d,asctime=%s\n",time_value,strt);
+*/
+
getcwd(pathcd, size);
printf("\n%s\n%s",version,fullversion);
else{
strcpy(pathtot,argv[1]);
}
- /*if(getcwd(pathcd, 80)!= NULL)printf ("Error pathcd\n");*/
+ /*if(getcwd(pathcd, 132)!= NULL)printf ("Error pathcd\n");*/
/*cygwin_split_path(pathtot,path,optionfile);
printf("pathtot=%s, path=%s, optionfile=%s\n",pathtot,path,optionfile);*/
/* cutv(path,optionfile,pathtot,'\\');*/
split(pathtot,path,optionfile,optionfilext,optionfilefiname);
- printf("pathtot=%s, path=%s, optionfile=%s optionfilext=%s optionfilefiname=%s\n",pathtot,path,optionfile,optionfilext,optionfilefiname);
+ printf("pathtot=%s,\npath=%s,\noptionfile=%s \noptionfilext=%s \noptionfilefiname=%s\n",pathtot,path,optionfile,optionfilext,optionfilefiname);
chdir(path);
replace(pathc,path);
goto end;
}
fprintf(ficlog,"Log filename:%s\n",filelog);
- fprintf(ficlog,"\n%s",version);
+ fprintf(ficlog,"\n%s\n%s",version,fullversion);
fprintf(ficlog,"\nEnter the parameter file name: ");
fprintf(ficlog,"pathtot=%s, path=%s, optionfile=%s optionfilext=%s optionfilefiname=%s\n",pathtot,path,optionfile,optionfilext,optionfilefiname);
+ printf("Localtime (at start)=%s",strt);
+ fprintf(ficlog,"Localtime (at start)=%s",strt);
fflush(ficlog);
/* */
if((ficpar=fopen(optionfile,"r"))==NULL) {
printf("Problem with optionfile %s\n",optionfile);
fprintf(ficlog,"Problem with optionfile %s\n",optionfile);
+ fflush(ficlog);
goto end;
}
if((ficparo=fopen(filereso,"w"))==NULL) {
printf("Problem with Output resultfile: %s\n", filereso);
fprintf(ficlog,"Problem with Output resultfile: %s\n", filereso);
+ fflush(ficlog);
goto end;
}
/* Reads comments: lines beginning with '#' */
+ numlinepar=0;
while((c=getc(ficpar))=='#' && c!= EOF){
ungetc(c,ficpar);
fgets(line, MAXLINE, ficpar);
+ numlinepar++;
puts(line);
fputs(line,ficparo);
+ fputs(line,ficlog);
}
ungetc(c,ficpar);
fscanf(ficpar,"title=%s datafile=%s lastobs=%d firstpass=%d lastpass=%d\nftol=%lf stepm=%d ncovcol=%d nlstate=%d ndeath=%d maxwav=%d mle=%d weight=%d model=%s\n",title, datafile, &lastobs, &firstpass,&lastpass,&ftol, &stepm, &ncovcol, &nlstate,&ndeath, &maxwav, &mle, &weightopt,model);
+ numlinepar++;
printf("title=%s datafile=%s lastobs=%d firstpass=%d lastpass=%d\nftol=%e stepm=%d ncovcol=%d nlstate=%d ndeath=%d maxwav=%d mle=%d weight=%d\nmodel=%s\n", title, datafile, lastobs, firstpass,lastpass,ftol, stepm, ncovcol, nlstate,ndeath, maxwav, mle, weightopt,model);
fprintf(ficparo,"title=%s datafile=%s lastobs=%d firstpass=%d lastpass=%d\nftol=%e stepm=%d ncovcol=%d nlstate=%d ndeath=%d maxwav=%d mle=%d weight=%d\nmodel=%s\n", title, datafile, lastobs, firstpass,lastpass,ftol,stepm,ncovcol,nlstate,ndeath,maxwav, mle, weightopt,model);
+ fprintf(ficlog,"title=%s datafile=%s lastobs=%d firstpass=%d lastpass=%d\nftol=%e stepm=%d ncovcol=%d nlstate=%d ndeath=%d maxwav=%d mle=%d weight=%d\nmodel=%s\n", title, datafile, lastobs, firstpass,lastpass,ftol,stepm,ncovcol,nlstate,ndeath,maxwav, mle, weightopt,model);
+ fflush(ficlog);
while((c=getc(ficpar))=='#' && c!= EOF){
ungetc(c,ficpar);
fgets(line, MAXLINE, ficpar);
+ numlinepar++;
puts(line);
fputs(line,ficparo);
+ fputs(line,ficlog);
}
ungetc(c,ficpar);
-
+
covar=matrix(0,NCOVMAX,1,n);
cptcovn=0; /*Number of covariates, i.e. number of '+' in model statement*/
while((c=getc(ficpar))=='#' && c!= EOF){
ungetc(c,ficpar);
fgets(line, MAXLINE, ficpar);
+ numlinepar++;
puts(line);
fputs(line,ficparo);
+ fputs(line,ficlog);
}
ungetc(c,ficpar);
-
+
param= ma3x(1,nlstate,1,nlstate+ndeath-1,1,ncovmodel);
- for(i=1; i <=nlstate; i++)
- for(j=1; j <=nlstate+ndeath-1; j++){
+ for(i=1; i <=nlstate; i++){
+ j=0;
+ for(jj=1; jj <=nlstate+ndeath; jj++){
+ if(jj==i) continue;
+ j++;
fscanf(ficpar,"%1d%1d",&i1,&j1);
+ if ((i1 != i) && (j1 != j)){
+ printf("Error in line parameters number %d, %1d%1d instead of %1d%1d \n",numlinepar, i,j, i1, j1);
+ exit(1);
+ }
fprintf(ficparo,"%1d%1d",i1,j1);
if(mle==1)
printf("%1d%1d",i,j);
fprintf(ficparo," %lf",param[i][j][k]);
}
fscanf(ficpar,"\n");
+ numlinepar++;
if(mle==1)
printf("\n");
fprintf(ficlog,"\n");
fprintf(ficparo,"\n");
}
-
+ }
+ fflush(ficlog);
+
npar= (nlstate+ndeath-1)*nlstate*ncovmodel; /* Number of parameters*/
p=param[1][1];
while((c=getc(ficpar))=='#' && c!= EOF){
ungetc(c,ficpar);
fgets(line, MAXLINE, ficpar);
+ numlinepar++;
puts(line);
fputs(line,ficparo);
+ fputs(line,ficlog);
}
ungetc(c,ficpar);
for(i=1; i <=nlstate; i++){
for(j=1; j <=nlstate+ndeath-1; j++){
fscanf(ficpar,"%1d%1d",&i1,&j1);
+ if ((i1-i)*(j1-j)!=0){
+ printf("Error in line parameters number %d, %1d%1d instead of %1d%1d \n",numlinepar, i,j, i1, j1);
+ exit(1);
+ }
printf("%1d%1d",i,j);
fprintf(ficparo,"%1d%1d",i1,j1);
+ fprintf(ficlog,"%1d%1d",i1,j1);
for(k=1; k<=ncovmodel;k++){
fscanf(ficpar,"%le",&delti3[i][j][k]);
printf(" %le",delti3[i][j][k]);
fprintf(ficparo," %le",delti3[i][j][k]);
+ fprintf(ficlog," %le",delti3[i][j][k]);
}
fscanf(ficpar,"\n");
+ numlinepar++;
printf("\n");
fprintf(ficparo,"\n");
+ fprintf(ficlog,"\n");
}
}
+ fflush(ficlog);
+
delti=delti3[1][1];
while((c=getc(ficpar))=='#' && c!= EOF){
ungetc(c,ficpar);
fgets(line, MAXLINE, ficpar);
+ numlinepar++;
puts(line);
fputs(line,ficparo);
+ fputs(line,ficlog);
}
ungetc(c,ficpar);
fscanf(ficpar," %le",&matcov[i][j]);
if(mle==1){
printf(" %.5le",matcov[i][j]);
- fprintf(ficlog," %.5le",matcov[i][j]);
}
- else
- fprintf(ficlog," %.5le",matcov[i][j]);
+ fprintf(ficlog," %.5le",matcov[i][j]);
fprintf(ficparo," %.5le",matcov[i][j]);
}
fscanf(ficpar,"\n");
+ numlinepar++;
if(mle==1)
printf("\n");
fprintf(ficlog,"\n");
printf("\n");
fprintf(ficlog,"\n");
+ fflush(ficlog);
/*-------- Rewriting paramater file ----------*/
strcpy(rfileres,"r"); /* "Rparameterfile */
n= lastobs;
severity = vector(1,maxwav);
outcome=imatrix(1,maxwav+1,1,n);
- num=ivector(1,n);
+ num=lvector(1,n);
moisnais=vector(1,n);
annais=vector(1,n);
moisdc=vector(1,n);
for (j=ncovcol;j>=1;j--){
cutv(stra, strb,line,' '); covar[j][i]=(double)(atoi(strb)); strcpy(line,stra);
}
- num[i]=atol(stra);
+ lstra=strlen(stra);
+ if(lstra > 9){ /* More than 2**32 or max of what printf can write with %ld */
+ stratrunc = &(stra[lstra-9]);
+ num[i]=atol(stratrunc);
+ }
+ else
+ num[i]=atol(stra);
/*if((s[2][i]==2) && (s[3][i]==-1)&&(s[4][i]==9)){
- printf("%d %.lf %.lf %.lf %.lf/%.lf %.lf/%.lf %.lf/%.lf %d %.lf/%.lf %d %.lf/%.lf %d %.lf/%.lf %d\n",num[i],(covar[1][i]), (covar[2][i]),weight[i], (moisnais[i]), (annais[i]), (moisdc[i]), (andc[i]), (mint[1][i]), (anint[1][i]), (s[1][i]), (mint[2][i]), (anint[2][i]), (s[2][i]), (mint[3][i]), (anint[3][i]), (s[3][i]), (mint[4][i]), (anint[4][i]), (s[4][i])); ij=ij+1;}*/
+ printf("%ld %.lf %.lf %.lf %.lf/%.lf %.lf/%.lf %.lf/%.lf %d %.lf/%.lf %d %.lf/%.lf %d %.lf/%.lf %d\n",num[i],(covar[1][i]), (covar[2][i]),weight[i], (moisnais[i]), (annais[i]), (moisdc[i]), (andc[i]), (mint[1][i]), (anint[1][i]), (s[1][i]), (mint[2][i]), (anint[2][i]), (s[2][i]), (mint[3][i]), (anint[3][i]), (s[3][i]), (mint[4][i]), (anint[4][i]), (s[4][i])); ij=ij+1;}*/
i=i+1;
}
}*/
/* for (i=1; i<=imx; i++){
if (s[4][i]==9) s[4][i]=-1;
- printf("%d %.lf %.lf %.lf %.lf/%.lf %.lf/%.lf %.lf/%.lf %d %.lf/%.lf %d %.lf/%.lf %d %.lf/%.lf %d\n",num[i],(covar[1][i]), (covar[2][i]), (weight[i]), (moisnais[i]), (annais[i]), (moisdc[i]), (andc[i]), (mint[1][i]), (anint[1][i]), (s[1][i]), (mint[2][i]), (anint[2][i]), (s[2][i]), (mint[3][i]), (anint[3][i]), (s[3][i]), (mint[4][i]), (anint[4][i]), (s[4][i]));}*/
+ printf("%ld %.lf %.lf %.lf %.lf/%.lf %.lf/%.lf %.lf/%.lf %d %.lf/%.lf %d %.lf/%.lf %d %.lf/%.lf %d\n",num[i],(covar[1][i]), (covar[2][i]), (weight[i]), (moisnais[i]), (annais[i]), (moisdc[i]), (andc[i]), (mint[1][i]), (anint[1][i]), (s[1][i]), (mint[2][i]), (anint[2][i]), (s[2][i]), (mint[3][i]), (anint[3][i]), (s[3][i]), (mint[4][i]), (anint[4][i]), (s[4][i]));}*/
for (i=1; i<=imx; i++)
s[m][i]=-1;
}
if((int)moisdc[i]==99 && (int)andc[i]==9999 && s[m][i]>nlstate){
- printf("Error! Date of death (month %2d and year %4d) of individual %d on line %d was unknown, you must set an arbitrary year of death or he/she is skipped and results are biased\n",(int)moisdc[i],(int)andc[i],num[i],i);
- fprintf(ficlog,"Error! Date of death (month %2d and year %4d) of individual %d on line %d was unknown, you must set an arbitrary year of death or he/she is skipped and results are biased\n",(int)moisdc[i],(int)andc[i],num[i],i);
+ printf("Error! Date of death (month %2d and year %4d) of individual %ld on line %d was unknown, you must set an arbitrary year of death or he/she is skipped and results are biased\n",(int)moisdc[i],(int)andc[i],num[i],i);
+ fprintf(ficlog,"Error! Date of death (month %2d and year %4d) of individual %ld on line %d was unknown, you must set an arbitrary year of death or he/she is skipped and results are biased\n",(int)moisdc[i],(int)andc[i],num[i],i);
s[m][i]=-1;
}
if((int)moisdc[i]==99 && (int)andc[i]!=9999 && s[m][i]>nlstate){
- printf("Error! Month of death of individual %d on line %d was unknown %2d, you should set it otherwise the information on the death is skipped and results are biased.\n",num[i],i,(int)moisdc[i]);
- fprintf(ficlog,"Error! Month of death of individual %d on line %d was unknown %f, you should set it otherwise the information on the death is skipped and results are biased.\n",num[i],i,moisdc[i]);
+ printf("Error! Month of death of individual %ld on line %d was unknown %2d, you should set it otherwise the information on the death is skipped and results are biased.\n",num[i],i,(int)moisdc[i]);
+ fprintf(ficlog,"Error! Month of death of individual %ld on line %d was unknown %f, you should set it otherwise the information on the death is skipped and results are biased.\n",num[i],i,moisdc[i]);
s[m][i]=-1; /* We prefer to skip it (and to skip it in version 0.8a1 too */
}
}
/*if(moisdc[i]==99 && andc[i]==9999) s[m][i]=-1;*/
else {
if ((int)andc[i]!=9999){
- printf("Warning negative age at death: %d line:%d\n",num[i],i);
- fprintf(ficlog,"Warning negative age at death: %d line:%d\n",num[i],i);
+ printf("Warning negative age at death: %ld line:%d\n",num[i],i);
+ fprintf(ficlog,"Warning negative age at death: %ld line:%d\n",num[i],i);
agev[m][i]=-1;
}
}
/*for (i=1; i<=imx; i++){
for (m=firstpass; (m<lastpass); m++){
- printf("%d %d %.lf %d %d\n", num[i],(covar[1][i]),agev[m][i],s[m][i],s[m+1][i]);
+ printf("%ld %d %.lf %d %d\n", num[i],(covar[1][i]),agev[m][i],s[m][i],s[m+1][i]);
}
}*/
so we point p on param[1][1] so that p[1] maps on param[1][1][1] */
p=param[1][1]; /* *(*(*(param +1)+1)+0) */
+ globpr=0; /* To get ipmx number of contributions and sum of weights*/
+ likelione(ficres, p, npar, nlstate, &globpr, &ipmx, &sw, &fretone, funcone); /* Prints the contributions to the likelihood */
+ printf("First Likeli=%12.6f ipmx=%ld sw=%12.6f",fretone,ipmx,sw);
+ for (k=1; k<=npar;k++)
+ printf(" %d %8.5f",k,p[k]);
+ printf("\n");
+ globpr=1; /* to print the contributions */
+ likelione(ficres, p, npar, nlstate, &globpr, &ipmx, &sw, &fretone, funcone); /* Prints the contributions to the likelihood */
+ printf("Second Likeli=%12.6f ipmx=%ld sw=%12.6f",fretone,ipmx,sw);
+ for (k=1; k<=npar;k++)
+ printf(" %d %8.5f",k,p[k]);
+ printf("\n");
if(mle>=1){ /* Could be 1 or 2 */
mlikeli(ficres,p, npar, ncovmodel, nlstate, ftol, func);
}
printf("Problem with %s \n",optionfilehtm), exit(0);
}
- fprintf(fichtm,"<body> <font size=\"2\">%s </font> <hr size=\"2\" color=\"#EC5E5E\"> \n
-Title=%s <br>Datafile=%s Firstpass=%d Lastpass=%d Stepm=%d Weight=%d Model=%s<br>\n
-\n
-Total number of observations=%d <br>\n
-Youngest age at first (selected) pass %.2f, oldest age %.2f<br>\n
-Interval (in months) between two waves: Min=%d Max=%d Mean=%.2lf<br>\n
-<hr size=\"2\" color=\"#EC5E5E\">
- <ul><li><h4>Parameter files</h4>\n
- - Copy of the parameter file: <a href=\"o%s\">o%s</a><br>\n
- - Log file of the run: <a href=\"%s\">%s</a><br>\n
- - Gnuplot file name: <a href=\"%s\">%s</a></ul>\n",version,title,datafile,firstpass,lastpass,stepm, weightopt,model,imx,agemin,agemax,jmin,jmax,jmean,fileres,fileres,filelog,filelog,optionfilegnuplot,optionfilegnuplot);
- fclose(fichtm);
-
- printinghtml(fileres,title,datafile, firstpass, lastpass, stepm, weightopt,model,imx,jmin,jmax,jmean,rfileres,popforecast,estepm,jprev1,mprev1,anprev1,jprev2,mprev2,anprev2);
+ fprintf(fichtm,"<body> <font size=\"2\">%s </font> <hr size=\"2\" color=\"#EC5E5E\"> \n\
+Title=%s <br>Datafile=%s Firstpass=%d Lastpass=%d Stepm=%d Weight=%d Model=%s<br>\n\
+\n\
+Total number of observations=%d <br>\n\
+Youngest age at first (selected) pass %.2f, oldest age %.2f<br>\n\
+Interval (in months) between two waves: Min=%d Max=%d Mean=%.2lf<br>\n\
+<hr size=\"2\" color=\"#EC5E5E\">\
+ <ul><li><h4>Parameter files</h4>\n\
+ - Copy of the parameter file: <a href=\"o%s\">o%s</a><br>\n\
+ - Log file of the run: <a href=\"%s\">%s</a><br>\n\
+ - Gnuplot file name: <a href=\"%s\">%s</a></ul>\n",\
+ version,title,datafile,firstpass,lastpass,stepm, weightopt,\
+ model,imx,agemin,agemax,jmin,jmax,jmean,fileres,fileres,\
+ filelog,filelog,optionfilegnuplot,optionfilegnuplot);
+ fclose(fichtm);
+
+ printinghtml(fileres,title,datafile, firstpass, lastpass, stepm, weightopt,\
+ model,imx,jmin,jmax,jmean,rfileres,popforecast,estepm,\
+ jprev1,mprev1,anprev1,jprev2,mprev2,anprev2);
/*------------ free_vector -------------*/
chdir(path);
free_imatrix(dh,1,lastpass-firstpass+1,1,imx);
free_imatrix(bh,1,lastpass-firstpass+1,1,imx);
free_imatrix(mw,1,lastpass-firstpass+1,1,imx);
- free_ivector(num,1,n);
+ free_lvector(num,1,n);
free_vector(agedc,1,n);
/*free_matrix(covar,0,NCOVMAX,1,n);*/
/*free_matrix(covar,1,NCOVMAX,1,n);*/
printf("See log file on %s\n",filelog);
fclose(ficlog);
/* gettimeofday(&end_time, (struct timezone*)0);*/ /* after time */
-
- /* printf("Total time was %d Sec. %d uSec.\n", end_time.tv_sec -start_time.tv_sec, end_time.tv_usec -start_time.tv_usec);*/
- /*printf("Total time was %d uSec.\n", total_usecs);*/
+ (void) gettimeofday(&end_time,&tzp);
+ tm = *localtime(&end_time.tv_sec);
+ tmg = *gmtime(&end_time.tv_sec);
+ strtend=asctime(&tm);
+ printf("Localtime at start %s and at end=%s",strt, strtend);
+ fprintf(ficlog,"Localtime at start %s and at end=%s",strt, strtend);
+ /* printf("Total time used %d Sec\n", asc_time(end_time.tv_sec -start_time.tv_sec);*/
+
+ printf("Total time was %d Sec. %d uSec.\n", end_time.tv_sec -start_time.tv_sec, end_time.tv_usec -start_time.tv_usec);
+ fprintf(ficlog,"Total time was %d Sec. %d uSec.\n", end_time.tv_sec -start_time.tv_sec, end_time.tv_usec -start_time.tv_usec);
+ /* printf("Total time was %d uSec.\n", total_usecs);*/
/*------ End -----------*/
end:
git://henry.ined.fr / .git / commitdiff