--- imach/src/imach.c 2017/04/26 06:01:29 1.264 +++ imach/src/imach.c 2018/02/21 07:58:13 1.280 @@ -1,6 +1,56 @@ -/* $Id: imach.c,v 1.264 2017/04/26 06:01:29 brouard Exp $ +/* $Id: imach.c,v 1.280 2018/02/21 07:58:13 brouard Exp $ $State: Exp $ $Log: imach.c,v $ + Revision 1.280 2018/02/21 07:58:13 brouard + Summary: 0.99r15 + + New Makefile with recent VirtualBox 5.26. Bug in sqrt negatve in imach.c + + Revision 1.279 2017/07/20 13:35:01 brouard + Summary: temporary working + + Revision 1.278 2017/07/19 14:09:02 brouard + Summary: Bug for mobil_average=0 and prevforecast fixed(?) + + Revision 1.277 2017/07/17 08:53:49 brouard + Summary: BOM files can be read now + + Revision 1.276 2017/06/30 15:48:31 brouard + Summary: Graphs improvements + + Revision 1.275 2017/06/30 13:39:33 brouard + Summary: Saito's color + + Revision 1.274 2017/06/29 09:47:08 brouard + Summary: Version 0.99r14 + + Revision 1.273 2017/06/27 11:06:02 brouard + Summary: More documentation on projections + + Revision 1.272 2017/06/27 10:22:40 brouard + Summary: Color of backprojection changed from 6 to 5(yellow) + + Revision 1.271 2017/06/27 10:17:50 brouard + Summary: Some bug with rint + + Revision 1.270 2017/05/24 05:45:29 brouard + *** empty log message *** + + Revision 1.269 2017/05/23 08:39:25 brouard + Summary: Code into subroutine, cleanings + + Revision 1.268 2017/05/18 20:09:32 brouard + Summary: backprojection and confidence intervals of backprevalence + + Revision 1.267 2017/05/13 10:25:05 brouard + Summary: temporary save for backprojection + + Revision 1.266 2017/05/13 07:26:12 brouard + Summary: Version 0.99r13 (improvements and bugs fixed) + + Revision 1.265 2017/04/26 16:22:11 brouard + Summary: imach 0.99r13 Some bugs fixed + Revision 1.264 2017/04/26 06:01:29 brouard Summary: Labels in graphs @@ -812,7 +862,7 @@ Back prevalence and projections: p3mat=ma3x(1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); oldm=oldms;savm=savms; - - hbxij(p3mat,nhstepm,agedeb,hstepm,p,nlstate,stepm,oldm,savm, k); + - hbxij(p3mat,nhstepm,agedeb,hstepm,p,nlstate,stepm,oldm,savm, k, nres); Computes the transition matrix starting at age 'age' over 'nhstepm*hstepm*stepm' months (i.e. until age (in years) age+nhstepm*hstepm*stepm/12) by multiplying @@ -980,6 +1030,7 @@ typedef struct { #define YEARM 12. /**< Number of months per year */ /* #define AGESUP 130 */ #define AGESUP 150 +#define AGEINF 0 #define AGEMARGE 25 /* Marge for agemin and agemax for(iage=agemin-AGEMARGE; iage <= agemax+3+AGEMARGE; iage++) */ #define AGEBASE 40 #define AGEOVERFLOW 1.e20 @@ -994,12 +1045,12 @@ typedef struct { #define ODIRSEPARATOR '\\' #endif -/* $Id: imach.c,v 1.264 2017/04/26 06:01:29 brouard Exp $ */ +/* $Id: imach.c,v 1.280 2018/02/21 07:58:13 brouard Exp $ */ /* $State: Exp $ */ #include "version.h" char version[]=__IMACH_VERSION__; char copyright[]="February 2016,INED-EUROREVES-Institut de longevite-Japan Society for the Promotion of Science (Grant-in-Aid for Scientific Research 25293121), Intel Software 2015-2018"; -char fullversion[]="$Revision: 1.264 $ $Date: 2017/04/26 06:01:29 $"; +char fullversion[]="$Revision: 1.280 $ $Date: 2018/02/21 07:58:13 $"; char strstart[80]; char optionfilext[10], optionfilefiname[FILENAMELENGTH]; int erreur=0, nberr=0, nbwarn=0; /* Error number, number of errors number of warnings */ @@ -1071,8 +1122,7 @@ FILE *ficrescveij; char filerescve[FILENAMELENGTH]; FILE *ficresvij; char fileresv[FILENAMELENGTH]; -FILE *ficresvpl; -char fileresvpl[FILENAMELENGTH]; + char title[MAXLINE]; char model[MAXLINE]; /**< The model line */ char optionfile[FILENAMELENGTH], datafile[FILENAMELENGTH], filerespl[FILENAMELENGTH], fileresplb[FILENAMELENGTH]; @@ -1170,8 +1220,8 @@ double *agedc; double **covar; /**< covar[j,i], value of jth covariate for individual i, * covar=matrix(0,NCOVMAX,1,n); * cov[Tage[kk]+2]=covar[Tvar[Tage[kk]]][i]*age; */ -double **coqvar; /* Fixed quantitative covariate iqv */ -double ***cotvar; /* Time varying covariate itv */ +double **coqvar; /* Fixed quantitative covariate nqv */ +double ***cotvar; /* Time varying covariate ntv */ double ***cotqvar; /* Time varying quantitative covariate itqv */ double idx; int **nbcode, *Tvar; /**< model=V2 => Tvar[1]= 2 */ @@ -2474,15 +2524,18 @@ void powell(double p[], double **xi, int double **prevalim(double **prlim, int nlstate, double x[], double age, double **oldm, double **savm, double ftolpl, int *ncvyear, int ij, int nres) { - /* Computes the prevalence limit in each live state at age x and for covariate combination ij - (and selected quantitative values in nres) - by left multiplying the unit - matrix by transitions matrix until convergence is reached with precision ftolpl */ - /* Wx= Wx-1 Px-1= Wx-2 Px-2 Px-1 = Wx-n Px-n ... Px-2 Px-1 I */ - /* Wx is row vector: population in state 1, population in state 2, population dead */ - /* or prevalence in state 1, prevalence in state 2, 0 */ - /* newm is the matrix after multiplications, its rows are identical at a factor */ - /* Initial matrix pimij */ + /**< Computes the prevalence limit in each live state at age x and for covariate combination ij + * (and selected quantitative values in nres) + * by left multiplying the unit + * matrix by transitions matrix until convergence is reached with precision ftolpl + * Wx= Wx-1 Px-1= Wx-2 Px-2 Px-1 = Wx-n Px-n ... Px-2 Px-1 I + * Wx is row vector: population in state 1, population in state 2, population dead + * or prevalence in state 1, prevalence in state 2, 0 + * newm is the matrix after multiplications, its rows are identical at a factor. + * Inputs are the parameter, age, a tolerance for the prevalence limit ftolpl. + * Output is prlim. + * Initial matrix pimij + */ /* {0.85204250825084937, 0.13044499163996345, 0.017512500109187184, */ /* 0.090851990222114765, 0.88271245433047185, 0.026435555447413338, */ /* 0, 0 , 1} */ @@ -2654,12 +2707,12 @@ Earliest age to start was %d-%d=%d, ncvl max=vector(1,nlstate); meandiff=vector(1,nlstate); - dnewm=ddnewms; doldm=ddoldms; dsavm=ddsavms; - oldm=oldms; savm=savms; - - /* Starting with matrix unity */ - for (ii=1;ii<=nlstate+ndeath;ii++) - for (j=1;j<=nlstate+ndeath;j++){ + dnewm=ddnewms; doldm=ddoldms; dsavm=ddsavms; + oldm=oldms; savm=savms; + + /* Starting with matrix unity */ + for (ii=1;ii<=nlstate+ndeath;ii++) + for (j=1;j<=nlstate+ndeath;j++){ oldm[ii][j]=(ii==j ? 1.0 : 0.0); } @@ -2733,8 +2786,27 @@ Earliest age to start was %d-%d=%d, ncvl /* out=matprod2(newm,oldm,1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, bmij(pmmij,cov,ncovmodel,x,nlstate,prevacurrent, ageminpar, agemaxpar, dnewm, doldm, dsavm,ij)); /\* Bug Valgrind *\/ */ /* out=matprod2(newm,oldm,1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, bmij(pmmij,cov,ncovmodel,x,nlstate,prevacurrent, dnewm, doldm, dsavm,ij)); /\* Bug Valgrind *\/ */ out=matprod2(newm,oldm,1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, bmij(pmmij,cov,ncovmodel,x,nlstate,prevacurrent,ij)); /* Bug Valgrind */ + /* if((int)age == 86 || (int)age == 87){ */ + /* printf(" Backward prevalim age=%d agefin=%d \n", (int) age, (int) agefin); */ + /* for(i=1; i<=nlstate+ndeath; i++) { */ + /* printf("%d newm= ",i); */ + /* for(j=1;j<=nlstate+ndeath;j++) { */ + /* printf("%f ",newm[i][j]); */ + /* } */ + /* printf("oldm * "); */ + /* for(j=1;j<=nlstate+ndeath;j++) { */ + /* printf("%f ",oldm[i][j]); */ + /* } */ + /* printf(" bmmij "); */ + /* for(j=1;j<=nlstate+ndeath;j++) { */ + /* printf("%f ",pmmij[i][j]); */ + /* } */ + /* printf("\n"); */ + /* } */ + /* } */ savm=oldm; oldm=newm; + for(j=1; j<=nlstate; j++){ max[j]=0.; min[j]=1.; @@ -2753,9 +2825,9 @@ Earliest age to start was %d-%d=%d, ncvl meandiff[i]=(max[i]-min[i])/(max[i]+min[i])*2.; /* mean difference for each column */ maxmax=FMAX(maxmax,meandiff[i]); /* printf("Back age= %d meandiff[%d]=%f, agefin=%d max[%d]=%f min[%d]=%f maxmax=%f\n", (int)age, i, meandiff[i],(int)agefin, i, max[i], i, min[i],maxmax); */ - } /* j loop */ + } /* i loop */ *ncvyear= -( (int)age- (int)agefin); - /* printf("Back maxmax=%lf ncvloop=%d, age=%d, agefin=%d ncvyear=%d \n", maxmax, ncvloop, (int)age, (int)agefin, *ncvyear);*/ + /* printf("Back maxmax=%lf ncvloop=%d, age=%d, agefin=%d ncvyear=%d \n", maxmax, ncvloop, (int)age, (int)agefin, *ncvyear); */ if(maxmax < ftolpl){ /* printf("OK Back maxmax=%lf ncvloop=%d, age=%d, agefin=%d ncvyear=%d \n", maxmax, ncvloop, (int)age, (int)agefin, *ncvyear); */ free_vector(min,1,nlstate); @@ -2785,7 +2857,7 @@ Oldest age to start was %d-%d=%d, ncvloo double **pmij(double **ps, double *cov, int ncovmodel, double *x, int nlstate ) { /* According to parameters values stored in x and the covariate's values stored in cov, - computes the probability to be observed in state j being in state i by appying the + computes the probability to be observed in state j (after stepm years) being in state i by appying the model to the ncovmodel covariates (including constant and age). lnpijopii=ln(pij/pii)= aij+bij*age+cij*v1+dij*v2+... = sum_nc=1^ncovmodel xij(nc)*cov[nc] and, according on how parameters are entered, the position of the coefficient xij(nc) of the @@ -2794,8 +2866,9 @@ double **pmij(double **ps, double *cov, j>=i nc + ((i-1)*(nlstate+ndeath-1)+(j-2))*ncovmodel Computes ln(pij/pii) (lnpijopii), deduces pij/pii by exponentiation, sums on j different of i to get 1-pii/pii, deduces pii, and then all pij. - Outputs ps[i][j] the probability to be observed in j being in j according to + Outputs ps[i][j] or probability to be observed in j being in i according to the values of the covariates cov[nc] and corresponding parameter values x[nc+shiftij] + Sum on j ps[i][j] should equal to 1. */ double s1, lnpijopii; /*double t34;*/ @@ -2859,7 +2932,7 @@ double **pmij(double **ps, double *cov, /* for(i=1; i<= npar; i++) printf("%f ",x[i]); goto end;*/ - return ps; + return ps; /* Pointer is unchanged since its call */ } /*************** backward transition probabilities ***************/ @@ -2868,15 +2941,15 @@ double **pmij(double **ps, double *cov, /* double **bmij(double **ps, double *cov, int ncovmodel, double *x, int nlstate, double ***prevacurrent, double ***dnewm, double **doldm, double **dsavm, int ij ) */ double **bmij(double **ps, double *cov, int ncovmodel, double *x, int nlstate, double ***prevacurrent, int ij ) { - /* Computes the backward probability at age agefin and covariate ij - * and returns in **ps as well as **bmij. + /* Computes the backward probability at age agefin and covariate combination ij. In fact cov is already filled and x too. + * Call to pmij(cov and x), call to cross prevalence, sums and inverses, left multiply, and returns in **ps as well as **bmij. */ int i, ii, j,k; double **out, **pmij(); double sumnew=0.; double agefin; - + double k3=0.; /* constant of the w_x diagonal matrixe (in order for B to sum to 1 even for death state) */ double **dnewm, **dsavm, **doldm; double **bbmij; @@ -2885,44 +2958,68 @@ double **pmij(double **ps, double *cov, dsavm=ddsavms; agefin=cov[2]; + /* Bx = Diag(w_x) P_x Diag(Sum_i w^i_x p^ij_x */ /* bmij *//* age is cov[2], ij is included in cov, but we need for - the observed prevalence (with this covariate ij) */ - dsavm=pmij(pmmij,cov,ncovmodel,x,nlstate); - /* We do have the matrix Px in savm and we need pij */ + the observed prevalence (with this covariate ij) at beginning of transition */ + /* dsavm=pmij(pmmij,cov,ncovmodel,x,nlstate); */ + + /* P_x */ + pmmij=pmij(pmmij,cov,ncovmodel,x,nlstate); /*This is forward probability from agefin to agefin + stepm */ + /* outputs pmmij which is a stochastic matrix in row */ + + /* Diag(w_x) */ + /* Problem with prevacurrent which can be zero */ + sumnew=0.; + /*for (ii=1;ii<=nlstate+ndeath;ii++){*/ + for (ii=1;ii<=nlstate;ii++){ /* Only on live states */ + /* printf(" agefin=%d, ii=%d, ij=%d, prev=%f\n",(int)agefin,ii, ij, prevacurrent[(int)agefin][ii][ij]); */ + sumnew+=prevacurrent[(int)agefin][ii][ij]; + } + if(sumnew >0.01){ /* At least some value in the prevalence */ + for (ii=1;ii<=nlstate+ndeath;ii++){ + for (j=1;j<=nlstate+ndeath;j++) + doldm[ii][j]=(ii==j ? prevacurrent[(int)agefin][ii][ij]/sumnew : 0.0); + } + }else{ + for (ii=1;ii<=nlstate+ndeath;ii++){ + for (j=1;j<=nlstate+ndeath;j++) + doldm[ii][j]=(ii==j ? 1./nlstate : 0.0); + } + /* if(sumnew <0.9){ */ + /* printf("Problem internal bmij B: sum on i wi <0.9: j=%d, sum_i wi=%lf,agefin=%d\n",j,sumnew, (int)agefin); */ + /* } */ + } + k3=0.0; /* We put the last diagonal to 0 */ + for (ii=nlstate+1;ii<=nlstate+ndeath;ii++){ + doldm[ii][ii]= k3; + } + /* End doldm, At the end doldm is diag[(w_i)] */ + + /* left Product of this diag matrix by pmmij=Px (dnewm=dsavm*doldm) */ + bbmij=matprod2(dnewm, doldm,1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, pmmij); /* Bug Valgrind */ + + /* Diag(Sum_i w^i_x p^ij_x */ + /* w1 p11 + w2 p21 only on live states N1./N..*N11/N1. + N2./N..*N21/N2.=(N11+N21)/N..=N.1/N.. */ for (j=1;j<=nlstate+ndeath;j++){ - sumnew=0.; /* w1 p11 + w2 p21 only on live states */ + sumnew=0.; for (ii=1;ii<=nlstate;ii++){ - sumnew+=dsavm[ii][j]*prevacurrent[(int)agefin][ii][ij]; + /* sumnew+=dsavm[ii][j]*prevacurrent[(int)agefin][ii][ij]; */ + sumnew+=pmmij[ii][j]*doldm[ii][ii]; /* Yes prevalence at beginning of transition */ } /* sumnew is (N11+N21)/N..= N.1/N.. = sum on i of w_i pij */ for (ii=1;ii<=nlstate+ndeath;ii++){ - if(sumnew >= 1.e-10){ /* if(agefin >= agemaxpar && agefin <= agemaxpar+stepm/YEARM){ */ - /* doldm[ii][j]=(ii==j ? 1./sumnew : 0.0); */ + /* dsavm[ii][j]=(ii==j ? 1./sumnew : 0.0); */ /* }else if(agefin >= agemaxpar+stepm/YEARM){ */ - /* doldm[ii][j]=(ii==j ? 1./sumnew : 0.0); */ + /* dsavm[ii][j]=(ii==j ? 1./sumnew : 0.0); */ /* }else */ - doldm[ii][j]=(ii==j ? 1./sumnew : 0.0); - }else{ - ; - /* printf("ii=%d, i=%d, doldm=%lf dsavm=%lf, probs=%lf, sumnew=%lf,agefin=%d\n",ii,j,doldm[ii][j],dsavm[ii][j],prevacurrent[(int)agefin][ii][ij],sumnew, (int)agefin); */ - } + dsavm[ii][j]=(ii==j ? 1./sumnew : 0.0); } /*End ii */ - } /* End j, At the end doldm is diag[1/(w_1p1i+w_2 p2i)] */ - /* left Product of this diag matrix by dsavm=Px (newm=dsavm*doldm) */ - bbmij=matprod2(dnewm, dsavm,1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, doldm); /* Bug Valgrind */ - /* dsavm=doldm; /\* dsavm is now diag [1/(w_1p1i+w_2 p2i)] but can be overwritten*\/ */ - /* doldm=dnewm; /\* doldm is now Px * diag [1/(w_1p1i+w_2 p2i)] *\/ */ - /* dnewm=dsavm; /\* doldm is now Px * diag [1/(w_1p1i+w_2 p2i)] *\/ */ - /* left Product of this matrix by diag matrix of prevalences (savm) */ - for (j=1;j<=nlstate+ndeath;j++){ - for (ii=1;ii<=nlstate+ndeath;ii++){ - dsavm[ii][j]=(ii==j ? prevacurrent[(int)agefin][ii][ij] : 0.0); - } - } /* End j, At the end oldm is diag[1/(w_1p1i+w_2 p2i)] */ - ps=matprod2(doldm, dsavm,1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, dnewm); /* Bug Valgrind */ - /* newm or out is now diag[w_i] * Px * diag [1/(w_1p1i+w_2 p2i)] */ + } /* End j, At the end dsavm is diag[1/(w_1p1i+w_2 p2i)] for ALL states even if the sum is only for live states */ + + ps=matprod2(ps, dnewm,1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, dsavm); /* Bug Valgrind */ + /* ps is now diag[w_i] * Px * diag [1/(w_1p1i+w_2 p2i)] */ /* end bmij */ - return ps; + return ps; /*pointer is unchanged */ } /*************** transition probabilities ***************/ @@ -3135,20 +3232,20 @@ double ***hpxij(double ***po, int nhstep } for(i=1; i<=nlstate+ndeath; i++) for(j=1;j<=nlstate+ndeath;j++) { - po[i][j][h]=newm[i][j]; - /*if(h==nhstepm) printf("po[%d][%d][%d]=%f ",i,j,h,po[i][j][h]);*/ + po[i][j][h]=newm[i][j]; + /*if(h==nhstepm) printf("po[%d][%d][%d]=%f ",i,j,h,po[i][j][h]);*/ } /*printf("h=%d ",h);*/ } /* end h */ - /* printf("\n H=%d \n",h); */ + /* printf("\n H=%d \n",h); */ return po; } /************* Higher Back Matrix Product ***************/ /* double ***hbxij(double ***po, int nhstepm, double age, int hstepm, double *x, double ***prevacurrent, int nlstate, int stepm, double **oldm, double **savm, double **dnewm, double **doldm, double **dsavm, int ij ) */ -double ***hbxij(double ***po, int nhstepm, double age, int hstepm, double *x, double ***prevacurrent, int nlstate, int stepm, int ij ) +double ***hbxij(double ***po, int nhstepm, double age, int hstepm, double *x, double ***prevacurrent, int nlstate, int stepm, int ij, int nres ) { - /* Computes the transition matrix starting at age 'age' over + /* For a combination of dummy covariate ij, computes the transition matrix starting at age 'age' over 'nhstepm*hstepm*stepm' months (i.e. until age (in years) age+nhstepm*hstepm*stepm/12) by multiplying nhstepm*hstepm matrices. @@ -3156,18 +3253,19 @@ double ***hbxij(double ***po, int nhstep (typically every 2 years instead of every month which is too big for the memory). Model is determined by parameters x and covariates have to be - included manually here. - + included manually here. Then we use a call to bmij(x and cov) + The addresss of po (p3mat allocated to the dimension of nhstepm) should be stored for output */ int i, j, d, h, k; - double **out, cov[NCOVMAX+1]; - double **newm; + double **out, cov[NCOVMAX+1], **bmij(); + double **newm, ***newmm; double agexact; double agebegin, ageend; double **oldm, **savm; - oldm=oldms;savm=savms; + newmm=po; /* To be saved */ + oldm=oldms;savm=savms; /* Global pointers */ /* Hstepm could be zero and should return the unit matrix */ for (i=1;i<=nlstate+ndeath;i++) for (j=1;j<=nlstate+ndeath;j++){ @@ -3180,27 +3278,38 @@ double ***hbxij(double ***po, int nhstep newm=savm; /* Covariates have to be included here again */ cov[1]=1.; - agexact=age-((h-1)*hstepm + (d-1))*stepm/YEARM; /* age just before transition */ + agexact=age-( (h-1)*hstepm + (d) )*stepm/YEARM; /* age just before transition, d or d-1? */ /* agexact=age+((h-1)*hstepm + (d-1))*stepm/YEARM; /\* age just before transition *\/ */ cov[2]=agexact; if(nagesqr==1) cov[3]= agexact*agexact; - for (k=1; k<=cptcovn;k++) - cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(ij,k)]; - /* cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(ij,Tvar[k])]; */ - for (k=1; k<=cptcovage;k++) /* Should start at cptcovn+1 */ - /* cov[2+Tage[k]]=cov[2+Tage[k]]*cov[2]; */ - cov[2+nagesqr+Tage[k]]=nbcode[Tvar[Tage[k]]][codtabm(ij,k)]*cov[2]; - /* cov[2+nagesqr+Tage[k]]=nbcode[Tvar[Tage[k]]][codtabm(ij,Tvar[Tage[k]])]*cov[2]; */ - for (k=1; k<=cptcovprod;k++) /* Useless because included in cptcovn */ + for (k=1; k<=cptcovn;k++){ + /* cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(ij,k)]; */ + /* /\* cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(ij,Tvar[k])]; *\/ */ + cov[2+nagesqr+TvarsDind[k]]=nbcode[TvarsD[k]][codtabm(ij,k)]; + /* printf("hbxij Dummy agexact=%.0f combi=%d k=%d TvarsD[%d]=V%d TvarsDind[%d]=%d nbcode=%d cov[%d]=%lf codtabm(%d,Tvar[%d])=%d \n",agexact,ij,k, k, TvarsD[k],k,TvarsDind[k],nbcode[TvarsD[k]][codtabm(ij,k)],2+nagesqr+TvarsDind[k],cov[2+nagesqr+TvarsDind[k]], ij, k, codtabm(ij,k)); */ + } + for (k=1; k<=nsq;k++) { /* For single varying covariates only */ + /* Here comes the value of quantitative after renumbering k with single quantitative covariates */ + cov[2+nagesqr+TvarsQind[k]]=Tqresult[nres][k]; + /* printf("hPxij Quantitative k=%d TvarsQind[%d]=%d, TvarsQ[%d]=V%d,Tqresult[%d][%d]=%f\n",k,k,TvarsQind[k],k,TvarsQ[k],nres,k,Tqresult[nres][k]); */ + } + for (k=1; k<=cptcovage;k++){ /* Should start at cptcovn+1 */ + if(Dummy[Tvar[Tage[k]]]){ + cov[2+nagesqr+Tage[k]]=nbcode[Tvar[Tage[k]]][codtabm(ij,k)]*cov[2]; + } else{ + cov[2+nagesqr+Tage[k]]=Tqresult[nres][k]; + } + /* printf("hBxij Age combi=%d k=%d Tage[%d]=V%d Tqresult[%d][%d]=%f\n",ij,k,k,Tage[k],nres,k,Tqresult[nres][k]); */ + } + for (k=1; k<=cptcovprod;k++){ /* Useless because included in cptcovn */ cov[2+nagesqr+Tprod[k]]=nbcode[Tvard[k][1]][codtabm(ij,k)]*nbcode[Tvard[k][2]][codtabm(ij,k)]; - /* cov[2+nagesqr+Tprod[k]]=nbcode[Tvard[k][1]][codtabm(ij,Tvard[k][1])]*nbcode[Tvard[k][2]][codtabm(ij,Tvard[k][2])]; */ - - + } /*printf("hxi cptcov=%d cptcode=%d\n",cptcov,cptcode);*/ /*printf("h=%d d=%d age=%f cov=%f\n",h,d,age,cov[2]);*/ + /* Careful transposed matrix */ - /* age is in cov[2] */ + /* age is in cov[2], prevacurrent at beginning of transition. */ /* out=matprod2(newm, bmij(pmmij,cov,ncovmodel,x,nlstate,prevacurrent, dnewm, doldm, dsavm,ij),\ */ /* 1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, oldm); */ out=matprod2(newm, bmij(pmmij,cov,ncovmodel,x,nlstate,prevacurrent,ij),\ @@ -3225,11 +3334,12 @@ double ***hbxij(double ***po, int nhstep for(i=1; i<=nlstate+ndeath; i++) for(j=1;j<=nlstate+ndeath;j++) { po[i][j][h]=newm[i][j]; - /*if(h==nhstepm) printf("po[%d][%d][%d]=%f ",i,j,h,po[i][j][h]);*/ + /* if(h==nhstepm) */ + /* printf("po[%d][%d][%d]=%f ",i,j,h,po[i][j][h]); */ } - /*printf("h=%d ",h);*/ + /* printf("h=%d %.1f ",h, agexact); */ } /* end h */ - /* printf("\n H=%d \n",h); */ + /* printf("\n H=%d nhs=%d \n",h, nhstepm); */ return po; } @@ -3684,7 +3794,7 @@ double funcone( double *x) s1=s[mw[mi][i]][i]; s2=s[mw[mi+1][i]][i]; /* if(s2==-1){ */ - /* printf(" s1=%d, s2=%d i=%d \n", s1, s2, i); */ + /* printf(" ERROR s1=%d, s2=%d i=%d \n", s1, s2, i); */ /* /\* exit(1); *\/ */ /* } */ bbh=(double)bh[mi][i]/(double)stepm; @@ -3717,7 +3827,7 @@ double funcone( double *x) fprintf(ficresilk,"%09ld %6.1f %6.1f %6d %2d %2d %2d %2d %3d %15.6f %8.4f %8.3f\ %11.6f %11.6f %11.6f ", \ num[i], agebegin, ageend, i,s1,s2,mi,mw[mi][i],dh[mi][i],exp(lli),weight[i],weight[i]*gipmx/gsw, - 2*weight[i]*lli,out[s1][s2],savm[s1][s2]); + 2*weight[i]*lli,(s2==-1? -1: out[s1][s2]),(s2==-1? -1: savm[s1][s2])); for(k=1,llt=0.,l=0.; k<=nlstate; k++){ llt +=ll[k]*gipmx/gsw; fprintf(ficresilk," %10.6f",-ll[k]*gipmx/gsw); @@ -3770,7 +3880,7 @@ void likelione(FILE *ficres,double p[], else if(mle >=1) fprintf(fichtm,"\n
File of contributions to the likelihood computed with optimized parameters mle = %d.",mle); fprintf(fichtm," You should at least run with mle >= 1 to get starting values corresponding to the optimized parameters in order to visualize the real contribution of each individual/wave: %s
\n",subdirf(fileresilk),subdirf(fileresilk)); - + fprintf(fichtm,"\n
Equation of the model: model=1+age+%s
\n",model); for (k=1; k<= nlstate ; k++) { fprintf(fichtm,"
- Probability p%dj by origin %d and destination j. Dot's sizes are related to corresponding weight: %s-p%dj.png
\ @@ -4237,70 +4347,7 @@ void pstamp(FILE *fichier) fprintf(fichier,"# %s.%s\n#IMaCh version %s, %s\n#%s\n# %s", optionfilefiname,optionfilext,version,copyright, fullversion, strstart); } -int linreg(int ifi, int ila, int *no, const double x[], const double y[], double* a, double* b, double* r, double* sa, double * sb) { - /* y=a+bx regression */ - double sumx = 0.0; /* sum of x */ - double sumx2 = 0.0; /* sum of x**2 */ - double sumxy = 0.0; /* sum of x * y */ - double sumy = 0.0; /* sum of y */ - double sumy2 = 0.0; /* sum of y**2 */ - double sume2; /* sum of square or residuals */ - double yhat; - - double denom=0; - int i; - int ne=*no; - - for ( i=ifi, ne=0;i<=ila;i++) { - if(!isfinite(x[i]) || !isfinite(y[i])){ - /* printf(" x[%d]=%f, y[%d]=%f\n",i,x[i],i,y[i]); */ - continue; - } - ne=ne+1; - sumx += x[i]; - sumx2 += x[i]*x[i]; - sumxy += x[i] * y[i]; - sumy += y[i]; - sumy2 += y[i]*y[i]; - denom = (ne * sumx2 - sumx*sumx); - /* printf("ne=%d, i=%d,x[%d]=%f, y[%d]=%f sumx=%f, sumx2=%f, sumxy=%f, sumy=%f, sumy2=%f, denom=%f\n",ne,i,i,x[i],i,y[i], sumx, sumx2,sumxy, sumy, sumy2,denom); */ - } - - denom = (ne * sumx2 - sumx*sumx); - if (denom == 0) { - // vertical, slope m is infinity - *b = INFINITY; - *a = 0; - if (r) *r = 0; - return 1; - } - - *b = (ne * sumxy - sumx * sumy) / denom; - *a = (sumy * sumx2 - sumx * sumxy) / denom; - if (r!=NULL) { - *r = (sumxy - sumx * sumy / ne) / /* compute correlation coeff */ - sqrt((sumx2 - sumx*sumx/ne) * - (sumy2 - sumy*sumy/ne)); - } - *no=ne; - for ( i=ifi, ne=0;i<=ila;i++) { - if(!isfinite(x[i]) || !isfinite(y[i])){ - /* printf(" x[%d]=%f, y[%d]=%f\n",i,x[i],i,y[i]); */ - continue; - } - ne=ne+1; - yhat = y[i] - *a -*b* x[i]; - sume2 += yhat * yhat ; - - denom = (ne * sumx2 - sumx*sumx); - /* printf("ne=%d, i=%d,x[%d]=%f, y[%d]=%f sumx=%f, sumx2=%f, sumxy=%f, sumy=%f, sumy2=%f, denom=%f\n",ne,i,i,x[i],i,y[i], sumx, sumx2,sumxy, sumy, sumy2,denom); */ - } - *sb = sqrt(sume2/(ne-2)/(sumx2 - sumx * sumx /ne)); - *sa= *sb * sqrt(sumx2/ne); - - return 0; -} /************ Frequencies ********************/ void freqsummary(char fileres[], double p[], double pstart[], int iagemin, int iagemax, int **s, double **agev, int nlstate, int imx, \ @@ -4308,13 +4355,13 @@ void freqsummary(char fileres[], double int firstpass, int lastpass, int stepm, int weightopt, char model[]) { /* Some frequencies as well as proposing some starting values */ - int i, m, jk, j1, bool, z1,j, nj, nl, k, iv, jj=0; + int i, m, jk, j1, bool, z1,j, nj, nl, k, iv, jj=0, s1=1, s2=1; int iind=0, iage=0; int mi; /* Effective wave */ int first; double ***freq; /* Frequencies */ - double *x, *y, a,b,r, sa, sb; /* for regression, y=b+m*x and r is the correlation coefficient */ - int no; + double *x, *y, a=0.,b=0.,r=1., sa=0., sb=0.; /* for regression, y=b+m*x and r is the correlation coefficient */ + int no=0, linreg(int ifi, int ila, int *no, const double x[], const double y[], double* a, double* b, double* r, double* sa, double * sb); double *meanq; double **meanqt; double *pp, **prop, *posprop, *pospropt; @@ -4387,23 +4434,48 @@ Title=%s
Datafile=%s Firstpass=%d La k2cpt=0; if(cptcoveff == 0 ) - nl=1; /* Constant model only */ + nl=1; /* Constant and age model only */ else nl=2; + + /* if a constant only model, one pass to compute frequency tables and to write it on ficresp */ + /* Loop on nj=1 or 2 if dummy covariates j!=0 + * Loop on j1(1 to 2**cptcoveff) covariate combination + * freq[s1][s2][iage] =0. + * Loop on iind + * ++freq[s1][s2][iage] weighted + * end iind + * if covariate and j!0 + * headers Variable on one line + * endif cov j!=0 + * header of frequency table by age + * Loop on age + * pp[s1]+=freq[s1][s2][iage] weighted + * pos+=freq[s1][s2][iage] weighted + * Loop on s1 initial state + * fprintf(ficresp + * end s1 + * end age + * if j!=0 computes starting values + * end compute starting values + * end j1 + * end nl + */ for (nj = 1; nj <= nl; nj++){ /* nj= 1 constant model, nl number of loops. */ if(nj==1) j=0; /* First pass for the constant */ - else + else{ j=cptcoveff; /* Other passes for the covariate values */ + } first=1; - for (j1 = 1; j1 <= (int) pow(2,j); j1++){ /* Loop on covariates combination in order of model, excluding quantitatives, V4=0, V3=0 for example, fixed or varying covariates */ + for (j1 = 1; j1 <= (int) pow(2,j); j1++){ /* Loop on all covariates combination of the model, excluding quantitatives, V4=0, V3=0 for example, fixed or varying covariates */ posproptt=0.; /*printf("cptcoveff=%d Tvaraff=%d", cptcoveff,Tvaraff[1]); scanf("%d", i);*/ for (i=-5; i<=nlstate+ndeath; i++) - for (jk=-5; jk<=nlstate+ndeath; jk++) + for (s2=-5; s2<=nlstate+ndeath; s2++) for(m=iagemin; m <= iagemax+3; m++) - freq[i][jk][m]=0; + freq[i][s2][m]=0; for (i=1; i<=nlstate; i++) { for(m=iagemin; m <= iagemax+3; m++) @@ -4421,7 +4493,7 @@ Title=%s
Datafile=%s Firstpass=%d La /* dateintsum=0; */ /* k2cpt=0; */ - /* For that combination of covariate j1, we count and print the frequencies in one pass */ + /* For that combination of covariates j1 (V4=1 V3=0 for example), we count and print the frequencies in one pass */ for (iind=1; iind<=imx; iind++) { /* For each individual iind */ bool=1; if(j !=0){ @@ -4437,7 +4509,7 @@ Title=%s
Datafile=%s Firstpass=%d La /* /\* sumnew+=coqvar[z1][iind]; *\/ */ /* }else */ if (covar[Tvaraff[z1]][iind]!= nbcode[Tvaraff[z1]][codtabm(j1,z1)]){ /* for combination j1 of covariates */ - /* Tests if this individual iind responded to combination j1 (V4=1 V3=0) */ + /* Tests if the value of the covariate z1 for this individual iind responded to combination j1 (V4=1 V3=0) */ bool=0; /* bool should be equal to 1 to be selected, one covariate value failed */ /* printf("bool=%d i=%d, z1=%d, Tvaraff[%d]=%d, covar[Tvarff][%d]=%2f, codtabm(%d,%d)=%d, nbcode[Tvaraff][codtabm(%d,%d)=%d, j1=%d\n", bool,i,z1, z1, Tvaraff[z1],i,covar[Tvaraff[z1]][i],j1,z1,codtabm(j1,z1), @@ -4448,7 +4520,7 @@ Title=%s
Datafile=%s Firstpass=%d La } /* cptcovn > 0 */ } /* end any */ }/* end j==0 */ - if (bool==1){ /* We selected an individual iind satisfying combination j1 or all fixed */ + if (bool==1){ /* We selected an individual iind satisfying combination j1 (V4=1 V3=0) or all fixed covariates */ /* for(m=firstpass; m<=lastpass; m++){ */ for(mi=1; miDatafile=%s Firstpass=%d La /* fprintf(ficresp, "#Count between %.lf/%.lf/%.lf and %.lf/%.lf/%.lf\n",jprev1, mprev1,anprev1,jprev2, mprev2,anprev2);*/ - pstamp(ficresp); + if(cptcoveff==0 && nj==1) /* no covariate and first pass */ + pstamp(ficresp); if (cptcoveff>0 && j!=0){ + pstamp(ficresp); printf( "\n#********** Variable "); fprintf(ficresp, "\n#********** Variable "); fprintf(ficresphtm, "\n

********** Variable "); @@ -4539,20 +4613,23 @@ Title=%s
Datafile=%s Firstpass=%d La fprintf(ficlog, "**********\n"); } fprintf(ficresphtm,""); + if((cptcoveff==0 && nj==1)|| nj==2 ) /* no covariate and first pass */ + fprintf(ficresp, " Age"); + if(nj==2) for (z1=1; z1<=cptcoveff; z1++) fprintf(ficresp, " V%d=%d",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); for(i=1; i<=nlstate;i++) { - fprintf(ficresp, " Age Prev(%d) N(%d) N ",i,i); + if((cptcoveff==0 && nj==1)|| nj==2 ) fprintf(ficresp," Prev(%d) N(%d) N ",i,i); fprintf(ficresphtm, "",i,i); } - fprintf(ficresp, "\n"); + if((cptcoveff==0 && nj==1)|| nj==2 ) fprintf(ficresp, "\n"); fprintf(ficresphtm, "\n"); /* Header of frequency table by age */ fprintf(ficresphtmfr,"
AgePrev(%d)N(%d)N
"); fprintf(ficresphtmfr," "); - for(jk=-1; jk <=nlstate+ndeath; jk++){ + for(s2=-1; s2 <=nlstate+ndeath; s2++){ for(m=-1; m <=nlstate+ndeath; m++){ - if(jk!=0 && m!=0) - fprintf(ficresphtmfr," ",jk,m); + if(s2!=0 && m!=0) + fprintf(ficresphtmfr," ",s2,m); } } fprintf(ficresphtmfr, "\n"); @@ -4577,97 +4654,112 @@ Title=%s
Datafile=%s Firstpass=%d La fprintf(ficresphtmfr," ",iage); fprintf(ficlog,"Age %d", iage); } - for(jk=1; jk <=nlstate ; jk++){ - for(m=-1, pp[jk]=0; m <=nlstate+ndeath ; m++) - pp[jk] += freq[jk][m][iage]; + for(s1=1; s1 <=nlstate ; s1++){ + for(m=-1, pp[s1]=0; m <=nlstate+ndeath ; m++) + pp[s1] += freq[s1][m][iage]; } - for(jk=1; jk <=nlstate ; jk++){ + for(s1=1; s1 <=nlstate ; s1++){ for(m=-1, pos=0; m <=0 ; m++) - pos += freq[jk][m][iage]; - if(pp[jk]>=1.e-10){ + pos += freq[s1][m][iage]; + if(pp[s1]>=1.e-10){ if(first==1){ - printf(" %d.=%.0f loss[%d]=%.1f%%",jk,pp[jk],jk,100*pos/pp[jk]); + printf(" %d.=%.0f loss[%d]=%.1f%%",s1,pp[s1],s1,100*pos/pp[s1]); } - fprintf(ficlog," %d.=%.0f loss[%d]=%.1f%%",jk,pp[jk],jk,100*pos/pp[jk]); + fprintf(ficlog," %d.=%.0f loss[%d]=%.1f%%",s1,pp[s1],s1,100*pos/pp[s1]); }else{ if(first==1) - printf(" %d.=%.0f loss[%d]=NaNQ%%",jk,pp[jk],jk); - fprintf(ficlog," %d.=%.0f loss[%d]=NaNQ%%",jk,pp[jk],jk); + printf(" %d.=%.0f loss[%d]=NaNQ%%",s1,pp[s1],s1); + fprintf(ficlog," %d.=%.0f loss[%d]=NaNQ%%",s1,pp[s1],s1); } } - for(jk=1; jk <=nlstate ; jk++){ - /* posprop[jk]=0; */ - for(m=0, pp[jk]=0; m <=nlstate+ndeath; m++)/* Summing on all ages */ - pp[jk] += freq[jk][m][iage]; - } /* pp[jk] is the total number of transitions starting from state jk and any ending status until this age */ - - for(jk=1,pos=0, pospropta=0.; jk <=nlstate ; jk++){ - pos += pp[jk]; /* pos is the total number of transitions until this age */ - posprop[jk] += prop[jk][iage]; /* prop is the number of transitions from a live state - from jk at age iage prop[s[m][iind]][(int)agev[m][iind]] += weight[iind] */ - pospropta += prop[jk][iage]; /* prop is the number of transitions from a live state - from jk at age iage prop[s[m][iind]][(int)agev[m][iind]] += weight[iind] */ + for(s1=1; s1 <=nlstate ; s1++){ + /* posprop[s1]=0; */ + for(m=0, pp[s1]=0; m <=nlstate+ndeath; m++)/* Summing on all ages */ + pp[s1] += freq[s1][m][iage]; + } /* pp[s1] is the total number of transitions starting from state s1 and any ending status until this age */ + + for(s1=1,pos=0, pospropta=0.; s1 <=nlstate ; s1++){ + pos += pp[s1]; /* pos is the total number of transitions until this age */ + posprop[s1] += prop[s1][iage]; /* prop is the number of transitions from a live state + from s1 at age iage prop[s[m][iind]][(int)agev[m][iind]] += weight[iind] */ + pospropta += prop[s1][iage]; /* prop is the number of transitions from a live state + from s1 at age iage prop[s[m][iind]][(int)agev[m][iind]] += weight[iind] */ } - for(jk=1; jk <=nlstate ; jk++){ + + /* Writing ficresp */ + if(cptcoveff==0 && nj==1){ /* no covariate and first pass */ + if( iage <= iagemax){ + fprintf(ficresp," %d",iage); + } + }else if( nj==2){ + if( iage <= iagemax){ + fprintf(ficresp," %d",iage); + for (z1=1; z1<=cptcoveff; z1++) fprintf(ficresp, " %d %d",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); + } + } + for(s1=1; s1 <=nlstate ; s1++){ if(pos>=1.e-5){ if(first==1) - printf(" %d.=%.0f prev[%d]=%.1f%%",jk,pp[jk],jk,100*pp[jk]/pos); - fprintf(ficlog," %d.=%.0f prev[%d]=%.1f%%",jk,pp[jk],jk,100*pp[jk]/pos); + printf(" %d.=%.0f prev[%d]=%.1f%%",s1,pp[s1],s1,100*pp[s1]/pos); + fprintf(ficlog," %d.=%.0f prev[%d]=%.1f%%",s1,pp[s1],s1,100*pp[s1]/pos); }else{ if(first==1) - printf(" %d.=%.0f prev[%d]=NaNQ%%",jk,pp[jk],jk); - fprintf(ficlog," %d.=%.0f prev[%d]=NaNQ%%",jk,pp[jk],jk); + printf(" %d.=%.0f prev[%d]=NaNQ%%",s1,pp[s1],s1); + fprintf(ficlog," %d.=%.0f prev[%d]=NaNQ%%",s1,pp[s1],s1); } if( iage <= iagemax){ if(pos>=1.e-5){ - fprintf(ficresp," %d %.5f %.0f %.0f",iage,prop[jk][iage]/pospropta, prop[jk][iage],pospropta); - /* fprintf(ficresp, "%d %d %d %.5f %.0f %.0f",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)],iage,prop[jk][iage]/pospropta, prop[jk][iage],pospropta); */ - - fprintf(ficresphtm,"",iage,prop[jk][iage]/pospropta, prop[jk][iage],pospropta); - /*probs[iage][jk][j1]= pp[jk]/pos;*/ - /*printf("\niage=%d jk=%d j1=%d %.5f %.0f %.0f %f",iage,jk,j1,pp[jk]/pos, pp[jk],pos,probs[iage][jk][j1]);*/ - } - else{ - fprintf(ficresp," %d NaNq %.0f %.0f",iage,prop[jk][iage],pospropta); - fprintf(ficresphtm,"",iage, prop[jk][iage],pospropta); + if(cptcoveff==0 && nj==1){ /* no covariate and first pass */ + fprintf(ficresp," %.5f %.0f %.0f",prop[s1][iage]/pospropta, prop[s1][iage],pospropta); + }else if( nj==2){ + fprintf(ficresp," %.5f %.0f %.0f",prop[s1][iage]/pospropta, prop[s1][iage],pospropta); + } + fprintf(ficresphtm,"",iage,prop[s1][iage]/pospropta, prop[s1][iage],pospropta); + /*probs[iage][s1][j1]= pp[s1]/pos;*/ + /*printf("\niage=%d s1=%d j1=%d %.5f %.0f %.0f %f",iage,s1,j1,pp[s1]/pos, pp[s1],pos,probs[iage][s1][j1]);*/ + } else{ + if((cptcoveff==0 && nj==1)|| nj==2 ) fprintf(ficresp," NaNq %.0f %.0f",prop[s1][iage],pospropta); + fprintf(ficresphtm,"",iage, prop[s1][iage],pospropta); } } - pospropt[jk] +=posprop[jk]; - } /* end loop jk */ + pospropt[s1] +=posprop[s1]; + } /* end loop s1 */ /* pospropt=0.; */ - for(jk=-1; jk <=nlstate+ndeath; jk++){ + for(s1=-1; s1 <=nlstate+ndeath; s1++){ for(m=-1; m <=nlstate+ndeath; m++){ - if(freq[jk][m][iage] !=0 ) { /* minimizing output */ + if(freq[s1][m][iage] !=0 ) { /* minimizing output */ if(first==1){ - printf(" %d%d=%.0f",jk,m,freq[jk][m][iage]); + printf(" %d%d=%.0f",s1,m,freq[s1][m][iage]); } - /* printf(" %d%d=%.0f",jk,m,freq[jk][m][iage]); */ - fprintf(ficlog," %d%d=%.0f",jk,m,freq[jk][m][iage]); + /* printf(" %d%d=%.0f",s1,m,freq[s1][m][iage]); */ + fprintf(ficlog," %d%d=%.0f",s1,m,freq[s1][m][iage]); } - if(jk!=0 && m!=0) - fprintf(ficresphtmfr," ",freq[jk][m][iage]); + if(s1!=0 && m!=0) + fprintf(ficresphtmfr," ",freq[s1][m][iage]); } - } /* end loop jk */ + } /* end loop s1 */ posproptt=0.; - for(jk=1; jk <=nlstate; jk++){ - posproptt += pospropt[jk]; + for(s1=1; s1 <=nlstate; s1++){ + posproptt += pospropt[s1]; } fprintf(ficresphtmfr,"\n "); - if(iage <= iagemax){ - fprintf(ficresp,"\n"); - fprintf(ficresphtm,"\n"); + fprintf(ficresphtm,"\n"); + if((cptcoveff==0 && nj==1)|| nj==2 ) { + if(iage <= iagemax) + fprintf(ficresp,"\n"); } if(first==1) printf("Others in log...\n"); fprintf(ficlog,"\n"); } /* end loop age iage */ + fprintf(ficresphtm,""); - for(jk=1; jk <=nlstate ; jk++){ + for(s1=1; s1 <=nlstate ; s1++){ if(posproptt < 1.e-5){ - fprintf(ficresphtm,"",pospropt[jk],posproptt); + fprintf(ficresphtm,"",pospropt[s1],posproptt); }else{ - fprintf(ficresphtm,"",pospropt[jk]/posproptt,pospropt[jk],posproptt); + fprintf(ficresphtm,"",pospropt[s1]/posproptt,pospropt[s1],posproptt); } } fprintf(ficresphtm,"\n"); @@ -4687,66 +4779,68 @@ Title=%s
Datafile=%s Firstpass=%d La fprintf(ficlog,"\n"); if(j!=0){ printf("#Freqsummary: Starting values for combination j1=%d:\n", j1); - for(i=1,jk=1; i <=nlstate; i++){ + for(i=1,s1=1; i <=nlstate; i++){ for(k=1; k <=(nlstate+ndeath); k++){ if (k != i) { - for(jj=1; jj <=ncovmodel; jj++){ /* For counting jk */ + for(jj=1; jj <=ncovmodel; jj++){ /* For counting s1 */ if(jj==1){ /* Constant case (in fact cste + age) */ if(j1==1){ /* All dummy covariates to zero */ freq[i][k][iagemax+4]=freq[i][k][iagemax+3]; /* Stores case 0 0 0 */ freq[i][i][iagemax+4]=freq[i][i][iagemax+3]; /* Stores case 0 0 0 */ printf("%d%d ",i,k); fprintf(ficlog,"%d%d ",i,k); - printf("%12.7f ln(%.0f/%.0f)= %f, OR=%f sd=%f \n",p[jk],freq[i][k][iagemax+3],freq[i][i][iagemax+3], log(freq[i][k][iagemax+3]/freq[i][i][iagemax+3]),freq[i][k][iagemax+3]/freq[i][i][iagemax+3], sqrt(1/freq[i][k][iagemax+3]+1/freq[i][i][iagemax+3])); - fprintf(ficlog,"%12.7f ln(%.0f/%.0f)= %12.7f \n",p[jk],freq[i][k][iagemax+3],freq[i][i][iagemax+3], log(freq[i][k][iagemax+3]/freq[i][i][iagemax+3])); - pstart[jk]= log(freq[i][k][iagemax+3]/freq[i][i][iagemax+3]); + printf("%12.7f ln(%.0f/%.0f)= %f, OR=%f sd=%f \n",p[s1],freq[i][k][iagemax+3],freq[i][i][iagemax+3], log(freq[i][k][iagemax+3]/freq[i][i][iagemax+3]),freq[i][k][iagemax+3]/freq[i][i][iagemax+3], sqrt(1/freq[i][k][iagemax+3]+1/freq[i][i][iagemax+3])); + fprintf(ficlog,"%12.7f ln(%.0f/%.0f)= %12.7f \n",p[s1],freq[i][k][iagemax+3],freq[i][i][iagemax+3], log(freq[i][k][iagemax+3]/freq[i][i][iagemax+3])); + pstart[s1]= log(freq[i][k][iagemax+3]/freq[i][i][iagemax+3]); } }else if((j1==1) && (jj==2 || nagesqr==1)){ /* age or age*age parameter without covariate V4*age (to be done later) */ for(iage=iagemin; iage <= iagemax+3; iage++){ x[iage]= (double)iage; y[iage]= log(freq[i][k][iage]/freq[i][i][iage]); - /* printf("i=%d, k=%d, jk=%d, j1=%d, jj=%d, y[%d]=%f\n",i,k,jk,j1,jj, iage, y[iage]); */ + /* printf("i=%d, k=%d, s1=%d, j1=%d, jj=%d, y[%d]=%f\n",i,k,s1,j1,jj, iage, y[iage]); */ } + /* Some are not finite, but linreg will ignore these ages */ + no=0; linreg(iagemin,iagemax,&no,x,y,&a,&b,&r, &sa, &sb ); /* y= a+b*x with standard errors */ - pstart[jk]=b; - pstart[jk-1]=a; + pstart[s1]=b; + pstart[s1-1]=a; }else if( j1!=1 && (j1==2 || (log(j1-1.)/log(2.)-(int)(log(j1-1.)/log(2.))) <0.010) && ( TvarsDind[(int)(log(j1-1.)/log(2.))+1]+2+nagesqr == jj) && Dummy[jj-2-nagesqr]==0){ /* We want only if the position, jj, in model corresponds to unique covariate equal to 1 in j1 combination */ printf("j1=%d, jj=%d, (int)(log(j1-1.)/log(2.))+1=%d, TvarsDind[(int)(log(j1-1.)/log(2.))+1]=%d\n",j1, jj,(int)(log(j1-1.)/log(2.))+1,TvarsDind[(int)(log(j1-1.)/log(2.))+1]); printf("j1=%d, jj=%d, (log(j1-1.)/log(2.))+1=%f, TvarsDind[(int)(log(j1-1.)/log(2.))+1]=%d\n",j1, jj,(log(j1-1.)/log(2.))+1,TvarsDind[(int)(log(j1-1.)/log(2.))+1]); - pstart[jk]= log((freq[i][k][iagemax+3]/freq[i][i][iagemax+3])/(freq[i][k][iagemax+4]/freq[i][i][iagemax+4])); + pstart[s1]= log((freq[i][k][iagemax+3]/freq[i][i][iagemax+3])/(freq[i][k][iagemax+4]/freq[i][i][iagemax+4])); printf("%d%d ",i,k); fprintf(ficlog,"%d%d ",i,k); - printf("jk=%d,i=%d,k=%d,p[%d]=%12.7f ln((%.0f/%.0f)/(%.0f/%.0f))= %f, OR=%f sd=%f \n",jk,i,k,jk,p[jk],freq[i][k][iagemax+3],freq[i][i][iagemax+3],freq[i][k][iagemax+4],freq[i][i][iagemax+4], log((freq[i][k][iagemax+3]/freq[i][i][iagemax+3])/(freq[i][k][iagemax+4]/freq[i][i][iagemax+4])),(freq[i][k][iagemax+3]/freq[i][i][iagemax+3])/(freq[i][k][iagemax+4]/freq[i][i][iagemax+4]), sqrt(1/freq[i][k][iagemax+3]+1/freq[i][i][iagemax+3]+1/freq[i][k][iagemax+4]+1/freq[i][i][iagemax+4])); + printf("s1=%d,i=%d,k=%d,p[%d]=%12.7f ln((%.0f/%.0f)/(%.0f/%.0f))= %f, OR=%f sd=%f \n",s1,i,k,s1,p[s1],freq[i][k][iagemax+3],freq[i][i][iagemax+3],freq[i][k][iagemax+4],freq[i][i][iagemax+4], log((freq[i][k][iagemax+3]/freq[i][i][iagemax+3])/(freq[i][k][iagemax+4]/freq[i][i][iagemax+4])),(freq[i][k][iagemax+3]/freq[i][i][iagemax+3])/(freq[i][k][iagemax+4]/freq[i][i][iagemax+4]), sqrt(1/freq[i][k][iagemax+3]+1/freq[i][i][iagemax+3]+1/freq[i][k][iagemax+4]+1/freq[i][i][iagemax+4])); }else{ /* Other cases, like quantitative fixed or varying covariates */ ; } /* printf("%12.7f )", param[i][jj][k]); */ /* fprintf(ficlog,"%12.7f )", param[i][jj][k]); */ - jk++; + s1++; } /* end jj */ } /* end k!= i */ } /* end k */ - } /* end i, jk */ + } /* end i, s1 */ } /* end j !=0 */ } /* end selected combination of covariate j1 */ if(j==0){ /* We can estimate starting values from the occurences in each case */ printf("#Freqsummary: Starting values for the constants:\n"); fprintf(ficlog,"\n"); - for(i=1,jk=1; i <=nlstate; i++){ + for(i=1,s1=1; i <=nlstate; i++){ for(k=1; k <=(nlstate+ndeath); k++){ if (k != i) { printf("%d%d ",i,k); fprintf(ficlog,"%d%d ",i,k); for(jj=1; jj <=ncovmodel; jj++){ - pstart[jk]=p[jk]; /* Setting pstart to p values by default */ + pstart[s1]=p[s1]; /* Setting pstart to p values by default */ if(jj==1){ /* Age has to be done */ - pstart[jk]= log(freq[i][k][iagemax+3]/freq[i][i][iagemax+3]); - printf("%12.7f ln(%.0f/%.0f)= %12.7f ",p[jk],freq[i][k][iagemax+3],freq[i][i][iagemax+3], log(freq[i][k][iagemax+3]/freq[i][i][iagemax+3])); - fprintf(ficlog,"%12.7f ln(%.0f/%.0f)= %12.7f ",p[jk],freq[i][k][iagemax+3],freq[i][i][iagemax+3], log(freq[i][k][iagemax+3]/freq[i][i][iagemax+3])); + pstart[s1]= log(freq[i][k][iagemax+3]/freq[i][i][iagemax+3]); + printf("%12.7f ln(%.0f/%.0f)= %12.7f ",p[s1],freq[i][k][iagemax+3],freq[i][i][iagemax+3], log(freq[i][k][iagemax+3]/freq[i][i][iagemax+3])); + fprintf(ficlog,"%12.7f ln(%.0f/%.0f)= %12.7f ",p[s1],freq[i][k][iagemax+3],freq[i][i][iagemax+3], log(freq[i][k][iagemax+3]/freq[i][i][iagemax+3])); } /* printf("%12.7f )", param[i][jj][k]); */ /* fprintf(ficlog,"%12.7f )", param[i][jj][k]); */ - jk++; + s1++; } printf("\n"); fprintf(ficlog,"\n"); @@ -4755,17 +4849,17 @@ Title=%s
Datafile=%s Firstpass=%d La } printf("#Freqsummary\n"); fprintf(ficlog,"\n"); - for(jk=-1; jk <=nlstate+ndeath; jk++){ - for(m=-1; m <=nlstate+ndeath; m++){ - /* param[i]|j][k]= freq[jk][m][iagemax+3] */ - printf(" %d%d=%.0f",jk,m,freq[jk][m][iagemax+3]); - fprintf(ficlog," %d%d=%.0f",jk,m,freq[jk][m][iagemax+3]); - /* if(freq[jk][m][iage] !=0 ) { /\* minimizing output *\/ */ - /* printf(" %d%d=%.0f",jk,m,freq[jk][m][iagemax+3]); */ - /* fprintf(ficlog," %d%d=%.0f",jk,m,freq[jk][m][iagemax+3]); */ + for(s1=-1; s1 <=nlstate+ndeath; s1++){ + for(s2=-1; s2 <=nlstate+ndeath; s2++){ + /* param[i]|j][k]= freq[s1][s2][iagemax+3] */ + printf(" %d%d=%.0f",s1,s2,freq[s1][s2][iagemax+3]); + fprintf(ficlog," %d%d=%.0f",s1,s2,freq[s1][s2][iagemax+3]); + /* if(freq[s1][s2][iage] !=0 ) { /\* minimizing output *\/ */ + /* printf(" %d%d=%.0f",s1,s2,freq[s1][s2][iagemax+3]); */ + /* fprintf(ficlog," %d%d=%.0f",s1,s2,freq[s1][s2][iagemax+3]); */ /* } */ } - } /* end loop jk */ + } /* end loop s1 */ printf("\n"); fprintf(ficlog,"\n"); @@ -4810,6 +4904,72 @@ Title=%s
Datafile=%s Firstpass=%d La /* End of freqsummary */ } +/* Simple linear regression */ +int linreg(int ifi, int ila, int *no, const double x[], const double y[], double* a, double* b, double* r, double* sa, double * sb) { + + /* y=a+bx regression */ + double sumx = 0.0; /* sum of x */ + double sumx2 = 0.0; /* sum of x**2 */ + double sumxy = 0.0; /* sum of x * y */ + double sumy = 0.0; /* sum of y */ + double sumy2 = 0.0; /* sum of y**2 */ + double sume2 = 0.0; /* sum of square or residuals */ + double yhat; + + double denom=0; + int i; + int ne=*no; + + for ( i=ifi, ne=0;i<=ila;i++) { + if(!isfinite(x[i]) || !isfinite(y[i])){ + /* printf(" x[%d]=%f, y[%d]=%f\n",i,x[i],i,y[i]); */ + continue; + } + ne=ne+1; + sumx += x[i]; + sumx2 += x[i]*x[i]; + sumxy += x[i] * y[i]; + sumy += y[i]; + sumy2 += y[i]*y[i]; + denom = (ne * sumx2 - sumx*sumx); + /* printf("ne=%d, i=%d,x[%d]=%f, y[%d]=%f sumx=%f, sumx2=%f, sumxy=%f, sumy=%f, sumy2=%f, denom=%f\n",ne,i,i,x[i],i,y[i], sumx, sumx2,sumxy, sumy, sumy2,denom); */ + } + + denom = (ne * sumx2 - sumx*sumx); + if (denom == 0) { + // vertical, slope m is infinity + *b = INFINITY; + *a = 0; + if (r) *r = 0; + return 1; + } + + *b = (ne * sumxy - sumx * sumy) / denom; + *a = (sumy * sumx2 - sumx * sumxy) / denom; + if (r!=NULL) { + *r = (sumxy - sumx * sumy / ne) / /* compute correlation coeff */ + sqrt((sumx2 - sumx*sumx/ne) * + (sumy2 - sumy*sumy/ne)); + } + *no=ne; + for ( i=ifi, ne=0;i<=ila;i++) { + if(!isfinite(x[i]) || !isfinite(y[i])){ + /* printf(" x[%d]=%f, y[%d]=%f\n",i,x[i],i,y[i]); */ + continue; + } + ne=ne+1; + yhat = y[i] - *a -*b* x[i]; + sume2 += yhat * yhat ; + + denom = (ne * sumx2 - sumx*sumx); + /* printf("ne=%d, i=%d,x[%d]=%f, y[%d]=%f sumx=%f, sumx2=%f, sumxy=%f, sumy=%f, sumy2=%f, denom=%f\n",ne,i,i,x[i],i,y[i], sumx, sumx2,sumxy, sumy, sumy2,denom); */ + } + *sb = sqrt(sume2/(double)(ne-2)/(sumx2 - sumx * sumx /(double)ne)); + *sa= *sb * sqrt(sumx2/ne); + + return 0; +} + /************ Prevalence ********************/ void prevalence(double ***probs, double agemin, double agemax, int **s, double **agev, int nlstate, int imx, int *Tvar, int **nbcode, int *ncodemax,double **mint,double **anint, double dateprev1,double dateprev2, int firstpass, int lastpass) { @@ -4899,7 +5059,10 @@ void prevalence(double ***probs, double } else{ if(first==1){ first=0; - printf("Warning Observed prevalence probs[%d][%d][%d]=%lf because of lack of cases\nSee others in log file...\n",jk,i,j1,probs[i][jk][j1]); + printf("Warning Observed prevalence doesn't sum to 1 for state %d: probs[%d][%d][%d]=%lf because of lack of cases\nSee others in log file...\n",jk,i,jk, j1,probs[i][jk][j1]); + fprintf(ficlog,"Warning Observed prevalence doesn't sum to 1 for state %d: probs[%d][%d][%d]=%lf because of lack of cases\nSee others in log file...\n",jk,i,jk, j1,probs[i][jk][j1]); + }else{ + fprintf(ficlog,"Warning Observed prevalence doesn't sum to 1 for state %d: probs[%d][%d][%d]=%lf because of lack of cases\nSee others in log file...\n",jk,i,jk, j1,probs[i][jk][j1]); } } } @@ -5339,7 +5502,7 @@ void concatwav(int wav[], int **dh, int /* hstepm beeing the number of stepms, if hstepm=1 the length of hstepm is stepm. nhstepm is the number of hstepm from age to agelim nstepm is the number of stepm from age to agelin. - Look at hpijx to understand the reason of that which relies in memory size + Look at hpijx to understand the reason which relies in memory size consideration and note for a fixed period like estepm months */ /* We decided (b) to get a life expectancy respecting the most precise curvature of the survival function given by stepm (the optimization length). Unfortunately it @@ -5570,7 +5733,8 @@ void concatwav(int wav[], int **dh, int /* if((int)age==70)printf("i=%2d,j=%2d,h=%2d,age=%3d,%9.4f,%9.4f,%9.4f\n",i,j,h,(int)age,p3mat[i][j][h],hf,eij[i][j][(int)age]);*/ } - + + /* Standard deviation of expectancies ij */ fprintf(ficresstdeij,"%3.0f",age ); for(i=1; i<=nlstate;i++){ eip=0.; @@ -5585,6 +5749,7 @@ void concatwav(int wav[], int **dh, int } fprintf(ficresstdeij,"\n"); + /* Variance of expectancies ij */ fprintf(ficrescveij,"%3.0f",age ); for(i=1; i<=nlstate;i++) for(j=1; j<=nlstate;j++){ @@ -5618,10 +5783,11 @@ void concatwav(int wav[], int **dh, int /************ Variance ******************/ void varevsij(char optionfilefiname[], double ***vareij, double **matcov, double x[], double delti[], int nlstate, int stepm, double bage, double fage, double **oldm, double **savm, double **prlim, double ftolpl, int *ncvyearp, int ij, int estepm, int cptcov, int cptcod, int popbased, int mobilav, char strstart[], int nres) { - /* Variance of health expectancies */ - /* double **prevalim(double **prlim, int nlstate, double *xp, double age, double **oldm, double ** savm,double ftolpl);*/ - /* double **newm;*/ - /* int movingaverage(double ***probs, double bage,double fage, double ***mobaverage, int mobilav)*/ + /** Variance of health expectancies + * double **prevalim(double **prlim, int nlstate, double *xp, double age, double **oldm, double ** savm,double ftolpl); + * double **newm; + * int movingaverage(double ***probs, double bage,double fage, double ***mobaverage, int mobilav) + */ /* int movingaverage(); */ double **dnewm,**doldm; @@ -5629,11 +5795,11 @@ void concatwav(int wav[], int **dh, int int i, j, nhstepm, hstepm, h, nstepm ; int k; double *xp; - double **gp, **gm; /* for var eij */ - double ***gradg, ***trgradg; /*for var eij */ - double **gradgp, **trgradgp; /* for var p point j */ - double *gpp, *gmp; /* for var p point j */ - double **varppt; /* for var p point j nlstate to nlstate+ndeath */ + double **gp, **gm; /**< for var eij */ + double ***gradg, ***trgradg; /**< for var eij */ + double **gradgp, **trgradgp; /**< for var p point j */ + double *gpp, *gmp; /**< for var p point j */ + double **varppt; /**< for var p point j nlstate to nlstate+ndeath */ double ***p3mat; double age,agelim, hf; /* double ***mobaverage; */ @@ -5694,7 +5860,7 @@ void concatwav(int wav[], int **dh, int /* fprintf(fichtm, "#Local time at start: %s", strstart);*/ fprintf(fichtm,"\n

  • Computing probabilities of dying over estepm months as a weighted average (i.e global mortality independent of initial healh state)

    • \n"); fprintf(fichtm,"\n
    %s
    \n",digitp); - /* } */ + varppt = matrix(nlstate+1,nlstate+ndeath,nlstate+1,nlstate+ndeath); pstamp(ficresvij); fprintf(ficresvij,"# Variance and covariance of health expectancies e.j \n# (weighted average of eij where weights are "); @@ -5749,9 +5915,12 @@ void concatwav(int wav[], int **dh, int for(i=1; i<=npar; i++){ /* Computes gradient x + delta*/ xp[i] = x[i] + (i==theta ?delti[theta]:0); } - + /**< Computes the prevalence limit with parameter theta shifted of delta up to ftolpl precision and + * returns into prlim . + */ prevalim(prlim,nlstate,xp,age,oldm,savm,ftolpl,ncvyearp,ij, nres); - + + /* If popbased = 1 we use crossection prevalences. Previous step is useless but prlim is created */ if (popbased==1) { if(mobilav ==0){ for(i=1; i<=nlstate;i++) @@ -5761,23 +5930,28 @@ void concatwav(int wav[], int **dh, int prlim[i][i]=mobaverage[(int)age][i][ij]; } } - - hpxij(p3mat,nhstepm,age,hstepm,xp,nlstate,stepm,oldm,savm, ij,nres); /* Returns p3mat[i][j][h] for h=1 to nhstepm */ + /**< Computes the shifted transition matrix \f$ {}{h}_p^{ij}_x\f$ at horizon h. + */ + hpxij(p3mat,nhstepm,age,hstepm,xp,nlstate,stepm,oldm,savm, ij,nres); /* Returns p3mat[i][j][h] for h=0 to nhstepm */ + /**< And for each alive state j, sums over i \f$ w^i_x {}{h}_p^{ij}_x\f$, which are the probability + * at horizon h in state j including mortality. + */ for(j=1; j<= nlstate; j++){ for(h=0; h<=nhstepm; h++){ for(i=1, gp[h][j]=0.;i<=nlstate;i++) gp[h][j] += prlim[i][i]*p3mat[i][j][h]; } } - /* Next for computing probability of death (h=1 means + /* Next for computing shifted+ probability of death (h=1 means computed over hstepm matrices product = hstepm*stepm months) - as a weighted average of prlim. + as a weighted average of prlim(i) * p(i,j) p.3=w1*p13 + w2*p23 . */ for(j=nlstate+1;j<=nlstate+ndeath;j++){ for(i=1,gpp[j]=0.; i<= nlstate; i++) gpp[j] += prlim[i][i]*p3mat[i][j][1]; - } - /* end probability of death */ + } + + /* Again with minus shift */ for(i=1; i<=npar; i++) /* Computes gradient x - delta */ xp[i] = x[i] - (i==theta ?delti[theta]:0); @@ -5810,19 +5984,23 @@ void concatwav(int wav[], int **dh, int for(i=1,gmp[j]=0.; i<= nlstate; i++) gmp[j] += prlim[i][i]*p3mat[i][j][1]; } - /* end probability of death */ - + /* end shifting computations */ + + /**< Computing gradient matrix at horizon h + */ for(j=1; j<= nlstate; j++) /* vareij */ for(h=0; h<=nhstepm; h++){ gradg[h][theta][j]= (gp[h][j]-gm[h][j])/2./delti[theta]; } - - for(j=nlstate+1; j<= nlstate+ndeath; j++){ /* var mu */ + /**< Gradient of overall mortality p.3 (or p.j) + */ + for(j=nlstate+1; j<= nlstate+ndeath; j++){ /* var mu mortality from j */ gradgp[theta][j]= (gpp[j]-gmp[j])/2./delti[theta]; } } /* End theta */ - + + /* We got the gradient matrix for each theta and state j */ trgradg =ma3x(0,nhstepm,1,nlstate,1,npar); /* veij */ for(h=0; h<=nhstepm; h++) /* veij */ @@ -5833,13 +6011,19 @@ void concatwav(int wav[], int **dh, int for(j=nlstate+1; j<=nlstate+ndeath;j++) /* mu */ for(theta=1; theta <=npar; theta++) trgradgp[j][theta]=gradgp[theta][j]; - + /**< as well as its transposed matrix + */ hf=hstepm*stepm/YEARM; /* Duration of hstepm expressed in year unit. */ for(i=1;i<=nlstate;i++) for(j=1;j<=nlstate;j++) vareij[i][j][(int)age] =0.; - + + /* Computing trgradg by matcov by gradg at age and summing over h + * and k (nhstepm) formula 15 of article + * Lievre-Brouard-Heathcote + */ + for(h=0;h<=nhstepm;h++){ for(k=0;k<=nhstepm;k++){ matprod2(dnewm,trgradg[h],1,nlstate,1,npar,1,npar,matcov); @@ -5850,7 +6034,11 @@ void concatwav(int wav[], int **dh, int } } - /* pptj */ + /* pptj is p.3 or p.j = trgradgp by cov by gradgp, variance of + * p.j overall mortality formula 49 but computed directly because + * we compute the grad (wix pijx) instead of grad (pijx),even if + * wix is independent of theta. + */ matprod2(dnewmp,trgradgp,nlstate+1,nlstate+ndeath,1,npar,1,npar,matcov); matprod2(doldmp,dnewmp,nlstate+1,nlstate+ndeath,1,npar,nlstate+1,nlstate+ndeath,gradgp); for(j=nlstate+1;j<=nlstate+ndeath;j++) @@ -5938,12 +6126,12 @@ void concatwav(int wav[], int **dh, int } /* end varevsij */ /************ Variance of prevlim ******************/ - void varprevlim(char fileres[], double **varpl, double **matcov, double x[], double delti[], int nlstate, int stepm, double bage, double fage, double **oldm, double **savm, double **prlim, double ftolpl, int *ncvyearp, int ij, char strstart[], int nres) + void varprevlim(char fileresvpl[], FILE *ficresvpl, double **varpl, double **matcov, double x[], double delti[], int nlstate, int stepm, double bage, double fage, double **oldm, double **savm, double **prlim, double ftolpl, int *ncvyearp, int ij, char strstart[], int nres) { /* Variance of prevalence limit for each state ij using current parameters x[] and estimates of neighbourhood give by delti*/ /* double **prevalim(double **prlim, int nlstate, double *xp, double age, double **oldm, double **savm,double ftolpl);*/ - double **dnewm,**doldm; + double **dnewmpar,**doldm; int i, j, nhstepm, hstepm; double *xp; double *gp, *gm; @@ -5962,7 +6150,7 @@ void concatwav(int wav[], int **dh, int fprintf(ficresvpl,"\n"); xp=vector(1,npar); - dnewm=matrix(1,nlstate,1,npar); + dnewmpar=matrix(1,nlstate,1,npar); doldm=matrix(1,nlstate,1,nlstate); hstepm=1*YEARM; /* Every year of age */ @@ -6032,11 +6220,11 @@ void concatwav(int wav[], int **dh, int for(i=1;i<=nlstate;i++) varpl[i][(int)age] =0.; if((int)age==79 ||(int)age== 80 ||(int)age== 81){ - matprod2(dnewm,trgradg,1,nlstate,1,npar,1,npar,matcov); - matprod2(doldm,dnewm,1,nlstate,1,npar,1,nlstate,gradg); + matprod2(dnewmpar,trgradg,1,nlstate,1,npar,1,npar,matcov); + matprod2(doldm,dnewmpar,1,nlstate,1,npar,1,nlstate,gradg); }else{ - matprod2(dnewm,trgradg,1,nlstate,1,npar,1,npar,matcov); - matprod2(doldm,dnewm,1,nlstate,1,npar,1,nlstate,gradg); + matprod2(dnewmpar,trgradg,1,nlstate,1,npar,1,npar,matcov); + matprod2(doldm,dnewmpar,1,nlstate,1,npar,1,nlstate,gradg); } for(i=1;i<=nlstate;i++) varpl[i][(int)age] = doldm[i][i]; /* Covariances are useless */ @@ -6057,13 +6245,138 @@ void concatwav(int wav[], int **dh, int free_vector(xp,1,npar); free_matrix(doldm,1,nlstate,1,npar); - free_matrix(dnewm,1,nlstate,1,nlstate); + free_matrix(dnewmpar,1,nlstate,1,nlstate); } -/************ Variance of one-step probabilities ******************/ -void varprob(char optionfilefiname[], double **matcov, double x[], double delti[], int nlstate, double bage, double fage, int ij, int *Tvar, int **nbcode, int *ncodemax, char strstart[]) - { + +/************ Variance of backprevalence limit ******************/ + void varbrevlim(char fileresvbl[], FILE *ficresvbl, double **varbpl, double **matcov, double x[], double delti[], int nlstate, int stepm, double bage, double fage, double **oldm, double **savm, double **bprlim, double ftolpl, int mobilavproj, int *ncvyearp, int ij, char strstart[], int nres) +{ + /* Variance of backward prevalence limit for each state ij using current parameters x[] and estimates of neighbourhood give by delti*/ + /* double **prevalim(double **prlim, int nlstate, double *xp, double age, double **oldm, double **savm,double ftolpl);*/ + + double **dnewmpar,**doldm; + int i, j, nhstepm, hstepm; + double *xp; + double *gp, *gm; + double **gradg, **trgradg; + double **mgm, **mgp; + double age,agelim; + int theta; + + pstamp(ficresvbl); + fprintf(ficresvbl,"# Standard deviation of back (stable) prevalences \n"); + fprintf(ficresvbl,"# Age "); + if(nresult >=1) + fprintf(ficresvbl," Result# "); + for(i=1; i<=nlstate;i++) + fprintf(ficresvbl," %1d-%1d",i,i); + fprintf(ficresvbl,"\n"); + + xp=vector(1,npar); + dnewmpar=matrix(1,nlstate,1,npar); + doldm=matrix(1,nlstate,1,nlstate); + + hstepm=1*YEARM; /* Every year of age */ + hstepm=hstepm/stepm; /* Typically in stepm units, if j= 2 years, = 2/6 months = 4 */ + agelim = AGEINF; + for (age=fage; age>=bage; age --){ /* If stepm=6 months */ + nhstepm=(int) rint((age-agelim)*YEARM/stepm); /* Typically 20 years = 20*12/6=40 */ + if (stepm >= YEARM) hstepm=1; + nhstepm = nhstepm/hstepm; /* Typically 40/4=10 */ + gradg=matrix(1,npar,1,nlstate); + mgp=matrix(1,npar,1,nlstate); + mgm=matrix(1,npar,1,nlstate); + gp=vector(1,nlstate); + gm=vector(1,nlstate); + + for(theta=1; theta <=npar; theta++){ + for(i=1; i<=npar; i++){ /* Computes gradient */ + xp[i] = x[i] + (i==theta ?delti[theta]:0); + } + if(mobilavproj > 0 ) + bprevalim(bprlim, mobaverage,nlstate,xp,age,ftolpl,ncvyearp,ij,nres); + else + bprevalim(bprlim, mobaverage,nlstate,xp,age,ftolpl,ncvyearp,ij,nres); + for(i=1;i<=nlstate;i++){ + gp[i] = bprlim[i][i]; + mgp[theta][i] = bprlim[i][i]; + } + for(i=1; i<=npar; i++) /* Computes gradient */ + xp[i] = x[i] - (i==theta ?delti[theta]:0); + if(mobilavproj > 0 ) + bprevalim(bprlim, mobaverage,nlstate,xp,age,ftolpl,ncvyearp,ij,nres); + else + bprevalim(bprlim, mobaverage,nlstate,xp,age,ftolpl,ncvyearp,ij,nres); + for(i=1;i<=nlstate;i++){ + gm[i] = bprlim[i][i]; + mgm[theta][i] = bprlim[i][i]; + } + for(i=1;i<=nlstate;i++) + gradg[theta][i]= (gp[i]-gm[i])/2./delti[theta]; + /* gradg[theta][2]= -gradg[theta][1]; */ /* For testing if nlstate=2 */ + } /* End theta */ + + trgradg =matrix(1,nlstate,1,npar); + + for(j=1; j<=nlstate;j++) + for(theta=1; theta <=npar; theta++) + trgradg[j][theta]=gradg[theta][j]; + /* if((int)age==79 ||(int)age== 80 ||(int)age== 81 ){ */ + /* printf("\nmgm mgp %d ",(int)age); */ + /* for(j=1; j<=nlstate;j++){ */ + /* printf(" %d ",j); */ + /* for(theta=1; theta <=npar; theta++) */ + /* printf(" %d %lf %lf",theta,mgm[theta][j],mgp[theta][j]); */ + /* printf("\n "); */ + /* } */ + /* } */ + /* if((int)age==79 ||(int)age== 80 ||(int)age== 81 ){ */ + /* printf("\n gradg %d ",(int)age); */ + /* for(j=1; j<=nlstate;j++){ */ + /* printf("%d ",j); */ + /* for(theta=1; theta <=npar; theta++) */ + /* printf("%d %lf ",theta,gradg[theta][j]); */ + /* printf("\n "); */ + /* } */ + /* } */ + + for(i=1;i<=nlstate;i++) + varbpl[i][(int)age] =0.; + if((int)age==79 ||(int)age== 80 ||(int)age== 81){ + matprod2(dnewmpar,trgradg,1,nlstate,1,npar,1,npar,matcov); + matprod2(doldm,dnewmpar,1,nlstate,1,npar,1,nlstate,gradg); + }else{ + matprod2(dnewmpar,trgradg,1,nlstate,1,npar,1,npar,matcov); + matprod2(doldm,dnewmpar,1,nlstate,1,npar,1,nlstate,gradg); + } + for(i=1;i<=nlstate;i++) + varbpl[i][(int)age] = doldm[i][i]; /* Covariances are useless */ + + fprintf(ficresvbl,"%.0f ",age ); + if(nresult >=1) + fprintf(ficresvbl,"%d ",nres ); + for(i=1; i<=nlstate;i++) + fprintf(ficresvbl," %.5f (%.5f)",bprlim[i][i],sqrt(varbpl[i][(int)age])); + fprintf(ficresvbl,"\n"); + free_vector(gp,1,nlstate); + free_vector(gm,1,nlstate); + free_matrix(mgm,1,npar,1,nlstate); + free_matrix(mgp,1,npar,1,nlstate); + free_matrix(gradg,1,npar,1,nlstate); + free_matrix(trgradg,1,nlstate,1,npar); + } /* End age */ + + free_vector(xp,1,npar); + free_matrix(doldm,1,nlstate,1,npar); + free_matrix(dnewmpar,1,nlstate,1,nlstate); + +} + +/************ Variance of one-step probabilities ******************/ +void varprob(char optionfilefiname[], double **matcov, double x[], double delti[], int nlstate, double bage, double fage, int ij, int *Tvar, int **nbcode, int *ncodemax, char strstart[]) + { int i, j=0, k1, l1, tj; int k2, l2, j1, z1; int k=0, l; @@ -6137,7 +6450,7 @@ void varprob(char optionfilefiname[], do fprintf(fichtm,"\n

  • Computing and drawing one step probabilities with their confidence intervals

    • \n"); fprintf(fichtm,"\n"); - fprintf(fichtm,"\n

  • Matrix of variance-covariance of one-step probabilities (drawings)

    this page is important in order to visualize confidence intervals and especially correlation between disability and recovery, or more generally, way in and way back.
    • \n",optionfilehtmcov); + fprintf(fichtm,"\n

  • Matrix of variance-covariance of one-step probabilities (drawings)

    this page is important in order to visualize confidence intervals and especially correlation between disability and recovery, or more generally, way in and way back. %s
    • \n",optionfilehtmcov,optionfilehtmcov); fprintf(fichtmcov,"Current page is file %s
    \n\n

    Matrix of variance-covariance of pairs of step probabilities

    \n",optionfilehtmcov, optionfilehtmcov); fprintf(fichtmcov,"\nEllipsoids of confidence centered on point (pij, pkl) are estimated \ and drawn. It helps understanding how is the covariance between two incidences.\ @@ -6334,7 +6647,12 @@ To be simple, these graphs help to under } /* Eigen vectors */ - v11=(1./sqrt(1+(v1-lc1)*(v1-lc1)/cv12/cv12)); + if(1+(v1-lc1)*(v1-lc1)/cv12/cv12 <1.e-5){ + printf(" Error sqrt of a negative number: %lf\n",1+(v1-lc1)*(v1-lc1)/cv12/cv12); + fprintf(ficlog," Error sqrt of a negative number: %lf\n",1+(v1-lc1)*(v1-lc1)/cv12/cv12); + v11=(1./sqrt(fabs(1+(v1-lc1)*(v1-lc1)/cv12/cv12))); + }else + v11=(1./sqrt(1+(v1-lc1)*(v1-lc1)/cv12/cv12)); /*v21=sqrt(1.-v11*v11); *//* error */ v21=(lc1-v1)/cv12*v11; v12=-v21; @@ -6354,7 +6672,7 @@ To be simple, these graphs help to under fprintf(ficgp,"\nset parametric;unset label"); fprintf(ficgp,"\nset log y;set log x; set xlabel \"p%1d%1d (year-1)\";set ylabel \"p%1d%1d (year-1)\"",k1,l1,k2,l2); fprintf(ficgp,"\nset ter svg size 640, 480"); - fprintf(fichtmcov,"\n
    Ellipsoids of confidence cov(p%1d%1d,p%1d%1d) expressed in year-1\ + fprintf(fichtmcov,"\n


    Ellipsoids of confidence cov(p%1d%1d,p%1d%1d) expressed in year-1\ : \ %s_%d%1d%1d-%1d%1d.svg, ",k1,l1,k2,l2,\ subdirf2(optionfilefiname,"VARPIJGR_"), j1,k1,l1,k2,l2, \ @@ -6365,16 +6683,16 @@ To be simple, these graphs help to under fprintf(ficgp,"\nset label \"%d\" at %11.3e,%11.3e center",(int) age, mu1,mu2); fprintf(ficgp,"\n# Age %d, p%1d%1d - p%1d%1d",(int) age, k1,l1,k2,l2); fprintf(ficgp,"\nplot [-pi:pi] %11.3e+ %.3f*(%11.3e*%11.3e*cos(t)+%11.3e*%11.3e*sin(t)), %11.3e +%.3f*(%11.3e*%11.3e*cos(t)+%11.3e*%11.3e*sin(t)) not", \ - mu1,std,v11,sqrt(lc1),v12,sqrt(lc2), \ - mu2,std,v21,sqrt(lc1),v22,sqrt(lc2)); + mu1,std,v11,sqrt(fabs(lc1)),v12,sqrt(fabs(lc2)), \ + mu2,std,v21,sqrt(fabs(lc1)),v22,sqrt(fabs(lc2))); /* For gnuplot only */ }else{ first=0; fprintf(fichtmcov," %d (%.3f),",(int) age, c12); fprintf(ficgp,"\n# Age %d, p%1d%1d - p%1d%1d",(int) age, k1,l1,k2,l2); fprintf(ficgp,"\nset label \"%d\" at %11.3e,%11.3e center",(int) age, mu1,mu2); fprintf(ficgp,"\nreplot %11.3e+ %.3f*(%11.3e*%11.3e*cos(t)+%11.3e*%11.3e*sin(t)), %11.3e +%.3f*(%11.3e*%11.3e*cos(t)+%11.3e*%11.3e*sin(t)) not", \ - mu1,std,v11,sqrt(lc1),v12,sqrt(lc2), \ - mu2,std,v21,sqrt(lc1),v22,sqrt(lc2)); + mu1,std,v11,sqrt(lc1),v12,sqrt(fabs(lc2)), \ + mu2,std,v21,sqrt(lc1),v22,sqrt(fabs(lc2))); }/* if first */ } /* age mod 5 */ } /* end loop age */ @@ -6403,8 +6721,8 @@ void printinghtml(char fileresu[], char int lastpass, int stepm, int weightopt, char model[],\ int imx,int jmin, int jmax, double jmeanint,char rfileres[],\ int popforecast, int mobilav, int prevfcast, int mobilavproj, int backcast, int estepm , \ - double jprev1, double mprev1,double anprev1, double dateprev1, \ - double jprev2, double mprev2,double anprev2, double dateprev2){ + double jprev1, double mprev1,double anprev1, double dateprev1, double dateproj1, double dateback1, \ + double jprev2, double mprev2,double anprev2, double dateprev2, double dateproj2, double dateback2){ int jj1, k1, i1, cpt, k4, nres; fprintf(fichtm,"

    Age%d%d%d%d
    %d%d%.5f%.0f%.0f%dNaNq%.0f%.0f%d%.5f%.0f%.0f%dNaNq%.0f%.0f%.0f%.0f
    TotNanq%.0f%.0fNanq%.0f%.0f%.5f%.0f%.0f%.5f%.0f%.0f