--- imach/src/imach.c 2015/04/30 08:27:53 1.188
+++ imach/src/imach.c 2015/09/22 19:45:16 1.202
@@ -1,6 +1,60 @@
-/* $Id: imach.c,v 1.188 2015/04/30 08:27:53 brouard Exp $
+/* $Id: imach.c,v 1.202 2015/09/22 19:45:16 brouard Exp $
$State: Exp $
$Log: imach.c,v $
+ Revision 1.202 2015/09/22 19:45:16 brouard
+ Summary: Adding some overall graph on contribution to likelihood. Might change
+
+ Revision 1.201 2015/09/15 17:34:58 brouard
+ Summary: 0.98r0
+
+ - Some new graphs like suvival functions
+ - Some bugs fixed like model=1+age+V2.
+
+ Revision 1.200 2015/09/09 16:53:55 brouard
+ Summary: Big bug thanks to Flavia
+
+ Even model=1+age+V2. did not work anymore
+
+ Revision 1.199 2015/09/07 14:09:23 brouard
+ Summary: 0.98q6 changing default small png format for graph to vectorized svg.
+
+ Revision 1.198 2015/09/03 07:14:39 brouard
+ Summary: 0.98q5 Flavia
+
+ Revision 1.197 2015/09/01 18:24:39 brouard
+ *** empty log message ***
+
+ Revision 1.196 2015/08/18 23:17:52 brouard
+ Summary: 0.98q5
+
+ Revision 1.195 2015/08/18 16:28:39 brouard
+ Summary: Adding a hack for testing purpose
+
+ After reading the title, ftol and model lines, if the comment line has
+ a q, starting with #q, the answer at the end of the run is quit. It
+ permits to run test files in batch with ctest. The former workaround was
+ $ echo q | imach foo.imach
+
+ Revision 1.194 2015/08/18 13:32:00 brouard
+ Summary: Adding error when the covariance matrix doesn't contain the exact number of lines required by the model line.
+
+ Revision 1.193 2015/08/04 07:17:42 brouard
+ Summary: 0.98q4
+
+ Revision 1.192 2015/07/16 16:49:02 brouard
+ Summary: Fixing some outputs
+
+ Revision 1.191 2015/07/14 10:00:33 brouard
+ Summary: Some fixes
+
+ Revision 1.190 2015/05/05 08:51:13 brouard
+ Summary: Adding digits in output parameters (7 digits instead of 6)
+
+ Fix 1+age+.
+
+ Revision 1.189 2015/04/30 14:45:16 brouard
+ Summary: 0.98q2
+
Revision 1.188 2015/04/30 08:27:53 brouard
*** empty log message ***
@@ -593,7 +647,9 @@
/* #define DEBUG */
/* #define DEBUGBRENT */
+#define DEBUGLINMIN
#define POWELL /* Instead of NLOPT */
+#define POWELLF1F3 /* Skip test */
/* #define POWELLORIGINAL /\* Don't use Directest to decide new direction but original Powell test *\/ */
/* #define MNBRAKORIGINAL /\* Don't use mnbrak fix *\/ */
@@ -662,11 +718,12 @@ typedef struct {
#define NLSTATEMAX 8 /**< Maximum number of live states (for func) */
#define NDEATHMAX 8 /**< Maximum number of dead states (for func) */
#define NCOVMAX 20 /**< Maximum number of covariates, including generated covariates V1*V2 */
-#define codtabm(h,k) 1 & (h-1) >> (k-1) ;
+#define codtabm(h,k) (1 & (h-1) >> (k-1))+1
#define MAXN 20000
#define YEARM 12. /**< Number of months per year */
#define AGESUP 130
#define AGEBASE 40
+#define AGEOVERFLOW 1.e20
#define AGEGOMP 10 /**< Minimal age for Gompertz adjustment */
#ifdef _WIN32
#define DIRSEPARATOR '\\'
@@ -678,11 +735,12 @@ typedef struct {
#define ODIRSEPARATOR '\\'
#endif
-/* $Id: imach.c,v 1.188 2015/04/30 08:27:53 brouard Exp $ */
+/* $Id: imach.c,v 1.202 2015/09/22 19:45:16 brouard Exp $ */
/* $State: Exp $ */
-
-char version[]="Imach version 0.98q1, April 2015,INED-EUROREVES-Institut de longevite-Japan Society for the Promotion of Science (Grant-in-Aid for Scientific Research 25293121), Intel Software 2015";
-char fullversion[]="$Revision: 1.188 $ $Date: 2015/04/30 08:27:53 $";
+#include "version.h"
+char version[]=__IMACH_VERSION__;
+char copyright[]="September 2015,INED-EUROREVES-Institut de longevite-Japan Society for the Promotion of Science (Grant-in-Aid for Scientific Research 25293121), Intel Software 2015";
+char fullversion[]="$Revision: 1.202 $ $Date: 2015/09/22 19:45:16 $";
char strstart[80];
char optionfilext[10], optionfilefiname[FILENAMELENGTH];
int erreur=0, nberr=0, nbwarn=0; /* Error number, number of errors number of warnings */
@@ -748,7 +806,7 @@ char command[FILENAMELENGTH];
int outcmd=0;
char fileres[FILENAMELENGTH], filerespij[FILENAMELENGTH], filereso[FILENAMELENGTH], rfileres[FILENAMELENGTH];
-
+char fileresu[FILENAMELENGTH]; /* fileres without r in front */
char filelog[FILENAMELENGTH]; /* Log file */
char filerest[FILENAMELENGTH];
char fileregp[FILENAMELENGTH];
@@ -816,7 +874,13 @@ int estepm;
int m,nb;
long *num;
-int firstpass=0, lastpass=4,*cod, *ncodemax, *Tage,*cens;
+int firstpass=0, lastpass=4,*cod, *cens;
+int *ncodemax; /* ncodemax[j]= Number of modalities of the j th
+ covariate for which somebody answered excluding
+ undefined. Usually 2: 0 and 1. */
+int *ncodemaxwundef; /* ncodemax[j]= Number of modalities of the j th
+ covariate for which somebody answered including
+ undefined. Usually 3: -1, 0 and 1. */
double **agev,*moisnais, *annais, *moisdc, *andc,**mint, **anint;
double **pmmij, ***probs;
double *ageexmed,*agecens;
@@ -830,8 +894,9 @@ double **covar; /**< covar[j,i], value
* cov[Tage[kk]+2]=covar[Tvar[Tage[kk]]][i]*age; */
double idx;
int **nbcode, *Tvar; /**< model=V2 => Tvar[1]= 2 */
+int *Tage;
int *Ndum; /** Freq of modality (tricode */
-int **codtab; /**< codtab=imatrix(1,100,1,10); */
+/* int **codtab;*/ /**< codtab=imatrix(1,100,1,10); */
int **Tvard, *Tprod, cptcovprod, *Tvaraff;
double *lsurv, *lpop, *tpop;
@@ -1442,31 +1507,41 @@ values at the three points, fa, fb , and
#endif
#ifdef MNBRAKORIGINAL
#else
- if (fu > *fc) {
-#ifdef DEBUG
- printf("mnbrak4 fu > fc \n");
- fprintf(ficlog, "mnbrak4 fu > fc\n");
-#endif
- /* SHFT(u,*cx,*cx,u) /\* ie a=c, c=u and u=c; in that case, next SHFT(a,b,c,u) will give a=b=b, b=c=u, c=u=c and *\/ */
- /* SHFT(*fa,*fc,fu,*fc) /\* (b, u, c) is a bracket while test fb > fc will be fu > fc will exit *\/ */
- dum=u; /* Shifting c and u */
- u = *cx;
- *cx = dum;
- dum = fu;
- fu = *fc;
- *fc =dum;
- } else { /* end */
+/* if (fu > *fc) { */
+/* #ifdef DEBUG */
+/* printf("mnbrak4 fu > fc \n"); */
+/* fprintf(ficlog, "mnbrak4 fu > fc\n"); */
+/* #endif */
+/* /\* SHFT(u,*cx,*cx,u) /\\* ie a=c, c=u and u=c; in that case, next SHFT(a,b,c,u) will give a=b=b, b=c=u, c=u=c and *\\/ *\/ */
+/* /\* SHFT(*fa,*fc,fu,*fc) /\\* (b, u, c) is a bracket while test fb > fc will be fu > fc will exit *\\/ *\/ */
+/* dum=u; /\* Shifting c and u *\/ */
+/* u = *cx; */
+/* *cx = dum; */
+/* dum = fu; */
+/* fu = *fc; */
+/* *fc =dum; */
+/* } else { /\* end *\/ */
+/* #ifdef DEBUG */
+/* printf("mnbrak3 fu < fc \n"); */
+/* fprintf(ficlog, "mnbrak3 fu < fc\n"); */
+/* #endif */
+/* dum=u; /\* Shifting c and u *\/ */
+/* u = *cx; */
+/* *cx = dum; */
+/* dum = fu; */
+/* fu = *fc; */
+/* *fc =dum; */
+/* } */
#ifdef DEBUG
- printf("mnbrak3 fu < fc \n");
- fprintf(ficlog, "mnbrak3 fu < fc\n");
+ printf("mnbrak34 fu < or >= fc \n");
+ fprintf(ficlog, "mnbrak34 fu < fc\n");
#endif
- dum=u; /* Shifting c and u */
- u = *cx;
- *cx = dum;
- dum = fu;
- fu = *fc;
- *fc =dum;
- }
+ dum=u; /* Shifting c and u */
+ u = *cx;
+ *cx = dum;
+ dum = fu;
+ fu = *fc;
+ *fc =dum;
#endif
} else if ((*cx-u)*(u-ulim) > 0.0) { /* u is after c but before ulim */
#ifdef DEBUG
@@ -1535,13 +1610,13 @@ void linmin(double p[], double xi[], int
nrfunc=func;
for (j=1;j<=n;j++) {
pcom[j]=p[j];
- xicom[j]=xi[j];
+ xicom[j]=xi[j]; /* Former scale xi[j] of currrent direction i */
}
- axs=0.0;
- xxss=1; /* 1 and using scale */
+ /* axs=0.0; */
+ /* xxss=1; /\* 1 and using scale *\/ */
xxs=1;
- do{
+ /* do{ */
ax=0.;
xx= xxs;
mnbrak(&ax,&xx,&bx,&fa,&fx,&fb,f1dim); /* Outputs: xtx[j]=pcom[j]+(*xx)*xicom[j]; fx=f(xtx[j]) */
@@ -1551,12 +1626,16 @@ void linmin(double p[], double xi[], int
/* Given input ax=axs and xx=xxs, xx might be too far from ax to get a finite f(xx) */
/* Searches on line, outputs (ax, xx, bx) such that fx < min(fa and fb) */
/* Find a bracket a,x,b in direction n=xi ie xicom, order may change. Scale is [0:xxs*xi[j]] et non plus [0:xi[j]]*/
- if (fx != fx){
- xxs=xxs/scale; /* Trying a smaller xx, closer to initial ax=0 */
- printf("\nLinmin NAN : input [axs=%lf:xxs=%lf], mnbrak outputs fx=%lf <(fb=%lf and fa=%lf) with xx=%lf in [ax=%lf:bx=%lf] \n", axs, xxs, fx,fb, fa, xx, ax, bx);
- }
- }while(fx != fx);
-
+ /* if (fx != fx){ */
+ /* xxs=xxs/scale; /\* Trying a smaller xx, closer to initial ax=0 *\/ */
+ /* printf("\nLinmin NAN : input [axs=%lf:xxs=%lf], mnbrak outputs fx=%lf <(fb=%lf and fa=%lf) with xx=%lf in [ax=%lf:bx=%lf] \n", axs, xxs, fx,fb, fa, xx, ax, bx); */
+ /* } */
+ /* }while(fx != fx); */
+
+#ifdef DEBUGLINMIN
+ printf("\nLinmin after mnbrak: ax=%12.7f xx=%12.7f bx=%12.7f fa=%12.2f fx=%12.2f fb=%12.2f\n", ax,xx,bx,fa,fx,fb);
+ fprintf(ficlog,"\nLinmin after mnbrak: ax=%12.7f xx=%12.7f bx=%12.7f fa=%12.2f fx=%12.2f fb=%12.2f\n", ax,xx,bx,fa,fx,fb);
+#endif
*fret=brent(ax,xx,bx,f1dim,TOL,&xmin); /* Giving a bracketting triplet (ax, xx, bx), find a minimum, xmin, according to f1dim, *fret(xmin),*/
/* fa = f(p[j] + ax * xi[j]), fx = f(p[j] + xx * xi[j]), fb = f(p[j] + bx * xi[j]) */
/* fmin = f(p[j] + xmin * xi[j]) */
@@ -1566,16 +1645,30 @@ void linmin(double p[], double xi[], int
printf("retour brent fret=%.12e xmin=%.12e\n",*fret,xmin);
fprintf(ficlog,"retour brent fret=%.12e xmin=%.12e\n",*fret,xmin);
#endif
+#ifdef DEBUGLINMIN
printf("linmin end ");
+ fprintf(ficlog,"linmin end ");
+#endif
for (j=1;j<=n;j++) {
/* printf(" before xi[%d]=%12.8f", j,xi[j]); */
xi[j] *= xmin; /* xi rescaled by xmin: if xmin=-1.237 and xi=(1,0,...,0) xi=(-1.237,0,...,0) */
- if(xxs <1.0)
- printf(" after xi[%d]=%12.8f, xmin=%12.8f, ax=%12.8f, xx=%12.8f, bx=%12.8f, xxs=%12.8f", j,xi[j], xmin, ax, xx, bx,xxs );
+ /* if(xxs <1.0) */
+ /* printf(" after xi[%d]=%12.8f, xmin=%12.8f, ax=%12.8f, xx=%12.8f, bx=%12.8f, xxs=%12.8f", j,xi[j], xmin, ax, xx, bx,xxs ); */
p[j] += xi[j]; /* Parameters values are updated accordingly */
}
- printf("\n");
- printf("Comparing last *frec(xmin)=%12.8f from Brent and frec(0.)=%12.8f \n", (*func)(p));
+ /* printf("\n"); */
+#ifdef DEBUGLINMIN
+ printf("Comparing last *frec(xmin=%12.8f)=%12.8f from Brent and frec(0.)=%12.8f \n", xmin, *fret, (*func)(p));
+ fprintf(ficlog,"Comparing last *frec(xmin=%12.8f)=%12.8f from Brent and frec(0.)=%12.8f \n", xmin, *fret, (*func)(p));
+ for (j=1;j<=n;j++) {
+ printf(" xi[%d]= %14.10f p[%d]= %12.7f",j,xi[j],j,p[j]);
+ fprintf(ficlog," xi[%d]= %14.10f p[%d]= %12.7f",j,xi[j],j,p[j]);
+ if(j % ncovmodel == 0){
+ printf("\n");
+ fprintf(ficlog,"\n");
+ }
+ }
+#endif
free_vector(xicom,1,n);
free_vector(pcom,1,n);
}
@@ -1608,7 +1701,7 @@ void powell(double p[], double **xi, int
xits=vector(1,n);
*fret=(*func)(p);
for (j=1;j<=n;j++) pt[j]=p[j];
- rcurr_time = time(NULL);
+ rcurr_time = time(NULL);
for (*iter=1;;++(*iter)) {
fp=(*fret); /* From former iteration or initial value */
ibig=0;
@@ -1620,7 +1713,7 @@ void powell(double p[], double **xi, int
printf("\nPowell iter=%d -2*LL=%.12f %ld sec. %ld sec.",*iter,*fret, rcurr_time-rlast_time, rcurr_time-rstart_time);fflush(stdout);
fprintf(ficlog,"\nPowell iter=%d -2*LL=%.12f %ld sec. %ld sec.",*iter,*fret,rcurr_time-rlast_time, rcurr_time-rstart_time); fflush(ficlog);
/* fprintf(ficrespow,"%d %.12f %ld",*iter,*fret,curr_time.tm_sec-start_time.tm_sec); */
- for (i=1;i<=n;i++) {
+ for (i=1;i<=n;i++) {
printf(" %d %.12f",i, p[i]);
fprintf(ficlog," %d %.12lf",i, p[i]);
fprintf(ficrespow," %.12lf", p[i]);
@@ -1728,7 +1821,7 @@ void powell(double p[], double **xi, int
free_vector(ptt,1,n);
free_vector(pt,1,n);
return;
- }
+ } /* enough precision */
if (*iter == ITMAX) nrerror("powell exceeding maximum iterations.");
for (j=1;j<=n;j++) { /* Computes the extrapolated point P_0 + 2 (P_n-P_0) */
ptt[j]=2.0*p[j]-pt[j];
@@ -1736,7 +1829,10 @@ void powell(double p[], double **xi, int
pt[j]=p[j];
}
fptt=(*func)(ptt); /* f_3 */
+#ifdef POWELLF1F3
+#else
if (fptt < fp) { /* If extrapolated point is better, decide if we keep that new direction or not */
+#endif
/* (x1 f1=fp), (x2 f2=*fret), (x3 f3=fptt), (xm fm) */
/* From x1 (P0) distance of x2 is at h and x3 is 2h */
/* Let f"(x2) be the 2nd derivative equal everywhere. */
@@ -1750,7 +1846,7 @@ void powell(double p[], double **xi, int
t=2.0*(fp-2.0*(*fret)+fptt)*SQR(fp-(*fret)-del); /* Intel compiler doesn't work on one line; bug reported */
t= t- del*SQR(fp-fptt);
#endif
- directest = fp-2.0*(*fret)+fptt - 2.0 * del; /* If del was big enough we change it for a new direction */
+ directest = fp-2.0*(*fret)+fptt - 2.0 * del; /* If delta was big enough we change it for a new direction */
#ifdef DEBUG
printf("t1= %.12lf, t2= %.12lf, t=%.12lf directest=%.12lf\n", 2.0*(fp-2.0*(*fret)+fptt)*SQR(fp-(*fret)-del),del*SQR(fp-fptt),t,directest);
fprintf(ficlog,"t1= %.12lf, t2= %.12lf, t=%.12lf directest=%.12lf\n", 2.0*(fp-2.0*(*fret)+fptt)*SQR(fp-(*fret)-del),del*SQR(fp-fptt),t,directest);
@@ -1765,14 +1861,35 @@ void powell(double p[], double **xi, int
if (t < 0.0) { /* Then we use it for new direction */
#else
if (directest*t < 0.0) { /* Contradiction between both tests */
- printf("directest= %.12lf, t= %.12lf, f1= %.12lf,f2= %.12lf,f3= %.12lf, del= %.12lf\n",directest, t, fp,(*fret),fptt,del);
- printf("f1-2f2+f3= %.12lf, f1-f2-del= %.12lf, f1-f3= %.12lf\n",fp-2.0*(*fret)+fptt, fp -(*fret) -del, fp-fptt);
- fprintf(ficlog,"directest= %.12lf, t= %.12lf, f1= %.12lf,f2= %.12lf,f3= %.12lf, del= %.12lf\n",directest, t, fp,(*fret),fptt, del);
- fprintf(ficlog,"f1-2f2+f3= %.12lf, f1-f2-del= %.12lf, f1-f3= %.12lf\n",fp-2.0*(*fret)+fptt, fp -(*fret) -del, fp-fptt);
- }
+ printf("directest= %.12lf (if <0 we include P0 Pn as new direction), t= %.12lf, f1= %.12lf,f2= %.12lf,f3= %.12lf, del= %.12lf\n",directest, t, fp,(*fret),fptt,del);
+ printf("f1-2f2+f3= %.12lf, f1-f2-del= %.12lf, f1-f3= %.12lf\n",fp-2.0*(*fret)+fptt, fp -(*fret) -del, fp-fptt);
+ fprintf(ficlog,"directest= %.12lf (if <0 we include P0 Pn as new direction), t= %.12lf, f1= %.12lf,f2= %.12lf,f3= %.12lf, del= %.12lf\n",directest, t, fp,(*fret),fptt, del);
+ fprintf(ficlog,"f1-2f2+f3= %.12lf, f1-f2-del= %.12lf, f1-f3= %.12lf\n",fp-2.0*(*fret)+fptt, fp -(*fret) -del, fp-fptt);
+ }
if (directest < 0.0) { /* Then we use it for new direction */
#endif
+#ifdef DEBUGLINMIN
+ printf("Before linmin in direction P%d-P0\n",n);
+ for (j=1;j<=n;j++) {
+ printf(" Before xit[%d]= %12.7f p[%d]= %12.7f",j,xit[j],j,p[j]);
+ fprintf(ficlog," Before xit[%d]= %12.7f p[%d]= %12.7f",j,xit[j],j,p[j]);
+ if(j % ncovmodel == 0){
+ printf("\n");
+ fprintf(ficlog,"\n");
+ }
+ }
+#endif
linmin(p,xit,n,fret,func); /* computes minimum on the extrapolated direction: changes p and rescales xit.*/
+#ifdef DEBUGLINMIN
+ for (j=1;j<=n;j++) {
+ printf("After xit[%d]= %12.7f p[%d]= %12.7f",j,xit[j],j,p[j]);
+ fprintf(ficlog,"After xit[%d]= %12.7f p[%d]= %12.7f",j,xit[j],j,p[j]);
+ if(j % ncovmodel == 0){
+ printf("\n");
+ fprintf(ficlog,"\n");
+ }
+ }
+#endif
for (j=1;j<=n;j++) {
xi[j][ibig]=xi[j][n]; /* Replace direction with biggest decrease by last direction n */
xi[j][n]=xit[j]; /* and this nth direction by the by the average p_0 p_n */
@@ -1790,9 +1907,12 @@ void powell(double p[], double **xi, int
printf("\n");
fprintf(ficlog,"\n");
#endif
- } /* end of t negative */
+ } /* end of t or directest negative */
+#ifdef POWELLF1F3
+#else
} /* end if (fptt < fp) */
- }
+#endif
+ } /* loop iteration */
}
/**** Prevalence limit (stable or period prevalence) ****************/
@@ -1807,7 +1927,8 @@ double **prevalim(double **prlim, int nl
/* double **matprod2(); */ /* test */
double **out, cov[NCOVMAX+1], **pmij();
double **newm;
- double agefin, delaymax=50 ; /* Max number of years to converge */
+ double agefin, delaymax=100 ; /* Max number of years to converge */
+ long int ncvyear=0, ncvloop=0;
for (ii=1;ii<=nlstate+ndeath;ii++)
for (j=1;j<=nlstate+ndeath;j++){
@@ -1817,20 +1938,25 @@ double **prevalim(double **prlim, int nl
cov[1]=1.;
/* Even if hstepm = 1, at least one multiplication by the unit matrix */
+ /* Start at agefin= age, computes the matrix of passage and loops decreasing agefin until convergence is reached */
for(agefin=age-stepm/YEARM; agefin>=age-delaymax; agefin=agefin-stepm/YEARM){
+ ncvloop++;
newm=savm;
/* Covariates have to be included here again */
cov[2]=agefin;
if(nagesqr==1)
cov[3]= agefin*agefin;;
for (k=1; k<=cptcovn;k++) {
- cov[2+nagesqr+k]=nbcode[Tvar[k]][codtab[ij][Tvar[k]]];
- /*printf("prevalim ij=%d k=%d Tvar[%d]=%d nbcode=%d cov=%lf codtab[%d][Tvar[%d]]=%d \n",ij,k, k, Tvar[k],nbcode[Tvar[k]][codtab[ij][Tvar[k]]],cov[2+k], ij, k, codtab[ij][Tvar[k]]);*/
+ /* cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(ij,Tvar[k])]; */
+ cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(ij,k)];
+ /* printf("prevalim ij=%d k=%d Tvar[%d]=%d nbcode=%d cov=%lf codtabm(%d,Tvar[%d])=%d \n",ij,k, k, Tvar[k],nbcode[Tvar[k]][codtabm(ij,Tvar[k])],cov[2+k], ij, k, codtabm(ij,Tvar[k])]); */
}
/*wrong? for (k=1; k<=cptcovage;k++) cov[2+Tage[k]]=cov[2+Tage[k]]*cov[2]; */
- for (k=1; k<=cptcovage;k++) cov[2+nagesqr+Tage[k]]=nbcode[Tvar[k]][codtab[ij][Tvar[k]]]*cov[2];
+ /* for (k=1; k<=cptcovage;k++) cov[2+nagesqr+Tage[k]]=nbcode[Tvar[k]][codtabm(ij,Tvar[k])]*cov[2]; */
+ for (k=1; k<=cptcovage;k++) cov[2+nagesqr+Tage[k]]=nbcode[Tvar[k]][codtabm(ij,k)]*cov[2];
for (k=1; k<=cptcovprod;k++) /* Useless */
- cov[2+nagesqr+Tprod[k]]=nbcode[Tvard[k][1]][codtab[ij][Tvard[k][1]]] * nbcode[Tvard[k][2]][codtab[ij][Tvard[k][2]]];
+ /* cov[2+nagesqr+Tprod[k]]=nbcode[Tvard[k][1]][codtabm(ij,Tvard[k][1])] * nbcode[Tvard[k][2]][codtabm(ij,Tvard[k][2])]; */
+ cov[2+nagesqr+Tprod[k]]=nbcode[Tvard[k][1]][codtabm(ij,k)] * nbcode[Tvard[k][2]][codtabm(ij,k)];
/*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]);*/
@@ -1849,17 +1975,21 @@ double **prevalim(double **prlim, int nl
sumnew=0;
for(k=1; k<=ndeath; k++) sumnew+=newm[i][nlstate+k];
prlim[i][j]= newm[i][j]/(1-sumnew);
- /*printf(" prevalim i=%d, j=%d, prmlim[%d][%d]=%f, agefin=%d \n", i, j, i, j, prlim[i][j],(int)agefin);*/
max=FMAX(max,prlim[i][j]);
min=FMIN(min,prlim[i][j]);
+ /* printf(" age= %d prevalim i=%d, j=%d, prmlim[%d][%d]=%f, agefin=%d max=%f min=%f\n", (int)age, i, j, i, j, prlim[i][j],(int)agefin, max, min); */
}
maxmin=max-min;
maxmax=FMAX(maxmax,maxmin);
} /* j loop */
if(maxmax < ftolpl){
+ /* printf("maxmax=%lf maxmin=%lf ncvloop=%ld, ncvyear=%d \n", maxmax, maxmin, ncvloop, (int)age-(int)agefin); */
return prlim;
}
} /* age loop */
+ printf("Warning: the stable prevalence did not converge with the required precision ftolpl=6*10^5*ftol=%g. \n\
+Earliest age to start was %d-%d=%d, ncvloop=%ld, ncvyear=%d\n\
+Try to lower 'ftol', for example from 1.e-8 to 6.e-9.\n", ftolpl, (int)age, (int)delaymax, (int)agefin, ncvloop, (int)age-(int)agefin);
return prlim; /* should not reach here */
}
@@ -2003,12 +2133,15 @@ double ***hpxij(double ***po, int nhstep
if(nagesqr==1)
cov[3]= agexact*agexact;
for (k=1; k<=cptcovn;k++)
- cov[2+nagesqr+k]=nbcode[Tvar[k]][codtab[ij][Tvar[k]]];
+ cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(ij,k)];
+ /* cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(ij,Tvar[k])]; */
for (k=1; k<=cptcovage;k++) /* Should start at cptcovn+1 */
/* cov[2+Tage[k]]=cov[2+Tage[k]]*cov[2]; */
- cov[2+nagesqr+Tage[k]]=nbcode[Tvar[Tage[k]]][codtab[ij][Tvar[Tage[k]]]]*cov[2];
+ cov[2+nagesqr+Tage[k]]=nbcode[Tvar[Tage[k]]][codtabm(ij,k)]*cov[2];
+ /* cov[2+nagesqr+Tage[k]]=nbcode[Tvar[Tage[k]]][codtabm(ij,Tvar[Tage[k]])]*cov[2]; */
for (k=1; k<=cptcovprod;k++) /* Useless because included in cptcovn */
- cov[2+nagesqr+Tprod[k]]=nbcode[Tvard[k][1]][codtab[ij][Tvard[k][1]]]*nbcode[Tvard[k][2]][codtab[ij][Tvard[k][2]]];
+ cov[2+nagesqr+Tprod[k]]=nbcode[Tvard[k][1]][codtabm(ij,k)]*nbcode[Tvard[k][2]][codtabm(ij,k)];
+ /* cov[2+nagesqr+Tprod[k]]=nbcode[Tvard[k][1]][codtabm(ij,Tvard[k][1])]*nbcode[Tvard[k][2]][codtabm(ij,Tvard[k][2])]; */
/*printf("hxi cptcov=%d cptcode=%d\n",cptcov,cptcode);*/
@@ -2432,9 +2565,9 @@ 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,"%9ld %6d %2d %2d %1d %1d %3d %11.6f %8.4f\
+ fprintf(ficresilk,"%9ld %6.1f %6d %2d %2d %2d %2d %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],
+ num[i], agexact, 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++){
llt +=ll[k]*gipmx/gsw;
@@ -2466,14 +2599,14 @@ void likelione(FILE *ficres,double p[],
int k;
if(*globpri !=0){ /* Just counts and sums, no printings */
- strcpy(fileresilk,"ilk");
- strcat(fileresilk,fileres);
+ strcpy(fileresilk,"ILK_");
+ strcat(fileresilk,fileresu);
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_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 2wlli out sav ");
+ fprintf(ficresilk, "#num_i age 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);
@@ -2483,8 +2616,10 @@ 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",subdirf(fileresilk),subdirf(fileresilk));
- fflush(fichtm);
+ fprintf(fichtm,"\n
File of contributions to the likelihood computed with initial parameters and mle >= 1. You should at least run with mle >= 1 and starting values corresponding to the optimized parameters in order to visualize the real contribution of each individual/wave: %s
\n",subdirf(fileresilk),subdirf(fileresilk));
+ fprintf(fichtm,"
- The first 3 individuals are drawn with lines. The function drawn is -2Log(L) in log scale: %s.png
\
+",subdirf2(optionfilefiname,"ILK_"),subdirf2(optionfilefiname,"ILK_"),subdirf2(optionfilefiname,"ILK_"));
+ fflush(fichtm);
}
return;
}
@@ -2516,7 +2651,7 @@ void mlikeli(FILE *ficres,double p[], in
for (j=1;j<=npar;j++)
xi[i][j]=(i==j ? 1.0 : 0.0);
printf("Powell\n"); fprintf(ficlog,"Powell\n");
- strcpy(filerespow,"pow");
+ strcpy(filerespow,"POW_");
strcat(filerespow,fileres);
if((ficrespow=fopen(filerespow,"w"))==NULL) {
printf("Problem with resultfile: %s\n", filerespow);
@@ -2827,7 +2962,7 @@ 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);
+ fprintf(fichier,"# %s.%s\n#IMaCh version %s, %s\n#%s\n# %s", optionfilefiname,optionfilext,version,copyright, fullversion, strstart);
}
/************ Frequencies ********************/
@@ -2843,8 +2978,8 @@ void freqsummary(char fileres[], int ia
pp=vector(1,nlstate);
prop=matrix(1,nlstate,iagemin,iagemax+3);
- strcpy(fileresp,"p");
- strcat(fileresp,fileres);
+ strcpy(fileresp,"P_");
+ strcat(fileresp,fileresu);
if((ficresp=fopen(fileresp,"w"))==NULL) {
printf("Problem with prevalence resultfile: %s\n", fileresp);
fprintf(ficlog,"Problem with prevalence resultfile: %s\n", fileresp);
@@ -2879,13 +3014,13 @@ void freqsummary(char fileres[], int ia
bool=1;
if (cptcovn>0) { /* Filter is here: Must be looked at for model=V1+V2+V3+V4 */
for (z1=1; z1<=cptcoveff; z1++)
- if (covar[Tvaraff[z1]][i]!= nbcode[Tvaraff[z1]][codtab[j1][z1]]){
+ if (covar[Tvaraff[z1]][i]!= nbcode[Tvaraff[z1]][codtabm(j1,z1)]){
/* Tests if the value of each of the covariates of i is equal to filter j1 */
bool=0;
- /* printf("bool=%d i=%d, z1=%d, Tvaraff[%d]=%d, covar[Tvarff][%d]=%2f, codtab[%d][%d]=%d, nbcode[Tvaraff][codtab[%d][%d]=%d, j1=%d\n",
- bool,i,z1, z1, Tvaraff[z1],i,covar[Tvaraff[z1]][i],j1,z1,codtab[j1][z1],
- j1,z1,nbcode[Tvaraff[z1]][codtab[j1][z1]],j1);*/
- /* For j1=7 in V1+V2+V3+V4 = 0 1 1 0 and codtab[7][3]=1 and nbcde[3][?]=1*/
+ /* printf("bool=%d i=%d, z1=%d, Tvaraff[%d]=%d, covar[Tvarff][%d]=%2f, codtabm(%d,%d)=%d, nbcode[Tvaraff][codtabm(%d,%d)=%d, j1=%d\n",
+ bool,i,z1, z1, Tvaraff[z1],i,covar[Tvaraff[z1]][i],j1,z1,codtabm(j1,z1),
+ j1,z1,nbcode[Tvaraff[z1]][codtabm(j1,z1)],j1);*/
+ /* For j1=7 in V1+V2+V3+V4 = 0 1 1 0 and codtabm(7,3)=1 and nbcde[3][?]=1*/
}
}
@@ -2914,10 +3049,10 @@ void freqsummary(char fileres[], int ia
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]]);
+ for (z1=1; z1<=cptcoveff; z1++) fprintf(ficresp, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]);
fprintf(ficresp, "**********\n#");
fprintf(ficlog, "\n#********** Variable ");
- for (z1=1; z1<=cptcoveff; z1++) fprintf(ficlog, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtab[j1][z1]]);
+ for (z1=1; z1<=cptcoveff; z1++) fprintf(ficlog, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]);
fprintf(ficlog, "**********\n#");
}
for(i=1; i<=nlstate;i++)
@@ -3045,7 +3180,7 @@ void prevalence(double ***probs, double
bool=1;
if (cptcovn>0) {
for (z1=1; z1<=cptcoveff; z1++)
- if (covar[Tvaraff[z1]][i]!= nbcode[Tvaraff[z1]][codtab[j1][z1]])
+ if (covar[Tvaraff[z1]][i]!= nbcode[Tvaraff[z1]][codtabm(j1,z1)])
bool=0;
}
if (bool==1) {
@@ -3250,11 +3385,11 @@ void tricode(int *Tvar, int **nbcode, in
cptcoveff=0;
- for (k=-1; k < maxncov; k++) Ndum[k]=0;
for (k=1; k <= maxncov; k++) ncodemax[k]=0; /* Horrible constant again replaced by NCOVMAX */
/* Loop on covariates without age and products */
for (j=1; j<=(cptcovs); j++) { /* From model V1 + V2*age+ V3 + V3*V4 keeps V1 + V3 = 2 only */
+ for (k=-1; k < maxncov; k++) Ndum[k]=0;
for (i=1; i<=imx; i++) { /* Loop on individuals: reads the data file to get the maximum value of the
modality of this covariate Vj*/
ij=(int)(covar[Tvar[j]][i]); /* ij=0 or 1 or -1. Value of the covariate Tvar[j] for individual i
@@ -3277,15 +3412,24 @@ void tricode(int *Tvar, int **nbcode, in
/* getting the maximum value of the modality of the covariate
(should be 0 or 1 now) Tvar[j]. If V=sex and male is coded 0 and
female is 1, then modmaxcovj=1.*/
- } /* end for loop on individuals */
+ } /* end for loop on individuals i */
printf(" Minimal and maximal values of %d th covariate V%d: min=%d max=%d \n", j, Tvar[j], modmincovj, modmaxcovj);
+ fprintf(ficlog," Minimal and maximal values of %d th covariate V%d: min=%d max=%d \n", j, Tvar[j], modmincovj, modmaxcovj);
cptcode=modmaxcovj;
/* Ndum[0] = frequency of 0 for model-covariate j, Ndum[1] frequency of 1 etc. */
/*for (i=0; i<=cptcode; i++) {*/
- for (i=modmincovj; i<=modmaxcovj; i++) { /* i=-1 ? 0 and 1*//* For each value of the modality of model-cov j */
- printf("Frequencies of covariates %d ie V%d with value %d: %d\n", j, Tvar[j], i, Ndum[i]);
- if( Ndum[i] != 0 ){ /* Counts if nobody answered, empty modality */
- ncodemax[j]++; /* ncodemax[j]= Number of non-null modalities of the j th covariate. */
+ for (k=modmincovj; k<=modmaxcovj; k++) { /* k=-1 ? 0 and 1*//* For each value k of the modality of model-cov j */
+ printf("Frequencies of covariates %d ie V%d with value %d: %d\n", j, Tvar[j], k, Ndum[k]);
+ fprintf(ficlog, "Frequencies of covariates %d ie V%d with value %d: %d\n", j, Tvar[j], k, Ndum[k]);
+ if( Ndum[k] != 0 ){ /* Counts if nobody answered modality k ie empty modality, we skip it and reorder */
+ if( k != -1){
+ ncodemax[j]++; /* ncodemax[j]= Number of modalities of the j th
+ covariate for which somebody answered excluding
+ undefined. Usually 2: 0 and 1. */
+ }
+ ncodemaxwundef[j]++; /* ncodemax[j]= Number of modalities of the j th
+ covariate for which somebody answered including
+ undefined. Usually 3: -1, 0 and 1. */
}
/* In fact ncodemax[j]=2 (dichotom. variables only) but it could be more for
historical reasons: 3 if coded 1, 2, 3 and 4 and Ndum[2]=0 */
@@ -3302,20 +3446,31 @@ void tricode(int *Tvar, int **nbcode, in
nbcode[Tvar[j]][1]=0;
nbcode[Tvar[j]][2]=1;
nbcode[Tvar[j]][3]=2;
+ To be continued (not working yet).
*/
- ij=1; /* ij is similar to i but can jumps over null modalities */
- for (i=modmincovj; i<=modmaxcovj; i++) { /* i= 1 to 2 for dichotomous, or from 1 to 3 */
- for (k=0; k<= cptcode; k++) { /* k=-1 ? k=0 to 1 *//* Could be 1 to 4 */
- /*recode from 0 */
- if (Ndum[k] != 0) { /* If at least one individual responded to this modality k */
- nbcode[Tvar[j]][ij]=k; /* stores the modality k in an array nbcode.
- k is a modality. If we have model=V1+V1*sex
- then: nbcode[1][1]=0 ; nbcode[1][2]=1; nbcode[2][1]=0 ; nbcode[2][2]=1; */
- ij++;
- }
- if (ij > ncodemax[j]) break;
- } /* end of loop on */
- } /* end of loop on modality */
+ ij=0; /* ij is similar to i but can jump over null modalities */
+ for (i=modmincovj; i<=modmaxcovj; i++) { /* i= 1 to 2 for dichotomous, or from 1 to 3 or from -1 or 0 to 1 currently*/
+ if (Ndum[i] == 0) { /* If nobody responded to this modality k */
+ break;
+ }
+ ij++;
+ nbcode[Tvar[j]][ij]=i; /* stores the original value of modality i in an array nbcode, ij modality from 1 to last non-nul modality.*/
+ cptcode = ij; /* New max modality for covar j */
+ } /* end of loop on modality i=-1 to 1 or more */
+
+ /* for (k=0; k<= cptcode; k++) { /\* k=-1 ? k=0 to 1 *\//\* Could be 1 to 4 *\//\* cptcode=modmaxcovj *\/ */
+ /* /\*recode from 0 *\/ */
+ /* k is a modality. If we have model=V1+V1*sex */
+ /* then: nbcode[1][1]=0 ; nbcode[1][2]=1; nbcode[2][1]=0 ; nbcode[2][2]=1; */
+ /* But if some modality were not used, it is recoded from 0 to a newer modmaxcovj=cptcode *\/ */
+ /* } */
+ /* /\* cptcode = ij; *\/ /\* New max modality for covar j *\/ */
+ /* if (ij > ncodemax[j]) { */
+ /* printf( " Error ij=%d > ncodemax[%d]=%d\n", ij, j, ncodemax[j]); */
+ /* fprintf(ficlog, " Error ij=%d > ncodemax[%d]=%d\n", ij, j, ncodemax[j]); */
+ /* break; */
+ /* } */
+ /* } /\* end of loop on modality k *\/ */
} /* end of loop on model-covariate j. nbcode[Tvarj][1]=0 and nbcode[Tvarj][2]=1 sets the value of covariate j*/
for (k=-1; k< maxncov; k++) Ndum[k]=0;
@@ -3326,17 +3481,18 @@ void tricode(int *Tvar, int **nbcode, in
Ndum[ij]++; /* Might be supersed V1 + V1*age */
}
- ij=1;
+ ij=0;
for (i=0; i<= maxncov-1; i++) { /* modmaxcovj is unknown here. Only Ndum[2(V2),3(age*V3), 5(V3*V2) 6(V1*V4) */
/*printf("Ndum[%d]=%d\n",i, Ndum[i]);*/
if((Ndum[i]!=0) && (i<=ncovcol)){
+ ij++;
/*printf("diff Ndum[%d]=%d\n",i, Ndum[i]);*/
Tvaraff[ij]=i; /*For printing (unclear) */
- ij++;
- }else
- Tvaraff[ij]=0;
+ }else{
+ /* Tvaraff[ij]=0; */
+ }
}
- ij--;
+ /* ij--; */
cptcoveff=ij; /*Number of total covariates*/
}
@@ -3691,11 +3847,11 @@ void varevsij(char optionfilefiname[], d
if(popbased==1){
if(mobilav!=0)
- strcpy(digitp,"-populbased-mobilav-");
- else strcpy(digitp,"-populbased-nomobil-");
+ strcpy(digitp,"-POPULBASED-MOBILAV_");
+ else strcpy(digitp,"-POPULBASED-NOMOBIL_");
}
else
- strcpy(digitp,"-stablbased-");
+ strcpy(digitp,"-STABLBASED_");
if (mobilav!=0) {
mobaverage= ma3x(1, AGESUP,1,NCOVMAX, 1,NCOVMAX);
@@ -3705,12 +3861,12 @@ void varevsij(char optionfilefiname[], d
}
}
- strcpy(fileresprobmorprev,"prmorprev");
+ strcpy(fileresprobmorprev,"PRMORPREV-");
sprintf(digit,"%-d",ij);
/*printf("DIGIT=%s, ij=%d ijr=%-d|\n",digit, ij,ij);*/
strcat(fileresprobmorprev,digit); /* Tvar to be done */
strcat(fileresprobmorprev,digitp); /* Popbased or not, mobilav or not */
- strcat(fileresprobmorprev,fileres);
+ strcat(fileresprobmorprev,fileresu);
if((ficresprobmorprev=fopen(fileresprobmorprev,"w"))==NULL) {
printf("Problem with resultfile: %s\n", fileresprobmorprev);
fprintf(ficlog,"Problem with resultfile: %s\n", fileresprobmorprev);
@@ -3728,7 +3884,8 @@ void varevsij(char optionfilefiname[], d
}
fprintf(ficresprobmorprev,"\n");
fprintf(ficgp,"\n# Routine varevsij");
- /* fprintf(fichtm, "#Local time at start: %s", strstart);*/
+ fprintf(ficgp,"\nunset title \n");
+/* fprintf(fichtm, "#Local time at start: %s", strstart);*/
fprintf(fichtm,"\n
"); @@ -4422,65 +4582,90 @@ fprintf(fichtm," \n