--- imach/src/imach.c 2003/06/18 12:26:01 1.87
+++ imach/src/imach.c 2003/06/27 13:00:02 1.94
@@ -1,6 +1,38 @@
-/* $Id: imach.c,v 1.87 2003/06/18 12:26:01 brouard Exp $
+/* $Id: imach.c,v 1.94 2003/06/27 13:00:02 brouard Exp $
$State: Exp $
$Log: imach.c,v $
+ Revision 1.94 2003/06/27 13:00:02 brouard
+ Just cleaning
+
+ Revision 1.93 2003/06/25 16:33:55 brouard
+ (Module): On windows (cygwin) function asctime_r doesn't
+ exist so I changed back to asctime which exists.
+ (Module): Version 0.96b
+
+ Revision 1.92 2003/06/25 16:30:45 brouard
+ (Module): On windows (cygwin) function asctime_r doesn't
+ exist so I changed back to asctime which exists.
+
+ Revision 1.91 2003/06/25 15:30:29 brouard
+ * imach.c (Repository): Duplicated warning errors corrected.
+ (Repository): Elapsed time after each iteration is now output. It
+ helps to forecast when convergence will be reached. Elapsed time
+ is stamped in powell. We created a new html file for the graphs
+ concerning matrix of covariance. It has extension -cov.htm.
+
+ Revision 1.90 2003/06/24 12:34:15 brouard
+ (Module): Some bugs corrected for windows. Also, when
+ mle=-1 a template is output in file "or"mypar.txt with the design
+ of the covariance matrix to be input.
+
+ Revision 1.89 2003/06/24 12:30:52 brouard
+ (Module): Some bugs corrected for windows. Also, when
+ mle=-1 a template is output in file "or"mypar.txt with the design
+ of the covariance matrix to be input.
+
+ Revision 1.88 2003/06/23 17:54:56 brouard
+ * imach.c (Repository): Create a sub-directory where all the secondary files are. Only imach, htm, gp and r(imach) are on the main directory. Correct time and other things.
+
Revision 1.87 2003/06/18 12:26:01 brouard
Version 0.96
@@ -161,12 +193,12 @@
#define ODIRSEPARATOR '/'
#endif
-/* $Id: imach.c,v 1.87 2003/06/18 12:26:01 brouard Exp $ */
+/* $Id: imach.c,v 1.94 2003/06/27 13:00:02 brouard Exp $ */
/* $State: Exp $ */
-char version[]="Imach version 0.96, June 2003, INED-EUROREVES ";
-char fullversion[]="$Revision: 1.87 $ $Date: 2003/06/18 12:26:01 $";
-int erreur; /* Error number */
+char version[]="Imach version 0.96b, June 2003, INED-EUROREVES ";
+char fullversion[]="$Revision: 1.94 $ $Date: 2003/06/27 13:00:02 $";
+int erreur, nberr=0, nbwarn=0; /* Error number, number of errors number of warnings */
int nvar;
int cptcovn=0, cptcovage=0, cptcoveff=0,cptcov;
int npar=NPARMAX;
@@ -198,7 +230,7 @@ char fileresilk[FILENAMELENGTH]; /* File
FILE *ficresilk;
FILE *ficgp,*ficresprob,*ficpop, *ficresprobcov, *ficresprobcor;
FILE *ficresprobmorprev;
-FILE *fichtm; /* Html File */
+FILE *fichtm, *fichtmcov; /* Html File */
FILE *ficreseij;
char filerese[FILENAMELENGTH];
FILE *ficresvij;
@@ -208,14 +240,26 @@ char fileresvpl[FILENAMELENGTH];
char title[MAXLINE];
char optionfile[FILENAMELENGTH], datafile[FILENAMELENGTH], filerespl[FILENAMELENGTH];
char optionfilext[10], optionfilefiname[FILENAMELENGTH], plotcmd[FILENAMELENGTH];
+char tmpout[FILENAMELENGTH];
+char command[FILENAMELENGTH];
+int outcmd=0;
char fileres[FILENAMELENGTH], filerespij[FILENAMELENGTH], filereso[FILENAMELENGTH], rfileres[FILENAMELENGTH];
+
char filelog[FILENAMELENGTH]; /* Log file */
char filerest[FILENAMELENGTH];
char fileregp[FILENAMELENGTH];
char popfile[FILENAMELENGTH];
-char optionfilegnuplot[FILENAMELENGTH], optionfilehtm[FILENAMELENGTH];
+char optionfilegnuplot[FILENAMELENGTH], optionfilehtm[FILENAMELENGTH], optionfilehtmcov[FILENAMELENGTH] ;
+
+struct timeval start_time, end_time, curr_time, last_time, forecast_time;
+struct timezone tzp;
+extern int gettimeofday();
+struct tm tmg, tm, tmf, *gmtime(), *localtime();
+long time_value;
+extern long time();
+char strcurr[80], strfor[80];
#define NR_END 1
#define FREE_ARG char*
@@ -313,10 +357,10 @@ static int split( char *path, char *dirc
/******************************************/
-void replace(char *s, char*t)
+void replace_back_to_slash(char *s, char*t)
{
int i;
- int lg=20;
+ int lg=0;
i=0;
lg=strlen(t);
for(i=0; i<= lg; i++) {
@@ -521,6 +565,41 @@ void free_ma3x(double ***m, long nrl, lo
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 *************************/
extern int ncom;
extern double *pcom,*xicom;
@@ -696,6 +775,19 @@ void linmin(double p[], double xi[], int
free_vector(pcom,1,n);
}
+char *asc_diff_time(long time_sec, char ascdiff[])
+{
+ long sec_left, days, hours, minutes;
+ days = (time_sec) / (60*60*24);
+ sec_left = (time_sec) % (60*60*24);
+ hours = (sec_left) / (60*60) ;
+ sec_left = (sec_left) %(60*60);
+ minutes = (sec_left) /60;
+ sec_left = (sec_left) % (60);
+ sprintf(ascdiff,"%d day(s) %d hour(s) %d minute(s) %d second(s)",days, hours, minutes, sec_left);
+ return ascdiff;
+}
+
/*************** powell ************************/
void powell(double p[], double **xi, int n, double ftol, int *iter, double *fret,
double (*func)(double []))
@@ -706,6 +798,8 @@ void powell(double p[], double **xi, int
double del,t,*pt,*ptt,*xit;
double fp,fptt;
double *xits;
+ int niterf, itmp;
+
pt=vector(1,n);
ptt=vector(1,n);
xit=vector(1,n);
@@ -716,9 +810,11 @@ void powell(double p[], double **xi, int
fp=(*fret);
ibig=0;
del=0.0;
- printf("\nPowell iter=%d -2*LL=%.12f",*iter,*fret);
- fprintf(ficlog,"\nPowell iter=%d -2*LL=%.12f",*iter,*fret);
- fprintf(ficrespow,"%d %.12f",*iter,*fret);
+ last_time=curr_time;
+ (void) gettimeofday(&curr_time,&tzp);
+ printf("\nPowell iter=%d -2*LL=%.12f %ld sec. %ld sec.",*iter,*fret, curr_time.tv_sec-last_time.tv_sec, curr_time.tv_sec-start_time.tv_sec);fflush(stdout);
+ fprintf(ficlog,"\nPowell iter=%d -2*LL=%.12f %ld sec. %ld sec.",*iter,*fret, curr_time.tv_sec-last_time.tv_sec, curr_time.tv_sec-start_time.tv_sec);
+ fprintf(ficrespow,"%d %.12f %ld",*iter,*fret,curr_time.tv_sec-start_time.tv_sec);
for (i=1;i<=n;i++) {
printf(" %d %.12f",i, p[i]);
fprintf(ficlog," %d %.12lf",i, p[i]);
@@ -726,7 +822,29 @@ void powell(double p[], double **xi, int
}
printf("\n");
fprintf(ficlog,"\n");
- fprintf(ficrespow,"\n");
+ fprintf(ficrespow,"\n");fflush(ficrespow);
+ if(*iter <=3){
+ tm = *localtime(&curr_time.tv_sec);
+ strcpy(strcurr,asctime(&tmf));
+/* asctime_r(&tm,strcurr); */
+ forecast_time=curr_time;
+ itmp = strlen(strcurr);
+ if(strcurr[itmp-1]=='\n')
+ strcurr[itmp-1]='\0';
+ printf("\nConsidering the time needed for this last iteration #%d: %ld seconds,\n",*iter,curr_time.tv_sec-last_time.tv_sec);
+ fprintf(ficlog,"\nConsidering the time needed for this last iteration #%d: %ld seconds,\n",*iter,curr_time.tv_sec-last_time.tv_sec);
+ for(niterf=10;niterf<=30;niterf+=10){
+ forecast_time.tv_sec=curr_time.tv_sec+(niterf-*iter)*(curr_time.tv_sec-last_time.tv_sec);
+ tmf = *localtime(&forecast_time.tv_sec);
+/* asctime_r(&tmf,strfor); */
+ strcpy(strfor,asctime(&tmf));
+ itmp = strlen(strfor);
+ if(strfor[itmp-1]=='\n')
+ strfor[itmp-1]='\0';
+ printf(" - if your program needs %d iterations to converge, convergence will be \n reached in %s or\n on %s (current time is %s);\n",niterf, asc_diff_time(forecast_time.tv_sec-curr_time.tv_sec,tmpout),strfor,strcurr);
+ fprintf(ficlog," - if your program needs %d iterations to converge, convergence will be \n reached in %s or\n on %s (current time is %s);\n",niterf, asc_diff_time(forecast_time.tv_sec-curr_time.tv_sec,tmpout),strfor,strcurr);
+ }
+ }
for (i=1;i<=n;i++) {
for (j=1;j<=n;j++) xit[j]=xi[j][i];
fptt=(*fret);
@@ -1139,31 +1257,10 @@ double func( double *x)
oldm=newm;
} /* 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];
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.
- */
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;
sw += weight[i];
ll[s[mw[mi][i]][i]] += 2*weight[i]*lli;
@@ -1190,30 +1287,10 @@ double func( double *x)
oldm=newm;
} /* 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];
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.
- */
- /* 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=(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;
sw += weight[i];
ll[s[mw[mi][i]][i]] += 2*weight[i]*lli;
@@ -1357,7 +1434,7 @@ double funcone( double *x)
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,"%ld %6d %1d %1d %1d %1d %3d %10.6f %6.4f\
+ fprintf(ficresilk,"%9d %6d %1d %1d %1d %1d %3d %10.6f %6.4f\
%10.6f %10.6f %10.6f ", \
num[i],i,s1,s2,mi,mw[mi][i],dh[mi][i],exp(lli),weight[i],
2*weight[i]*lli,out[s1][s2],savm[s1][s2]);
@@ -1380,6 +1457,7 @@ double funcone( double *x)
}
+/*************** function likelione ***********/
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
@@ -1389,7 +1467,7 @@ void likelione(FILE *ficres,double p[],
*/
int k;
- if(*globpri !=0){ /* Just counts and sums no printings */
+ if(*globpri !=0){ /* Just counts and sums, no printings */
strcpy(fileresilk,"ilk");
strcat(fileresilk,fileres);
if((ficresilk=fopen(fileresilk,"w"))==NULL) {
@@ -1397,7 +1475,7 @@ void likelione(FILE *ficres,double p[],
fprintf(ficlog,"Problem with resultfile: %s\n", fileresilk);
}
fprintf(ficresilk, "#individual(line's_record) s1 s2 wave# effective_wave# number_of_matrices_product pij weight -2ln(pij)*weight 0pij_x 0pij_(x-stepm) cumulating_loglikeli_by_health_state(reweighted=-2ll*weightXnumber_of_contribs/sum_of_weights) and_total\n");
- fprintf(ficresilk, "#num_i i s1 s2 mi mw dh likeli weight out sav ");
+ fprintf(ficresilk, "#num_i i s1 s2 mi mw dh likeli weight 2wlli 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," -2*gipw/gsw*weight*ll[%d]++",k);
@@ -1407,12 +1485,13 @@ void likelione(FILE *ficres,double p[],
*fretone=(*funcone)(p);
if(*globpri !=0){
fclose(ficresilk);
- fprintf(fichtm,"\n
File of contributions to the likelihood: %s
\n",fileresilk,fileresilk);
+ fprintf(fichtm,"\n
File of contributions to the likelihood: %s
\n",subdirf(fileresilk),subdirf(fileresilk));
fflush(fichtm);
}
return;
}
+
/*********** Maximum Likelihood Estimation ***************/
void mlikeli(FILE *ficres,double p[], int npar, int ncovmodel, int nlstate, double ftol, double (*func)(double []))
@@ -1990,6 +2069,7 @@ void concatwav(int wav[], int **dh, int
wav[i]=mi;
if(mi==0){
+ nbwarn++;
if(first==0){
printf("Warning! None valid information for:%ld line=%d (skipped) and may be others, see log file\n",num[i],i);
first=1;
@@ -2010,10 +2090,11 @@ void concatwav(int wav[], int **dh, int
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){
+ nberr++;
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 */
+ j=1; /* Temporary Dangerous 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 fix 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,"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;
@@ -2033,6 +2114,7 @@ void concatwav(int wav[], int **dh, int
/* 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){
+ nberr++;
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]);
}
@@ -2368,20 +2450,7 @@ void varevsij(char optionfilefiname[], d
fprintf(ficresprobmorprev," w%1d p%-d%-d",i,i,j);
}
fprintf(ficresprobmorprev,"\n");
- if((ficgp=fopen(optionfilegnuplot,"a"))==NULL) {
- printf("Problem with gnuplot file: %s\n", optionfilegnuplot);
- fprintf(ficlog,"Problem with gnuplot file: %s\n", optionfilegnuplot);
- exit(0);
- }
- else{
- fprintf(ficgp,"\n# Routine varevsij");
- }
-/* if((fichtm=fopen(optionfilehtm,"a"))==NULL) { */
-/* printf("Problem with html file: %s\n", optionfilehtm); */
-/* fprintf(ficlog,"Problem with html file: %s\n", optionfilehtm); */
-/* exit(0); */
-/* } */
-/* else{ */
+ fprintf(ficgp,"\n# Routine varevsij");
fprintf(fichtm,"\n
"); @@ -3050,24 +3123,24 @@ fprintf(fichtm," \n