--- imach/src/imach.c 2001/05/02 17:42:45 1.5 +++ imach/src/imach.c 2002/02/27 15:42:00 1.26 @@ -1,34 +1,42 @@ - -/*********************** Imach ************************************** - This program computes Healthy Life Expectancies from cross-longitudinal - data. Cross-longitudinal consist in a first survey ("cross") where - individuals from different ages are interviewed on their health status - or degree of disability. At least a second wave of interviews - ("longitudinal") should measure each new individual health status. - 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. - 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: - log(pij/pii)= aij + bij*age+ cij*sex + etc , where 'age' is age and 'sex' - is a covariate. If you want to have a more complex model than "constant and - age", you should modify the program where the markup - *Covariates have to be included here again* invites you to do it. - More covariates you add, less is the speed of the convergence. - - The advantage that this computer programme claims, comes from that if the - 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 - 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 - quarter trimester, semester or year) is model as a multinomial logistic. - The hPx matrix is simply the matrix product of nh*stepm elementary matrices - and the contribution of each individual to the likelihood is simply hPijx. +/* $Id: imach.c,v 1.26 2002/02/27 15:42:00 lievre Exp $ + Interpolated Markov Chain + + Short summary of the programme: + + This program computes Healthy Life Expectancies from + cross-longitudinal data. Cross-longitudinal data consist in: -1- a + first survey ("cross") where individuals from different ages are + interviewed on their health status or degree of disability (in the + case of a health survey which is our main interest) -2- at least a + second wave of interviews ("longitudinal") which measure each change + (if any) in individual health status. Health expectancies are + computed from the time spent in each health state according to a + model. More health states you consider, more time is necessary to 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: log(pij/pii)= aij + bij*age+ cij*sex + etc , where + 'age' is age and 'sex' is a covariate. If you want to have a more + complex model than "constant and age", you should modify the program + where the markup *Covariates have to be included here again* invites + you to do it. More covariates you add, slower the + convergence. + + The advantage of this computer programme, compared to a simple + multinomial logistic model, is clear when the delay between waves is not + identical for each individual. Also, if a individual missed an + intermediate interview, the information is lost, but taken into + account using an interpolation or extrapolation. + + 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 quarter trimester, + semester or year) is model as a multinomial logistic. The hPx + matrix is simply the matrix product of nh*stepm elementary matrices + and the contribution of each individual to the likelihood is simply + hPijx. Also this programme outputs the covariance matrix of the parameters but also of the life expectancies. It also computes the prevalence limits. @@ -48,14 +56,13 @@ #include #define MAXLINE 256 +#define GNUPLOTPROGRAM "..\\gp37mgw\\wgnuplot" #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 */ @@ -69,23 +76,26 @@ #define AGEBASE 40 +int erreur; /* Error number */ 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,*ficresprob,*ficpop; FILE *ficreseij; char filerese[FILENAMELENGTH]; FILE *ficresvij; @@ -93,9 +103,6 @@ FILE *ficreseij; FILE *ficresvpl; char fileresvpl[FILENAMELENGTH]; - - - #define NR_END 1 #define FREE_ARG char* #define FTOL 1.0e-10 @@ -116,7 +123,7 @@ FILE *ficreseij; static double maxarg1,maxarg2; #define FMAX(a,b) (maxarg1=(a),maxarg2=(b),(maxarg1)>(maxarg2)? (maxarg1):(maxarg2)) #define FMIN(a,b) (maxarg1=(a),maxarg2=(b),(maxarg1)<(maxarg2)? (maxarg1):(maxarg2)) - + #define SIGN(a,b) ((b)>0.0 ? fabs(a) : -fabs(a)) #define rint(a) floor(a+0.5) @@ -129,27 +136,32 @@ 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 */ - -static int split( char *path, char *dirc, char *name ) +/**************** split *************************/ +static int split( char *path, char *dirc, char *name, char *ext, char *finame ) { char *s; /* pointer */ int l1, l2; /* length counters */ l1 = strlen( path ); /* length of path */ if ( l1 == 0 ) return( GLOCK_ERROR_NOPATH ); +#ifdef windows s = strrchr( path, '\\' ); /* find last / */ +#else + s = strrchr( path, '/' ); /* find last / */ +#endif if ( s == NULL ) { /* no directory, so use current */ #if defined(__bsd__) /* get current working directory */ extern char *getwd( ); @@ -172,7 +184,18 @@ static int split( char *path, char *dirc dirc[l1-l2] = 0; /* add zero */ } l1 = strlen( dirc ); /* length of directory */ +#ifdef windows if ( dirc[l1-1] != '\\' ) { dirc[l1] = '\\'; dirc[l1+1] = 0; } +#else + if ( dirc[l1-1] != '/' ) { dirc[l1] = '/'; dirc[l1+1] = 0; } +#endif + s = strrchr( name, '.' ); /* find last / */ + s++; + strcpy(ext,s); /* save extension */ + l1= strlen( name); + l2= strlen( s)+1; + strncpy( finame, name, l1-l2); + finame[l1-l2]= 0; return( 0 ); /* we're done */ } @@ -205,7 +228,7 @@ 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; for(j=0; j<=strlen(t)-1; j++) { if((t[j]!= occ) && (t[j+1]== occ)) p=j+1; @@ -214,8 +237,8 @@ void cutv(char *u,char *v, char*t, char lg=strlen(t); for(j=0; j=(p+1))(v[j-p-1] = t[j]); @@ -652,15 +675,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; @@ -685,7 +720,7 @@ double **prevalim(double **prlim, int nl } } -/*************** transition probabilities **********/ +/*************** transition probabilities ***************/ double **pmij(double **ps, double *cov, int ncovmodel, double *x, int nlstate ) { @@ -711,6 +746,8 @@ double **pmij(double **ps, double *cov, 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, @@ -819,7 +861,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 */ @@ -829,29 +871,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[1+k-1][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; @@ -882,7 +926,7 @@ void mlikeli(FILE *ficres,double p[], in powell(p,xi,npar,ftol,&iter,&fret,func); printf("\n#Number of iterations = %d, -2 Log likelihood = %.12f\n",iter,func(p)); - fprintf(ficres,"#Number of iterations = %d, -2 Log likelihood = %.12f ",iter,func(p)); + fprintf(ficres,"#Number of iterations = %d, -2 Log likelihood = %.12f \n",iter,func(p)); } @@ -899,7 +943,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"); @@ -907,14 +950,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]);*/ } } } @@ -1018,7 +1063,7 @@ double hessii( double x[], double delta, } } delti[theta]=delts; - return res; + return res; } @@ -1131,18 +1176,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,double jprev1, double mprev1,double anprev1,double jprev2, double mprev2,double anprev2) { /* 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) { @@ -1152,38 +1197,53 @@ 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++; + } + + } } } } + + fprintf(ficresp, "#Count between %.lf/%.lf/%.lf and %.lf/%.lf/%.lf\n",jprev1, mprev1,anprev1,jprev2, mprev2,anprev2); + 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"); @@ -1195,7 +1255,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++) @@ -1205,10 +1265,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++){ @@ -1217,8 +1279,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); } @@ -1232,11 +1297,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-((int)calagedate %12)/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 ***************/ @@ -1251,9 +1400,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; @@ -1283,14 +1437,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)); 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; @@ -1305,30 +1467,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++; @@ -1336,9 +1503,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 ****************/ @@ -1399,7 +1582,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; @@ -1435,6 +1618,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++) @@ -1446,12 +1635,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]; @@ -1491,7 +1687,7 @@ void varevsij(char fileres[], double *** free_ma3x(trgradg,0,nhstepm,1,nlstate,1,npar); free_ma3x(p3mat,1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); } /* End age */ - + free_vector(xp,1,npar); free_matrix(doldm,1,nlstate,1,npar); free_matrix(dnewm,1,nlstate,1,nlstate); @@ -1581,144 +1777,529 @@ void varprevlim(char fileres[], double * } - - -/***********************************************/ -/**************** Main Program *****************/ -/***********************************************/ - -/*int main(int argc, char *argv[])*/ -int main() +/************ 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]; - int i,j, k, n=MAXN,iter,m,size,cptcode, aaa, cptcod; - double agedeb, agefin,hf; - double agemin=1.e20, agemax=-1.e20; - - double fret; - double **xi,tmp,delta; - - double dum; /* Dummy variable */ - double ***p3mat; - 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 filerest[FILENAMELENGTH]; - char fileregp[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,k2,k3,jk,aa,bb, stepsize; - int jnais,jdc,jint4,jint1,jint2,jint3,**outcome,**adl,*tab; + 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); - int hstepm, nhstepm; - double bage, fage, age, agelim, agebase; - double ftolpl=FTOL; - double **prlim; - double *severity; - double ***param; /* Matrix of parameters */ - double *p; - double **matcov; /* Matrix of covariance */ - double ***delti3; /* Scale */ - double *delti; /* Scale */ - double ***eij, ***vareij; - double **varpl; /* Variances of prevalence limits by age */ - double *epj, vepp; - char version[80]="Imach version 62c, May 1999, 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; + 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)); - gettimeofday(&start_time, (struct timezone*)0); */ /* at first time */ + 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); + - printf("\nIMACH, Version 0.64a"); - printf("\nEnter the parameter file name: "); + 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]; + } -#ifdef windows - scanf("%s",pathtot); - getcwd(pathcd, size); - /*cygwin_split_path(pathtot,path,optionfile); - printf("pathtot=%s, path=%s, optionfile=%s\n",pathtot,path,optionfile);*/ - /* cutv(path,optionfile,pathtot,'\\');*/ + 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); -split(pathtot, path,optionfile); - chdir(path); - replace(pathc,path); -#endif -#ifdef unix - scanf("%s",optionfile); -#endif + pmij(pmmij,cov,ncovmodel,x,nlstate); -/*-------- arguments in the command line --------*/ + 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++){ + - strcpy(fileres,"r"); - strcat(fileres, optionfile); + printf("%e [%e ;%e] ",gm[i],gm[i]-2*sqrt(doldm[i][i]),gm[i]+2*sqrt(doldm[i][i])); + }*/ - /*---------arguments file --------*/ + fprintf(ficresprob,"\n%d ",(int)age); - if((ficpar=fopen(optionfile,"r"))==NULL) { - printf("Problem with optionfile %s\n",optionfile); - goto end; + 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]); } - strcpy(filereso,"o"); - strcat(filereso,fileres); - if((ficparo=fopen(filereso,"w"))==NULL) { - printf("Problem with Output resultfile: %s\n", filereso);goto end; - } + 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); - /* Reads comments: lines beginning with '#' */ - while((c=getc(ficpar))=='#' && c!= EOF){ - ungetc(c,ficpar); - fgets(line, MAXLINE, ficpar); - puts(line); - fputs(line,ficparo); - } - ungetc(c,ficpar); +} - 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); +/******************* Printing html file ***********/ +void printinghtml(char fileres[], char title[], char datafile[], int firstpass, int lastpass, int stepm, int weightopt, char model[],int imx,int jmin, int jmax, double jmeanint,char optionfile[],char optionfilehtm[] ){ + int jj1, k1, i1, cpt; + FILE *fichtm; + /*char optionfilehtm[FILENAMELENGTH];*/ - covar=matrix(1,NCOVMAX,1,n); - if (strlen(model)<=1) cptcovn=0; - else { - j=0; - j=nbocc(model,'+'); - cptcovn=j+1; + strcpy(optionfilehtm,optionfile); + strcat(optionfilehtm,".htm"); + if((fichtm=fopen(optionfilehtm,"w"))==NULL) { + printf("Problem with %s \n",optionfilehtm), exit(0); } - ncovmodel=2+cptcovn; - nvar=ncovmodel-1; /* Suppressing age as a basic covariate */ - - /* Read guess parameters */ - /* Reads comments: lines beginning with '#' */ - while((c=getc(ficpar))=='#' && c!= EOF){ - ungetc(c,ficpar); - fgets(line, MAXLINE, ficpar); - puts(line); - fputs(line,ficparo); - } - ungetc(c,ficpar); - - param= ma3x(1,nlstate,1,nlstate+ndeath-1,1,ncovmodel); - for(i=1; i <=nlstate; i++) - for(j=1; j <=nlstate+ndeath-1; j++){ - fscanf(ficpar,"%1d%1d",&i1,&j1); - fprintf(ficparo,"%1d%1d",i1,j1); - printf("%1d%1d",i,j); - for(k=1; k<=ncovmodel;k++){ - fscanf(ficpar," %lf",¶m[i][j][k]); + fprintf(fichtm,"
    Imach, Version 0.7
    +Title=%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
    + - Transition probabilities: pij%s
    + - Copy of the parameter file: o%s
    + - 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
    + - 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

    • "); + + m=cptcoveff; + if (cptcovn < 1) {m=1;ncodemax[1]=1;} + + jj1=0; + for(k1=1; k1<=m;k1++){ + for(i1=1; i1<=ncodemax[k1];i1++){ + jj1++; + if (cptcovn > 0) { + fprintf(fichtm,"

    ************ Results for covariates"); + for (cpt=1; cpt<=cptcoveff;cpt++) + fprintf(fichtm," V%d=%d ",Tvaraff[cpt],nbcode[Tvaraff[cpt]][codtab[jj1][cpt]]); + fprintf(fichtm," ************\n
    "); + } + fprintf(fichtm,"
    - Probabilities: pe%s%d.gif
    +",strtok(optionfile, "."),jj1,strtok(optionfile, "."),jj1); + for(cpt=1; cpt- Prevalence of disability : p%s%d%d.gif
    +",strtok(optionfile, "."),cpt,jj1,strtok(optionfile, "."),cpt,jj1); + } + for(cpt=1; cpt<=nlstate;cpt++) { + fprintf(fichtm,"
    - Observed and stationary prevalence (with confident +interval) in state (%d): v%s%d%d.gif
    +",cpt,strtok(optionfile, "."),cpt,jj1,strtok(optionfile, "."),cpt,jj1); + } + for(cpt=1; cpt<=nlstate;cpt++) { + fprintf(fichtm,"\n
    - Health life expectancies by age and initial health state (%d): exp%s%d%d.gif
    +",cpt,strtok(optionfile, "."),cpt,jj1,strtok(optionfile, "."),cpt,jj1); + } + fprintf(fichtm,"\n
    - Total life expectancy by age and +health expectancies in states (1) and (2): e%s%d.gif
    +",strtok(optionfile, "."),jj1,strtok(optionfile, "."),jj1); +fprintf(fichtm,"\n"); + } + } +fclose(fichtm); +} + +/******************* Gnuplot file **************/ +void printinggnuplot(char fileres[],char optionfilefiname[],char optionfile[],char optionfilegnuplot[], double agemin, double agemax, double fage , char pathc[], double p[]){ + + int m,cpt,k1,i,k,j,jk,k2,k3,ij,l; + + strcpy(optionfilegnuplot,optionfilefiname); + strcat(optionfilegnuplot,".plt"); + if((ficgp=fopen(optionfilegnuplot,"w"))==NULL) { + printf("Problem with file %s",optionfilegnuplot); + } + +#ifdef windows + fprintf(ficgp,"cd \"%s\" \n",pathc); +#endif +m=pow(2,cptcoveff); + + /* 1eme*/ + for (cpt=1; cpt<= nlstate ; cpt ++) { + for (k1=1; k1<= m ; k1 ++) { + +#ifdef windows + fprintf(ficgp,"set xlabel \"Age\" \nset ylabel \"Probability\" \nset ter gif small size 400,300\nplot [%.f:%.f] \"vpl%s\" every :::%d::%d u 1:2 \"\%%lf",agemin,fage,fileres,k1-1,k1-1); +#endif +#ifdef unix +fprintf(ficgp,"set xlabel \"Age\" \nset ylabel \"Probability\" \nplot [%.f:%.f] \"vpl%s\" u 1:2 \"\%%lf",agemin,fage,fileres); +#endif + +for (i=1; i<= nlstate ; i ++) { + if (i==cpt) fprintf(ficgp," \%%lf (\%%lf)"); + else fprintf(ficgp," \%%*lf (\%%*lf)"); +} + fprintf(ficgp,"\" t\"Stationary prevalence\" w l 0,\"vpl%s\" every :::%d::%d u 1:($2+2*$3) \"\%%lf",fileres,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,\"vpl%s\" every :::%d::%d u 1:($2-2*$3) \"\%%lf",fileres,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,\"p%s\" every :::%d::%d u 1:($%d) t\"Observed prevalence \" w l 2",fileres,k1-1,k1-1,2+4*(cpt-1)); +#ifdef unix +fprintf(ficgp,"\nset ter gif small size 400,300"); +#endif +fprintf(ficgp,"\nset out \"v%s%d%d.gif\" \nreplot\n\n",strtok(optionfile, "."),cpt,k1); + } + } + /*2 eme*/ + + for (k1=1; k1<= m ; k1 ++) { + fprintf(ficgp,"set ylabel \"Years\" \nset ter gif small size 400,300\nplot [%.f:%.f] ",agemin,fage); + + for (i=1; i<= nlstate+1 ; i ++) { + k=2*i; + fprintf(ficgp,"\"t%s\" every :::%d::%d u 1:2 \"\%%lf",fileres,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== 1) fprintf(ficgp,"\" t\"TLE\" w l ,"); + else fprintf(ficgp,"\" t\"LE in state (%d)\" w l ,",i-1); + fprintf(ficgp,"\"t%s\" every :::%d::%d u 1:($2-$3*2) \"\%%lf",fileres,k1-1,k1-1); + for (j=1; j<= nlstate+1 ; j ++) { + if (j==i) fprintf(ficgp," \%%lf (\%%lf)"); + else fprintf(ficgp," \%%*lf (\%%*lf)"); +} + fprintf(ficgp,"\" t\"\" w l 0,"); + fprintf(ficgp,"\"t%s\" every :::%d::%d u 1:($2+$3*2) \"\%%lf",fileres,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,"); + } + fprintf(ficgp,"\nset out \"e%s%d.gif\" \nreplot\n\n",strtok(optionfile, "."),k1); + } + + /*3eme*/ + + for (k1=1; k1<= m ; k1 ++) { + for (cpt=1; cpt<= nlstate ; cpt ++) { + k=2+nlstate*(cpt-1); + fprintf(ficgp,"set ter gif small size 400,300\nplot [%.f:%.f] \"e%s\" every :::%d::%d u 1:%d t \"e%d1\" w l",agemin,fage,fileres,k1-1,k1-1,k,cpt); + for (i=1; i< nlstate ; i ++) { + fprintf(ficgp,",\"e%s\" every :::%d::%d u 1:%d t \"e%d%d\" w l",fileres,k1-1,k1-1,k+i,cpt,i+1); + } + fprintf(ficgp,"\nset out \"exp%s%d%d.gif\" \nreplot\n\n",strtok(optionfile, "."),cpt,k1); + } + } + + /* CV preval stat */ + for (k1=1; k1<= m ; k1 ++) { + for (cpt=1; cpt +#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("\n%s",version); + if(argc <=1){ + printf("\nEnter the parameter file name: "); + scanf("%s",pathtot); + } + else{ + strcpy(pathtot,argv[1]); + } + /*if(getcwd(pathcd, 80)!= NULL)printf ("Error pathcd\n");*/ + /*cygwin_split_path(pathtot,path,optionfile); + printf("pathtot=%s, path=%s, optionfile=%s\n",pathtot,path,optionfile);*/ + /* cutv(path,optionfile,pathtot,'\\');*/ + + split(pathtot,path,optionfile,optionfilext,optionfilefiname); + printf("pathtot=%s, path=%s, optionfile=%s optionfilext=%s optionfilefiname=%s\n",pathtot,path,optionfile,optionfilext,optionfilefiname); + chdir(path); + replace(pathc,path); + +/*-------- arguments in the command line --------*/ + + strcpy(fileres,"r"); + strcat(fileres, optionfilefiname); + strcat(fileres,".txt"); /* Other files have txt extension */ + + /*---------arguments file --------*/ + + if((ficpar=fopen(optionfile,"r"))==NULL) { + printf("Problem with optionfile %s\n",optionfile); + goto end; + } + + strcpy(filereso,"o"); + strcat(filereso,fileres); + if((ficparo=fopen(filereso,"w"))==NULL) { + printf("Problem with Output resultfile: %s\n", filereso);goto end; + } + + /* Reads comments: lines beginning with '#' */ + while((c=getc(ficpar))=='#' && c!= EOF){ + ungetc(c,ficpar); + fgets(line, MAXLINE, ficpar); + puts(line); + fputs(line,ficparo); + } + ungetc(c,ficpar); + + 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); +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 */ + + /* Read guess parameters */ + /* Reads comments: lines beginning with '#' */ + while((c=getc(ficpar))=='#' && c!= EOF){ + ungetc(c,ficpar); + fgets(line, MAXLINE, ficpar); + puts(line); + fputs(line,ficparo); + } + ungetc(c,ficpar); + + param= ma3x(1,nlstate,1,nlstate+ndeath-1,1,ncovmodel); + for(i=1; i <=nlstate; i++) + for(j=1; j <=nlstate+ndeath-1; j++){ + fscanf(ficpar,"%1d%1d",&i1,&j1); + fprintf(ficparo,"%1d%1d",i1,j1); + printf("%1d%1d",i,j); + for(k=1; k<=ncovmodel;k++){ + fscanf(ficpar," %lf",¶m[i][j][k]); printf(" %lf",param[i][j][k]); fprintf(ficparo," %lf",param[i][j][k]); } @@ -1727,7 +2308,8 @@ split(pathtot, path,optionfile); fprintf(ficparo,"\n"); } - npar= (nlstate+ndeath-1)*nlstate*ncovmodel; + npar= (nlstate+ndeath-1)*nlstate*ncovmodel; + p=param[1][1]; /* Reads comments: lines beginning with '#' */ @@ -1788,7 +2370,6 @@ split(pathtot, path,optionfile); printf("\n"); - if(mle==1){ /*-------- data file ----------*/ if((ficres =fopen(fileres,"w"))==NULL) { printf("Problem with resultfile: %s\n", fileres);goto end; @@ -1818,7 +2399,7 @@ split(pathtot, path,optionfile); tab=ivector(1,NCOVMAX); ncodemax=ivector(1,8); - i=1; + i=1; while (fgets(line, MAXLINE, fic) != NULL) { if ((i >= firstobs) && (i <=lastobs)) { @@ -1840,56 +2421,114 @@ split(pathtot, path,optionfile); 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]));*/ + + /*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; + + 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(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+1][k]=covar[atoi(stre)][k]*covar[atoi(strc)][k]; - } - else {cutv(strd,strc,strb,'V'); - Tvar[i+1]=atoi(strc); + 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]); @@ -1899,9 +2538,11 @@ split(pathtot, path,optionfile); 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 */ @@ -1944,8 +2585,8 @@ printf("Total number of individuals= %d, free_imatrix(outcome,1,maxwav+1,1,n); free_vector(moisnais,1,n); free_vector(annais,1,n); - free_matrix(mint,1,maxwav,1,n); - free_matrix(anint,1,maxwav,1,n); + /* free_matrix(mint,1,maxwav,1,n); + free_matrix(anint,1,maxwav,1,n);*/ free_vector(moisdc,1,n); free_vector(andc,1,n); @@ -1958,305 +2599,194 @@ printf("Total number of individuals= %d, concatwav(wav, dh, mw, s, agedc, agev, firstpass, lastpass, imx, nlstate, stepm); -Tcode=ivector(1,100); - nbcode=imatrix(1,nvar,1,8); - ncodemax[1]=1; - if (cptcovn > 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) */ - - 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); - - jk=1; - fprintf(ficres,"# Parameters\n"); - printf("# Parameters\n"); - for(i=1,jk=1; i <=nlstate; i++){ - for(k=1; k <=(nlstate+ndeath); k++){ - if (k != i) - { - printf("%d%d ",i,k); - fprintf(ficres,"%1d%1d ",i,k); - for(j=1; j <=ncovmodel; j++){ - printf("%f ",p[jk]); - fprintf(ficres,"%f ",p[jk]); - jk++; - } - printf("\n"); - fprintf(ficres,"\n"); - } - } - } - - /* 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++){ - for(j=1; j <=nlstate+ndeath; j++){ - if (j!=i) { - fprintf(ficres,"%1d%1d",i,j); - printf("%1d%1d",i,j); - for(k=1; k<=ncovmodel;k++){ - printf(" %.5e",delti[jk]); - fprintf(ficres," %.5e",delti[jk]); - jk++; - } - printf("\n"); - fprintf(ficres,"\n"); - } - } - } - - k=1; - fprintf(ficres,"# Covariance\n"); - printf("# Covariance\n"); - for(i=1;i<=npar;i++){ - /* if (k>nlstate) k=1; - i1=(i-1)/(ncovmodel*nlstate)+1; - fprintf(ficres,"%s%d%d",alph[k],i1,tab[i]); - printf("%s%d%d",alph[k],i1,tab[i]);*/ - fprintf(ficres,"%3d",i); - printf("%3d",i); - for(j=1; j<=i;j++){ - fprintf(ficres," %.5e",matcov[i][j]); - printf(" %.5e",matcov[i][j]); - } - fprintf(ficres,"\n"); - printf("\n"); - k++; - } - - while((c=getc(ficpar))=='#' && c!= EOF){ - ungetc(c,ficpar); - fgets(line, MAXLINE, ficpar); - puts(line); - fputs(line,ficparo); - } - ungetc(c,ficpar); - - fscanf(ficpar,"agemin=%lf agemax=%lf bage=%lf fage=%lf\n",&agemin,&agemax, &bage, &fage); - - if (fage <= 2) { - bage = agemin; - fage = agemax; - } - - fprintf(ficres,"# agemin agemax for life expectancy, bage fage (if mle==0 ie no data nor Max likelihood).\n"); - fprintf(ficres,"agemin=%.0f agemax=%.0f bage=%.0f fage=%.0f\n",agemin,agemax,bage,fage); -/*------------ gnuplot -------------*/ -chdir(pathcd); - if((ficgp=fopen("graph.plt","w"))==NULL) { - printf("Problem with file graph.gp");goto end; - } -#ifdef windows - fprintf(ficgp,"cd \"%s\" \n",pathc); -#endif -m=pow(2,cptcovn); - - /* 1eme*/ - for (cpt=1; cpt<= nlstate ; cpt ++) { - for (k1=1; k1<= m ; k1 ++) { - -#ifdef windows - fprintf(ficgp,"set xlabel \"Age\" \nset ylabel \"Probability\" \nset ter gif small size 400,300\nplot [%.f:%.f] \"vpl%s\" every :::%d::%d u 1:2 \"\%%lf",agemin,fage,fileres,k1-1,k1-1); -#endif -#ifdef unix -fprintf(ficgp,"set xlabel \"Age\" \nset ylabel \"Probability\" \nplot [%.f:%.f] \"vpl%s\" u 1:2 \"\%%lf",agemin,fage,fileres); -#endif - -for (i=1; i<= nlstate ; i ++) { - if (i==cpt) fprintf(ficgp," \%%lf (\%%lf)"); - else fprintf(ficgp," \%%*lf (\%%*lf)"); -} - fprintf(ficgp,"\" t\"Stationary prevalence\" w l 0,\"vpl%s\" every :::%d::%d u 1:($2+2*$3) \"\%%lf",fileres,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,\"vpl%s\" every :::%d::%d u 1:($2-2*$3) \"\%%lf",fileres,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,\"p%s\" every :::%d::%d u 1:($%d) t\"Observed prevalence \" w l 2",fileres,k1-1,k1-1,2+4*(cpt-1)); -#ifdef unix -fprintf(ficgp,"\nset ter gif small size 400,300"); -#endif -fprintf(ficgp,"\nset out \"v%s%d%d.gif\" \nreplot\n\n",strtok(optionfile, "."),cpt,k1); - } - } - /*2 eme*/ - - for (k1=1; k1<= m ; k1 ++) { - fprintf(ficgp,"set ylabel \"Years\" \nset ter gif small size 400,300\nplot [%.f:%.f] ",agemin,fage); - - for (i=1; i<= nlstate+1 ; i ++) { - k=2*i; - fprintf(ficgp,"\"t%s\" every :::%d::%d u 1:2 \"\%%lf",fileres,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== 1) fprintf(ficgp,"\" t\"TLE\" w l ,"); - else fprintf(ficgp,"\" t\"LE in state (%d)\" w l ,",i-1); - fprintf(ficgp,"\"t%s\" every :::%d::%d u 1:($2-$3*2) \"\%%lf",fileres,k1-1,k1-1); - for (j=1; j<= nlstate+1 ; j ++) { - if (j==i) fprintf(ficgp," \%%lf (\%%lf)"); - else fprintf(ficgp," \%%*lf (\%%*lf)"); -} - fprintf(ficgp,"\" t\"\" w l 0,"); - fprintf(ficgp,"\"t%s\" every :::%d::%d u 1:($2+$3*2) \"\%%lf",fileres,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,"); - } - fprintf(ficgp,"\nset out \"e%s%d.gif\" \nreplot\n\n",strtok(optionfile, "."),k1); - } - - /*3eme*/ - - for (k1=1; k1<= m ; k1 ++) { - for (cpt=1; cpt<= nlstate ; cpt ++) { - k=2+nlstate*(cpt-1); - fprintf(ficgp,"set ter gif small size 400,300\nplot [%.f:%.f] \"e%s\" every :::%d::%d u 1:%d t \"e%d1\" w l",agemin,fage,fileres,k1-1,k1-1,k,cpt); - for (i=1; i< nlstate ; i ++) { - fprintf(ficgp,",\"e%s\" every :::%d::%d u 1:%d t \"e%d%d\" w l",fileres,k1-1,k1-1,k+i,cpt,i+1); - } - fprintf(ficgp,"\nset out \"exp%s%d%d.gif\" \nreplot\n\n",strtok(optionfile, "."),cpt,k1); - } - } - - /* CV preval stat */ - for (k1=1; k1<= m ; k1 ++) { - for (cpt=1; cptnlstate) k=1; + i1=(i-1)/(ncovmodel*nlstate)+1; + fprintf(ficres,"%s%d%d",alph[k],i1,tab[i]); + printf("%s%d%d",alph[k],i1,tab[i]);*/ + fprintf(ficres,"%3d",i); + printf("%3d",i); + for(j=1; j<=i;j++){ + fprintf(ficres," %.5e",matcov[i][j]); + printf(" %.5e",matcov[i][j]); + } + fprintf(ficres,"\n"); + printf("\n"); + k++; + } + + while((c=getc(ficpar))=='#' && c!= EOF){ + ungetc(c,ficpar); + fgets(line, MAXLINE, ficpar); + puts(line); + fputs(line,ficparo); + } + ungetc(c,ficpar); + + fscanf(ficpar,"agemin=%lf agemax=%lf bage=%lf fage=%lf\n",&agemin,&agemax, &bage, &fage); + + if (fage <= 2) { + bage = agemin; + fage = agemax; + } + + fprintf(ficres,"# agemin agemax for life expectancy, bage fage (if mle==0 ie no data nor Max likelihood).\n"); + fprintf(ficres,"agemin=%.0f agemax=%.0f bage=%.0f fage=%.0f\n",agemin,agemax,bage,fage); + 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); - /* No more information from the sample is required now */ + fscanf(ficpar,"begin-prev-date=%lf/%lf/%lf end-prev-date=%lf/%lf/%lf\n",&jprev1, &mprev1,&anprev1,&jprev2, &mprev2,&anprev2); + fprintf(ficparo,"begin-prev-date=%.lf/%.lf/%.lf end-prev-date=%.lf/%.lf/%.lf\n",jprev1, mprev1,anprev1,jprev2, mprev2,anprev2); + fprintf(ficres,"begin-prev-date=%.lf/%.lf/%.lf end-prev-date=%.lf/%.lf/%.lf\n",jprev1, mprev1,anprev1,jprev2, mprev2,anprev2); + + 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 mov_average=%d\n",&popforecast,popfile,&jproj1,&mproj1,&anproj1,&jproj2,&mproj2,&anproj2,&mobilav); +fprintf(ficparo,"popforecast=%d popfile=%s starting-proj-date=%.lf/%.lf/%.lf final-proj-date=%.lf/%.lf/%.lf mov_average=%d\n",popforecast,popfile,jproj1,mproj1,anproj1,jproj2,mproj2,anproj2,mobilav); +fprintf(ficres,"popforecast=%d popfile=%s starting-proj-date=%.lf/%.lf/%.lf final-proj-date=%.lf/%.lf/%.lf mov_average=%d\n",popforecast,popfile,jproj1,mproj1,anproj1,jproj2,mproj2,anproj2,mobilav); + + freqsummary(fileres, agemin, agemax, s, agev, nlstate, imx,Tvar,nbcode, ncodemax,mint,anint,dateprev1,dateprev2,jprev1, mprev1,anprev1,jprev2, mprev2,anprev2); + +/*------------ gnuplot -------------*/ + printinggnuplot(fileres,optionfilefiname,optionfile,optionfilegnuplot, agemin,agemax,fage, pathc,p); + +/*------------ free_vector -------------*/ + chdir(path); + + free_ivector(wav,1,imx); + free_imatrix(dh,1,lastpass-firstpass+1,1,imx); + free_imatrix(mw,1,lastpass-firstpass+1,1,imx); + free_ivector(num,1,n); + free_vector(agedc,1,n); + /*free_matrix(covar,1,NCOVMAX,1,n);*/ + fclose(ficparo); + fclose(ficres); + /* Reads comments: lines beginning with '#' */ while((c=getc(ficpar))=='#' && c!= EOF){ ungetc(c,ficpar); @@ -2271,59 +2801,9 @@ 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; - } - - fprintf(fichtm,"
      Imach, Version 0.64a
    • 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
      - - Transition probabilities: pij%s
      - - Copy of the parameter file: o%s
      - - 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); - - fprintf(fichtm,"
    • Graphs
      • \n

      "); - - m=cptcovn; - if (cptcovn < 1) {m=1;ncodemax[1]=1;} - - j1=0; - for(k1=1; k1<=m;k1++){ - 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,"
      - Probabilities: pe%s%d.gif
      -",strtok(optionfile, "."),j1,strtok(optionfile, "."),j1); - for(cpt=1; cpt- Prevalence of disability : p%s%d%d.gif
      -",strtok(optionfile, "."),cpt,j1,strtok(optionfile, "."),cpt,j1); - } - for(cpt=1; cpt<=nlstate;cpt++) { - fprintf(fichtm,"
      - Observed and stationary prevalence (with confident -interval) in state (%d): v%s%d%d.gif
      -",cpt,strtok(optionfile, "."),cpt,j1,strtok(optionfile, "."),cpt,j1); - } - for(cpt=1; cpt<=nlstate;cpt++) { - fprintf(fichtm,"\n
      - Health life expectancies by age and initial health state (%d): exp%s%d%d.gif
      -",cpt,strtok(optionfile, "."),cpt,j1,strtok(optionfile, "."),cpt,j1); - } - fprintf(fichtm,"\n
      - Total life expectancy by age and -health expectancies in states (1) and (2): e%s%d.gif
      -",strtok(optionfile, "."),j1,strtok(optionfile, "."),j1); -fprintf(fichtm,"\n"); - } - } -fclose(fichtm); + printinghtml(fileres,title,datafile, firstpass, lastpass, stepm, weightopt,model,imx,jmin,jmax,jmean,optionfile,optionfilehtm); + /*--------------- Prevalence limit --------------*/ strcpy(filerespl,"pl"); @@ -2347,16 +2827,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++){ @@ -2369,6 +2849,7 @@ fclose(fichtm); } } fclose(ficrespl); + /*------------- h Pij x at various ages ------------*/ strcpy(filerespij,"pij"); strcat(filerespij,fileres); @@ -2378,7 +2859,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 */ @@ -2389,8 +2870,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 */ @@ -2417,8 +2898,143 @@ fclose(fichtm); } } + /* varprob(fileres, matcov, p, delti, nlstate, (int) bage, (int) fage,k);*/ + fclose(ficrespij); + if(stepm == 1) { + /*---------- 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); + + if (cptcoveff==0) ncodemax[cptcoveff]=1; + + if (mobilav==1) { + mobaverage= ma3x(1, AGESUP,1,NCOVMAX, 1,NCOVMAX); + movingaverage(agedeb, fage, agemin, mobaverage); + } + + stepsize=(int) (stepm+YEARM-1)/YEARM; + if (stepm<=12) stepsize=1; + + agelim=AGESUP; + + hstepm=1; + hstepm=hstepm/stepm; + yp1=modf(dateintmean,&yp); + anprojmean=yp; + yp2=modf((yp1*12),&yp); + mprojmean=yp; + yp1=modf((yp2*30.5),&yp); + jprojmean=yp; + if(jprojmean==0) jprojmean=1; + if(mprojmean==0) jprojmean=1; + + 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=(agemin-((int)calagedate %12)/12.); agedeb--){ + nhstepm=(int) rint((agelim-agedeb)*YEARM/stepm); + nhstepm = nhstepm/hstepm; + + 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+YEARM*cpt)) { + fprintf(ficresf,"\n %.f ",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+1][i][cptcod]; + else { + kk1=kk1+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); + } + + /* End forecasting */ + else{ + erreur=108; + printf("Error %d!! You can only forecast the prevalences if the optimization\n has been performed with stepm = 1 (month) instead of %d\n", erreur, stepm); + } + + /*---------- Health expectancies and variances ------------*/ strcpy(filerest,"t"); @@ -2448,17 +3064,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"); @@ -2467,17 +3083,24 @@ fclose(fichtm); evsij(fileres, eij, p, nlstate, stepm, (int) bage, (int)fage, oldm, savm, k); vareij=ma3x(1,nlstate,1,nlstate,(int) bage, (int) fage); oldm=oldms;savm=savms; - varevsij(fileres, vareij, matcov, p, delti, nlstate, stepm, (int) bage, (int) fage, oldm, savm, prlim, ftolpl,k); - + varevsij(fileres, vareij, matcov, p, delti, nlstate, stepm, (int) bage, (int) fage, oldm, savm, prlim, ftolpl,k); + + + fprintf(ficrest,"#Total LEs with variances: e.. (std) "); for (i=1;i<=nlstate;i++) fprintf(ficrest,"e.%d (std) ",i); fprintf(ficrest,"\n"); - + hf=1; if (stepm >= YEARM) hf=stepm/YEARM; 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++) { @@ -2497,13 +3120,16 @@ fclose(fichtm); } } + + + fclose(ficreseij); fclose(ficresvij); fclose(ficrest); fclose(ficpar); free_vector(epj,1,nlstate+1); /* scanf("%d ",i); */ - + /*------- Variance limit prevalence------*/ strcpy(fileresvpl,"vpl"); @@ -2519,8 +3145,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); @@ -2542,34 +3168,44 @@ 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); - + free_matrix(agev,1,maxwav,1,imx); free_ma3x(param,1,nlstate,1, nlstate+ndeath-1,1,ncovmodel); - printf("End of Imach\n"); + if(erreur >0) + printf("End of Imach with error %d\n",erreur); + else printf("End of Imach\n"); /* gettimeofday(&end_time, (struct timezone*)0);*/ /* after time */ /* printf("Total time was %d Sec. %d uSec.\n", end_time.tv_sec -start_time.tv_sec, end_time.tv_usec -start_time.tv_usec);*/ /*printf("Total time was %d uSec.\n", total_usecs);*/ /*------ End -----------*/ + end: #ifdef windows - chdir(pathcd); + /* chdir(pathcd);*/ #endif - system("wgnuplot graph.plt"); + /*system("wgnuplot graph.plt");*/ + /*system("../gp37mgw/wgnuplot graph.plt");*/ + /*system("cd ../gp37mgw");*/ + /* system("..\\gp37mgw\\wgnuplot graph.plt");*/ + strcpy(plotcmd,GNUPLOTPROGRAM); + strcat(plotcmd," "); + strcat(plotcmd,optionfilegnuplot); + system(plotcmd); #ifdef windows while (z[0] != 'q') { - chdir(pathcd); + chdir(path); printf("\nType e to edit output files, c to start again, and q for exiting: "); scanf("%s",z); 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); }