--- imach096d/src/imach.c 2001/03/13 18:10:26 1.2 +++ imach096d/src/imach.c 2002/02/20 17:19:10 1.19 @@ -8,7 +8,7 @@ Health expectancies are computed from the transistions observed between waves and are computed for each degree of severity of disability (number of life states). More degrees you consider, more time is necessary to - reach the Maximum Likelihood of the parameters involved in the model. + reach the Maximum Likelihood of the parameters involved in the model. The simplest model is the multinomial logistic model where pij is the probabibility to be observed in state j at the second wave conditional to be observed in state i at the first wave. Therefore the model is: @@ -22,7 +22,7 @@ delay between waves is not identical for each individual, or if some individual missed an interview, the information is not rounded or lost, but taken into account using an interpolation or extrapolation. - hPijx is the probability to be + hPijx is the probability to be observed in state i at age x+h conditional to the observed state i at age x. The delay 'h' can be split into an exact number (nh*stepm) of unobserved intermediate states. This elementary transition (by month or @@ -51,6 +51,8 @@ #define FILENAMELENGTH 80 /*#define DEBUG*/ #define windows +#define GLOCK_ERROR_NOPATH -1 /* empty path */ +#define GLOCK_ERROR_GETCWD -2 /* cannot get cwd */ #define MAXPARM 30 /* Maximum number of parameters for the optimization */ #define NPARMAX 64 /* (nlstate+ndeath-1)*nlstate*ncovmodel */ @@ -59,29 +61,31 @@ #define NLSTATEMAX 8 /* Maximum number of live states (for func) */ #define NDEATHMAX 8 /* Maximum number of dead states (for func) */ #define NCOVMAX 8 /* Maximum number of covariates */ -#define MAXN 80000 +#define MAXN 20000 #define YEARM 12. /* Number of months per year */ #define AGESUP 130 #define AGEBASE 40 int nvar; -static int cptcov; -int cptcovn; +int cptcovn, cptcovage=0, cptcoveff=0,cptcov; int npar=NPARMAX; int nlstate=2; /* Number of live states */ int ndeath=1; /* Number of dead states */ int ncovmodel, ncov; /* Total number of covariables including constant a12*1 +b12*x ncovmodel=2 */ +int popbased=0; int *wav; /* Number of waves for this individuual 0 is possible */ int maxwav; /* Maxim number of waves */ +int jmin, jmax; /* min, max spacing between 2 waves */ int mle, weightopt; int **mw; /* mw[mi][i] is number of the mi wave for this individual */ int **dh; /* dh[mi][i] is number of steps between mi,mi+1 for this individual */ +double jmean; /* Mean space between 2 waves */ double **oldm, **newm, **savm; /* Working pointers to matrices */ double **oldms, **newms, **savms; /* Fixed working pointers to matrices */ -FILE *fic,*ficpar, *ficparo,*ficres, *ficrespl, *ficrespij, *ficrest; -FILE *ficgp, *fichtm; +FILE *fic,*ficpar, *ficparo,*ficres, *ficrespl, *ficrespij, *ficrest,*ficresf; +FILE *ficgp, *fichtm,*ficresprob,*ficpop; FILE *ficreseij; char filerese[FILENAMELENGTH]; FILE *ficresvij; @@ -89,9 +93,6 @@ FILE *ficreseij; FILE *ficresvpl; char fileresvpl[FILENAMELENGTH]; - - - #define NR_END 1 #define FREE_ARG char* #define FTOL 1.0e-10 @@ -125,18 +126,54 @@ int stepm; /* Stepm, step in month: minimum step interpolation*/ int m,nb; -int *num, firstpass=0, lastpass=4,*cod, *ncodemax; +int *num, firstpass=0, lastpass=4,*cod, *ncodemax, *Tage; double **agev,*moisnais, *annais, *moisdc, *andc,**mint, **anint; -double **pmmij; +double **pmmij, ***probs, ***mobaverage; +double dateintmean=0; double *weight; int **s; /* Status */ double *agedc, **covar, idx; -int **nbcode, *Tcode, *Tvar, **codtab; +int **nbcode, *Tcode, *Tvar, **codtab, **Tvard, *Tprod, cptcovprod, *Tvaraff; double ftol=FTOL; /* Tolerance for computing Max Likelihood */ double ftolhess; /* Tolerance for computing hessian */ +/**************** split *************************/ +static int split( char *path, char *dirc, char *name ) +{ + char *s; /* pointer */ + int l1, l2; /* length counters */ + + l1 = strlen( path ); /* length of path */ + if ( l1 == 0 ) return( GLOCK_ERROR_NOPATH ); + s = strrchr( path, '\\' ); /* find last / */ + if ( s == NULL ) { /* no directory, so use current */ +#if defined(__bsd__) /* get current working directory */ + extern char *getwd( ); + + if ( getwd( dirc ) == NULL ) { +#else + extern char *getcwd( ); + + if ( getcwd( dirc, FILENAME_MAX ) == NULL ) { +#endif + return( GLOCK_ERROR_GETCWD ); + } + strcpy( name, path ); /* we've got it */ + } else { /* strip direcotry from path */ + s++; /* after this, the filename */ + l2 = strlen( s ); /* length of filename */ + if ( l2 == 0 ) return( GLOCK_ERROR_NOPATH ); + strcpy( name, s ); /* save file name */ + strncpy( dirc, path, l1 - l2 ); /* now the directory */ + dirc[l1-l2] = 0; /* add zero */ + } + l1 = strlen( dirc ); /* length of directory */ + if ( dirc[l1-1] != '\\' ) { dirc[l1] = '\\'; dirc[l1+1] = 0; } + return( 0 ); /* we're done */ +} + /******************************************/ @@ -166,25 +203,23 @@ int nbocc(char *s, char occ) void cutv(char *u,char *v, char*t, char occ) { - int i,lg,j,p; + int i,lg,j,p=0; i=0; - if (t[0]== occ) p=0; for(j=0; j<=strlen(t)-1; j++) { - if((t[j]!= occ) && (t[j+1]==occ)) p=j+1; + if((t[j]!= occ) && (t[j+1]== occ)) p=j+1; } lg=strlen(t); for(j=0; j=(p+1))(v[j-p-1] = t[j]); } } - /********************** nrerror ********************/ void nrerror(char error_text[]) @@ -615,15 +650,27 @@ double **prevalim(double **prlim, int nl for (j=1;j<=nlstate+ndeath;j++){ oldm[ii][j]=(ii==j ? 1.0 : 0.0); } - /* Even if hstepm = 1, at least one multiplication by the unit matrix */ + + cov[1]=1.; + + /* Even if hstepm = 1, at least one multiplication by the unit matrix */ for(agefin=age-stepm/YEARM; agefin>=age-delaymax; agefin=agefin-stepm/YEARM){ newm=savm; /* Covariates have to be included here again */ - cov[1]=1.; - cov[2]=agefin; - if (cptcovn>0){ - for (k=1; k<=cptcovn;k++) {cov[2+k]=nbcode[Tvar[k]][codtab[ij][k]];/*printf("Tcode[ij]=%d nbcode=%d\n",Tcode[ij],nbcode[k][Tcode[ij]]);*/} - } + cov[2]=agefin; + + for (k=1; k<=cptcovn;k++) { + cov[2+k]=nbcode[Tvar[k]][codtab[ij][Tvar[k]]]; + /*printf("ij=%d Tvar[k]=%d nbcode=%d cov=%lf\n",ij, Tvar[k],nbcode[Tvar[k]][codtab[ij][Tvar[k]]],cov[2+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]);*/ + out=matprod2(newm, pmij(pmmij,cov,ncovmodel,x,nlstate),1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, oldm); savm=oldm; @@ -648,7 +695,7 @@ double **prevalim(double **prlim, int nl } } -/*************** transition probabilities **********/ +/*************** transition probabilities ***************/ double **pmij(double **ps, double *cov, int ncovmodel, double *x, int nlstate ) { @@ -671,9 +718,11 @@ double **pmij(double **ps, double *cov, s2 += x[(i-1)*nlstate*ncovmodel+(j-2)*ncovmodel+nc+(i-1)*(ndeath-1)*ncovmodel]*cov[nc]; /*printf("Int j>i s1=%.17e, s2=%.17e %lx %lx\n",s1,s2,s1,s2);*/ } - ps[i][j]=s2; + ps[i][j]=(s2); } } + /*ps[3][2]=1;*/ + for(i=1; i<= nlstate; i++){ s1=0; for(j=1; j0){ - for (k=1; k<=cptcovn;k++) cov[2+k]=nbcode[Tvar[k]][codtab[ij][k]]; - } + 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=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("hxi cptcov=%d cptcode=%d\n",cptcov,cptcode);*/ /*printf("h=%d d=%d age=%f cov=%f\n",h,d,age,cov[2]);*/ out=matprod2(newm,oldm,1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, @@ -782,7 +836,7 @@ double ***hpxij(double ***po, int nhstep /*************** log-likelihood *************/ double func( double *x) { - int i, ii, j, k, mi, d; + int i, ii, j, k, mi, d, kk; double l, ll[NLSTATEMAX], cov[NCOVMAX]; double **out; double sw; /* Sum of weights */ @@ -792,30 +846,31 @@ double func( double *x) /* We are differentiating ll according to initial status */ /* for (i=1;i<=npar;i++) printf("%f ", x[i]);*/ /*for(i=1;i0){ - for (k=1; k<=cptcovn;k++) { - cov[2+k]=covar[Tvar[k]][i]; - /* printf("k=%d cptcovn=%d %lf\n",k,cptcovn,covar[Tvar[k]][i]);*/ - } - } - out=matprod2(newm,oldm,1,nlstate+ndeath,1,nlstate+ndeath, - 1,nlstate+ndeath,pmij(pmmij,cov,ncovmodel,x,nlstate)); - savm=oldm; - oldm=newm; + cov[2]=agev[mw[mi][i]][i]+d*stepm/YEARM; + for (kk=1; kk<=cptcovage;kk++) { + cov[Tage[kk]+2]=covar[Tvar[Tage[kk]]][i]*cov[2]; + } + + out=matprod2(newm,oldm,1,nlstate+ndeath,1,nlstate+ndeath, + 1,nlstate+ndeath,pmij(pmmij,cov,ncovmodel,x,nlstate)); + savm=oldm; + oldm=newm; + + } /* end mult */ - + lli=log(out[s[mw[mi][i]][i]][s[mw[mi+1][i]][i]]); /* printf(" %f ",out[s[mw[mi][i]][i]][s[mw[mi+1][i]][i]]);*/ ipmx +=1; @@ -827,7 +882,6 @@ printf(" %d\n",s[4][i]); for(k=1,l=0.; k<=nlstate; k++) l += ll[k]; /* printf("l1=%f l2=%f ",ll[1],ll[2]); */ l= l*ipmx/sw; /* To get the same order of magnitude as if weight=1 for every body */ - return -l; } @@ -864,7 +918,6 @@ void hesscov(double **matcov, double p[] void lubksb(double **a, int npar, int *indx, double b[]) ; void ludcmp(double **a, int npar, int *indx, double *d) ; - hess=matrix(1,npar,1,npar); printf("\nCalculation of the hessian matrix. Wait...\n"); @@ -872,14 +925,16 @@ void hesscov(double **matcov, double p[] printf("%d",i);fflush(stdout); hess[i][i]=hessii(p,ftolhess,i,delti); /*printf(" %f ",p[i]);*/ + /*printf(" %lf ",hess[i][i]);*/ } - + for (i=1;i<=npar;i++) { for (j=1;j<=npar;j++) { if (j>i) { printf(".%d%d",i,j);fflush(stdout); hess[i][j]=hessij(p,delti,i,j); - hess[j][i]=hess[i][j]; + hess[j][i]=hess[i][j]; + /*printf(" %lf ",hess[i][j]);*/ } } } @@ -983,7 +1038,8 @@ double hessii( double x[], double delta, } } delti[theta]=delts; - return res; + return res; + } double hessij( double x[], double delti[], int thetai,int thetaj) @@ -1095,18 +1151,18 @@ void lubksb(double **a, int n, int *indx } /************ Frequencies ********************/ -void freqsummary(char fileres[], int agemin, int agemax, int **s, double **agev, int nlstate, int imx, int *Tvar, int **nbcode, int *ncodemax) +void freqsummary(char fileres[], int agemin, int agemax, int **s, double **agev, int nlstate, int imx, int *Tvar, int **nbcode, int *ncodemax,double **mint,double **anint, double dateprev1,double dateprev2) { /* Some frequencies */ - int i, m, jk, k1, i1, j1, bool, z1,z2,j; + int i, m, jk, k1,i1, j1, bool, z1,z2,j; double ***freq; /* Frequencies */ double *pp; - double pos; + double pos, k2, dateintsum=0,k2cpt=0; FILE *ficresp; char fileresp[FILENAMELENGTH]; pp=vector(1,nlstate); - + probs= ma3x(1,AGESUP,1,NCOVMAX, 1,NCOVMAX); strcpy(fileresp,"p"); strcat(fileresp,fileres); if((ficresp=fopen(fileresp,"w"))==NULL) { @@ -1116,38 +1172,50 @@ void freqsummary(char fileres[], int ag freq= ma3x(-1,nlstate+ndeath,-1,nlstate+ndeath,agemin,agemax+3); j1=0; - j=cptcovn; + j=cptcoveff; if (cptcovn<1) {j=1;ncodemax[1]=1;} for(k1=1; k1<=j;k1++){ for(i1=1; i1<=ncodemax[k1];i1++){ 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(m=agemin; m <= agemax+3; m++) freq[i][jk][m]=0; - + + dateintsum=0; + k2cpt=0; for (i=1; i<=imx; i++) { bool=1; if (cptcovn>0) { - for (z1=1; z1<=cptcovn; z1++) - if (covar[Tvar[z1]][i]!= nbcode[Tvar[z1]][codtab[j1][z1]]) bool=0; + for (z1=1; z1<=cptcoveff; z1++) + if (covar[Tvaraff[z1]][i]!= nbcode[Tvaraff[z1]][codtab[j1][z1]]) + bool=0; } - if (bool==1) { - for(m=firstpass; m<=lastpass-1; m++){ - if(agev[m][i]==0) agev[m][i]=agemax+1; - if(agev[m][i]==1) agev[m][i]=agemax+2; - freq[s[m][i]][s[m+1][i]][(int)agev[m][i]] += weight[i]; - freq[s[m][i]][s[m+1][i]][(int) agemax+3] += weight[i]; + if (bool==1) { + for(m=firstpass; m<=lastpass; m++){ + k2=anint[m][i]+(mint[m][i]/12.); + if ((k2>=dateprev1) && (k2<=dateprev2)) { + if(agev[m][i]==0) agev[m][i]=agemax+1; + if(agev[m][i]==1) agev[m][i]=agemax+2; + freq[s[m][i]][s[m+1][i]][(int)agev[m][i]] += weight[i]; + freq[s[m][i]][s[m+1][i]][(int) agemax+3] += weight[i]; + if ((agev[m][i]>1) && (agev[m][i]< (agemax+3))) { + dateintsum=dateintsum+k2; + k2cpt++; + } + + } } } } if (cptcovn>0) { - fprintf(ficresp, "\n#Variable"); - for (z1=1; z1<=cptcovn; z1++) fprintf(ficresp, " V%d=%d",Tvar[z1],nbcode[Tvar[z1]][codtab[j1][z1]]); - } - fprintf(ficresp, "\n#"); + fprintf(ficresp, "\n#********** Variable "); + for (z1=1; z1<=cptcoveff; z1++) fprintf(ficresp, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtab[j1][z1]]); + fprintf(ficresp, "**********\n#"); + } for(i=1; i<=nlstate;i++) fprintf(ficresp, " Age Prev(%d) N(%d) N",i,i); fprintf(ficresp, "\n"); @@ -1159,7 +1227,7 @@ void freqsummary(char fileres[], int ag printf("Age %d", i); for(jk=1; jk <=nlstate ; jk++){ for(m=-1, pp[jk]=0; m <=nlstate+ndeath ; m++) - pp[jk] += freq[jk][m][i]; + pp[jk] += freq[jk][m][i]; } for(jk=1; jk <=nlstate ; jk++){ for(m=-1, pos=0; m <=0 ; m++) @@ -1169,10 +1237,12 @@ void freqsummary(char fileres[], int ag else printf(" %d.=%.0f loss[%d]=NaNQ%%",jk,pp[jk],jk); } - for(jk=1; jk <=nlstate ; jk++){ - for(m=1, pp[jk]=0; m <=nlstate+ndeath; m++) + + for(jk=1; jk <=nlstate ; jk++){ + for(m=0, pp[jk]=0; m <=nlstate+ndeath; m++) pp[jk] += freq[jk][m][i]; - } + } + for(jk=1,pos=0; jk <=nlstate ; jk++) pos += pp[jk]; for(jk=1; jk <=nlstate ; jk++){ @@ -1181,8 +1251,11 @@ void freqsummary(char fileres[], int ag else printf(" %d.=%.0f prev[%d]=NaNQ%%",jk,pp[jk],jk); if( i <= (int) agemax){ - if(pos>=1.e-5) + if(pos>=1.e-5){ fprintf(ficresp," %d %.5f %.0f %.0f",i,pp[jk]/pos, pp[jk],pos); + probs[i][jk][j1]= pp[jk]/pos; + /*printf("\ni=%d jk=%d j1=%d %.5f %.0f %.0f %f",i,jk,j1,pp[jk]/pos, pp[jk],pos,probs[i][jk][j1]);*/ + } else fprintf(ficresp," %d NaNq %.0f %.0f",i,pp[jk],pos); } @@ -1196,11 +1269,95 @@ void freqsummary(char fileres[], int ag } } } + dateintmean=dateintsum/k2cpt; fclose(ficresp); free_ma3x(freq,-1,nlstate+ndeath,-1,nlstate+ndeath,(int) agemin,(int) agemax+3); free_vector(pp,1,nlstate); + /* End of Freq */ +} + +/************ Prevalence ********************/ +void prevalence(int agemin, int agemax, int **s, double **agev, int nlstate, int imx, int *Tvar, int **nbcode, int *ncodemax,double **mint,double **anint, double dateprev1,double dateprev2, double calagedate) +{ /* Some frequencies */ + + int i, m, jk, k1, i1, j1, bool, z1,z2,j; + double ***freq; /* Frequencies */ + double *pp; + double pos, k2; + + pp=vector(1,nlstate); + probs= ma3x(1,AGESUP,1,NCOVMAX, 1,NCOVMAX); + + freq=ma3x(-1,nlstate+ndeath,-1,nlstate+ndeath,agemin,agemax+3); + j1=0; + + j=cptcoveff; + if (cptcovn<1) {j=1;ncodemax[1]=1;} + + for(k1=1; k1<=j;k1++){ + for(i1=1; i1<=ncodemax[k1];i1++){ + j1++; + + for (i=-1; i<=nlstate+ndeath; i++) + for (jk=-1; jk<=nlstate+ndeath; jk++) + for(m=agemin; m <= agemax+3; m++) + freq[i][jk][m]=0; + + for (i=1; i<=imx; i++) { + bool=1; + if (cptcovn>0) { + for (z1=1; z1<=cptcoveff; z1++) + if (covar[Tvaraff[z1]][i]!= nbcode[Tvaraff[z1]][codtab[j1][z1]]) + bool=0; + } + if (bool==1) { + for(m=firstpass; m<=lastpass; m++){ + k2=anint[m][i]+(mint[m][i]/12.); + if ((k2>=dateprev1) && (k2<=dateprev2)) { + if(agev[m][i]==0) agev[m][i]=agemax+1; + if(agev[m][i]==1) agev[m][i]=agemax+2; + freq[s[m][i]][s[m+1][i]][(int)(agev[m][i]+1-1/12.)] += weight[i]; + freq[s[m][i]][s[m+1][i]][(int)(agemax+3+1)] += weight[i]; + } + } + } + } + + for(i=(int)agemin; i <= (int)agemax+3; i++){ + for(jk=1; jk <=nlstate ; jk++){ + for(m=-1, pp[jk]=0; m <=nlstate+ndeath ; m++) + pp[jk] += freq[jk][m][i]; + } + for(jk=1; jk <=nlstate ; jk++){ + for(m=-1, pos=0; m <=0 ; m++) + pos += freq[jk][m][i]; + } + + for(jk=1; jk <=nlstate ; jk++){ + for(m=0, pp[jk]=0; m <=nlstate+ndeath; m++) + pp[jk] += freq[jk][m][i]; + } + + for(jk=1,pos=0; jk <=nlstate ; jk++) pos += pp[jk]; + + for(jk=1; jk <=nlstate ; jk++){ + if( i <= (int) agemax){ + if(pos>=1.e-5){ + probs[i][jk][j1]= pp[jk]/pos; + } + } + } + + } + } + } + + + free_ma3x(freq,-1,nlstate+ndeath,-1,nlstate+ndeath,(int) agemin,(int) agemax+3); + free_vector(pp,1,nlstate); + } /* End of Freq */ /************* Waves Concatenation ***************/ @@ -1215,9 +1372,14 @@ void concatwav(int wav[], int **dh, int */ int i, mi, m; - int j, k=0,jk, ju, jl,jmin=1e+5, jmax=-1; -float sum=0.; + /* int j, k=0,jk, ju, jl,jmin=1e+5, jmax=-1; + double sum=0., jmean=0.;*/ + int j, k=0,jk, ju, jl; + double sum=0.; + jmin=1e+5; + jmax=-1; + jmean=0.; for(i=1; i<=imx; i++){ mi=0; m=firstpass; @@ -1247,16 +1409,22 @@ float sum=0.; dh[mi][i]=1; else{ if (s[mw[mi+1][i]][i] > nlstate) { + if (agedc[i] < 2*AGESUP) { j= rint(agedc[i]*12-agev[mw[mi][i]][i]*12); - if(j=0) j=1; /* Survives at least one month after exam */ + if(j==0) j=1; /* Survives at least one month after exam */ + k=k+1; + if (j >= jmax) jmax=j; + if (j <= jmin) jmin=j; + sum=sum+j; + /* if (j<10) printf("j=%d num=%d ",j,i); */ + } } else{ j= rint( (agev[mw[mi+1][i]][i]*12 - agev[mw[mi][i]][i]*12)); - /*printf("i=%d agevi+1=%lf agevi=%lf j=%d\n", i,agev[mw[mi+1][i]][i],agev[mw[mi][i]][i],j);*/ - k=k+1; if (j >= jmax) jmax=j; else if (j <= jmin)jmin=j; + /* if (j<10) printf("j=%d jmin=%d num=%d ",j,jmin,i); */ sum=sum+j; } jk= j/stepm; @@ -1271,30 +1439,35 @@ float sum=0.; } } } - printf("Delay (in months) between two waves Min=%d Max=%d Mean=%f\n\n ",jmin, jmax,sum/k); -} + jmean=sum/k; + printf("Delay (in months) between two waves Min=%d Max=%d Mean=%f\n\n ",jmin, jmax,jmean); + } /*********** Tricode ****************************/ void tricode(int *Tvar, int **nbcode, int imx) { - int Ndum[80],ij, k, j, i; + int Ndum[20],ij=1, k, j, i; int cptcode=0; - for (k=0; k<79; k++) Ndum[k]=0; + cptcoveff=0; + + for (k=0; k<19; k++) Ndum[k]=0; for (k=1; k<=7; k++) ncodemax[k]=0; - - for (j=1; j<=cptcovn; j++) { + + for (j=1; j<=(cptcovn+2*cptcovprod); j++) { for (i=1; i<=imx; i++) { ij=(int)(covar[Tvar[j]][i]); Ndum[ij]++; + /*printf("i=%d ij=%d Ndum[ij]=%d imx=%d",i,ij,Ndum[ij],imx);*/ if (ij > cptcode) cptcode=ij; } - /*printf("cptcode=%d cptcovn=%d ",cptcode,cptcovn);*/ + for (i=0; i<=cptcode; i++) { if(Ndum[i]!=0) ncodemax[j]++; } - ij=1; + + for (i=1; i<=ncodemax[j]; i++) { - for (k=0; k<=79; k++) { + for (k=0; k<=19; k++) { if (Ndum[k] != 0) { nbcode[Tvar[j]][ij]=k; ij++; @@ -1302,9 +1475,25 @@ void tricode(int *Tvar, int **nbcode, in if (ij > ncodemax[j]) break; } } - } + } - } + for (k=0; k<19; k++) Ndum[k]=0; + + for (i=1; i<=ncovmodel-2; i++) { + ij=Tvar[i]; + Ndum[ij]++; + } + + ij=1; + for (i=1; i<=10; i++) { + if((Ndum[i]!=0) && (i<=ncov)){ + Tvaraff[ij]=i; + ij++; + } + } + + cptcoveff=ij-1; +} /*********** Health Expectancies ****************/ @@ -1365,7 +1554,7 @@ void varevsij(char fileres[], double *** double **dnewm,**doldm; int i, j, nhstepm, hstepm, h; int k, cptcode; - double *xp; + double *xp; double **gp, **gm; double ***gradg, ***trgradg; double ***p3mat; @@ -1401,6 +1590,12 @@ void varevsij(char fileres[], double *** } hpxij(p3mat,nhstepm,age,hstepm,xp,nlstate,stepm,oldm,savm, ij); prevalim(prlim,nlstate,xp,age,oldm,savm,ftolpl,ij); + + if (popbased==1) { + for(i=1; i<=nlstate;i++) + prlim[i][i]=probs[(int)age][i][ij]; + } + for(j=1; j<= nlstate; j++){ for(h=0; h<=nhstepm; h++){ for(i=1, gp[h][j]=0.;i<=nlstate;i++) @@ -1412,12 +1607,19 @@ void varevsij(char fileres[], double *** xp[i] = x[i] - (i==theta ?delti[theta]:0); hpxij(p3mat,nhstepm,age,hstepm,xp,nlstate,stepm,oldm,savm, ij); prevalim(prlim,nlstate,xp,age,oldm,savm,ftolpl,ij); + + if (popbased==1) { + for(i=1; i<=nlstate;i++) + prlim[i][i]=probs[(int)age][i][ij]; + } + for(j=1; j<= nlstate; 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]; } } + for(j=1; j<= nlstate; j++) for(h=0; h<=nhstepm; h++){ gradg[h][theta][j]= (gp[h][j]-gm[h][j])/2./delti[theta]; @@ -1547,7 +1749,110 @@ void varprevlim(char fileres[], double * } +/************ Variance of one-step probabilities ******************/ +void varprob(char fileres[], double **matcov, double x[], double delti[], int nlstate, double bage, double fage, int ij) +{ + int i, j; + int k=0, cptcode; + double **dnewm,**doldm; + double *xp; + double *gp, *gm; + double **gradg, **trgradg; + double age,agelim, cov[NCOVMAX]; + int theta; + char fileresprob[FILENAMELENGTH]; + + strcpy(fileresprob,"prob"); + strcat(fileresprob,fileres); + if((ficresprob=fopen(fileresprob,"w"))==NULL) { + printf("Problem with resultfile: %s\n", fileresprob); + } + printf("Computing variance of one-step probabilities: result on file '%s' \n",fileresprob); + + xp=vector(1,npar); + dnewm=matrix(1,(nlstate+ndeath)*(nlstate+ndeath),1,npar); + doldm=matrix(1,(nlstate+ndeath)*(nlstate+ndeath),1,(nlstate+ndeath)*(nlstate+ndeath)); + + cov[1]=1; + for (age=bage; age<=fage; age ++){ + cov[2]=age; + gradg=matrix(1,npar,1,9); + trgradg=matrix(1,9,1,npar); + gp=vector(1,(nlstate+ndeath)*(nlstate+ndeath)); + gm=vector(1,(nlstate+ndeath)*(nlstate+ndeath)); + + for(theta=1; theta <=npar; theta++){ + for(i=1; i<=npar; i++) + xp[i] = x[i] + (i==theta ?delti[theta]:0); + + pmij(pmmij,cov,ncovmodel,xp,nlstate); + + k=0; + for(i=1; i<= (nlstate+ndeath); i++){ + for(j=1; j<=(nlstate+ndeath);j++){ + k=k+1; + gp[k]=pmmij[i][j]; + } + } + + for(i=1; i<=npar; i++) + xp[i] = x[i] - (i==theta ?delti[theta]:0); + + + pmij(pmmij,cov,ncovmodel,xp,nlstate); + k=0; + for(i=1; i<=(nlstate+ndeath); i++){ + for(j=1; j<=(nlstate+ndeath);j++){ + k=k+1; + gm[k]=pmmij[i][j]; + } + } + + for(i=1; i<= (nlstate+ndeath)*(nlstate+ndeath); i++) + gradg[theta][i]=(gp[i]-gm[i])/2./delti[theta]; + } + + for(j=1; j<=(nlstate+ndeath)*(nlstate+ndeath);j++) + for(theta=1; theta <=npar; theta++) + trgradg[j][theta]=gradg[theta][j]; + + matprod2(dnewm,trgradg,1,9,1,npar,1,npar,matcov); + matprod2(doldm,dnewm,1,9,1,npar,1,9,gradg); + + pmij(pmmij,cov,ncovmodel,x,nlstate); + + k=0; + for(i=1; i<=(nlstate+ndeath); i++){ + for(j=1; j<=(nlstate+ndeath);j++){ + k=k+1; + gm[k]=pmmij[i][j]; + } + } + + /*printf("\n%d ",(int)age); + for (i=1; i<=(nlstate+ndeath)*(nlstate+ndeath-1);i++){ + + + printf("%e [%e ;%e] ",gm[i],gm[i]-2*sqrt(doldm[i][i]),gm[i]+2*sqrt(doldm[i][i])); + }*/ + + fprintf(ficresprob,"\n%d ",(int)age); + + for (i=1; i<=(nlstate+ndeath)*(nlstate+ndeath-1);i++){ + if (i== 2) fprintf(ficresprob,"%.3e %.3e ",gm[i],doldm[i][i]); +if (i== 4) fprintf(ficresprob,"%.3e %.3e ",gm[i],doldm[i][i]); + } + + free_vector(gp,1,(nlstate+ndeath)*(nlstate+ndeath)); + free_vector(gm,1,(nlstate+ndeath)*(nlstate+ndeath)); + free_matrix(trgradg,1,(nlstate+ndeath)*(nlstate+ndeath),1,npar); + free_matrix(gradg,1,(nlstate+ndeath)*(nlstate+ndeath),1,npar); +} + free_vector(xp,1,npar); +fclose(ficresprob); + exit(0); +} /***********************************************/ /**************** Main Program *****************/ @@ -1557,7 +1862,7 @@ void varprevlim(char fileres[], double * int main() { - int i,j, k, n=MAXN,iter,m,size,cptcode, aaa, cptcod; + int i,j, k, n=MAXN,iter,m,size,cptcode, cptcod; double agedeb, agefin,hf; double agemin=1.e20, agemax=-1.e20; @@ -1569,19 +1874,23 @@ int main() int *indx; char line[MAXLINE], linepar[MAXLINE]; char title[MAXLINE]; - char optionfile[FILENAMELENGTH], datafile[FILENAMELENGTH], filerespl[FILENAMELENGTH]; - char fileres[FILENAMELENGTH], filerespij[FILENAMELENGTH], filereso[FILENAMELENGTH]; + char optionfile[FILENAMELENGTH], datafile[FILENAMELENGTH], filerespl[FILENAMELENGTH], optionfilehtm[FILENAMELENGTH]; + char fileres[FILENAMELENGTH], filerespij[FILENAMELENGTH], filereso[FILENAMELENGTH], fileresf[FILENAMELENGTH]; char filerest[FILENAMELENGTH]; char fileregp[FILENAMELENGTH]; + char popfile[FILENAMELENGTH]; char path[80],pathc[80],pathcd[80],pathtot[80],model[20]; int firstobs=1, lastobs=10; int sdeb, sfin; /* Status at beginning and end */ int c, h , cpt,l; int ju,jl, mi; - int i1,j1, k1,jk,aa,bb, stepsize; - int jnais,jdc,jint4,jint1,jint2,jint3,**outcome,**adl,*tab; - + int i1,j1, k1,k2,k3,jk,aa,bb, stepsize, ij; + int jnais,jdc,jint4,jint1,jint2,jint3,**outcome,**adl,*tab; + int mobilav=0,popforecast=0; int hstepm, nhstepm; + int *popage;/*boolprev=0 if date and zero if wave*/ + double jprev1, mprev1,anprev1,jprev2, mprev2,anprev2; + double bage, fage, age, agelim, agebase; double ftolpl=FTOL; double **prlim; @@ -1594,25 +1903,37 @@ int main() double ***eij, ***vareij; double **varpl; /* Variances of prevalence limits by age */ double *epj, vepp; - char version[80]="Imach version 62c, May 1999, INED-EUROREVES "; + double kk1, kk2; + double *popeffectif,*popcount; + double dateprev1, dateprev2,jproj1,mproj1,anproj1,jproj2,mproj2,anproj2,jprojmean,mprojmean,anprojmean, calagedate; + double yp,yp1,yp2; + + char version[80]="Imach version 64b, May 2001, INED-EUROREVES "; char *alph[]={"a","a","b","c","d","e"}, str[4]; + + char z[1]="c", occ; #include #include char stra[80], strb[80], strc[80], strd[80],stre[80],modelsav[80]; + /* long total_usecs; struct timeval start_time, end_time; gettimeofday(&start_time, (struct timezone*)0); */ /* at first time */ - printf("\nIMACH, Version 0.63"); + printf("\nIMACH, Version 0.7"); printf("\nEnter the parameter file name: "); #ifdef windows scanf("%s",pathtot); getcwd(pathcd, size); - cutv(path,optionfile,pathtot,'\\'); + /*cygwin_split_path(pathtot,path,optionfile); + printf("pathtot=%s, path=%s, optionfile=%s\n",pathtot,path,optionfile);*/ + /* cutv(path,optionfile,pathtot,'\\');*/ + +split(pathtot, path,optionfile); chdir(path); replace(pathc,path); #endif @@ -1650,14 +1971,18 @@ int main() fscanf(ficpar,"title=%s datafile=%s lastobs=%d firstpass=%d lastpass=%d\nftol=%lf stepm=%d ncov=%d nlstate=%d ndeath=%d maxwav=%d mle=%d weight=%d\nmodel=%s\n",title, datafile, &lastobs, &firstpass,&lastpass,&ftol, &stepm, &ncov, &nlstate,&ndeath, &maxwav, &mle, &weightopt,model); printf("title=%s datafile=%s lastobs=%d firstpass=%d lastpass=%d\nftol=%e stepm=%d ncov=%d nlstate=%d ndeath=%d maxwav=%d mle=%d weight=%d\nmodel=%s\n", title, datafile, lastobs, firstpass,lastpass,ftol, stepm, ncov, nlstate,ndeath, maxwav, mle, weightopt,model); fprintf(ficparo,"title=%s datafile=%s lastobs=%d firstpass=%d lastpass=%d\nftol=%e stepm=%d ncov=%d nlstate=%d ndeath=%d maxwav=%d mle=%d weight=%d\nmodel=%s\n", title, datafile, lastobs, firstpass,lastpass,ftol,stepm,ncov,nlstate,ndeath,maxwav, mle, weightopt,model); - - covar=matrix(1,NCOVMAX,1,n); - if (strlen(model)<=1) cptcovn=0; - else { - j=0; - j=nbocc(model,'+'); - cptcovn=j+1; +while((c=getc(ficpar))=='#' && c!= EOF){ + ungetc(c,ficpar); + fgets(line, MAXLINE, ficpar); + puts(line); + fputs(line,ficparo); } + ungetc(c,ficpar); + + + covar=matrix(0,NCOVMAX,1,n); + cptcovn=0; + if (strlen(model)>1) cptcovn=nbocc(model,'+')+1; ncovmodel=2+cptcovn; nvar=ncovmodel-1; /* Suppressing age as a basic covariate */ @@ -1688,7 +2013,8 @@ int main() fprintf(ficparo,"\n"); } - npar= (nlstate+ndeath-1)*nlstate*ncovmodel; + npar= (nlstate+ndeath-1)*nlstate*ncovmodel; + p=param[1][1]; /* Reads comments: lines beginning with '#' */ @@ -1749,7 +2075,6 @@ int main() printf("\n"); - if(mle==1){ /*-------- data file ----------*/ if((ficres =fopen(fileres,"w"))==NULL) { printf("Problem with resultfile: %s\n", fileres);goto end; @@ -1777,9 +2102,9 @@ int main() s=imatrix(1,maxwav+1,1,n); adl=imatrix(1,maxwav+1,1,n); tab=ivector(1,NCOVMAX); - ncodemax=ivector(1,NCOVMAX); + ncodemax=ivector(1,8); - i=1; + i=1; while (fgets(line, MAXLINE, fic) != NULL) { if ((i >= firstobs) && (i <=lastobs)) { @@ -1801,80 +2126,134 @@ int main() cutv(stra, strb,line,' '); covar[j][i]=(double)(atoi(strb)); strcpy(line,stra); } num[i]=atol(stra); - - /* printf("%d %.lf %.lf %.lf %.lf/%.lf %.lf/%.lf %.lf/%.lf %d %.lf/%.lf %d %.lf/%.lf %d %.lf/%.lf %d\n",num[i],(covar[1][i]), (covar[2][i]), (weight[i]), (moisnais[i]), (annais[i]), (moisdc[i]), (andc[i]), (mint[1][i]), (anint[1][i]), (s[1][i]), (mint[2][i]), (anint[2][i]), (s[2][i]), (mint[3][i]), (anint[3][i]), (s[3][i]), (mint[4][i]), (anint[4][i]), (s[4][i]));*/ - - /*printf("%d %.lf %.lf %.lf %.lf %.lf %.lf/%.lf %.lf/%.lf %.lf/%.lf %d %.lf/%.lf %d\n",num[i],(covar[1][i]), (covar[2][i]),(covar[3][i]), (covar[4][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]));*/ + + /*if((s[2][i]==2) && (s[3][i]==-1)&&(s[4][i]==9)){ + printf("%d %.lf %.lf %.lf %.lf/%.lf %.lf/%.lf %.lf/%.lf %d %.lf/%.lf %d %.lf/%.lf %d %.lf/%.lf %d\n",num[i],(covar[1][i]), (covar[2][i]),weight[i], (moisnais[i]), (annais[i]), (moisdc[i]), (andc[i]), (mint[1][i]), (anint[1][i]), (s[1][i]), (mint[2][i]), (anint[2][i]), (s[2][i]), (mint[3][i]), (anint[3][i]), (s[3][i]), (mint[4][i]), (anint[4][i]), (s[4][i])); ij=ij+1;}*/ i=i+1; } } - /*scanf("%d",i);*/ - + /* printf("ii=%d", ij); + scanf("%d",i);*/ imx=i-1; /* Number of individuals */ - + + /* for (i=1; i<=imx; i++){ + if ((s[1][i]==3) && (s[2][i]==2)) s[2][i]=3; + if ((s[2][i]==3) && (s[3][i]==2)) s[3][i]=3; + if ((s[3][i]==3) && (s[4][i]==2)) s[4][i]=3; + } + + for (i=1; i<=imx; i++) + if (covar[1][i]==0) printf("%d %.lf %.lf %.lf %.lf/%.lf %.lf/%.lf %.lf/%.lf %d %.lf/%.lf %d %.lf/%.lf %d %.lf/%.lf %d\n",num[i],(covar[1][i]), (covar[2][i]), (weight[i]), (moisnais[i]), (annais[i]), (moisdc[i]), (andc[i]), (mint[1][i]), (anint[1][i]), (s[1][i]), (mint[2][i]), (anint[2][i]), (s[2][i]), (mint[3][i]), (anint[3][i]), (s[3][i]), (mint[4][i]), (anint[4][i]), (s[4][i]));*/ + /* Calculation of the number of parameter from char model*/ - Tvar=ivector(1,8); + Tvar=ivector(1,15); + Tprod=ivector(1,15); + Tvaraff=ivector(1,15); + Tvard=imatrix(1,15,1,2); + Tage=ivector(1,15); if (strlen(model) >1){ - j=0; + j=0, j1=0, k1=1, k2=1; j=nbocc(model,'+'); + j1=nbocc(model,'*'); cptcovn=j+1; - + cptcovprod=j1; + + strcpy(modelsav,model); - if (j==0) { - cutv(stra,strb,modelsav,'V'); Tvar[1]=atoi(strb); + if ((strcmp(model,"age")==0) || (strcmp(model,"age*age")==0)){ + printf("Error. Non available option model=%s ",model); + goto end; } - else { - for(i=j; i>=1;i--){ - cutv(stra,strb,modelsav,'+'); - if (strchr(strb,'*')) { - cutv(strd,strc,strb,'*'); - cutv(strb,stre,strc,'V');Tvar[i+1]=ncov+1; - cutv(strb,strc,strd,'V'); - for (k=1; k<=lastobs;k++) - covar[ncov+1][k]=covar[atoi(stre)][k]*covar[atoi(strc)][k]; + + for(i=(j+1); i>=1;i--){ + cutv(stra,strb,modelsav,'+'); + if (nbocc(modelsav,'+')==0) strcpy(strb,modelsav); + /* printf("i=%d a=%s b=%s sav=%s\n",i, stra,strb,modelsav);*/ + /*scanf("%d",i);*/ + if (strchr(strb,'*')) { + cutv(strd,strc,strb,'*'); + if (strcmp(strc,"age")==0) { + cptcovprod--; + cutv(strb,stre,strd,'V'); + Tvar[i]=atoi(stre); + cptcovage++; + Tage[cptcovage]=i; + /*printf("stre=%s ", stre);*/ + } + else if (strcmp(strd,"age")==0) { + cptcovprod--; + cutv(strb,stre,strc,'V'); + Tvar[i]=atoi(stre); + cptcovage++; + Tage[cptcovage]=i; } else { - cutv(strd,strc,strb,'V'); - Tvar[i+1]=atoi(strc); + cutv(strb,stre,strc,'V'); + Tvar[i]=ncov+k1; + cutv(strb,strc,strd,'V'); + Tprod[k1]=i; + Tvard[k1][1]=atoi(strc); + Tvard[k1][2]=atoi(stre); + Tvar[cptcovn+k2]=Tvard[k1][1]; + Tvar[cptcovn+k2+1]=Tvard[k1][2]; + for (k=1; k<=lastobs;k++) + covar[ncov+k1][k]=covar[atoi(stre)][k]*covar[atoi(strc)][k]; + k1++; + k2=k2+2; } - strcpy(modelsav,stra); } - /*cutv(strd,strc,stra,'V');*/ - Tvar[1]=atoi(strc); + else { + /*printf("d=%s c=%s b=%s\n", strd,strc,strb);*/ + /* scanf("%d",i);*/ + cutv(strd,strc,strb,'V'); + Tvar[i]=atoi(strc); + } + strcpy(modelsav,stra); + /*printf("a=%s b=%s sav=%s\n", stra,strb,modelsav); + scanf("%d",i);*/ } - } - /*printf("tvar=%d ",Tvar[1]);*/ - /*scanf("%d ",i);*/ +} + + /*printf("tvar1=%d tvar2=%d tvar3=%d cptcovage=%d Tage=%d",Tvar[1],Tvar[2],Tvar[3],cptcovage,Tage[1]); + printf("cptcovprod=%d ", cptcovprod); + scanf("%d ",i);*/ fclose(fic); + /* if(mle==1){*/ if (weightopt != 1) { /* Maximisation without weights*/ for(i=1;i<=n;i++) weight[i]=1.0; } /*-calculation of age at interview from date of interview and age at death -*/ agev=matrix(1,maxwav,1,imx); + + for (i=1; i<=imx; i++) + for(m=2; (m<= maxwav); m++) + if ((mint[m][i]== 99) && (s[m][i] <= nlstate)){ + anint[m][i]=9999; + s[m][i]=-1; + } for (i=1; i<=imx; i++) { agedc[i]=(moisdc[i]/12.+andc[i])-(moisnais[i]/12.+annais[i]); for(m=1; (m<= maxwav); m++){ - if (mint[m][i]==99 || anint[m][i]==9999) s[m][i]=-1; if(s[m][i] >0){ if (s[m][i] == nlstate+1) { if(agedc[i]>0) if(moisdc[i]!=99 && andc[i]!=9999) agev[m][i]=agedc[i]; - else{ + else { + if (andc[i]!=9999){ printf("Warning negative age at death: %d line:%d\n",num[i],i); agev[m][i]=-1; + } } } else if(s[m][i] !=9){ /* Should no more exist */ agev[m][i]=(mint[m][i]/12.+1./24.+anint[m][i])-(moisnais[i]/12.+1./24.+annais[i]); - if(mint[m][i]==99 || anint[m][i]==9999){ + if(mint[m][i]==99 || anint[m][i]==9999) agev[m][i]=1; - /* printf("i=%d m=%d agev=%lf \n",i,m, agev[m][i]); */ - } else if(agev[m][i] 0) tricode(Tvar,nbcode,imx); - + Tcode=ivector(1,100); + nbcode=imatrix(0,NCOVMAX,0,NCOVMAX); + ncodemax[1]=1; + if (cptcovn > 0) tricode(Tvar,nbcode,imx); + codtab=imatrix(1,100,1,10); h=0; - m=pow(2,cptcovn); + m=pow(2,cptcoveff); - for(k=1;k<=cptcovn; k++){ + for(k=1;k<=cptcoveff; k++){ for(i=1; i <=(m/pow(2,k));i++){ for(j=1; j <= ncodemax[k]; j++){ - for(cpt=1; cpt <=(m/pow(2,cptcovn+1-k)); cpt++){ + for(cpt=1; cpt <=(m/pow(2,cptcoveff+1-k)); cpt++){ h++; if (h>m) h=1;codtab[h][k]=j; } } } } - - /*for(i=1; i <=m ;i++){ - for(k=1; k <=cptcovn; k++){ - printf("i=%d k=%d %d ",i,k,codtab[i][k]); - } - printf("\n"); - } - scanf("%d",i);*/ /* Calculates basic frequencies. Computes observed prevalence at single age and prints on file fileres'p'. */ - freqsummary(fileres, agemin, agemax, s, agev, nlstate, imx,Tvar,nbcode, ncodemax); + + pmmij= matrix(1,nlstate+ndeath,1,nlstate+ndeath); /* creation */ oldms= matrix(1,nlstate+ndeath,1,nlstate+ndeath); /* creation */ newms= matrix(1,nlstate+ndeath,1,nlstate+ndeath); /* creation */ savms= matrix(1,nlstate+ndeath,1,nlstate+ndeath); /* creation */ oldm=oldms; newm=newms; savm=savms; /* Keeps fixed addresses to free */ - + /* For Powell, parameters are in a vector p[] starting at p[1] so we point p on param[1][1] so that p[1] maps on param[1][1][1] */ p=param[1][1]; /* *(*(*(param +1)+1)+0) */ - /*scanf("%d",i);*/ - mlikeli(ficres,p, npar, ncovmodel, nlstate, ftol, func); + if(mle==1){ + mlikeli(ficres,p, npar, ncovmodel, nlstate, ftol, func); + } /*--------- results files --------------*/ - fprintf(ficres,"\ntitle=%s datafile=%s lastobs=%d firstpass=%d lastpass=%d\nftol=%e stepm=%d ncov=%d nlstate=%d ndeath=%d maxwav=%d mle=%d weight=%d\nmodel=%s\n", title, datafile, lastobs, firstpass,lastpass,ftol, stepm, ncov, nlstate, ndeath, maxwav, mle,weightopt,model); - + fprintf(ficres,"title=%s datafile=%s lastobs=%d firstpass=%d lastpass=%d\nftol=%e stepm=%d ncov=%d nlstate=%d ndeath=%d maxwav=%d mle=%d weight=%d\nmodel=%s\n", title, datafile, lastobs, firstpass,lastpass,ftol, stepm, ncov, nlstate, ndeath, maxwav, mle,weightopt,model); + + jk=1; fprintf(ficres,"# Parameters\n"); printf("# Parameters\n"); @@ -1992,10 +2366,11 @@ Tcode=ivector(1,100); } } } - + if(mle==1){ /* Computing hessian and covariance matrix */ ftolhess=ftol; /* Usually correct */ hesscov(matcov, p, npar, delti, ftolhess, func); + } fprintf(ficres,"# Scales\n"); printf("# Scales\n"); for(i=1,jk=1; i <=nlstate; i++){ @@ -2012,7 +2387,7 @@ Tcode=ivector(1,100); fprintf(ficres,"\n"); } } - } + } k=1; fprintf(ficres,"# Covariance\n"); @@ -2048,9 +2423,53 @@ Tcode=ivector(1,100); fage = agemax; } - fprintf(ficres,"# agemin agemax for life expectancy, bage fage (if mle==0 ie no data nor Max likelihood).\n"); + fprintf(ficres,"# agemin agemax for life expectancy.\n"); + fprintf(ficres,"agemin=%.0f agemax=%.0f bage=%.0f fage=%.0f\n",agemin,agemax,bage,fage); -/*------------ gnuplot -------------*/ + fprintf(ficparo,"agemin=%.0f agemax=%.0f bage=%.0f fage=%.0f\n",agemin,agemax,bage,fage); + + while((c=getc(ficpar))=='#' && c!= EOF){ + ungetc(c,ficpar); + fgets(line, MAXLINE, ficpar); + puts(line); + fputs(line,ficparo); + } + ungetc(c,ficpar); + + fscanf(ficpar,"begin-prev-date=%lf/%lf/%lf end-prev-date=%lf/%lf/%lf mob_average=%d\n",&jprev1, &mprev1,&anprev1,&jprev2, &mprev2,&anprev2,&mobilav); + fprintf(ficparo,"begin-prev-date=%.lf/%.lf/%.lf end-prev-date=%.lf/%.lf/%.lf mob_average=%d\n",jprev1, mprev1,anprev1,jprev2, mprev2,anprev2,mobilav); + fprintf(ficres,"begin-prev-date=%.lf/%.lf/%.lf end-prev-date=%.lf/%.lf/%.lf mob_average=%d\n",jprev1, mprev1,anprev1,jprev2, mprev2,anprev2,mobilav); + + while((c=getc(ficpar))=='#' && c!= EOF){ + ungetc(c,ficpar); + fgets(line, MAXLINE, ficpar); + puts(line); + fputs(line,ficparo); + } + ungetc(c,ficpar); + + + dateprev1=anprev1+mprev1/12.+jprev1/365.; + dateprev2=anprev2+mprev2/12.+jprev2/365.; + + fscanf(ficpar,"pop_based=%d\n",&popbased); + fprintf(ficparo,"pop_based=%d\n",popbased); + fprintf(ficres,"pop_based=%d\n",popbased); + + while((c=getc(ficpar))=='#' && c!= EOF){ + ungetc(c,ficpar); + fgets(line, MAXLINE, ficpar); + puts(line); + fputs(line,ficparo); + } + ungetc(c,ficpar); + fscanf(ficpar,"popforecast=%d popfile=%s starting-proj-date=%lf/%lf/%lf final-proj-date=%lf/%lf/%lf\n",&popforecast,popfile,&jproj1,&mproj1,&anproj1,&jproj2,&mproj2,&anproj2); +fprintf(ficparo,"popforecast=%d popfile=%s starting-proj-date=%.lf/%.lf/%.lf final-proj-date=%.lf/%.lf/%.lf\n",popforecast,popfile,jproj1,mproj1,anproj1,jproj2,mproj2,anproj2); +fprintf(ficres,"popforecast=%d popfile=%s starting-proj-date=%.lf/%.lf/%.lf final-proj-date=%.lf/%.lf/%.lf\n",popforecast,popfile,jproj1,mproj1,anproj1,jproj2,mproj2,anproj2); + + freqsummary(fileres, agemin, agemax, s, agev, nlstate, imx,Tvar,nbcode, ncodemax,mint,anint,dateprev1,dateprev2); + + /*------------ gnuplot -------------*/ chdir(pathcd); if((ficgp=fopen("graph.plt","w"))==NULL) { printf("Problem with file graph.gp");goto end; @@ -2058,7 +2477,7 @@ chdir(pathcd); #ifdef windows fprintf(ficgp,"cd \"%s\" \n",pathc); #endif -m=pow(2,cptcovn); +m=pow(2,cptcoveff); /* 1eme*/ for (cpt=1; cpt<= nlstate ; cpt ++) { @@ -2154,62 +2573,77 @@ fprintf(ficgp,"\nset out \"v%s%d%d.gif\" fprintf(ficgp,")) t\"prev(%d,%d)\" w l\n",cpt+1,cpt+1); fprintf(ficgp,"set out \"p%s%d%d.gif\" \nreplot\n\n",strtok(optionfile, "."),cpt,k1); } - } + } /* proba elementaires */ - for(i=1,jk=1; i <=nlstate; i++){ + for(i=1,jk=1; i <=nlstate; i++){ for(k=1; k <=(nlstate+ndeath); k++){ if (k != i) { - /* fprintf(ficgp,"%1d%1d ",i,k);*/ for(j=1; j <=ncovmodel; j++){ - fprintf(ficgp,"%s%1d%1d=%f ",alph[j],i,k,p[jk]); + /*fprintf(ficgp,"%s%1d%1d=%f ",alph[j],i,k,p[jk]);*/ + /*fprintf(ficgp,"%s",alph[1]);*/ + fprintf(ficgp,"p%d=%f ",jk,p[jk]); jk++; fprintf(ficgp,"\n"); } } } - } + } + for(jk=1; jk <=m; jk++) { fprintf(ficgp,"\nset ter gif small size 400,300\nset log y\nplot [%.f:%.f] ",agemin,agemax); - for(i=1; i <=nlstate; i++) { - for(k=1; k <=(nlstate+ndeath); k++){ - if (k != i) { - fprintf(ficgp," exp(a%d%d+b%d%d*x",i,k,i,k); - for(j=3; j <=ncovmodel; j++) - fprintf(ficgp,"+%s%d%d*%d",alph[j],i,k,nbcode[Tvar[j-2]][codtab[jk][j-2]]); - fprintf(ficgp,")/(1"); - for(k1=1; k1 <=(nlstate+ndeath); k1++) - if (k1 != i) { - fprintf(ficgp,"+exp(a%d%d+b%d%d*x",i,k1,i,k1); - for(j=3; j <=ncovmodel; j++) - fprintf(ficgp,"+%s%d%d*%d",alph[j],i,k,nbcode[Tvar[j-2]][codtab[jk][j-2]]); - fprintf(ficgp,")"); + i=1; + for(k2=1; k2<=nlstate; k2++) { + k3=i; + for(k=1; k<=(nlstate+ndeath); k++) { + if (k != k2){ + fprintf(ficgp," exp(p%d+p%d*x",i,i+1); +ij=1; + for(j=3; j <=ncovmodel; j++) { + if(((j-2)==Tage[ij]) &&(ij <=cptcovage)) { + fprintf(ficgp,"+p%d*%d*x",i+j-1,nbcode[Tvar[j-2]][codtab[jk][Tvar[j-2]]]); + ij++; } - fprintf(ficgp,") t \"p%d%d\" ", i,k); - if ((i+k)!= (nlstate*2+ndeath)) fprintf(ficgp,","); - } - } - } -fprintf(ficgp,"\nset out \"pe%s%d.gif\" \nreplot\n\n",strtok(optionfile, "."),jk); + else + fprintf(ficgp,"+p%d*%d",i+j-1,nbcode[Tvar[j-2]][codtab[jk][j-2]]); + } + fprintf(ficgp,")/(1"); + + for(k1=1; k1 <=nlstate; k1++){ + fprintf(ficgp,"+exp(p%d+p%d*x",k3+(k1-1)*ncovmodel,k3+(k1-1)*ncovmodel+1); +ij=1; + for(j=3; j <=ncovmodel; j++){ + if(((j-2)==Tage[ij]) &&(ij <=cptcovage)) { + fprintf(ficgp,"+p%d*%d*x",k3+(k1-1)*ncovmodel+1+j-2,nbcode[Tvar[j-2]][codtab[jk][Tvar[j-2]]]); + ij++; + } + else + fprintf(ficgp,"+p%d*%d",k3+(k1-1)*ncovmodel+1+j-2,nbcode[Tvar[j-2]][codtab[jk][j-2]]); + } + fprintf(ficgp,")"); + } + fprintf(ficgp,") t \"p%d%d\" ", k2,k); + if ((k+k2)!= (nlstate*2+ndeath)) fprintf(ficgp,","); + i=i+ncovmodel; + } + } + } + fprintf(ficgp,"\nset out \"pe%s%d.gif\" \nreplot\n\n",strtok(optionfile, "."),jk); } + fclose(ficgp); chdir(path); - free_matrix(agev,1,maxwav,1,imx); + free_ivector(wav,1,imx); free_imatrix(dh,1,lastpass-firstpass+1,1,imx); - free_imatrix(mw,1,lastpass-firstpass+1,1,imx); - - free_imatrix(s,1,maxwav+1,1,n); - - + free_imatrix(mw,1,lastpass-firstpass+1,1,imx); free_ivector(num,1,n); free_vector(agedc,1,n); - free_vector(weight,1,n); /*free_matrix(covar,1,NCOVMAX,1,n);*/ fclose(ficparo); fclose(ficres); - } + /* }*/ /*________fin mle=1_________*/ @@ -2230,11 +2664,18 @@ chdir(path); fprintf(ficparo,"agemin=%.0f agemax=%.0f bage=%.0f fage=%.0f\n",agemin,agemax,bage,fage); /*--------- index.htm --------*/ - if((fichtm=fopen("index.htm","w"))==NULL) { - printf("Problem with index.htm \n");goto end; + strcpy(optionfilehtm,optionfile); + strcat(optionfilehtm,".htm"); + if((fichtm=fopen(optionfilehtm,"w"))==NULL) { + printf("Problem with %s \n",optionfilehtm);goto end; } - fprintf(fichtm,"
    Imach, Version 0.63
  • Outputs files

    \n + fprintf(fichtm,"
      Imach, Version 0.7
      +Titre=%s
      Datafile=%s Firstpass=%d Lastpass=%d Stepm=%d Weight=%d Model=%s
      +Total number of observations=%d
      +Interval (in months) between two waves: Min=%d Max=%d Mean=%.2lf
      +
      +
    • Outputs files

      \n - Observed prevalence in each state: p%s
      \n - Estimated parameters and the covariance matrix: %s
      - Stationary prevalence in each state: pl%s
      @@ -2243,11 +2684,13 @@ chdir(path); - Life expectancies by age and initial health status: e%s
      - Variances of life expectancies by age and initial health status: v%s
      - Health expectancies with their variances: t%s
      - - Standard deviation of stationary prevalences: vpl%s

      ",fileres,fileres,fileres,fileres,fileres,fileres,fileres,fileres,fileres,fileres,fileres,fileres,fileres,fileres,fileres,fileres,fileres,fileres); + - Standard deviation of stationary prevalences: vpl%s
      + - Prevalences and population forecasting: f%s
      +
      ",title,datafile,firstpass,lastpass,stepm, weightopt,model,imx,jmin,jmax,jmean,fileres,fileres,fileres,fileres,fileres,fileres,fileres,fileres,fileres,fileres,fileres,fileres,fileres,fileres,fileres,fileres,fileres,fileres,fileres,fileres); - fprintf(fichtm,"
    • Graphs
      • \n

      "); + fprintf(fichtm,"

    • Graphs

      • "); - m=cptcovn; + m=cptcoveff; if (cptcovn < 1) {m=1;ncodemax[1]=1;} j1=0; @@ -2255,10 +2698,10 @@ chdir(path); for(i1=1; i1<=ncodemax[k1];i1++){ j1++; if (cptcovn > 0) { - fprintf(fichtm,"

      ************ Results for covariates"); - for (cpt=1; cpt<=cptcovn;cpt++) - fprintf(fichtm," V%d=%d ",Tvar[cpt],nbcode[Tvar[cpt]][codtab[j1][cpt]]); - fprintf(fichtm," ************\n
      "); + fprintf(fichtm,"
      ************ Results for covariates"); + for (cpt=1; cpt<=cptcoveff;cpt++) + fprintf(fichtm," V%d=%d ",Tvaraff[cpt],nbcode[Tvaraff[cpt]][codtab[j1][cpt]]); + fprintf(fichtm," ************\n
      "); } fprintf(fichtm,"
      - Probabilities: pe%s%d.gif
      ",strtok(optionfile, "."),j1,strtok(optionfile, "."),j1); @@ -2306,16 +2749,16 @@ fclose(fichtm); agebase=agemin; agelim=agemax; ftolpl=1.e-10; - i1=cptcovn; + i1=cptcoveff; if (cptcovn < 1){i1=1;} for(cptcov=1;cptcov<=i1;cptcov++){ for(cptcod=1;cptcod<=ncodemax[cptcov];cptcod++){ k=k+1; /*printf("cptcov=%d cptcod=%d codtab=%d nbcode=%d\n",cptcov, cptcod,Tcode[cptcode],codtab[cptcod][cptcov]);*/ - fprintf(ficrespl,"\n#****** "); - for(j=1;j<=cptcovn;j++) - fprintf(ficrespl,"V%d=%d ",Tvar[j],nbcode[Tvar[j]][codtab[k][j]]); + fprintf(ficrespl,"\n#******"); + for(j=1;j<=cptcoveff;j++) + fprintf(ficrespl," V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtab[k][j]]); fprintf(ficrespl,"******\n"); for (age=agebase; age<=agelim; age++){ @@ -2328,6 +2771,7 @@ fclose(fichtm); } } fclose(ficrespl); + /*------------- h Pij x at various ages ------------*/ strcpy(filerespij,"pij"); strcat(filerespij,fileres); @@ -2337,7 +2781,7 @@ fclose(fichtm); printf("Computing pij: result on file '%s' \n", filerespij); stepsize=(int) (stepm+YEARM-1)/YEARM; - if (stepm<=24) stepsize=2; + /*if (stepm<=24) stepsize=2;*/ agelim=AGESUP; hstepm=stepsize*YEARM; /* Every year of age */ @@ -2348,8 +2792,8 @@ fclose(fichtm); for(cptcod=1;cptcod<=ncodemax[cptcov];cptcod++){ k=k+1; fprintf(ficrespij,"\n#****** "); - for(j=1;j<=cptcovn;j++) - fprintf(ficrespij,"V%d=%d ",Tvar[j],nbcode[Tvar[j]][codtab[k][j]]); + for(j=1;j<=cptcoveff;j++) + fprintf(ficrespij,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtab[k][j]]); fprintf(ficrespij,"******\n"); for (agedeb=fage; agedeb>=bage; agedeb--){ /* If stepm=6 months */ @@ -2376,8 +2820,145 @@ fclose(fichtm); } } + /* varprob(fileres, matcov, p, delti, nlstate, (int) bage, (int) fage,k);*/ + fclose(ficrespij); + /*---------- Forecasting ------------------*/ + calagedate=(anproj1+mproj1/12.+jproj1/365.-dateintmean)*YEARM; + + prevalence(agemin, agemax, s, agev, nlstate, imx,Tvar,nbcode, ncodemax,mint,anint,dateprev1,dateprev2, calagedate); + + + strcpy(fileresf,"f"); + strcat(fileresf,fileres); + if((ficresf=fopen(fileresf,"w"))==NULL) { + printf("Problem with forecast resultfile: %s\n", fileresf);goto end; + } + printf("Computing forecasting: result on file '%s' \n", fileresf); + + free_matrix(mint,1,maxwav,1,n); + free_matrix(anint,1,maxwav,1,n); + free_matrix(agev,1,maxwav,1,imx); + /* Mobile average */ + + if (cptcoveff==0) ncodemax[cptcoveff]=1; + + if (mobilav==1) { + mobaverage= ma3x(1, AGESUP,1,NCOVMAX, 1,NCOVMAX); + for (agedeb=bage+3; agedeb<=fage-2; agedeb++) + for (i=1; i<=nlstate;i++) + for (cptcod=1;cptcod<=ncodemax[cptcov];cptcod++) + mobaverage[(int)agedeb][i][cptcod]=0.; + + for (agedeb=bage+4; agedeb<=fage; agedeb++){ + for (i=1; i<=nlstate;i++){ + for (cptcod=1;cptcod<=ncodemax[cptcoveff];cptcod++){ + for (cpt=0;cpt<=4;cpt++){ + mobaverage[(int)agedeb-2][i][cptcod]=mobaverage[(int)agedeb-2][i][cptcod]+probs[(int)agedeb-cpt][i][cptcod]; + } + mobaverage[(int)agedeb-2][i][cptcod]=mobaverage[(int)agedeb-2][i][cptcod]/5; + } + } + } + } + + stepsize=(int) (stepm+YEARM-1)/YEARM; + if (stepm<=12) stepsize=1; + + agelim=AGESUP; + /*hstepm=stepsize*YEARM; *//* Every year of age */ + hstepm=1; + hstepm=hstepm/stepm; /* Typically 2 years, = 2 years/6 months = 4 */ + yp1=modf(dateintmean,&yp); + anprojmean=yp; + yp2=modf((yp1*12),&yp); + mprojmean=yp; + yp1=modf((yp2*30.5),&yp); + jprojmean=yp; + fprintf(ficresf,"Estimated date of observed prevalence: %.lf/%.lf/%.lf ",jprojmean,mprojmean,anprojmean); + + if (popforecast==1) { + if((ficpop=fopen(popfile,"r"))==NULL) { + printf("Problem with population file : %s\n",popfile);goto end; + } + popage=ivector(0,AGESUP); + popeffectif=vector(0,AGESUP); + popcount=vector(0,AGESUP); + + i=1; + while ((c=fscanf(ficpop,"%d %lf\n",&popage[i],&popcount[i])) != EOF) + { + i=i+1; + } + imx=i; + + for (i=1; i=(bage-(1/12.)); agedeb--){ /* If stepm=6 months */ + nhstepm=(int) rint((agelim-agedeb)*YEARM/stepm); + nhstepm = nhstepm/hstepm; + /*printf("agedeb=%.lf stepm=%d hstepm=%d nhstepm=%d \n",agedeb,stepm,hstepm,nhstepm);*/ + + p3mat=ma3x(1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); + oldm=oldms;savm=savms; + hpxij(p3mat,nhstepm,agedeb,hstepm,p,nlstate,stepm,oldm,savm, k); + + for (h=0; h<=nhstepm; h++){ + if (h==(int) (calagedate+12*cpt)) { + fprintf(ficresf,"h=%d ", h); + fprintf(ficresf,"\n %f %f ",agedeb,agedeb+h*hstepm/YEARM*stepm); + } + for(j=1; j<=nlstate+ndeath;j++) { + kk1=0.;kk2=0; + for(i=1; i<=nlstate;i++) { + if (mobilav==1) + kk1=kk1+p3mat[i][j][h]*mobaverage[(int)agedeb][i][cptcod]; + else { + kk1=kk1+p3mat[i][j][h]*probs[(int)(agedeb+1)][i][cptcod]; + /* fprintf(ficresf," p3=%.3f p=%.3f ", p3mat[i][j][h],probs[(int)(agedeb)+1][i][cptcod]);*/ + } + + if (popforecast==1) kk2=kk1*popeffectif[(int)agedeb]; + } + + if (h==(int)(calagedate+12*cpt)){ + fprintf(ficresf," %.3f", kk1); + + if (popforecast==1) fprintf(ficresf," [%.f]", kk2); + } + } + } + free_ma3x(p3mat,1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); + } + } + } + } + if (mobilav==1) free_ma3x(mobaverage,1, AGESUP,1,NCOVMAX, 1,NCOVMAX); + if (popforecast==1) { + free_ivector(popage,0,AGESUP); + free_vector(popeffectif,0,AGESUP); + free_vector(popcount,0,AGESUP); + } + free_imatrix(s,1,maxwav+1,1,n); + free_vector(weight,1,n); + fclose(ficresf); /*---------- Health expectancies and variances ------------*/ strcpy(filerest,"t"); @@ -2407,17 +2988,17 @@ fclose(fichtm); for(cptcod=1;cptcod<=ncodemax[cptcov];cptcod++){ k=k+1; fprintf(ficrest,"\n#****** "); - for(j=1;j<=cptcovn;j++) - fprintf(ficrest,"V%d=%d ",Tvar[j],nbcode[Tvar[j]][codtab[k][j]]); + for(j=1;j<=cptcoveff;j++) + fprintf(ficrest,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtab[k][j]]); fprintf(ficrest,"******\n"); fprintf(ficreseij,"\n#****** "); - for(j=1;j<=cptcovn;j++) + for(j=1;j<=cptcoveff;j++) fprintf(ficreseij,"V%d=%d ",j,nbcode[j][codtab[k][j]]); fprintf(ficreseij,"******\n"); fprintf(ficresvij,"\n#****** "); - for(j=1;j<=cptcovn;j++) + for(j=1;j<=cptcoveff;j++) fprintf(ficresvij,"V%d=%d ",j,nbcode[j][codtab[k][j]]); fprintf(ficresvij,"******\n"); @@ -2437,6 +3018,11 @@ fclose(fichtm); epj=vector(1,nlstate+1); for(age=bage; age <=fage ;age++){ prevalim(prlim, nlstate, p, age, oldm, savm,ftolpl,k); + if (popbased==1) { + for(i=1; i<=nlstate;i++) + prlim[i][i]=probs[(int)age][i][k]; + } + fprintf(ficrest," %.0f",age); for(j=1, epj[nlstate+1]=0.;j <=nlstate;j++){ for(i=1, epj[j]=0.;i <=nlstate;i++) { @@ -2456,6 +3042,9 @@ fclose(fichtm); } } + + + fclose(ficreseij); fclose(ficresvij); fclose(ficrest); @@ -2478,8 +3067,8 @@ strcpy(fileresvpl,"vpl"); for(cptcod=1;cptcod<=ncodemax[cptcov];cptcod++){ k=k+1; fprintf(ficresvpl,"\n#****** "); - for(j=1;j<=cptcovn;j++) - fprintf(ficresvpl,"V%d=%d ",Tvar[j],nbcode[Tvar[j]][codtab[k][j]]); + for(j=1;j<=cptcoveff;j++) + fprintf(ficresvpl,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtab[k][j]]); fprintf(ficresvpl,"******\n"); varpl=matrix(1,nlstate,(int) bage, (int) fage); @@ -2501,7 +3090,7 @@ strcpy(fileresvpl,"vpl"); free_matrix(oldms, 1,nlstate+ndeath,1,nlstate+ndeath); free_matrix(newms, 1,nlstate+ndeath,1,nlstate+ndeath); free_matrix(savms, 1,nlstate+ndeath,1,nlstate+ndeath); - + free_matrix(matcov,1,npar,1,npar); free_vector(delti,1,npar); @@ -2514,11 +3103,13 @@ strcpy(fileresvpl,"vpl"); /*printf("Total time was %d uSec.\n", total_usecs);*/ /*------ End -----------*/ + end: #ifdef windows chdir(pathcd); #endif - system("wgnuplot ../gp37mgw/graph.plt"); + + system("..\\gp37mgw\\wgnuplot graph.plt"); #ifdef windows while (z[0] != 'q') { @@ -2528,7 +3119,7 @@ strcpy(fileresvpl,"vpl"); if (z[0] == 'c') system("./imach"); else if (z[0] == 'e') { chdir(path); - system("index.htm"); + system(optionfilehtm); } else if (z[0] == 'q') exit(0); }