--- imach/src/imach.c 2004/09/15 10:38:38 1.101 +++ imach/src/imach.c 2014/01/26 03:57:36 1.142 @@ -1,6 +1,193 @@ -/* $Id: imach.c,v 1.101 2004/09/15 10:38:38 brouard Exp $ +/* $Id: imach.c,v 1.142 2014/01/26 03:57:36 brouard Exp $ $State: Exp $ $Log: imach.c,v $ + Revision 1.142 2014/01/26 03:57:36 brouard + Summary: gnuplot changed plot w l 1 has to be changed to plot w l lt 2 + + * imach.c (Module): Trying to merge old staffs together while being at Tokyo. Not tested... + + Revision 1.141 2014/01/26 02:42:01 brouard + * imach.c (Module): Trying to merge old staffs together while being at Tokyo. Not tested... + + Revision 1.140 2011/09/02 10:37:54 brouard + Summary: times.h is ok with mingw32 now. + + Revision 1.139 2010/06/14 07:50:17 brouard + After the theft of my laptop, I probably lost some lines of codes which were not uploaded to the CVS tree. + I remember having already fixed agemin agemax which are pointers now but not cvs saved. + + Revision 1.138 2010/04/30 18:19:40 brouard + *** empty log message *** + + Revision 1.137 2010/04/29 18:11:38 brouard + (Module): Checking covariates for more complex models + than V1+V2. A lot of change to be done. Unstable. + + Revision 1.136 2010/04/26 20:30:53 brouard + (Module): merging some libgsl code. Fixing computation + of likelione (using inter/intrapolation if mle = 0) in order to + get same likelihood as if mle=1. + Some cleaning of code and comments added. + + Revision 1.135 2009/10/29 15:33:14 brouard + (Module): Now imach stops if date of birth, at least year of birth, is not given. Some cleaning of the code. + + Revision 1.134 2009/10/29 13:18:53 brouard + (Module): Now imach stops if date of birth, at least year of birth, is not given. Some cleaning of the code. + + Revision 1.133 2009/07/06 10:21:25 brouard + just nforces + + Revision 1.132 2009/07/06 08:22:05 brouard + Many tings + + Revision 1.131 2009/06/20 16:22:47 brouard + Some dimensions resccaled + + Revision 1.130 2009/05/26 06:44:34 brouard + (Module): Max Covariate is now set to 20 instead of 8. A + lot of cleaning with variables initialized to 0. Trying to make + V2+V3*age+V1+V4 strb=V3*age+V1+V4 working better. + + Revision 1.129 2007/08/31 13:49:27 lievre + Modification of the way of exiting when the covariate is not binary in order to see on the window the error message before exiting + + Revision 1.128 2006/06/30 13:02:05 brouard + (Module): Clarifications on computing e.j + + Revision 1.127 2006/04/28 18:11:50 brouard + (Module): Yes the sum of survivors was wrong since + imach-114 because nhstepm was no more computed in the age + loop. Now we define nhstepma in the age loop. + (Module): In order to speed up (in case of numerous covariates) we + compute health expectancies (without variances) in a first step + and then all the health expectancies with variances or standard + deviation (needs data from the Hessian matrices) which slows the + computation. + In the future we should be able to stop the program is only health + expectancies and graph are needed without standard deviations. + + Revision 1.126 2006/04/28 17:23:28 brouard + (Module): Yes the sum of survivors was wrong since + imach-114 because nhstepm was no more computed in the age + loop. Now we define nhstepma in the age loop. + Version 0.98h + + Revision 1.125 2006/04/04 15:20:31 lievre + Errors in calculation of health expectancies. Age was not initialized. + Forecasting file added. + + Revision 1.124 2006/03/22 17:13:53 lievre + Parameters are printed with %lf instead of %f (more numbers after the comma). + The log-likelihood is printed in the log file + + Revision 1.123 2006/03/20 10:52:43 brouard + * imach.c (Module):
=(p+1))(v[j-p-1] = t[j]);
- }
-}
+/* for(j=0; j<= lg; j++) { */
+/* if (j>=(p+1))(v[j-p-1] = t[j]); */
+/* } */
+/* } */
/********************** nrerror ********************/
@@ -840,7 +1110,7 @@ char *asc_diff_time(long time_sec, char
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);
+ sprintf(ascdiff,"%ld day(s) %ld hour(s) %ld minute(s) %ld second(s)",days, hours, minutes, sec_left);
return ascdiff;
}
@@ -869,9 +1139,8 @@ void powell(double p[], double **xi, int
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);
- */
+ 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); fflush(ficlog);
+/* 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]);
@@ -993,7 +1262,7 @@ void powell(double p[], double **xi, int
}
}
-/**** Prevalence limit (stable prevalence) ****************/
+/**** Prevalence limit (stable or period prevalence) ****************/
double **prevalim(double **prlim, int nlstate, double x[], double age, double **oldm, double **savm, double ftolpl, int ij)
{
@@ -1003,7 +1272,7 @@ double **prevalim(double **prlim, int nl
int i, ii,j,k;
double min, max, maxmin, maxmax,sumnew=0.;
double **matprod2();
- double **out, cov[NCOVMAX], **pmij();
+ double **out, cov[NCOVMAX+1], **pmij();
double **newm;
double agefin, delaymax=50 ; /* Max number of years to converge */
@@ -1018,21 +1287,21 @@ double **prevalim(double **prlim, int nl
for(agefin=age-stepm/YEARM; agefin>=age-delaymax; agefin=agefin-stepm/YEARM){
newm=savm;
/* Covariates have to be included here again */
- cov[2]=agefin;
-
- for (k=1; k<=cptcovn;k++) {
- cov[2+k]=nbcode[Tvar[k]][codtab[ij][Tvar[k]]];
- /* printf("ij=%d k=%d Tvar[k]=%d nbcode=%d cov=%lf codtab[ij][Tvar[k]]=%d \n",ij,k, Tvar[k],nbcode[Tvar[k]][codtab[ij][Tvar[k]]],cov[2+k], codtab[ij][Tvar[k]]);*/
- }
- for (k=1; k<=cptcovage;k++) cov[2+Tage[k]]=cov[2+Tage[k]]*cov[2];
- for (k=1; k<=cptcovprod;k++)
- cov[2+Tprod[k]]=nbcode[Tvard[k][1]][codtab[ij][Tvard[k][1]]]*nbcode[Tvard[k][2]][codtab[ij][Tvard[k][2]]];
-
- /*printf("ij=%d cptcovprod=%d tvar=%d ", ij, cptcovprod, Tvar[1]);*/
- /*printf("ij=%d cov[3]=%lf cov[4]=%lf \n",ij, cov[3],cov[4]);*/
- /*printf("ij=%d cov[3]=%lf \n",ij, cov[3]);*/
- out=matprod2(newm, pmij(pmmij,cov,ncovmodel,x,nlstate),1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, oldm);
-
+ cov[2]=agefin;
+
+ for (k=1; k<=cptcovn;k++) {
+ cov[2+k]=nbcode[Tvar[k]][codtab[ij][Tvar[k]]];
+ /* printf("ij=%d k=%d Tvar[k]=%d nbcode=%d cov=%lf codtab[ij][Tvar[k]]=%d \n",ij,k, Tvar[k],nbcode[Tvar[k]][codtab[ij][Tvar[k]]],cov[2+k], codtab[ij][Tvar[k]]);*/
+ }
+ for (k=1; k<=cptcovage;k++) cov[2+Tage[k]]=cov[2+Tage[k]]*cov[2];
+ for (k=1; k<=cptcovprod;k++)
+ cov[2+Tprod[k]]=nbcode[Tvard[k][1]][codtab[ij][Tvard[k][1]]] * nbcode[Tvard[k][2]][codtab[ij][Tvard[k][2]]];
+
+ /*printf("ij=%d cptcovprod=%d tvar=%d ", ij, cptcovprod, Tvar[1]);*/
+ /*printf("ij=%d cov[3]=%lf cov[4]=%lf \n",ij, cov[3],cov[4]);*/
+ /*printf("ij=%d cov[3]=%lf \n",ij, cov[3]);*/
+ out=matprod2(newm, pmij(pmmij,cov,ncovmodel,x,nlstate),1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, oldm); /* Bug Valgrind */
+
savm=oldm;
oldm=newm;
maxmax=0.;
@@ -1059,37 +1328,56 @@ double **prevalim(double **prlim, int nl
double **pmij(double **ps, double *cov, int ncovmodel, double *x, int nlstate )
{
- double s1, s2;
+ /* According to parameters values stored in x and the covariate's values stored in cov,
+ computes the probability to be observed in state j being in state i by appying the
+ model to the ncovmodel covariates (including constant and age).
+ lnpijopii=ln(pij/pii)= aij+bij*age+cij*v1+dij*v2+... = sum_nc=1^ncovmodel xij(nc)*cov[nc]
+ and, according on how parameters are entered, the position of the coefficient xij(nc) of the
+ ncth covariate in the global vector x is given by the formula:
+ j=i nc + ((i-1)*(nlstate+ndeath-1)+(j-2))*ncovmodel
+ Computes ln(pij/pii) (lnpijopii), deduces pij/pii by exponentiation,
+ sums on j different of i to get 1-pii/pii, deduces pii, and then all pij.
+ Outputs ps[i][j] the probability to be observed in j being in j according to
+ the values of the covariates cov[nc] and corresponding parameter values x[nc+shiftij]
+ */
+ double s1, lnpijopii;
/*double t34;*/
int i,j,j1, nc, ii, jj;
for(i=1; i<= nlstate; i++){
for(j=1; ji s1=%.17e, s2=%.17e %lx %lx\n",s1,s2,s1,s2); */
+ for (nc=1, lnpijopii=0.;nc <=ncovmodel; nc++){
+ /*lnpijopii += x[(i-1)*nlstate*ncovmodel+(j-2)*ncovmodel+nc+(i-1)*(ndeath-1)*ncovmodel]*cov[nc];*/
+ lnpijopii += x[nc + ((i-1)*(nlstate+ndeath-1)+(j-2))*ncovmodel]*cov[nc];
+/* printf("Int j>i s1=%.17e, lnpijopii=%.17e %lx %lx\n",s1,lnpijopii,s1,lnpijopii); */
}
- ps[i][j]=s2;
+ ps[i][j]=lnpijopii; /* In fact ln(pij/pii) */
}
}
- /*ps[3][2]=1;*/
for(i=1; i<= nlstate; i++){
s1=0;
- for(j=1; ji} pij/pii=(1-pii)/pii and thus pii is known from s1 */
ps[i][i]=1./(s1+1.);
+ /* Computing other pijs */
for(j=1; j1.e-8 ?(1.+bbh)*log(out[s1][s2])- bbh*log(savm[s1][s2]):log((1.+bbh)*out[s1][s2]));*/
if( s2 > nlstate){
- /* i.e. if s2 is a death state and if the date of death is known then the contribution
- to the likelihood is the probability to die between last step unit time and current
- step unit time, which is also equal to probability to die before dh
+ /* i.e. if s2 is a death state and if the date of death is known
+ then the contribution to the likelihood is the probability to
+ die between last step unit time and current step unit time,
+ which is also equal to probability to die before dh
minus probability to die before dh-stepm .
In version up to 0.92 likelihood was computed
as if date of death was unknown. Death was treated as any other
@@ -1281,7 +1580,28 @@ double func( double *x)
lower mortality.
*/
lli=log(out[s1][s2] - savm[s1][s2]);
- }else{
+
+
+ } else if (s2==-2) {
+ for (j=1,survp=0. ; j<=nlstate; j++)
+ survp += (1.+bbh)*out[s1][j]- bbh*savm[s1][j];
+ /*survp += out[s1][j]; */
+ lli= log(survp);
+ }
+
+ else if (s2==-4) {
+ for (j=3,survp=0. ; j<=nlstate; j++)
+ survp += (1.+bbh)*out[s1][j]- bbh*savm[s1][j];
+ lli= log(survp);
+ }
+
+ else if (s2==-5) {
+ for (j=1,survp=0. ; j<=2; j++)
+ survp += (1.+bbh)*out[s1][j]- bbh*savm[s1][j];
+ lli= log(survp);
+ }
+
+ else{
lli= log((1.+bbh)*out[s1][s2]- bbh*savm[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 */
}
@@ -1431,7 +1751,7 @@ double funcone( double *x)
{
/* Same as likeli but slower because of a lot of printf and if */
int i, ii, j, k, mi, d, kk;
- double l, ll[NLSTATEMAX], cov[NCOVMAX];
+ double l, ll[NLSTATEMAX+1], cov[NCOVMAX+1];
double **out;
double lli; /* Individual log likelihood */
double llt;
@@ -1475,7 +1795,11 @@ double funcone( double *x)
*/
if( s2 > nlstate && (mle <5) ){ /* Jackson */
lli=log(out[s1][s2] - savm[s1][s2]);
- } else if (mle==1){
+ } else if (s2==-2) {
+ for (j=1,survp=0. ; j<=nlstate; j++)
+ survp += (1.+bbh)*out[s1][j]- bbh*savm[s1][j];
+ lli= log(survp);
+ }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 */
@@ -1483,16 +1807,17 @@ double funcone( double *x)
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 */
+ } else{ /* mle=0 back to 1 */
+ lli= log((1.+bbh)*out[s1][s2]- bbh*savm[s1][s2]); /* linear interpolation */
+ /*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]); */
+ /*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,"%9d %6d %1d %1d %1d %1d %3d %10.6f %6.4f\
- %10.6f %10.6f %10.6f ", \
+ fprintf(ficresilk,"%9ld %6d %2d %2d %1d %1d %3d %11.6f %8.4f\
+ %11.6f %11.6f %11.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]);
for(k=1,llt=0.,l=0.; k<=nlstate; k++){
@@ -1577,6 +1902,7 @@ void mlikeli(FILE *ficres,double p[], in
powell(p,xi,npar,ftol,&iter,&fret,func);
+ free_matrix(xi,1,npar,1,npar);
fclose(ficrespow);
printf("\n#Number of iterations = %d, -2 Log likelihood = %.12f\n",iter,func(p));
fprintf(ficlog,"\n#Number of iterations = %d, -2 Log likelihood = %.12f \n",iter,func(p));
@@ -1693,7 +2019,7 @@ double hessii(double x[], double delta,
int i;
int l=1, lmax=20;
double k1,k2;
- double p2[NPARMAX+1];
+ double p2[MAXPARM+1]; /* identical to x */
double res;
double delt=0.0001, delts, nkhi=10.,nkhif=1., khi=1.e-4;
double fx;
@@ -1714,7 +2040,7 @@ double hessii(double x[], double delta,
/*res= (k1-2.0*fx+k2)/delt/delt; */
res= (k1+k2)/delt/delt/2.; /* Divided by because L and not 2*L */
-#ifdef DEBUG
+#ifdef DEBUGHESS
printf("%d %d k1=%.12e k2=%.12e xk1=%.12e xk2=%.12e delt=%.12e res=%.12e l=%d k=%d,fx=%.12e\n",theta,theta,k1,k2,x[theta]+delt,x[theta]-delt,delt,res, l, k,fx);
fprintf(ficlog,"%d %d k1=%.12e k2=%.12e xk1=%.12e xk2=%.12e delt=%.12e res=%.12e l=%d k=%d,fx=%.12e\n",theta,theta,k1,k2,x[theta]+delt,x[theta]-delt,delt,res, l, k,fx);
#endif
@@ -1740,7 +2066,7 @@ double hessij( double x[], double delti[
int i;
int l=1, l1, lmax=20;
double k1,k2,k3,k4,res,fx;
- double p2[NPARMAX+1];
+ double p2[MAXPARM+1];
int k;
fx=func(x);
@@ -1844,16 +2170,20 @@ void lubksb(double **a, int n, int *indx
}
}
+void pstamp(FILE *fichier)
+{
+ fprintf(fichier,"# %s.%s\n#%s\n#%s\n# %s", optionfilefiname,optionfilext,version,fullversion,strstart);
+}
+
/************ Frequencies ********************/
-void freqsummary(char fileres[], int iagemin, int iagemax, int **s, double **agev, int nlstate, int imx, int *Tvaraff, int **nbcode, int *ncodemax,double **mint,double **anint)
+void freqsummary(char fileres[], int iagemin, int iagemax, int **s, double **agev, int nlstate, int imx, int *Tvaraff, int **nbcode, int *ncodemax,double **mint,double **anint, char strstart[])
{ /* Some frequencies */
- int i, m, jk, k1,i1, j1, bool, z1,z2,j;
+ int i, m, jk, k1,i1, j1, bool, z1,j;
int first;
double ***freq; /* Frequencies */
double *pp, **prop;
double pos,posprop, k2, dateintsum=0,k2cpt=0;
- FILE *ficresp;
char fileresp[FILENAMELENGTH];
pp=vector(1,nlstate);
@@ -1865,7 +2195,7 @@ void freqsummary(char fileres[], int ia
fprintf(ficlog,"Problem with prevalence resultfile: %s\n", fileresp);
exit(0);
}
- freq= ma3x(-1,nlstate+ndeath,-1,nlstate+ndeath,iagemin,iagemax+3);
+ freq= ma3x(-5,nlstate+ndeath,-5,nlstate+ndeath,iagemin,iagemax+3);
j1=0;
j=cptcoveff;
@@ -1878,8 +2208,8 @@ void freqsummary(char fileres[], int ia
j1++;
/*printf("cptcoveff=%d Tvaraff=%d", cptcoveff,Tvaraff[1]);
scanf("%d", i);*/
- for (i=-1; i<=nlstate+ndeath; i++)
- for (jk=-1; jk<=nlstate+ndeath; jk++)
+ for (i=-5; i<=nlstate+ndeath; i++)
+ for (jk=-5; jk<=nlstate+ndeath; jk++)
for(m=iagemin; m <= iagemax+3; m++)
freq[i][jk][m]=0;
@@ -1918,7 +2248,7 @@ void freqsummary(char fileres[], int ia
}
/* fprintf(ficresp, "#Count between %.lf/%.lf/%.lf and %.lf/%.lf/%.lf\n",jprev1, mprev1,anprev1,jprev2, mprev2,anprev2);*/
-
+ pstamp(ficresp);
if (cptcovn>0) {
fprintf(ficresp, "\n#********** Variable ");
for (z1=1; z1<=cptcoveff; z1++) fprintf(ficresp, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtab[j1][z1]]);
@@ -1947,7 +2277,7 @@ void freqsummary(char fileres[], int ia
pos += freq[jk][m][i];
if(pp[jk]>=1.e-10){
if(first==1){
- printf(" %d.=%.0f loss[%d]=%.1f%%",jk,pp[jk],jk,100*pos/pp[jk]);
+ printf(" %d.=%.0f loss[%d]=%.1f%%",jk,pp[jk],jk,100*pos/pp[jk]);
}
fprintf(ficlog," %d.=%.0f loss[%d]=%.1f%%",jk,pp[jk],jk,100*pos/pp[jk]);
}else{
@@ -2004,7 +2334,7 @@ void freqsummary(char fileres[], int ia
dateintmean=dateintsum/k2cpt;
fclose(ficresp);
- free_ma3x(freq,-1,nlstate+ndeath,-1,nlstate+ndeath, iagemin, iagemax+3);
+ free_ma3x(freq,-5,nlstate+ndeath,-5,nlstate+ndeath, iagemin, iagemax+3);
free_vector(pp,1,nlstate);
free_matrix(prop,1,nlstate,iagemin, iagemax+3);
/* End of Freq */
@@ -2018,7 +2348,7 @@ void prevalence(double ***probs, double
We still use firstpass and lastpass as another selection.
*/
- int i, m, jk, k1, i1, j1, bool, z1,z2,j;
+ int i, m, jk, k1, i1, j1, bool, z1,j;
double ***freq; /* Frequencies */
double *pp, **prop;
double pos,posprop;
@@ -2076,7 +2406,8 @@ void prevalence(double ***probs, double
if( i <= iagemax){
if(posprop>=1.e-5){
probs[i][jk][j1]= prop[jk][i]/posprop;
- }
+ } else
+ printf("Warning Observed prevalence probs[%d][%d][%d]=%lf because of lack of cases\n",jk,i,j1,probs[i][jk][j1]);
}
}/* end jk */
}/* end i */
@@ -2113,7 +2444,7 @@ void concatwav(int wav[], int **dh, int
mi=0;
m=firstpass;
while(s[m][i] <= nlstate){
- if(s[m][i]>=1)
+ if(s[m][i]>=1 || s[m][i]==-2 || s[m][i]==-4 || s[m][i]==-5)
mw[++mi][i]=m;
if(m >=lastpass)
break;
@@ -2131,11 +2462,11 @@ void concatwav(int wav[], int **dh, int
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);
+ printf("Warning! No valid information for individual %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:%ld line=%d (skipped)\n",num[i],i);
+ fprintf(ficlog,"Warning! No valid information for individual %ld line=%d (skipped)\n",num[i],i);
}
} /* end mi==0 */
} /* End individuals */
@@ -2153,13 +2484,19 @@ void concatwav(int wav[], int **dh, int
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; /* 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(" 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. You MUST fix the contradiction between dates.\n",stepm);
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);
+ 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. You MUST fix the contradiction between dates.\n",stepm);
}
k=k+1;
- if (j >= jmax) jmax=j;
- if (j <= jmin) jmin=j;
+ if (j >= jmax){
+ jmax=j;
+ ijmax=i;
+ }
+ if (j <= jmin){
+ jmin=j;
+ ijmin=i;
+ }
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);*/
@@ -2167,10 +2504,17 @@ void concatwav(int wav[], int **dh, int
}
else{
j= rint( (agev[mw[mi+1][i]][i]*12 - agev[mw[mi][i]][i]*12));
- /* printf("%d %d %d %d\n", s[mw[mi][i]][i] ,s[mw[mi+1][i]][i],j,i);*/
+/* if (j<0) printf("%d %lf %lf %d %d %d\n", i,agev[mw[mi+1][i]][i], agev[mw[mi][i]][i],j,s[mw[mi][i]][i] ,s[mw[mi+1][i]][i]); */
+
k=k+1;
- if (j >= jmax) jmax=j;
- else if (j <= jmin)jmin=j;
+ if (j >= jmax) {
+ jmax=j;
+ ijmax=i;
+ }
+ else if (j <= jmin){
+ jmin=j;
+ ijmin=i;
+ }
/* 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){
@@ -2188,7 +2532,7 @@ void concatwav(int wav[], int **dh, int
dh[mi][i]=jk;
bh[mi][i]=0;
}else{ /* We want a negative bias in order to only have interpolation ie
- * at the price of an extra matrix product in likelihood */
+ * to avoid the price of an extra matrix product in likelihood */
dh[mi][i]=jk+1;
bh[mi][i]=ju;
}
@@ -2213,96 +2557,237 @@ void concatwav(int wav[], int **dh, int
} /* end wave */
}
jmean=sum/k;
- printf("Delay (in months) between two waves Min=%d Max=%d Mean=%f\n\n ",jmin, jmax,jmean);
- fprintf(ficlog,"Delay (in months) between two waves Min=%d Max=%d Mean=%f\n\n ",jmin, jmax,jmean);
+ printf("Delay (in months) between two waves Min=%d (for indiviudal %ld) Max=%d (%ld) Mean=%f\n\n ",jmin, num[ijmin], jmax, num[ijmax], jmean);
+ fprintf(ficlog,"Delay (in months) between two waves Min=%d (for indiviudal %d) Max=%d (%d) Mean=%f\n\n ",jmin, ijmin, jmax, ijmax, jmean);
}
/*********** Tricode ****************************/
void tricode(int *Tvar, int **nbcode, int imx)
{
-
- int Ndum[20],ij=1, k, j, i, maxncov=19;
- int cptcode=0;
+ /* Uses cptcovn+2*cptcovprod as the number of covariates */
+ /* Tvar[i]=atoi(stre); /* find 'n' in Vn and stores in Tvar. If model=V2+V1 Tvar[1]=2 and Tvar[2]=1 */
+
+ int Ndum[20],ij=1, k=0, j=0, i=0, maxncov=NCOVMAX;
+ int modmaxcovj=0; /* Modality max of covariates j */
cptcoveff=0;
for (k=0; k ");
@@ -3181,20 +3704,20 @@ fprintf(fichtm," \n Computing probabilities of dying over estepm months as a weighted average (i.e global mortality independent of initial healh state)
%s
\n",digitp);
/* } */
varppt = matrix(nlstate+1,nlstate+ndeath,nlstate+1,nlstate+ndeath);
-
- fprintf(ficresvij,"# Variance and covariance of health expectancies e.j \n# (weighted average of eij where weights are the stable prevalence in health states i\n");
+ pstamp(ficresvij);
+ fprintf(ficresvij,"# Variance and covariance of health expectancies e.j \n# (weighted average of eij where weights are ");
+ if(popbased==1)
+ fprintf(ficresvij,"the age specific prevalence observed (cross-sectionally) in the population i.e cross-sectionally\n in each health state (popbased=1) (mobilav=%d\n",mobilav);
+ else
+ fprintf(ficresvij,"the age specific period (stable) prevalences in each health state \n");
fprintf(ficresvij,"# Age");
for(i=1; i<=nlstate;i++)
for(j=1; j<=nlstate;j++)
- fprintf(ficresvij," Cov(e%1d, e%1d)",i,j);
+ fprintf(ficresvij," Cov(e.%1d, e.%1d)",i,j);
fprintf(ficresvij,"\n");
xp=vector(1,npar);
@@ -2542,8 +3048,7 @@ void varevsij(char optionfilefiname[], d
/* hstepm beeing the number of stepms, if hstepm=1 the length of hstepm is stepm.
nhstepm is the number of hstepm from age to agelim
nstepm is the number of stepm from age to agelin.
- Look at hpijx to understand the reason of that which relies in memory size
- and note for a fixed period like k years */
+ Look at function hpijx to understand why (it is linked to memory size questions) */
/* We decided (b) to get a life expectancy respecting the most precise curvature of the
survival function given by stepm (the optimization length). Unfortunately it
means that if the survival funtion is printed every two years of age and if
@@ -2609,7 +3114,7 @@ void varevsij(char optionfilefiname[], d
}
}
- for(j=1; j<= nlstate; j++){
+ for(j=1; j<= nlstate; j++){ /* Sum of wi * eij = e.j */
for(h=0; h<=nhstepm; h++){
for(i=1, gm[h][j]=0.;i<=nlstate;i++)
gm[h][j] += prlim[i][i]*p3mat[i][j][h];
@@ -2719,15 +3224,15 @@ void varevsij(char optionfilefiname[], d
free_vector(gmp,nlstate+1,nlstate+ndeath);
free_matrix(gradgp,1,npar,nlstate+1,nlstate+ndeath);
free_matrix(trgradgp,nlstate+1,nlstate+ndeath,1,npar); /* mu or p point j*/
- fprintf(ficgp,"\nset noparametric;set nolabel; set ter png small;set size 0.65, 0.65");
+ fprintf(ficgp,"\nunset parametric;unset label; set ter png small;set size 0.65, 0.65");
/* for(j=nlstate+1; j<= nlstate+ndeath; j++){ *//* Only the first actually */
- fprintf(ficgp,"\n set log y; set nolog x;set xlabel \"Age\"; set ylabel \"Force of mortality (year-1)\";");
+ fprintf(ficgp,"\n set log y; unset log x;set xlabel \"Age\"; set ylabel \"Force of mortality (year-1)\";");
/* fprintf(ficgp,"\n plot \"%s\" u 1:($3*%6.3f) not w l 1 ",fileresprobmorprev,YEARM/estepm); */
/* fprintf(ficgp,"\n replot \"%s\" u 1:(($3+1.96*$4)*%6.3f) t \"95\%% interval\" w l 2 ",fileresprobmorprev,YEARM/estepm); */
/* fprintf(ficgp,"\n replot \"%s\" u 1:(($3-1.96*$4)*%6.3f) not w l 2 ",fileresprobmorprev,YEARM/estepm); */
- fprintf(ficgp,"\n plot \"%s\" u 1:($3) not w l 1 ",subdirf(fileresprobmorprev));
- fprintf(ficgp,"\n replot \"%s\" u 1:(($3+1.96*$4)) t \"95\%% interval\" w l 2 ",subdirf(fileresprobmorprev));
- fprintf(ficgp,"\n replot \"%s\" u 1:(($3-1.96*$4)) not w l 2 ",subdirf(fileresprobmorprev));
+ fprintf(ficgp,"\n plot \"%s\" u 1:($3) not w l lt 2 ",subdirf(fileresprobmorprev));
+ fprintf(ficgp,"\n replot \"%s\" u 1:(($3+1.96*$4)) t \"95\%% interval\" w l lt 3 ",subdirf(fileresprobmorprev));
+ fprintf(ficgp,"\n replot \"%s\" u 1:(($3-1.96*$4)) not w l lt 3 ",subdirf(fileresprobmorprev));
fprintf(fichtm,"\n
File (multiple files are possible if covariates are present): %s\n",subdirf(fileresprobmorprev),subdirf(fileresprobmorprev));
fprintf(fichtm,"\n
Probability is computed over estepm=%d months.
\n", estepm,subdirf3(optionfilefiname,"varmuptjgr",digitp),digit);
/* fprintf(fichtm,"\n
Probability is computed over estepm=%d months and then divided by estepm and multiplied by %.0f in order to have the probability to die over a year
\n", stepm,YEARM,digitp,digit);
@@ -2748,7 +3253,7 @@ void varevsij(char optionfilefiname[], d
} /* end varevsij */
/************ Variance of prevlim ******************/
-void varprevlim(char fileres[], double **varpl, double **matcov, double x[], double delti[], int nlstate, int stepm, double bage, double fage, double **oldm, double **savm, double **prlim, double ftolpl, int ij)
+void varprevlim(char fileres[], double **varpl, double **matcov, double x[], double delti[], int nlstate, int stepm, double bage, double fage, double **oldm, double **savm, double **prlim, double ftolpl, int ij, char strstart[])
{
/* Variance of prevalence limit */
/* double **prevalim(double **prlim, int nlstate, double *xp, double age, double **oldm, double **savm,double ftolpl);*/
@@ -2761,8 +3266,9 @@ void varprevlim(char fileres[], double *
double **gradg, **trgradg;
double age,agelim;
int theta;
-
- fprintf(ficresvpl,"# Standard deviation of stable prevalences \n");
+
+ pstamp(ficresvpl);
+ fprintf(ficresvpl,"# Standard deviation of period (stable) prevalences \n");
fprintf(ficresvpl,"# Age");
for(i=1; i<=nlstate;i++)
fprintf(ficresvpl," %1d-%1d",i,i);
@@ -2831,7 +3337,7 @@ void varprevlim(char fileres[], double *
}
/************ Variance of one-step probabilities ******************/
-void varprob(char optionfilefiname[], double **matcov, double x[], double delti[], int nlstate, double bage, double fage, int ij, int *Tvar, int **nbcode, int *ncodemax)
+void varprob(char optionfilefiname[], double **matcov, double x[], double delti[], int nlstate, double bage, double fage, int ij, int *Tvar, int **nbcode, int *ncodemax, char strstart[])
{
int i, j=0, i1, k1, l1, t, tj;
int k2, l2, j1, z1;
@@ -2876,13 +3382,15 @@ void varprob(char optionfilefiname[], do
fprintf(ficlog,"Computing matrix of variance covariance of one-step probabilities: result on file '%s' \n",fileresprobcov);
printf("and correlation matrix of one-step probabilities: result on file '%s' \n",fileresprobcor);
fprintf(ficlog,"and correlation matrix of one-step probabilities: result on file '%s' \n",fileresprobcor);
-
+ pstamp(ficresprob);
fprintf(ficresprob,"#One-step probabilities and stand. devi in ()\n");
fprintf(ficresprob,"# Age");
+ pstamp(ficresprobcov);
fprintf(ficresprobcov,"#One-step probabilities and covariance matrix\n");
fprintf(ficresprobcov,"# Age");
+ pstamp(ficresprobcor);
fprintf(ficresprobcor,"#One-step probabilities and correlation matrix\n");
- fprintf(ficresprobcov,"# Age");
+ fprintf(ficresprobcor,"# Age");
for(i=1; i<=nlstate;i++)
@@ -2895,7 +3403,7 @@ void varprob(char optionfilefiname[], do
fprintf(ficresprobcov,"\n");
fprintf(ficresprobcor,"\n");
*/
- xp=vector(1,npar);
+ xp=vector(1,npar);
dnewm=matrix(1,(nlstate)*(nlstate+ndeath),1,npar);
doldm=matrix(1,(nlstate)*(nlstate+ndeath),1,(nlstate)*(nlstate+ndeath));
mu=matrix(1,(nlstate)*(nlstate+ndeath), (int) bage, (int)fage);
@@ -3048,7 +3556,7 @@ To be simple, these graphs help to under
/* Confidence intervalle of pij */
/*
- fprintf(ficgp,"\nset noparametric;unset label");
+ fprintf(ficgp,"\nunset parametric;unset label");
fprintf(ficgp,"\nset log y;unset log x; set xlabel \"Age\";set ylabel \"probability (year-1)\"");
fprintf(ficgp,"\nset ter png small\nset size 0.65,0.65");
fprintf(fichtm,"\n
Probability with confidence intervals expressed in year-1 :pijgr%s.png, ",optionfilefiname,optionfilefiname);
@@ -3079,6 +3587,13 @@ To be simple, these graphs help to under
/* Computing eigen value of matrix of covariance */
lc1=((v1+v2)+sqrt((v1+v2)*(v1+v2) - 4*(v1*v2-cv12*cv12)))/2.;
lc2=((v1+v2)-sqrt((v1+v2)*(v1+v2) - 4*(v1*v2-cv12*cv12)))/2.;
+ if ((lc2 <0) || (lc1 <0) ){
+ printf("Error: One eigen value of 2x2 matrix of covariance is negative, lc1=%11.3e, lc2=%11.3e, v1=%11.3e, v2=%11.3e, cv12=%11.3e.\n It means that the matrix was not well estimated (varpij), for i=%2d, j=%2d, age=%4d .\n See files %s and %s. Continuing by making them positive: WRONG RESULTS.\n", lc1, lc2, v1, v2, cv12, i, j, (int)age,fileresprobcov, fileresprobcor);
+ fprintf(ficlog,"Error: One eigen value of 2x2 matrix of covariance is negative, lc1=%11.3e, lc2=%11.3e, v1=%11.3e, v2=%11.3e, cv12=%11.3e\n", lc1, lc2, v1, v2, cv12);fflush(ficlog);
+ lc1=fabs(lc1);
+ lc2=fabs(lc2);
+ }
+
/* Eigen vectors */
v11=(1./sqrt(1+(v1-lc1)*(v1-lc1)/cv12/cv12));
/*v21=sqrt(1.-v11*v11); *//* error */
@@ -3133,6 +3648,8 @@ To be simple, these graphs help to under
}
free_ma3x(varpij,1,nlstate,1,nlstate+ndeath,(int) bage, (int)fage);
free_matrix(mu,1,(nlstate+ndeath)*(nlstate+ndeath),(int) bage, (int)fage);
+ free_matrix(doldm,1,(nlstate)*(nlstate+ndeath),1,(nlstate)*(nlstate+ndeath));
+ free_matrix(dnewm,1,(nlstate)*(nlstate+ndeath),1,npar);
free_vector(xp,1,npar);
fclose(ficresprob);
fclose(ficresprobcov);
@@ -3151,19 +3668,25 @@ void printinghtml(char fileres[], char t
double jprev2, double mprev2,double anprev2){
int jj1, k1, i1, cpt;
- fprintf(fichtm,"Result files (first order: no variance)
\n \
+ fprintf(fichtm,"");
+ fprintf(fichtm,"Result files (first order: no variance)
\n \
- Observed prevalence in each state (during the period defined between %.lf/%.lf/%.lf and %.lf/%.lf/%.lf): %s
\n ",
jprev1, mprev1,anprev1,jprev2, mprev2,anprev2,subdirf2(fileres,"p"),subdirf2(fileres,"p"));
fprintf(fichtm,"\
- Estimated transition probabilities over %d (stepm) months: %s
\n ",
stepm,subdirf2(fileres,"pij"),subdirf2(fileres,"pij"));
fprintf(fichtm,"\
- - Stable prevalence in each health state: %s
\n",
+ - Period (stable) prevalence in each health state: %s
\n",
subdirf2(fileres,"pl"),subdirf2(fileres,"pl"));
fprintf(fichtm,"\
- - Life expectancies by age and initial health status (estepm=%2d months): \
- %s
\n
\n",
estepm,subdirf2(fileres,"e"),subdirf2(fileres,"e"));
+ fprintf(fichtm,"\
+ - Population projections by age and states: \
+ %s
\n
");
}
/* Pij */
- fprintf(fichtm,"
- Pij or Conditional probabilities to be observed in state j being in state i, %d (stepm) months before: %s%d1.png
\
-",stepm,subdirf2(optionfilefiname,"pe"),jj1,subdirf2(optionfilefiname,"pe"),jj1);
+ fprintf(fichtm,"
- Pij or Conditional probabilities to be observed in state j being in state i, %d (stepm) months before: %s%d1.png
\
+",stepm,subdirf2(optionfilefiname,"pe"),jj1,subdirf2(optionfilefiname,"pe"),jj1,subdirf2(optionfilefiname,"pe"),jj1);
/* Quasi-incidences */
fprintf(fichtm,"
- 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: %s%d2.png
\
-",stepm,subdirf2(optionfilefiname,"pe"),jj1,subdirf2(optionfilefiname,"pe"),jj1);
- /* Stable prevalence in each health state */
+ before but expressed in per year i.e. quasi incidences if stepm is small and probabilities too: %s%d2.png
\
+",stepm,subdirf2(optionfilefiname,"pe"),jj1,subdirf2(optionfilefiname,"pe"),jj1,subdirf2(optionfilefiname,"pe"),jj1);
+ /* Period (stable) prevalence in each health state */
for(cpt=1; cpt
\
-",subdirf2(optionfilefiname,"p"),cpt,jj1,subdirf2(optionfilefiname,"p"),cpt,jj1);
+ fprintf(fichtm,"
- Period (stable) prevalence in each health state : %s%d%d.png
\
+",subdirf2(optionfilefiname,"p"),cpt,jj1,subdirf2(optionfilefiname,"p"),cpt,jj1,subdirf2(optionfilefiname,"p"),cpt,jj1);
}
for(cpt=1; cpt<=nlstate;cpt++) {
- fprintf(fichtm,"\n
- Health life expectancies by age and initial health state (%d): %s%d%d.png
\
-",cpt,subdirf2(optionfilefiname,"exp"),cpt,jj1,subdirf2(optionfilefiname,"exp"),cpt,jj1);
+ fprintf(fichtm,"\n
- Life expectancy by health state (%d) at initial age and its decomposition into health expectancies : %s%d%d.png
\
+",cpt,subdirf2(optionfilefiname,"exp"),cpt,jj1,subdirf2(optionfilefiname,"exp"),cpt,jj1,subdirf2(optionfilefiname,"exp"),cpt,jj1);
}
} /* end i1 */
}/* End k1 */
@@ -3202,7 +3725,7 @@ fprintf(fichtm," \n Result files (second order: variances)
\n\
+\n Result files (second order: variances)
\n\
- Parameter file with estimated parameters and covariance matrix: %s
\n", rfileres,rfileres);
fprintf(fichtm," - Variance of one-step probabilities: %s
\n",
@@ -3215,13 +3738,21 @@ fprintf(fichtm," \n
\n",
subdirf2(fileres,"probcor"),subdirf2(fileres,"probcor"));
fprintf(fichtm,"\
- - Variances and covariances of life expectancies by age and initial health status (estepm=%d months): %s
\n",
+ - Variances and covariances of health expectancies by age and initial health status (cov(eij,ekl)(estepm=%2d months): \
+ %s
\n
\n
\n",
estepm, subdirf2(fileres,"v"),subdirf2(fileres,"v"));
fprintf(fichtm,"\
- - Health expectancies with their variances (no covariance): %s
\n",
- subdirf2(fileres,"t"),subdirf2(fileres,"t"));
+ - Total life expectancy and total health expectancies to be spent in each health state e.j with their standard errors (if popbased=1, an additional computation is done using the cross-sectional prevalences, i.e population based) (estepm=%d months): %s
\n",
+ estepm, subdirf2(fileres,"t"),subdirf2(fileres,"t"));
fprintf(fichtm,"\
- - Standard deviation of stable prevalences: %s
\n",\
+ - Standard deviation of period (stable) prevalences: %s
\n",\
subdirf2(fileres,"vpl"),subdirf2(fileres,"vpl"));
/* if(popforecast==1) fprintf(fichtm,"\n */
@@ -3252,7 +3783,10 @@ prevalence (with 95%% confidence interva
",cpt,subdirf2(optionfilefiname,"v"),cpt,jj1,subdirf2(optionfilefiname,"v"),cpt,jj1);
}
fprintf(fichtm,"\n
- Total life expectancy by age and \
-health expectancies in states (1) and (2): %s%d.png
\
+health expectancies in states (1) and (2). If popbased=1 the smooth (due to the model) \
+true period expectancies (those weighted with period prevalences are also\
+ drawn in addition to the population based expectancies computed using\
+ observed and cahotic prevalences: %s%d.png
\
",subdirf2(optionfilefiname,"e"),jj1,subdirf2(optionfilefiname,"e"),jj1);
} /* end i1 */
}/* End k1 */
@@ -3264,8 +3798,8 @@ health expectancies in states (1) and (2
void printinggnuplot(char fileres[], char optionfilefiname[], double ageminpar, double agemaxpar, double fage , char pathc[], double p[]){
char dirfileres[132],optfileres[132];
- int m,cpt,k1,i,k,j,jk,k2,k3,ij,l;
- int ng;
+ int m0,cpt=0,k1=0,i=0,k=0,j=0,jk=0,k2=0,k3=0,ij=0,l=0;
+ int ng=0;
/* if((ficgp=fopen(optionfilegnuplot,"a"))==NULL) { */
/* printf("Problem with file %s",optionfilegnuplot); */
/* fprintf(ficlog,"Problem with file %s",optionfilegnuplot); */
@@ -3291,19 +3825,19 @@ plot [%.f:%.f] \"%s\" every :::%d::%d u
for (i=1; i<= nlstate ; i ++) {
if (i==cpt) fprintf(ficgp," \%%lf (\%%lf)");
- else fprintf(ficgp," \%%*lf (\%%*lf)");
+ else fprintf(ficgp," \%%*lf (\%%*lf)");
}
- fprintf(ficgp,"\" t\"Stable prevalence\" w l 0,\"%s\" every :::%d::%d u 1:($2+1.96*$3) \"\%%lf",subdirf2(fileres,"vpl"),k1-1,k1-1);
+ fprintf(ficgp,"\" t\"Period (stable) prevalence\" w l lt 1,\"%s\" every :::%d::%d u 1:($2+1.96*$3) \"\%%lf",subdirf2(fileres,"vpl"),k1-1,k1-1);
for (i=1; i<= nlstate ; i ++) {
if (i==cpt) fprintf(ficgp," \%%lf (\%%lf)");
else fprintf(ficgp," \%%*lf (\%%*lf)");
}
- fprintf(ficgp,"\" t\"95\%% CI\" w l 1,\"%s\" every :::%d::%d u 1:($2-1.96*$3) \"\%%lf",subdirf2(fileres,"vpl"),k1-1,k1-1);
+ fprintf(ficgp,"\" t\"95\%% CI\" w l lt 2,\"%s\" every :::%d::%d u 1:($2-1.96*$3) \"\%%lf",subdirf2(fileres,"vpl"),k1-1,k1-1);
for (i=1; i<= nlstate ; i ++) {
if (i==cpt) fprintf(ficgp," \%%lf (\%%lf)");
else fprintf(ficgp," \%%*lf (\%%*lf)");
}
- fprintf(ficgp,"\" t\"\" w l 1,\"%s\" every :::%d::%d u 1:($%d) t\"Observed prevalence \" w l 2",subdirf2(fileres,"p"),k1-1,k1-1,2+4*(cpt-1));
+ fprintf(ficgp,"\" t\"\" w l lt 2,\"%s\" every :::%d::%d u 1:($%d) t\"Observed prevalence \" w l lt 3",subdirf2(fileres,"p"),k1-1,k1-1,2+4*(cpt-1));
}
}
/*2 eme*/
@@ -3326,14 +3860,14 @@ plot [%.f:%.f] \"%s\" every :::%d::%d u
if (j==i) fprintf(ficgp," \%%lf (\%%lf)");
else fprintf(ficgp," \%%*lf (\%%*lf)");
}
- fprintf(ficgp,"\" t\"\" w l 0,");
+ fprintf(ficgp,"\" t\"\" w l lt 1,");
fprintf(ficgp,"\"%s\" every :::%d::%d u 1:($2+$3*2) \"\%%lf",subdirf2(fileres,"t"),k1-1,k1-1);
for (j=1; j<= nlstate+1 ; j ++) {
if (j==i) fprintf(ficgp," \%%lf (\%%lf)");
else fprintf(ficgp," \%%*lf (\%%*lf)");
}
- if (i== (nlstate+1)) fprintf(ficgp,"\" t\"\" w l 0");
- else fprintf(ficgp,"\" t\"\" w l 0,");
+ if (i== (nlstate+1)) fprintf(ficgp,"\" t\"\" w l lt 1");
+ else fprintf(ficgp,"\" t\"\" w l lt 1,");
}
}
@@ -3341,7 +3875,8 @@ plot [%.f:%.f] \"%s\" every :::%d::%d u
for (k1=1; k1<= m ; k1 ++) {
for (cpt=1; cpt<= nlstate ; cpt ++) {
- k=2+nlstate*(2*cpt-2);
+ /* k=2+nlstate*(2*cpt-2); */
+ k=2+(nlstate+1)*(cpt-1);
fprintf(ficgp,"\nset out \"%s%d%d.png\" \n",subdirf2(optionfilefiname,"exp"),cpt,k1);
fprintf(ficgp,"set ter png small\n\
set size 0.65,0.65\n\
@@ -3355,9 +3890,11 @@ plot [%.f:%.f] \"%s\" every :::%d::%d u
*/
for (i=1; i< nlstate ; i ++) {
- fprintf(ficgp," ,\"%s\" every :::%d::%d u 1:%d t \"e%d%d\" w l",subdirf2(fileres,"e"),k1-1,k1-1,k+2*i,cpt,i+1);
+ fprintf(ficgp," ,\"%s\" every :::%d::%d u 1:%d t \"e%d%d\" w l",subdirf2(fileres,"e"),k1-1,k1-1,k+i,cpt,i+1);
+ /* fprintf(ficgp," ,\"%s\" every :::%d::%d u 1:%d t \"e%d%d\" w l",subdirf2(fileres,"e"),k1-1,k1-1,k+2*i,cpt,i+1);*/
}
+ fprintf(ficgp," ,\"%s\" every :::%d::%d u 1:%d t \"e%d.\" w l",subdirf2(fileres,"e"),k1-1,k1-1,k+nlstate,cpt);
}
}
@@ -3415,9 +3952,9 @@ plot [%.f:%.f] \"%s\" u ($1==%d ? ($3):1
fprintf(ficgp," %f*exp(p%d+p%d*x",YEARM/stepm,i,i+1);
else
fprintf(ficgp," exp(p%d+p%d*x",i,i+1);
- ij=1;
+ ij=1;/* To be checked else nbcode[0][0] wrong */
for(j=3; j <=ncovmodel; j++) {
- if(((j-2)==Tage[ij]) &&(ij <=cptcovage)) {
+ if(((j-2)==Tage[ij]) &&(ij <=cptcovage)) { /* Bug valgrind */
fprintf(ficgp,"+p%d*%d*x",i+j-1,nbcode[Tvar[j-2]][codtab[jk][Tvar[j-2]]]);
ij++;
}
@@ -3916,28 +4453,28 @@ double gompertz(double x[])
{
double A,B,L=0.0,sump=0.,num=0.;
int i,n=0; /* n is the size of the sample */
+
for (i=0;i<=imx-1 ; i++) {
sump=sump+weight[i];
- sump=sump+1;
+ /* sump=sump+1;*/
num=num+1;
}
- /* for (i=1; i<=imx; i++)
+ /* for (i=0; i<=imx; i++)
if (wav[i]>0) printf("i=%d ageex=%lf agecens=%lf agedc=%lf cens=%d %d\n" ,i,ageexmed[i],agecens[i],agedc[i],cens[i],wav[i]);*/
- for (i=0;i<=imx-1 ; i++)
+ for (i=1;i<=imx ; i++)
{
- if (cens[i]==1 & wav[i]>1)
- A=-x[1]/(x[2])*
- (exp(x[2]/YEARM*(agecens[i]*12-agegomp*12))-exp(x[2]/YEARM*(ageexmed[i]*12-agegomp*12)));
+ if (cens[i] == 1 && wav[i]>1)
+ A=-x[1]/(x[2])*(exp(x[2]*(agecens[i]-agegomp))-exp(x[2]*(ageexmed[i]-agegomp)));
- if (cens[i]==0 & wav[i]>1)
- A=-x[1]/(x[2])*
- (exp(x[2]/YEARM*(agedc[i]*12-agegomp*12))-exp(x[2]/YEARM*(ageexmed[i]*12-agegomp*12)))
- +log(x[1]/YEARM)+x[2]/YEARM*(agedc[i]*12-agegomp*12)+log(YEARM);
+ if (cens[i] == 0 && wav[i]>1)
+ A=-x[1]/(x[2])*(exp(x[2]*(agedc[i]-agegomp))-exp(x[2]*(ageexmed[i]-agegomp)))
+ +log(x[1]/YEARM)+x[2]*(agedc[i]-agegomp)+log(YEARM);
- if (wav[i]>1 & agecens[i]>15) {
+ /*if (wav[i] > 1 && agecens[i] > 15) {*/ /* ??? */
+ if (wav[i] > 1 ) { /* ??? */
L=L+A*weight[i];
/* printf("\ni=%d A=%f L=%lf x[1]=%lf x[2]=%lf ageex=%lf agecens=%lf cens=%d agedc=%lf weight=%lf\n",i,A,L,x[1],x[2],ageexmed[i]*12,agecens[i]*12,cens[i],agedc[i]*12,weight[i]);*/
}
@@ -3948,18 +4485,68 @@ double gompertz(double x[])
return -2*L*num/sump;
}
-/******************* Printing html file ***********/
-void printinghtmlmort(char fileres[], char title[], char datafile[], int firstpass, \
- int lastpass, int stepm, int weightopt, char model[],\
- int imx, double p[],double **matcov){
- int i;
+#ifdef GSL
+/******************* Gompertz_f Likelihood ******************************/
+double gompertz_f(const gsl_vector *v, void *params)
+{
+ double A,B,LL=0.0,sump=0.,num=0.;
+ double *x= (double *) v->data;
+ int i,n=0; /* n is the size of the sample */
- fprintf(fichtm,"Result files
\n Force of mortality. Parameters of the Gompertz fit (with confidence interval in brackets):
");
- fprintf(fichtm," mu(age) =%lf*exp(%lf*(age-%d)) per year
",p[1],p[2],agegomp);
- for (i=1;i<=2;i++)
- fprintf(fichtm," p[%d] = %lf [%f ; %f]
\n",i,p[i],p[i]-2*sqrt(matcov[i][i]),p[i]+2*sqrt(matcov[i][i]));
- fprintf(fichtm,"
");
+ for (i=0;i<=imx-1 ; i++) {
+ sump=sump+weight[i];
+ /* sump=sump+1;*/
+ num=num+1;
+ }
+
+
+ /* for (i=0; i<=imx; i++)
+ if (wav[i]>0) printf("i=%d ageex=%lf agecens=%lf agedc=%lf cens=%d %d\n" ,i,ageexmed[i],agecens[i],agedc[i],cens[i],wav[i]);*/
+ printf("x[0]=%lf x[1]=%lf\n",x[0],x[1]);
+ for (i=1;i<=imx ; i++)
+ {
+ if (cens[i] == 1 && wav[i]>1)
+ A=-x[0]/(x[1])*(exp(x[1]*(agecens[i]-agegomp))-exp(x[1]*(ageexmed[i]-agegomp)));
+
+ if (cens[i] == 0 && wav[i]>1)
+ A=-x[0]/(x[1])*(exp(x[1]*(agedc[i]-agegomp))-exp(x[1]*(ageexmed[i]-agegomp)))
+ +log(x[0]/YEARM)+x[1]*(agedc[i]-agegomp)+log(YEARM);
+
+ /*if (wav[i] > 1 && agecens[i] > 15) {*/ /* ??? */
+ if (wav[i] > 1 ) { /* ??? */
+ LL=LL+A*weight[i];
+ /* printf("\ni=%d A=%f L=%lf x[1]=%lf x[2]=%lf ageex=%lf agecens=%lf cens=%d agedc=%lf weight=%lf\n",i,A,L,x[1],x[2],ageexmed[i]*12,agecens[i]*12,cens[i],agedc[i]*12,weight[i]);*/
+ }
+ }
+
+ /*printf("x1=%2.9f x2=%2.9f x3=%2.9f L=%f\n",x[1],x[2],x[3],L);*/
+ printf("x[0]=%lf x[1]=%lf -2*LL*num/sump=%lf\n",x[0],x[1],-2*LL*num/sump);
+
+ return -2*LL*num/sump;
+}
+#endif
+
+/******************* Printing html file ***********/
+void printinghtmlmort(char fileres[], char title[], char datafile[], int firstpass, \
+ int lastpass, int stepm, int weightopt, char model[],\
+ int imx, double p[],double **matcov,double agemortsup){
+ int i,k;
+
+ fprintf(fichtm,"
");
+
+fprintf(fichtm,"Result files
\n Force of mortality. Parameters of the Gompertz fit (with confidence interval in brackets):
");
+ fprintf(fichtm," mu(age) =%lf*exp(%lf*(age-%d)) per year
",p[1],p[2],agegomp);
+ for (i=1;i<=2;i++)
+ fprintf(fichtm," p[%d] = %lf [%f ; %f]
\n",i,p[i],p[i]-2*sqrt(matcov[i][i]),p[i]+2*sqrt(matcov[i][i]));
+ fprintf(fichtm,"
");
fprintf(fichtm,"Life table
\n
");
+
+ fprintf(fichtm,"\nAge l
");
+
+ for (k=agegomp;k<(agemortsup-2);k++)
+ fprintf(fichtm,"%d %.0lf %lf %.0lf %.0lf %.0lf %lf
\n",k,lsurv[k],p[1]*exp(p[2]*(k-agegomp)),(p[1]*exp(p[2]*(k-agegomp)))*lsurv[k],lpop[k],tpop[k],tpop[k]/lsurv[k]);
+
+
fflush(fichtm);
}
@@ -3986,8 +4573,402 @@ void printinggnuplotmort(char fileres[],
}
+int readdata(char datafile[], int firstobs, int lastobs, int *imax)
+{
+
+ /*-------- data file ----------*/
+ FILE *fic;
+ char dummy[]=" ";
+ int i, j, n;
+ int linei, month, year,iout;
+ char line[MAXLINE], linetmp[MAXLINE];
+ char stra[80], strb[80];
+ char *stratrunc;
+ int lstra;
+
+
+ if((fic=fopen(datafile,"r"))==NULL) {
+ printf("Problem while opening datafile: %s\n", datafile);return 1;
+ fprintf(ficlog,"Problem while opening datafile: %s\n", datafile);return 1;
+ }
+
+ i=1;
+ linei=0;
+ while ((fgets(line, MAXLINE, fic) != NULL) &&((i >= firstobs) && (i <=lastobs))) {
+ linei=linei+1;
+ for(j=strlen(line); j>=0;j--){ /* Untabifies line */
+ if(line[j] == '\t')
+ line[j] = ' ';
+ }
+ for(j=strlen(line)-1; (line[j]==' ')||(line[j]==10)||(line[j]==13);j--){
+ ;
+ };
+ line[j+1]=0; /* Trims blanks at end of line */
+ if(line[0]=='#'){
+ fprintf(ficlog,"Comment line\n%s\n",line);
+ printf("Comment line\n%s\n",line);
+ continue;
+ }
+ trimbb(linetmp,line); /* Trims multiple blanks in line */
+ for (j=0; line[j]!='\0';j++){
+ line[j]=linetmp[j];
+ }
+
+
+ for (j=maxwav;j>=1;j--){
+ cutv(stra, strb, line, ' ');
+ if(strb[0]=='.') { /* Missing status */
+ lval=-1;
+ }else{
+ errno=0;
+ lval=strtol(strb,&endptr,10);
+ /* if (errno == ERANGE && (lval == LONG_MAX || lval == LONG_MIN))*/
+ if( strb[0]=='\0' || (*endptr != '\0')){
+ printf("Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a status of wave %d. Setting maxwav=%d might be wrong. Exiting.\n", strb, linei,i,line,j,maxwav);
+ fprintf(ficlog,"Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a status of wave %d. Setting maxwav=%d might be wrong. Exiting.\n", strb, linei,i,line,j,maxwav);fflush(ficlog);
+ return 1;
+ }
+ }
+ s[j][i]=lval;
+
+ strcpy(line,stra);
+ cutv(stra, strb,line,' ');
+ if(iout=sscanf(strb,"%d/%d",&month, &year) != 0){
+ }
+ else if(iout=sscanf(strb,"%s.") != 0){
+ month=99;
+ year=9999;
+ }else{
+ printf("Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a date of interview (mm/yyyy or .) at wave %d. Exiting.\n",strb, linei,i, line,j);
+ fprintf(ficlog,"Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a date of interview (mm/yyyy or .) at wave %d. Exiting.\n",strb, linei,i, line,j);fflush(ficlog);
+ return 1;
+ }
+ anint[j][i]= (double) year;
+ mint[j][i]= (double)month;
+ strcpy(line,stra);
+ } /* ENd Waves */
+
+ cutv(stra, strb,line,' ');
+ if(iout=sscanf(strb,"%d/%d",&month, &year) != 0){
+ }
+ else if(iout=sscanf(strb,"%s.",dummy) != 0){
+ month=99;
+ year=9999;
+ }else{
+ printf("Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a date of death (mm/yyyy or .). Exiting.\n",strb, linei,i,line);
+ fprintf(ficlog,"Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a date of death (mm/yyyy or .). Exiting.\n",strb, linei,i,line);fflush(ficlog);
+ return 1;
+ }
+ andc[i]=(double) year;
+ moisdc[i]=(double) month;
+ strcpy(line,stra);
+
+ cutv(stra, strb,line,' ');
+ if(iout=sscanf(strb,"%d/%d",&month, &year) != 0){
+ }
+ else if(iout=sscanf(strb,"%s.") != 0){
+ month=99;
+ year=9999;
+ }else{
+ printf("Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a date of birth (mm/yyyy or .). Exiting.\n",strb, linei,i,line);
+ fprintf(ficlog,"Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a date of birth (mm/yyyy or .). Exiting.\n",strb, linei,i,line);fflush(ficlog);
+ return 1;
+ }
+ if (year==9999) {
+ printf("Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a date of birth (mm/yyyy) but at least the year of birth should be given. Exiting.\n",strb, linei,i,line);
+ fprintf(ficlog,"Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a date of birth (mm/yyyy) but at least the year of birth should be given. Exiting.\n",strb, linei,i,line);fflush(ficlog);
+ return 1;
+
+ }
+ annais[i]=(double)(year);
+ moisnais[i]=(double)(month);
+ strcpy(line,stra);
+
+ cutv(stra, strb,line,' ');
+ errno=0;
+ dval=strtod(strb,&endptr);
+ if( strb[0]=='\0' || (*endptr != '\0')){
+ printf("Error reading data around '%f' at line number %d, \"%s\" for individual %d\nShould be a weight. Exiting.\n",dval, i,line,linei);
+ fprintf(ficlog,"Error reading data around '%f' at line number %d, \"%s\" for individual %d\nShould be a weight. Exiting.\n",dval, i,line,linei);
+ fflush(ficlog);
+ return 1;
+ }
+ weight[i]=dval;
+ strcpy(line,stra);
+
+ for (j=ncovcol;j>=1;j--){
+ cutv(stra, strb,line,' ');
+ if(strb[0]=='.') { /* Missing status */
+ lval=-1;
+ }else{
+ errno=0;
+ lval=strtol(strb,&endptr,10);
+ if( strb[0]=='\0' || (*endptr != '\0')){
+ printf("Error reading data around '%ld' at line number %d for individual %d, '%s'\nShould be a covariate value (=0 for the reference or 1 for alternative). Exiting.\n",lval, linei,i, line);
+ fprintf(ficlog,"Error reading data around '%ld' at line number %d for individual %d, '%s'\nShould be a covariate value (=0 for the reference or 1 for alternative). Exiting.\n",lval, linei,i, line);fflush(ficlog);
+ return 1;
+ }
+ }
+ if(lval <-1 || lval >1){
+ printf("Error reading data around '%ld' at line number %d for individual %d, '%s'\n \
+ Should be a value of %d(nth) covariate (0 should be the value for the reference and 1\n \
+ for the alternative. IMaCh does not build design variables automatically, do it yourself.\n \
+ For example, for multinomial values like 1, 2 and 3,\n \
+ build V1=0 V2=0 for the reference value (1),\n \
+ V1=1 V2=0 for (2) \n \
+ and V1=0 V2=1 for (3). V1=1 V2=1 should not exist and the corresponding\n \
+ output of IMaCh is often meaningless.\n \
+ Exiting.\n",lval,linei, i,line,j);
+ fprintf(ficlog,"Error reading data around '%ld' at line number %d for individual %d, '%s'\n \
+ Should be a value of %d(nth) covariate (0 should be the value for the reference and 1\n \
+ for the alternative. IMaCh does not build design variables automatically, do it yourself.\n \
+ For example, for multinomial values like 1, 2 and 3,\n \
+ build V1=0 V2=0 for the reference value (1),\n \
+ V1=1 V2=0 for (2) \n \
+ and V1=0 V2=1 for (3). V1=1 V2=1 should not exist and the corresponding\n \
+ output of IMaCh is often meaningless.\n \
+ Exiting.\n",lval,linei, i,line,j);fflush(ficlog);
+ return 1;
+ }
+ covar[j][i]=(double)(lval);
+ strcpy(line,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("%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;
+ } /* End loop reading data */
+
+ *imax=i-1; /* Number of individuals */
+ fclose(fic);
+
+ return (0);
+ endread:
+ printf("Exiting readdata: ");
+ fclose(fic);
+ return (1);
+
+
+
+}
+
+int decodemodel ( char model[], int lastobs)
+{
+ int i, j, k;
+ int i1, j1, k1, k2;
+ char modelsav[80];
+ char stra[80], strb[80], strc[80], strd[80],stre[80];
+
+ if (strlen(model) >1){ /* If there is at least 1 covariate */
+ j=0, j1=0, k1=1, k2=1;
+ j=nbocc(model,'+'); /* j=Number of '+' */
+ j1=nbocc(model,'*'); /* j1=Number of '*' */
+ cptcovn=j+1; /* Number of covariates V1+V2*age+V3 =>(2 plus signs) + 1=3
+ but the covariates which are product must be computed and stored. */
+ cptcovprod=j1; /*Number of products V1*V2 +v3*age = 2 */
+
+ strcpy(modelsav,model);
+ if (strstr(model,"AGE") !=0){
+ printf("Error. AGE must be in lower case 'age' model=%s ",model);
+ fprintf(ficlog,"Error. AGE must be in lower case model=%s ",model);fflush(ficlog);
+ return 1;
+ }
+ if (strstr(model,"v") !=0){
+ printf("Error. 'v' must be in upper case 'V' model=%s ",model);
+ fprintf(ficlog,"Error. 'v' must be in upper case model=%s ",model);fflush(ficlog);
+ return 1;
+ }
+
+ /* This loop fills the array Tvar from the string 'model'.*/
+ /* j is the number of + signs in the model V1+V2+V3 j=2 i=3 to 1 */
+ /* modelsav=V2+V1+V4+age*V3 strb=age*V3 stra=V2+V1+V4 */
+ /* k=4 (age*V3) Tvar[k=4]= 3 (from V3) Tage[cptcovage=1]=4 */
+ /* k=3 V4 Tvar[k=3]= 4 (from V4) */
+ /* k=2 V1 Tvar[k=2]= 1 (from V1) */
+ /* k=1 Tvar[1]=2 (from V2) */
+ /* k=5 Tvar[5] */
+ /* for (k=1; k<=cptcovn;k++) { */
+ /* cov[2+k]=nbcode[Tvar[k]][codtab[ij][Tvar[k]]]; */
+ /* } */
+ /* for (k=1; k<=cptcovage;k++) cov[2+Tage[k]]=cov[2+Tage[k]]*cov[2]; */
+ for(k=cptcovn; k>=1;k--){
+ cutv(stra,strb,modelsav,'+'); /* keeps in strb after the first '+'
+ modelsav==V2+V1+V4+V3*age strb=V3*age stra=V2+V1+V4
+ */
+ if (nbocc(modelsav,'+')==0) strcpy(strb,modelsav); /* and analyzes it */
+ /* printf("i=%d a=%s b=%s sav=%s\n",i, stra,strb,modelsav);*/
+ /*scanf("%d",i);*/
+ if (strchr(strb,'*')) { /* Model includes a product V2+V1+V4+V3*age strb=V3*age */
+ cutv(strd,strc,strb,'*'); /* strd*strc Vm*Vn: strb=V3*age strc=age strd=V3 ; V3*V2 strc=V2, strd=V3 */
+ if (strcmp(strc,"age")==0) { /* Vn*age */
+ cptcovprod--;
+ cutv(strb,stre,strd,'V'); /* stre="V3" */
+ Tvar[k]=atoi(stre); /* V2+V1+V4+V3*age Tvar[4]=2 ; V1+V2*age Tvar[2]=2 */
+ cptcovage++; /* Sums the number of covariates which include age as a product */
+ Tage[cptcovage]=k; /* Tage[1] = 4 */
+ /*printf("stre=%s ", stre);*/
+ } else if (strcmp(strd,"age")==0) { /* or age*Vn */
+ cptcovprod--;
+ cutv(strb,stre,strc,'V');
+ Tvar[k]=atoi(stre);
+ cptcovage++;
+ Tage[cptcovage]=k;
+ } else { /* Age is not in the model product V2+V1+V1*V4+V3*age+V3*V2 strb=V3*V2*/
+ /* loops on k1=1 (V3*V2) and k1=2 V4*V3 */
+ cutv(strb,stre,strc,'V'); /* strc= Vn, stre is n; strb=V3*V2 stre=3 strc=*/
+ Tvar[k]=ncovcol+k1; /* For model-covariate k tells which data-covariate to use but
+ because this model-covariate is a construction we invent a new column
+ ncovcol + k1
+ If already ncovcol=4 and model=V2+V1+V1*V4+age*V3+V3*V2
+ Tvar[3=V1*V4]=4+1 Tvar[5=V3*V2]=4 + 2= 6, etc */
+ cutv(strb,strc,strd,'V'); /* strd was Vm, strc is m */
+ Tprod[k1]=k; /* Tprod[1]=3(=V1*V4) for V2+V1+V1*V4+age*V3+V3*V2 */
+ Tvard[k1][1]=atoi(strc); /* m 1 for V1*/
+ Tvard[k1][2]=atoi(stre); /* n 4 for V4*/
+ Tvar[cptcovn+k2]=Tvard[k1][1]; /* Tvar[(cptcovn=4+k2=1)=5]= 1 (V1) */
+ Tvar[cptcovn+k2+1]=Tvard[k1][2]; /* Tvar[(cptcovn=4+(k2=1)+1)=6]= 4 (V4) */
+ for (i=1; i<=lastobs;i++){
+ /* Computes the new covariate which is a product of
+ covar[n][i]* covar[m][i] and stores it at ncovol+k1 */
+ covar[ncovcol+k1][i]=covar[atoi(stre)][i]*covar[atoi(strc)][i];
+ }
+ k1++;
+ k2=k2+2;
+ } /* End age is not in the model */
+ } /* End if model includes a product */
+ else { /* no more sum */
+ /*printf("d=%s c=%s b=%s\n", strd,strc,strb);*/
+ /* scanf("%d",i);*/
+ cutv(strd,strc,strb,'V');
+ Tvar[k]=atoi(strc);
+ }
+ strcpy(modelsav,stra); /* modelsav=V2+V1+V4 stra=V2+V1+V4 */
+ /*printf("a=%s b=%s sav=%s\n", stra,strb,modelsav);
+ scanf("%d",i);*/
+ } /* end of loop + */
+ } /* end model */
+
+ /*The number n of Vn is stored in Tvar. cptcovage =number of age covariate. Tage gives the position of age. cptcovprod= number of products.
+ If model=V1+V1*age then Tvar[1]=1 Tvar[2]=1 cptcovage=1 Tage[1]=2 cptcovprod=0*/
+
+ /* printf("tvar1=%d tvar2=%d tvar3=%d cptcovage=%d Tage=%d",Tvar[1],Tvar[2],Tvar[3],cptcovage,Tage[1]);
+ printf("cptcovprod=%d ", cptcovprod);
+ fprintf(ficlog,"cptcovprod=%d ", cptcovprod);
+
+ scanf("%d ",i);*/
+
+
+ return (0); /* with covar[new additional covariate if product] and Tage if age */
+ endread:
+ printf("Exiting decodemodel: ");
+ return (1);
+}
+
+calandcheckages(int imx, int maxwav, double *agemin, double *agemax, int *nberr, int *nbwarn )
+{
+ int i, m;
+
+ for (i=1; i<=imx; i++) {
+ for(m=2; (m<= maxwav); m++) {
+ if (((int)mint[m][i]== 99) && (s[m][i] <= nlstate)){
+ anint[m][i]=9999;
+ s[m][i]=-1;
+ }
+ if((int)moisdc[i]==99 && (int)andc[i]==9999 && s[m][i]>nlstate){
+ *nberr++;
+ 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){
+ *nberr++;
+ 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 */
+ }
+ }
+ }
+
+ for (i=1; i<=imx; i++) {
+ agedc[i]=(moisdc[i]/12.+andc[i])-(moisnais[i]/12.+annais[i]);
+ for(m=firstpass; (m<= lastpass); m++){
+ if(s[m][i] >0 || s[m][i]==-2 || s[m][i]==-4 || s[m][i]==-5){
+ if (s[m][i] >= nlstate+1) {
+ if(agedc[i]>0)
+ if((int)moisdc[i]!=99 && (int)andc[i]!=9999)
+ agev[m][i]=agedc[i];
+ /*if(moisdc[i]==99 && andc[i]==9999) s[m][i]=-1;*/
+ else {
+ if ((int)andc[i]!=9999){
+ nbwarn++;
+ 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;
+ }
+ }
+ }
+ else if(s[m][i] !=9){ /* Standard case, age in fractional
+ years but with the precision of a month */
+ agev[m][i]=(mint[m][i]/12.+1./24.+anint[m][i])-(moisnais[i]/12.+1./24.+annais[i]);
+ if((int)mint[m][i]==99 || (int)anint[m][i]==9999)
+ agev[m][i]=1;
+ else if(agev[m][i] < *agemin){
+ *agemin=agev[m][i];
+ printf(" Min anint[%d][%d]=%.2f annais[%d]=%.2f, agemin=%.2f\n",m,i,anint[m][i], i,annais[i], *agemin);
+ }
+ else if(agev[m][i] >*agemax){
+ *agemax=agev[m][i];
+ printf(" Max anint[%d][%d]=%.0f annais[%d]=%.0f, agemax=%.2f\n",m,i,anint[m][i], i,annais[i], *agemax);
+ }
+ /*agev[m][i]=anint[m][i]-annais[i];*/
+ /* agev[m][i] = age[i]+2*m;*/
+ }
+ else { /* =9 */
+ agev[m][i]=1;
+ s[m][i]=-1;
+ }
+ }
+ else /*= 0 Unknown */
+ agev[m][i]=1;
+ }
+
+ }
+ for (i=1; i<=imx; i++) {
+ for(m=firstpass; (m<=lastpass); m++){
+ if (s[m][i] > (nlstate+ndeath)) {
+ *nberr++;
+ printf("Error: on wave %d of individual %d status %d > (nlstate+ndeath)=(%d+%d)=%d\n",m,i,s[m][i],nlstate, ndeath, nlstate+ndeath);
+ fprintf(ficlog,"Error: on wave %d of individual %d status %d > (nlstate+ndeath)=(%d+%d)=%d\n",m,i,s[m][i],nlstate, ndeath, nlstate+ndeath);
+ return 1;
+ }
+ }
+ }
+
+ /*for (i=1; i<=imx; i++){
+ for (m=firstpass; (m
%s \
+ fprintf(fichtmcov,"\n
%s \
\n\
Title=%s
Datafile=%s Firstpass=%d Lastpass=%d Stepm=%d Weight=%d Model=%s
\n",\
- fileres,version,fullversion,title,datafile,firstpass,lastpass,stepm, weightopt, model);
+ optionfilehtmcov,version,fullversion,title,datafile,firstpass,lastpass,stepm, weightopt, model);
}
- fprintf(fichtm,"\n
%s \
+ fprintf(fichtm,"\n
%s \
\n\
Title=%s
Datafile=%s Firstpass=%d Lastpass=%d Stepm=%d Weight=%d Model=%s
\n\
\n\
\
\n",\
- fileres,version,fullversion,title,datafile,firstpass,lastpass,stepm, weightopt, model,\
+ optionfilehtm,version,fullversion,title,datafile,firstpass,lastpass,stepm, weightopt, model,\
+ optionfilefiname,optionfilext,optionfilefiname,optionfilext,\
fileres,fileres,\
filelog,filelog,optionfilegnuplot,optionfilegnuplot,strstart);
fflush(fichtm);
@@ -4736,7 +5581,7 @@ Title=%s Parameter files
\n\
+ - Parameter file: %s.%s
\n\
- Copy of the parameter file: o%s
\n\
- Log file of the run: %s
\n\
- Gnuplot file name: %s
\n\
- Date and time at start: %s
Datafile=%s Firstpass=%d La
/* Calculates basic frequencies. Computes observed prevalence at single age
and prints on file fileres'p'. */
- freqsummary(fileres, agemin, agemax, s, agev, nlstate, imx,Tvaraff,nbcode, ncodemax,mint,anint);
+ freqsummary(fileres, agemin, agemax, s, agev, nlstate, imx,Tvaraff,nbcode, ncodemax,mint,anint,strstart);
fprintf(fichtm,"\n");
fprintf(fichtm,"
Total number of observations=%d
\n\
@@ -4755,8 +5600,10 @@ Interval (in months) between two waves:
p=param[1][1]; /* *(*(*(param +1)+1)+0) */
globpr=0; /* To get the number ipmx of contributions and the sum of weights*/
+
if (mle==-3){
- ximort=matrix(1,NDIM,1,NDIM);
+ ximort=matrix(1,NDIM,1,NDIM);
+/* ximort=gsl_matrix_alloc(1,NDIM,1,NDIM); */
cens=ivector(1,n);
ageexmed=vector(1,n);
agecens=vector(1,n);
@@ -4764,9 +5611,9 @@ Interval (in months) between two waves:
for (i=1; i<=imx; i++){
dcwave[i]=-1;
- for (j=1; j<=lastpass; j++)
- if (s[j][i]>nlstate) {
- dcwave[i]=j;
+ for (m=firstpass; m<=lastpass; m++)
+ if (s[m][i]>nlstate) {
+ dcwave[i]=m;
/* printf("i=%d j=%d s=%d dcwave=%d\n",i,j, s[j][i],dcwave[i]);*/
break;
}
@@ -4775,12 +5622,16 @@ Interval (in months) between two waves:
for (i=1; i<=imx; i++) {
if (wav[i]>0){
ageexmed[i]=agev[mw[1][i]][i];
- j=wav[i];agecens[i]=1.;
- if (ageexmed[i]>1 & wav[i]>0) agecens[i]=agev[mw[j][i]][i];
- cens[i]=1;
-
- if (ageexmed[i]<1) cens[i]=-1;
- if (agedc[i]< AGESUP & agedc[i]>1 & dcwave[i]>firstpass & dcwave[i]<=lastpass) cens[i]=0 ;
+ j=wav[i];
+ agecens[i]=1.;
+
+ if (ageexmed[i]> 1 && wav[i] > 0){
+ agecens[i]=agev[mw[j][i]][i];
+ cens[i]= 1;
+ }else if (ageexmed[i]< 1)
+ cens[i]= -1;
+ if (agedc[i]< AGESUP && agedc[i]>1 && dcwave[i]>firstpass && dcwave[i]<=lastpass)
+ cens[i]=0 ;
}
else cens[i]=-1;
}
@@ -4789,29 +5640,114 @@ Interval (in months) between two waves:
for (j=1;j<=NDIM;j++)
ximort[i][j]=(i == j ? 1.0 : 0.0);
}
-
- p[1]=0.1; p[2]=0.1;
+
+ p[1]=0.0268; p[NDIM]=0.083;
/*printf("%lf %lf", p[1], p[2]);*/
- printf("Powell\n"); fprintf(ficlog,"Powell\n");
- strcpy(filerespow,"pow-mort");
- strcat(filerespow,fileres);
- if((ficrespow=fopen(filerespow,"w"))==NULL) {
- printf("Problem with resultfile: %s\n", filerespow);
- fprintf(ficlog,"Problem with resultfile: %s\n", filerespow);
- }
- fprintf(ficrespow,"# Powell\n# iter -2*LL");
- /* for (i=1;i<=nlstate;i++)
- for(j=1;j<=nlstate+ndeath;j++)
- if(j!=i)fprintf(ficrespow," p%1d%1d",i,j);
- */
- fprintf(ficrespow,"\n");
+#ifdef GSL
+ printf("GSL optimization\n"); fprintf(ficlog,"Powell\n");
+#elsedef
+ printf("Powell\n"); fprintf(ficlog,"Powell\n");
+#endif
+ strcpy(filerespow,"pow-mort");
+ strcat(filerespow,fileres);
+ if((ficrespow=fopen(filerespow,"w"))==NULL) {
+ printf("Problem with resultfile: %s\n", filerespow);
+ fprintf(ficlog,"Problem with resultfile: %s\n", filerespow);
+ }
+#ifdef GSL
+ fprintf(ficrespow,"# GSL optimization\n# iter -2*LL");
+#elsedef
+ fprintf(ficrespow,"# Powell\n# iter -2*LL");
+#endif
+ /* for (i=1;i<=nlstate;i++)
+ for(j=1;j<=nlstate+ndeath;j++)
+ if(j!=i)fprintf(ficrespow," p%1d%1d",i,j);
+ */
+ fprintf(ficrespow,"\n");
+#ifdef GSL
+ /* gsl starts here */
+ T = gsl_multimin_fminimizer_nmsimplex;
+ gsl_multimin_fminimizer *sfm = NULL;
+ gsl_vector *ss, *x;
+ gsl_multimin_function minex_func;
+
+ /* Initial vertex size vector */
+ ss = gsl_vector_alloc (NDIM);
+
+ if (ss == NULL){
+ GSL_ERROR_VAL ("failed to allocate space for ss", GSL_ENOMEM, 0);
+ }
+ /* Set all step sizes to 1 */
+ gsl_vector_set_all (ss, 0.001);
- powell(p,ximort,NDIM,ftol,&iter,&fret,gompertz);
+ /* Starting point */
+
+ x = gsl_vector_alloc (NDIM);
+
+ if (x == NULL){
+ gsl_vector_free(ss);
+ GSL_ERROR_VAL ("failed to allocate space for x", GSL_ENOMEM, 0);
+ }
+
+ /* Initialize method and iterate */
+ /* p[1]=0.0268; p[NDIM]=0.083; */
+/* gsl_vector_set(x, 0, 0.0268); */
+/* gsl_vector_set(x, 1, 0.083); */
+ gsl_vector_set(x, 0, p[1]);
+ gsl_vector_set(x, 1, p[2]);
+
+ minex_func.f = &gompertz_f;
+ minex_func.n = NDIM;
+ minex_func.params = (void *)&p; /* ??? */
+
+ sfm = gsl_multimin_fminimizer_alloc (T, NDIM);
+ gsl_multimin_fminimizer_set (sfm, &minex_func, x, ss);
+
+ printf("Iterations beginning .....\n\n");
+ printf("Iter. # Intercept Slope -Log Likelihood Simplex size\n");
+
+ iteri=0;
+ while (rval == GSL_CONTINUE){
+ iteri++;
+ status = gsl_multimin_fminimizer_iterate(sfm);
+
+ if (status) printf("error: %s\n", gsl_strerror (status));
+ fflush(0);
+
+ if (status)
+ break;
+
+ rval = gsl_multimin_test_size (gsl_multimin_fminimizer_size (sfm), 1e-6);
+ ssval = gsl_multimin_fminimizer_size (sfm);
+
+ if (rval == GSL_SUCCESS)
+ printf ("converged to a local maximum at\n");
+
+ printf("%5d ", iteri);
+ for (it = 0; it < NDIM; it++){
+ printf ("%10.5f ", gsl_vector_get (sfm->x, it));
+ }
+ printf("f() = %-10.5f ssize = %.7f\n", sfm->fval, ssval);
+ }
+
+ printf("\n\n Please note: Program should be run many times with varying starting points to detemine global maximum\n\n");
+
+ gsl_vector_free(x); /* initial values */
+ gsl_vector_free(ss); /* inital step size */
+ for (it=0; it
Local time at start %s
Local time at end %s
",strstart, strtend);
+ fprintf(fichtm,"
Local time at start %s
Local time at end %s
\n",strstart, strtend);
fclose(fichtm);
+ fprintf(fichtmcov,"
Local time at start %s
Local time at end %s
\n",strstart, strtend);
fclose(fichtmcov);
fclose(ficgp);
fclose(ficlog);
/*------ End -----------*/
- chdir(path);
- strcpy(plotcmd,"\"");
- strcat(plotcmd,pathimach);
- strcat(plotcmd,GNUPLOTPROGRAM);
- strcat(plotcmd,"\"");
- strcat(plotcmd," ");
- strcat(plotcmd,optionfilegnuplot);
- printf("Starting graphs with: %s",plotcmd);fflush(stdout);
+
+ printf("Before Current directory %s!\n",pathcd);
+ if(chdir(pathcd) != 0)
+ printf("Can't move to directory %s!\n",path);
+ if(getcwd(pathcd,MAXLINE) > 0)
+ printf("Current directory %s!\n",pathcd);
+ /*strcat(plotcmd,CHARSEPARATOR);*/
+ sprintf(plotcmd,"gnuplot");
+#ifndef UNIX
+ sprintf(plotcmd,"\"%sgnuplot.exe\"",pathimach);
+#endif
+ if(!stat(plotcmd,&info)){
+ printf("Error gnuplot program not found: %s\n",plotcmd);fflush(stdout);
+ if(!stat(getenv("GNUPLOTBIN"),&info)){
+ printf("Error gnuplot program not found: %s Environment GNUPLOTBIN not set.\n",plotcmd);fflush(stdout);
+ }else
+ strcpy(pplotcmd,plotcmd);
+#ifdef UNIX
+ strcpy(plotcmd,GNUPLOTPROGRAM);
+ if(!stat(plotcmd,&info)){
+ printf("Error gnuplot program not found: %s\n",plotcmd);fflush(stdout);
+ }else
+ strcpy(pplotcmd,plotcmd);
+#endif
+ }else
+ strcpy(pplotcmd,plotcmd);
+
+ sprintf(plotcmd,"%s %s",pplotcmd, optionfilegnuplot);
+ printf("Starting graphs with: %s\n",plotcmd);fflush(stdout);
+
if((outcmd=system(plotcmd)) != 0){
- printf(" Problem with gnuplot\n");
+ printf("\n Problem with gnuplot\n");
}
printf(" Wait...");
while (z[0] != 'q') {