|
|
| version 1.217, 2015/12/23 17:18:31 | version 1.227, 2016/07/21 08:43:33 |
|---|---|
| Line 1 | Line 1 |
| /* $Id$ | /* $Id$ |
| $State$ | $State$ |
| $Log$ | $Log$ |
| Revision 1.227 2016/07/21 08:43:33 brouard | |
| Summary: 0.99 working (more or less) for Asian Workshop on multitate methods | |
| Revision 1.226 2016/07/12 18:42:34 brouard | |
| Summary: temp | |
| Revision 1.225 2016/07/12 08:40:03 brouard | |
| Summary: saving but not running | |
| Revision 1.224 2016/07/01 13:16:01 brouard | |
| Summary: Fixes | |
| Revision 1.223 2016/02/19 09:23:35 brouard | |
| Summary: temporary | |
| Revision 1.222 2016/02/17 08:14:50 brouard | |
| Summary: Probably last 0.98 stable version 0.98r6 | |
| Revision 1.221 2016/02/15 23:35:36 brouard | |
| Summary: minor bug | |
| Revision 1.219 2016/02/15 00:48:12 brouard | |
| *** empty log message *** | |
| Revision 1.218 2016/02/12 11:29:23 brouard | |
| Summary: 0.99 Back projections | |
| Revision 1.217 2015/12/23 17:18:31 brouard | Revision 1.217 2015/12/23 17:18:31 brouard |
| Summary: Experimental backcast | Summary: Experimental backcast |
| Line 615 | Line 642 |
| Short summary of the programme: | Short summary of the programme: |
| This program computes Healthy Life Expectancies from | This program computes Healthy Life Expectancies or State-specific |
| cross-longitudinal data. Cross-longitudinal data consist in: -1- a | (if states aren't health statuses) Expectancies from |
| first survey ("cross") where individuals from different ages are | cross-longitudinal data. Cross-longitudinal data consist in: |
| 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 | -1- a first survey ("cross") where individuals from different ages |
| second wave of interviews ("longitudinal") which measure each change | are interviewed on their health status or degree of disability (in |
| (if any) in individual health status. Health expectancies are | the case of a health survey which is our main interest) |
| 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 | -2- at least a second wave of interviews ("longitudinal") which |
| Maximum Likelihood of the parameters involved in the model. The | measure each change (if any) in individual health status. Health |
| simplest model is the multinomial logistic model where pij is the | expectancies are computed from the time spent in each health state |
| probability to be observed in state j at the second wave | according to a model. More health states you consider, more time is |
| conditional to be observed in state i at the first wave. Therefore | necessary to reach the Maximum Likelihood of the parameters involved |
| the model is: log(pij/pii)= aij + bij*age+ cij*sex + etc , where | in the model. The simplest model is the multinomial logistic model |
| 'age' is age and 'sex' is a covariate. If you want to have a more | where pij is the probability to be observed in state j at the second |
| complex model than "constant and age", you should modify the program | wave conditional to be observed in state i at the first |
| where the markup *Covariates have to be included here again* invites | wave. Therefore the model is: log(pij/pii)= aij + bij*age+ cij*sex + |
| you to do it. More covariates you add, slower the | 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. | convergence. |
| The advantage of this computer programme, compared to a simple | The advantage of this computer programme, compared to a simple |
| Line 651 | Line 681 |
| hPijx. | hPijx. |
| Also this programme outputs the covariance matrix of the parameters but also | Also this programme outputs the covariance matrix of the parameters but also |
| of the life expectancies. It also computes the period (stable) prevalence. | of the life expectancies. It also computes the period (stable) prevalence. |
| Back prevalence and projections: | |
| - back_prevalence_limit(double *p, double **bprlim, double ageminpar, | |
| double agemaxpar, double ftolpl, int *ncvyearp, double | |
| dateprev1,double dateprev2, int firstpass, int lastpass, int | |
| mobilavproj) | |
| Computes the back prevalence limit for any combination of | |
| covariate values k at any age between ageminpar and agemaxpar and | |
| returns it in **bprlim. In the loops, | |
| - **bprevalim(**bprlim, ***mobaverage, nlstate, *p, age, **oldm, | |
| **savm, **dnewm, **doldm, **dsavm, ftolpl, ncvyearp, k); | |
| - hBijx Back Probability to be in state i at age x-h being in j at x | |
| Computes for any combination of covariates k and any age between bage and fage | |
| 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); | |
| 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. | |
| Returns p3mat[i][j][h] after calling | |
| p3mat[i][j][h]=matprod2(newm, | |
| bmij(pmmij,cov,ncovmodel,x,nlstate,prevacurrent, dnewm, doldm, | |
| dsavm,ij),\ 1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, | |
| oldm); | |
| Important routines | |
| - func (or funcone), computes logit (pij) distinguishing | |
| o fixed variables (single or product dummies or quantitative); | |
| o varying variables by: | |
| (1) wave (single, product dummies, quantitative), | |
| (2) by age (can be month) age (done), age*age (done), age*Vn where Vn can be: | |
| % fixed dummy (treated) or quantitative (not done because time-consuming); | |
| % varying dummy (not done) or quantitative (not done); | |
| - Tricode which tests the modality of dummy variables (in order to warn with wrong or empty modalities) | |
| and returns the number of efficient covariates cptcoveff and modalities nbcode[Tvar[k]][1]= 0 and nbcode[Tvar[k]][2]= 1 usually. | |
| - printinghtml which outputs results like life expectancy in and from a state for a combination of modalities of dummy variables | |
| o There are 2*cptcoveff combinations of (0,1) for cptcoveff variables. Outputting only combinations with people, éliminating 1 1 if | |
| race White (0 0), Black vs White (1 0), Hispanic (0 1) and 1 1 being meaningless. | |
| Authors: Nicolas Brouard (brouard@ined.fr) and Agnès Lièvre (lievre@ined.fr). | Authors: Nicolas Brouard (brouard@ined.fr) and Agnès Lièvre (lievre@ined.fr). |
| Institut national d'études démographiques, Paris. | Institut national d'études démographiques, Paris. |
| Line 713 | Line 791 |
| /* #define DEBUGLINMIN */ | /* #define DEBUGLINMIN */ |
| /* #define DEBUGHESS */ | /* #define DEBUGHESS */ |
| #define DEBUGHESSIJ | #define DEBUGHESSIJ |
| /* #define LINMINORIGINAL /\* Don't use loop on scale in linmin (accepting nan)*\/ */ | /* #define LINMINORIGINAL /\* Don't use loop on scale in linmin (accepting nan) *\/ */ |
| #define POWELL /* Instead of NLOPT */ | #define POWELL /* Instead of NLOPT */ |
| #define POWELLF1F3 /* Skip test */ | #define POWELLNOF3INFF1TEST /* Skip test */ |
| /* #define POWELLORIGINAL /\* Don't use Directest to decide new direction but original Powell test *\/ */ | /* #define POWELLORIGINAL /\* Don't use Directest to decide new direction but original Powell test *\/ */ |
| /* #define MNBRAKORIGINAL /\* Don't use mnbrak fix *\/ */ | /* #define MNBRAKORIGINAL /\* Don't use mnbrak fix *\/ */ |
| Line 723 | Line 801 |
| #include <stdio.h> | #include <stdio.h> |
| #include <stdlib.h> | #include <stdlib.h> |
| #include <string.h> | #include <string.h> |
| #include <ctype.h> | |
| #ifdef _WIN32 | #ifdef _WIN32 |
| #include <io.h> | #include <io.h> |
| Line 789 typedef struct { | Line 868 typedef struct { |
| #define decodtabm(h,k,cptcoveff) (((h-1) >> (k-1)) & 1) +1 | #define decodtabm(h,k,cptcoveff) (((h-1) >> (k-1)) & 1) +1 |
| #define MAXN 20000 | #define MAXN 20000 |
| #define YEARM 12. /**< Number of months per year */ | #define YEARM 12. /**< Number of months per year */ |
| #define AGESUP 130 | /* #define AGESUP 130 */ |
| #define AGESUP 150 | |
| #define AGEMARGE 25 /* Marge for agemin and agemax for(iage=agemin-AGEMARGE; iage <= agemax+3+AGEMARGE; iage++) */ | |
| #define AGEBASE 40 | #define AGEBASE 40 |
| #define AGEOVERFLOW 1.e20 | #define AGEOVERFLOW 1.e20 |
| #define AGEGOMP 10 /**< Minimal age for Gompertz adjustment */ | #define AGEGOMP 10 /**< Minimal age for Gompertz adjustment */ |
| Line 807 typedef struct { | Line 888 typedef struct { |
| /* $State$ */ | /* $State$ */ |
| #include "version.h" | #include "version.h" |
| char version[]=__IMACH_VERSION__; | char version[]=__IMACH_VERSION__; |
| char copyright[]="October 2015,INED-EUROREVES-Institut de longevite-Japan Society for the Promotion of Science (Grant-in-Aid for Scientific Research 25293121), Intel Software 2015"; | 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$ $Date$"; | char fullversion[]="$Revision$ $Date$"; |
| char strstart[80]; | char strstart[80]; |
| char optionfilext[10], optionfilefiname[FILENAMELENGTH]; | char optionfilext[10], optionfilefiname[FILENAMELENGTH]; |
| Line 816 int nagesqr=0, nforce=0; /* nagesqr=1 if | Line 897 int nagesqr=0, nforce=0; /* nagesqr=1 if |
| /* Number of covariates model=V2+V1+ V3*age+V2*V4 */ | /* Number of covariates model=V2+V1+ V3*age+V2*V4 */ |
| int cptcovn=0; /**< cptcovn number of covariates added in the model (excepting constant and age and age*product) */ | int cptcovn=0; /**< cptcovn number of covariates added in the model (excepting constant and age and age*product) */ |
| int cptcovt=0; /**< cptcovt number of covariates added in the model (excepting constant and age) */ | int cptcovt=0; /**< cptcovt number of covariates added in the model (excepting constant and age) */ |
| int cptcovs=0; /**< cptcovs number of simple covariates V2+V1 =2 */ | int cptcovs=0; /**< cptcovs number of simple covariates in the model V2+V1 =2 */ |
| int cptcovsnq=0; /**< cptcovsnq number of simple covariates in the model but non quantitative V2+V1 =2 */ | |
| int cptcovage=0; /**< Number of covariates with age: V3*age only =1 */ | int cptcovage=0; /**< Number of covariates with age: V3*age only =1 */ |
| int cptcovprodnoage=0; /**< Number of covariate products without age */ | int cptcovprodnoage=0; /**< Number of covariate products without age */ |
| int cptcoveff=0; /* Total number of covariates to vary for printing results */ | int cptcoveff=0; /* Total number of covariates to vary for printing results */ |
| int ncoveff=0; /* Total number of effective covariates in the model */ | |
| int nqfveff=0; /**< nqfveff Number of Quantitative Fixed Variables Effective */ | |
| int ntveff=0; /**< ntveff number of effective time varying variables */ | |
| int nqtveff=0; /**< ntqveff number of effective time varying quantitative variables */ | |
| int cptcov=0; /* Working variable */ | int cptcov=0; /* Working variable */ |
| int ncovcombmax=NCOVMAX; /* Maximum calculated number of covariate combination = pow(2, cptcoveff) */ | |
| int npar=NPARMAX; | int npar=NPARMAX; |
| int nlstate=2; /* Number of live states */ | int nlstate=2; /* Number of live states */ |
| int ndeath=1; /* Number of dead states */ | int ndeath=1; /* Number of dead states */ |
| int ncovmodel=0, ncovcol=0; /* Total number of covariables including constant a12*1 +b12*x ncovmodel=2 */ | int ncovmodel=0, ncovcol=0; /* Total number of covariables including constant a12*1 +b12*x ncovmodel=2 */ |
| int nqv=0, ntv=0, nqtv=0; /* Total number of quantitative variables, time variable (dummy), quantitative and time variable */ | |
| int popbased=0; | int popbased=0; |
| int *wav; /* Number of waves for this individuual 0 is possible */ | int *wav; /* Number of waves for this individuual 0 is possible */ |
| Line 843 double jmean=1; /* Mean space between 2 | Line 931 double jmean=1; /* Mean space between 2 |
| double **matprod2(); /* test */ | double **matprod2(); /* test */ |
| double **oldm, **newm, **savm; /* Working pointers to matrices */ | double **oldm, **newm, **savm; /* Working pointers to matrices */ |
| double **oldms, **newms, **savms; /* Fixed working pointers to matrices */ | double **oldms, **newms, **savms; /* Fixed working pointers to matrices */ |
| double **ddnewms, **ddoldms, **ddsavms; /* for freeing later */ | |
| /*FILE *fic ; */ /* Used in readdata only */ | /*FILE *fic ; */ /* Used in readdata only */ |
| FILE *ficpar, *ficparo,*ficres, *ficresp, *ficresphtm, *ficresphtmfr, *ficrespl, *ficresplb,*ficrespij, *ficrespijb, *ficrest,*ficresf, *ficresfb,*ficrespop; | FILE *ficpar, *ficparo,*ficres, *ficresp, *ficresphtm, *ficresphtmfr, *ficrespl, *ficresplb,*ficrespij, *ficrespijb, *ficrest,*ficresf, *ficresfb,*ficrespop; |
| FILE *ficlog, *ficrespow; | FILE *ficlog, *ficrespow; |
| Line 950 int *ncodemaxwundef; /* ncodemax[j]= Nu | Line 1040 int *ncodemaxwundef; /* ncodemax[j]= Nu |
| covariate for which somebody answered including | covariate for which somebody answered including |
| undefined. Usually 3: -1, 0 and 1. */ | undefined. Usually 3: -1, 0 and 1. */ |
| double **agev,*moisnais, *annais, *moisdc, *andc,**mint, **anint; | double **agev,*moisnais, *annais, *moisdc, *andc,**mint, **anint; |
| double **pmmij, ***probs; | double **pmmij, ***probs; /* Global pointer */ |
| double ***mobaverage, ***mobaverages; /* New global variable */ | |
| double *ageexmed,*agecens; | double *ageexmed,*agecens; |
| double dateintmean=0; | double dateintmean=0; |
| Line 960 double *agedc; | Line 1051 double *agedc; |
| double **covar; /**< covar[j,i], value of jth covariate for individual i, | double **covar; /**< covar[j,i], value of jth covariate for individual i, |
| * covar=matrix(0,NCOVMAX,1,n); | * covar=matrix(0,NCOVMAX,1,n); |
| * cov[Tage[kk]+2]=covar[Tvar[Tage[kk]]][i]*age; */ | * cov[Tage[kk]+2]=covar[Tvar[Tage[kk]]][i]*age; */ |
| double **coqvar; /* Fixed quantitative covariate iqv */ | |
| double ***cotvar; /* Time varying covariate itv */ | |
| double ***cotqvar; /* Time varying quantitative covariate itqv */ | |
| double idx; | double idx; |
| int **nbcode, *Tvar; /**< model=V2 => Tvar[1]= 2 */ | int **nbcode, *Tvar; /**< model=V2 => Tvar[1]= 2 */ |
| int *Typevar; /**< 0 for simple covariate (dummy, quantitative, fixed or varying), 1 for age product, 2 for product */ | |
| int *Fixed; /** Fixed[k] 0=fixed, 1 varying, 2 fixed with age product, 3 varying with age product */ | |
| int *Dummy; /** Dummy[k] 0=dummy (0 1), 1 quantitative (single or product without age), 2 dummy with age product, 3 quant with age product */ | |
| int *Tage; | int *Tage; |
| int anyvaryingduminmodel=0; /**< Any varying dummy in Model=1 yes, 0 no, to avoid a loop on waves in freq */ | |
| int *Tmodelind; /** Tmodelind[Tvaraff[3]]=9,Tvaraff[1]@9={4, 3, 1, 0, 0, 0, 0, 0, 0}, model=V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1*/ | |
| int *Ndum; /** Freq of modality (tricode */ | int *Ndum; /** Freq of modality (tricode */ |
| /* int **codtab;*/ /**< codtab=imatrix(1,100,1,10); */ | /* int **codtab;*/ /**< codtab=imatrix(1,100,1,10); */ |
| int **Tvard, *Tprod, cptcovprod, *Tvaraff; | int **Tvard; |
| int *Tprod;/**< Gives the k position of the k1 product */ | |
| int *Tposprod; /**< Gives the k1 product from the k position */ | |
| /* Tprod[k1=1]=3(=V1*V4) for V2+V1+V1*V4+age*V3 | |
| if V2+V1+V1*V4+age*V3+V3*V2 TProd[k1=2]=5 (V3*V2) | |
| Tposprod[k]=k1 , Tposprod[3]=1, Tposprod[5]=2 | |
| */ | |
| int cptcovprod, *Tvaraff, *invalidvarcomb; | |
| double *lsurv, *lpop, *tpop; | double *lsurv, *lpop, *tpop; |
| double ftol=FTOL; /**< Tolerance for computing Max Likelihood */ | double ftol=FTOL; /**< Tolerance for computing Max Likelihood */ |
| Line 1507 double brent(double ax, double bx, doubl | Line 1613 double brent(double ax, double bx, doubl |
| etemp=e; | etemp=e; |
| e=d; | e=d; |
| if (fabs(p) >= fabs(0.5*q*etemp) || p <= q*(a-x) || p >= q*(b-x)) | if (fabs(p) >= fabs(0.5*q*etemp) || p <= q*(a-x) || p >= q*(b-x)) |
| d=CGOLD*(e=(x >= xm ? a-x : b-x)); | d=CGOLD*(e=(x >= xm ? a-x : b-x)); |
| else { | else { |
| d=p/q; | d=p/q; |
| u=x+d; | u=x+d; |
| if (u-a < tol2 || b-u < tol2) | if (u-a < tol2 || b-u < tol2) |
| d=SIGN(tol1,xm-x); | d=SIGN(tol1,xm-x); |
| } | } |
| } else { | } else { |
| d=CGOLD*(e=(x >= xm ? a-x : b-x)); | d=CGOLD*(e=(x >= xm ? a-x : b-x)); |
| Line 1526 double brent(double ax, double bx, doubl | Line 1632 double brent(double ax, double bx, doubl |
| } else { | } else { |
| if (u < x) a=u; else b=u; | if (u < x) a=u; else b=u; |
| if (fu <= fw || w == x) { | if (fu <= fw || w == x) { |
| v=w; | v=w; |
| w=u; | w=u; |
| fv=fw; | fv=fw; |
| fw=fu; | fw=fu; |
| } else if (fu <= fv || v == x || v == w) { | } else if (fu <= fv || v == x || v == w) { |
| v=u; | v=u; |
| fv=fu; | fv=fu; |
| } | } |
| } | } |
| } | } |
| Line 1573 values at the three points, fa, fb , and | Line 1679 values at the three points, fa, fb , and |
| *cx=(*bx)+GOLD*(*bx-*ax); | *cx=(*bx)+GOLD*(*bx-*ax); |
| *fc=(*func)(*cx); | *fc=(*func)(*cx); |
| #ifdef DEBUG | #ifdef DEBUG |
| printf("mnbrak0 *fb=%.12e *fc=%.12e\n",*fb,*fc); | printf("mnbrak0 a=%lf *fa=%lf, b=%lf *fb=%lf, c=%lf *fc=%lf\n",*ax,*fa,*bx,*fb,*cx, *fc); |
| fprintf(ficlog,"mnbrak0 *fb=%.12e *fc=%.12e\n",*fb,*fc); | fprintf(ficlog,"mnbrak0 a=%lf *fa=%lf, b=%lf *fb=%lf, c=%lf *fc=%lf\n",*ax,*fa,*bx,*fb,*cx, *fc); |
| #endif | #endif |
| while (*fb > *fc) { /* Declining a,b,c with fa> fb > fc */ | while (*fb > *fc) { /* Declining a,b,c with fa> fb > fc. If fc=inf it exits and if flat fb=fc it exits too.*/ |
| r=(*bx-*ax)*(*fb-*fc); | r=(*bx-*ax)*(*fb-*fc); |
| q=(*bx-*cx)*(*fb-*fa); | q=(*bx-*cx)*(*fb-*fa); /* What if fa=inf */ |
| u=(*bx)-((*bx-*cx)*q-(*bx-*ax)*r)/ | u=(*bx)-((*bx-*cx)*q-(*bx-*ax)*r)/ |
| (2.0*SIGN(FMAX(fabs(q-r),TINY),q-r)); /* Minimum abscissa of a parabolic estimated from (a,fa), (b,fb) and (c,fc). */ | (2.0*SIGN(FMAX(fabs(q-r),TINY),q-r)); /* Minimum abscissa of a parabolic estimated from (a,fa), (b,fb) and (c,fc). */ |
| ulim=(*bx)+GLIMIT*(*cx-*bx); /* Maximum abscissa where function should be evaluated */ | ulim=(*bx)+GLIMIT*(*cx-*bx); /* Maximum abscissa where function should be evaluated */ |
| Line 1589 values at the three points, fa, fb , and | Line 1695 values at the three points, fa, fb , and |
| double A, fparabu; | double A, fparabu; |
| A= (*fb - *fa)/(*bx-*ax)/(*bx+*ax-2*u); | A= (*fb - *fa)/(*bx-*ax)/(*bx+*ax-2*u); |
| fparabu= *fa - A*(*ax-u)*(*ax-u); | fparabu= *fa - A*(*ax-u)*(*ax-u); |
| printf("mnbrak (*ax=%.12f, *fa=%.12lf), (*bx=%.12f, *fb=%.12lf), (*cx=%.12f, *fc=%.12lf), (*u=%.12f, fu=%.12lf, fparabu=%.12f)\n",*ax,*fa,*bx,*fb,*cx,*fc,u,fu, fparabu); | printf("\nmnbrak (*ax=%.12f, *fa=%.12lf), (*bx=%.12f, *fb=%.12lf), (*cx=%.12f, *fc=%.12lf), (*u=%.12f, fu=%.12lf, fparabu=%.12f, q=%lf < %lf=r)\n",*ax,*fa,*bx,*fb,*cx,*fc,u,fu, fparabu,q,r); |
| fprintf(ficlog, "mnbrak (*ax=%.12f, *fa=%.12lf), (*bx=%.12f, *fb=%.12lf), (*cx=%.12f, *fc=%.12lf), (*u=%.12f, fu=%.12lf, fparabu=%.12f)\n",*ax,*fa,*bx,*fb,*cx,*fc,u,fu, fparabu); | fprintf(ficlog,"\nmnbrak (*ax=%.12f, *fa=%.12lf), (*bx=%.12f, *fb=%.12lf), (*cx=%.12f, *fc=%.12lf), (*u=%.12f, fu=%.12lf, fparabu=%.12f, q=%lf < %lf=r)\n",*ax,*fa,*bx,*fb,*cx,*fc,u,fu, fparabu,q,r); |
| /* And thus,it can be that fu > *fc even if fparabu < *fc */ | /* And thus,it can be that fu > *fc even if fparabu < *fc */ |
| /* mnbrak (*ax=7.666299858533, *fa=299039.693133272231), (*bx=8.595447774979, *fb=298976.598289369489), | /* mnbrak (*ax=7.666299858533, *fa=299039.693133272231), (*bx=8.595447774979, *fb=298976.598289369489), |
| (*cx=10.098840694817, *fc=298946.631474258087), (*u=9.852501168332, fu=298948.773013752128, fparabu=298945.434711494134) */ | (*cx=10.098840694817, *fc=298946.631474258087), (*u=9.852501168332, fu=298948.773013752128, fparabu=298945.434711494134) */ |
| Line 1623 values at the three points, fa, fb , and | Line 1729 values at the three points, fa, fb , and |
| /* fu = *fc; */ | /* fu = *fc; */ |
| /* *fc =dum; */ | /* *fc =dum; */ |
| /* } */ | /* } */ |
| #ifdef DEBUG | #ifdef DEBUGMNBRAK |
| printf("mnbrak34 fu < or >= fc \n"); | double A, fparabu; |
| fprintf(ficlog, "mnbrak34 fu < fc\n"); | A= (*fb - *fa)/(*bx-*ax)/(*bx+*ax-2*u); |
| fparabu= *fa - A*(*ax-u)*(*ax-u); | |
| printf("\nmnbrak35 ax=%lf fa=%lf bx=%lf fb=%lf, u=%lf fp=%lf fu=%lf < or >= fc=%lf cx=%lf, q=%lf < %lf=r \n",*ax, *fa, *bx,*fb,u,fparabu,fu,*fc,*cx,q,r); | |
| fprintf(ficlog,"\nmnbrak35 ax=%lf fa=%lf bx=%lf fb=%lf, u=%lf fp=%lf fu=%lf < or >= fc=%lf cx=%lf, q=%lf < %lf=r \n",*ax, *fa, *bx,*fb,u,fparabu,fu,*fc,*cx,q,r); | |
| #endif | #endif |
| dum=u; /* Shifting c and u */ | dum=u; /* Shifting c and u */ |
| u = *cx; | u = *cx; |
| Line 1636 values at the three points, fa, fb , and | Line 1745 values at the three points, fa, fb , and |
| #endif | #endif |
| } else if ((*cx-u)*(u-ulim) > 0.0) { /* u is after c but before ulim */ | } else if ((*cx-u)*(u-ulim) > 0.0) { /* u is after c but before ulim */ |
| #ifdef DEBUG | #ifdef DEBUG |
| printf("mnbrak2 u after c but before ulim\n"); | printf("\nmnbrak2 u=%lf after c=%lf but before ulim\n",u,*cx); |
| fprintf(ficlog, "mnbrak2 u after c but before ulim\n"); | fprintf(ficlog,"\nmnbrak2 u=%lf after c=%lf but before ulim\n",u,*cx); |
| #endif | #endif |
| fu=(*func)(u); | fu=(*func)(u); |
| if (fu < *fc) { | if (fu < *fc) { |
| #ifdef DEBUG | #ifdef DEBUG |
| printf("mnbrak2 u after c but before ulim AND fu < fc\n"); | printf("\nmnbrak2 u=%lf after c=%lf but before ulim=%lf AND fu=%lf < %lf=fc\n",u,*cx,ulim,fu, *fc); |
| fprintf(ficlog, "mnbrak2 u after c but before ulim AND fu <fc \n"); | fprintf(ficlog,"\nmnbrak2 u=%lf after c=%lf but before ulim=%lf AND fu=%lf < %lf=fc\n",u,*cx,ulim,fu, *fc); |
| #endif | |
| SHFT(*bx,*cx,u,*cx+GOLD*(*cx-*bx)) | |
| SHFT(*fb,*fc,fu,(*func)(u)) | |
| #ifdef DEBUG | |
| printf("\nmnbrak2 shift GOLD c=%lf",*cx+GOLD*(*cx-*bx)); | |
| #endif | #endif |
| SHFT(*bx,*cx,u,*cx+GOLD*(*cx-*bx)) | |
| SHFT(*fb,*fc,fu,(*func)(u)) | |
| } | } |
| } else if ((u-ulim)*(ulim-*cx) >= 0.0) { /* u outside ulim (verifying that ulim is beyond c) */ | } else if ((u-ulim)*(ulim-*cx) >= 0.0) { /* u outside ulim (verifying that ulim is beyond c) */ |
| #ifdef DEBUG | #ifdef DEBUG |
| printf("mnbrak2 u outside ulim (verifying that ulim is beyond c)\n"); | printf("\nmnbrak2 u=%lf outside ulim=%lf (verifying that ulim is beyond c=%lf)\n",u,ulim,*cx); |
| fprintf(ficlog, "mnbrak2 u outside ulim (verifying that ulim is beyond c)\n"); | fprintf(ficlog,"\nmnbrak2 u=%lf outside ulim=%lf (verifying that ulim is beyond c=%lf)\n",u,ulim,*cx); |
| #endif | #endif |
| u=ulim; | u=ulim; |
| fu=(*func)(u); | fu=(*func)(u); |
| } else { /* u could be left to b (if r > q parabola has a maximum) */ | } else { /* u could be left to b (if r > q parabola has a maximum) */ |
| #ifdef DEBUG | #ifdef DEBUG |
| printf("mnbrak2 u could be left to b (if r > q parabola has a maximum)\n"); | printf("\nmnbrak2 u=%lf could be left to b=%lf (if r=%lf > q=%lf parabola has a maximum)\n",u,*bx,r,q); |
| fprintf(ficlog, "mnbrak2 u could be left to b (if r > q parabola has a maximum)\n"); | fprintf(ficlog,"\nmnbrak2 u=%lf could be left to b=%lf (if r=%lf > q=%lf parabola has a maximum)\n",u,*bx,r,q); |
| #endif | #endif |
| u=(*cx)+GOLD*(*cx-*bx); | u=(*cx)+GOLD*(*cx-*bx); |
| fu=(*func)(u); | fu=(*func)(u); |
| #ifdef DEBUG | |
| printf("\nmnbrak2 new u=%lf fu=%lf shifted gold left from c=%lf and b=%lf \n",u,fu,*cx,*bx); | |
| fprintf(ficlog,"\nmnbrak2 new u=%lf fu=%lf shifted gold left from c=%lf and b=%lf \n",u,fu,*cx,*bx); | |
| #endif | |
| } /* end tests */ | } /* end tests */ |
| SHFT(*ax,*bx,*cx,u) | SHFT(*ax,*bx,*cx,u) |
| SHFT(*fa,*fb,*fc,fu) | SHFT(*fa,*fb,*fc,fu) |
| #ifdef DEBUG | #ifdef DEBUG |
| printf("mnbrak2 (*ax=%.12f, *fa=%.12lf), (*bx=%.12f, *fb=%.12lf), (*cx=%.12f, *fc=%.12lf), (*u=%.12f, fu=%.12lf)\n",*ax,*fa,*bx,*fb,*cx,*fc,u,fu); | printf("\nmnbrak2 shift (*ax=%.12f, *fa=%.12lf), (*bx=%.12f, *fb=%.12lf), (*cx=%.12f, *fc=%.12lf)\n",*ax,*fa,*bx,*fb,*cx,*fc); |
| fprintf(ficlog, "mnbrak2 (*ax=%.12f, *fa=%.12lf), (*bx=%.12f, *fb=%.12lf), (*cx=%.12f, *fc=%.12lf), (*u=%.12f, fu=%.12lf)\n",*ax,*fa,*bx,*fb,*cx,*fc,u,fu); | fprintf(ficlog, "\nmnbrak2 shift (*ax=%.12f, *fa=%.12lf), (*bx=%.12f, *fb=%.12lf), (*cx=%.12f, *fc=%.12lf)\n",*ax,*fa,*bx,*fb,*cx,*fc); |
| #endif | #endif |
| } /* end while; ie return (a, b, c, fa, fb, fc) such that a < b < c with f(a) > f(b) and fb < f(c) */ | } /* end while; ie return (a, b, c, fa, fb, fc) such that a < b < c with f(a) > f(b) and fb < f(c) */ |
| } | } |
| Line 1682 int ncom; | Line 1798 int ncom; |
| double *pcom,*xicom; | double *pcom,*xicom; |
| double (*nrfunc)(double []); | double (*nrfunc)(double []); |
| #ifdef LINMINORIGINAL | |
| void linmin(double p[], double xi[], int n, double *fret,double (*func)(double [])) | void linmin(double p[], double xi[], int n, double *fret,double (*func)(double [])) |
| #else | |
| void linmin(double p[], double xi[], int n, double *fret,double (*func)(double []), int *flat) | |
| #endif | |
| { | { |
| double brent(double ax, double bx, double cx, | double brent(double ax, double bx, double cx, |
| double (*f)(double), double tol, double *xmin); | double (*f)(double), double tol, double *xmin); |
| Line 1726 void linmin(double p[], double xi[], int | Line 1846 void linmin(double p[], double xi[], int |
| #ifdef LINMINORIGINAL | #ifdef LINMINORIGINAL |
| #else | #else |
| if (fx != fx){ | if (fx != fx){ |
| xxs=xxs/scale; /* Trying a smaller xx, closer to initial ax=0 */ | xxs=xxs/scale; /* Trying a smaller xx, closer to initial ax=0 */ |
| printf("|"); | printf("|"); |
| fprintf(ficlog,"|"); | fprintf(ficlog,"|"); |
| #ifdef DEBUGLINMIN | #ifdef DEBUGLINMIN |
| printf("\nLinmin NAN : input [axs=%lf:xxs=%lf], mnbrak outputs fx=%lf <(fb=%lf and fa=%lf) with xx=%lf in [ax=%lf:bx=%lf] \n", axs, xxs, fx,fb, fa, xx, ax, bx); | printf("\nLinmin NAN : input [axs=%lf:xxs=%lf], mnbrak outputs fx=%lf <(fb=%lf and fa=%lf) with xx=%lf in [ax=%lf:bx=%lf] \n", axs, xxs, fx,fb, fa, xx, ax, bx); |
| #endif | #endif |
| } | } |
| }while(fx != fx); | }while(fx != fx && xxs > 1.e-5); |
| #endif | #endif |
| #ifdef DEBUGLINMIN | #ifdef DEBUGLINMIN |
| printf("\nLinmin after mnbrak: ax=%12.7f xx=%12.7f bx=%12.7f fa=%12.2f fx=%12.2f fb=%12.2f\n", ax,xx,bx,fa,fx,fb); | printf("\nLinmin after mnbrak: ax=%12.7f xx=%12.7f bx=%12.7f fa=%12.2f fx=%12.2f fb=%12.2f\n", ax,xx,bx,fa,fx,fb); |
| fprintf(ficlog,"\nLinmin after mnbrak: ax=%12.7f xx=%12.7f bx=%12.7f fa=%12.2f fx=%12.2f fb=%12.2f\n", ax,xx,bx,fa,fx,fb); | fprintf(ficlog,"\nLinmin after mnbrak: ax=%12.7f xx=%12.7f bx=%12.7f fa=%12.2f fx=%12.2f fb=%12.2f\n", ax,xx,bx,fa,fx,fb); |
| #endif | #endif |
| #ifdef LINMINORIGINAL | |
| #else | |
| if(fb == fx){ /* Flat function in the direction */ | |
| xmin=xx; | |
| *flat=1; | |
| }else{ | |
| *flat=0; | |
| #endif | |
| /*Flat mnbrak2 shift (*ax=0.000000000000, *fa=51626.272983130431), (*bx=-1.618034000000, *fb=51590.149499362531), (*cx=-4.236068025156, *fc=51590.149499362531) */ | |
| *fret=brent(ax,xx,bx,f1dim,TOL,&xmin); /* Giving a bracketting triplet (ax, xx, bx), find a minimum, xmin, according to f1dim, *fret(xmin),*/ | *fret=brent(ax,xx,bx,f1dim,TOL,&xmin); /* Giving a bracketting triplet (ax, xx, bx), find a minimum, xmin, according to f1dim, *fret(xmin),*/ |
| /* fa = f(p[j] + ax * xi[j]), fx = f(p[j] + xx * xi[j]), fb = f(p[j] + bx * xi[j]) */ | /* fa = f(p[j] + ax * xi[j]), fx = f(p[j] + xx * xi[j]), fb = f(p[j] + bx * xi[j]) */ |
| /* fmin = f(p[j] + xmin * xi[j]) */ | /* fmin = f(p[j] + xmin * xi[j]) */ |
| /* P+lambda n in that direction (lambdamin), with TOL between abscisses */ | /* P+lambda n in that direction (lambdamin), with TOL between abscisses */ |
| /* f1dim(xmin): for (j=1;j<=ncom;j++) xt[j]=pcom[j]+xmin*xicom[j]; */ | /* f1dim(xmin): for (j=1;j<=ncom;j++) xt[j]=pcom[j]+xmin*xicom[j]; */ |
| #ifdef DEBUG | #ifdef DEBUG |
| printf("retour brent fret=%.12e xmin=%.12e\n",*fret,xmin); | printf("retour brent from bracket (a=%lf fa=%lf, xx=%lf fx=%lf, b=%lf fb=%lf): fret=%lf xmin=%lf\n",ax,fa,xx,fx,bx,fb,*fret,xmin); |
| fprintf(ficlog,"retour brent fret=%.12e xmin=%.12e\n",*fret,xmin); | fprintf(ficlog,"retour brent from bracket (a=%lf fa=%lf, xx=%lf fx=%lf, b=%lf fb=%lf): fret=%lf xmin=%lf\n",ax,fa,xx,fx,bx,fb,*fret,xmin); |
| #endif | |
| #ifdef LINMINORIGINAL | |
| #else | |
| } | |
| #endif | #endif |
| #ifdef DEBUGLINMIN | #ifdef DEBUGLINMIN |
| printf("linmin end "); | printf("linmin end "); |
| Line 1797 such that failure to decrease by more th | Line 1930 such that failure to decrease by more th |
| output, p is set to the best point found, xi is the then-current direction set, fret is the returned | output, p is set to the best point found, xi is the then-current direction set, fret is the returned |
| function value at p , and iter is the number of iterations taken. The routine linmin is used. | function value at p , and iter is the number of iterations taken. The routine linmin is used. |
| */ | */ |
| #ifdef LINMINORIGINAL | |
| #else | |
| int *flatdir; /* Function is vanishing in that direction */ | |
| int flat=0, flatd=0; /* Function is vanishing in that direction */ | |
| #endif | |
| void powell(double p[], double **xi, int n, double ftol, int *iter, double *fret, | void powell(double p[], double **xi, int n, double ftol, int *iter, double *fret, |
| double (*func)(double [])) | double (*func)(double [])) |
| { | { |
| void linmin(double p[], double xi[], int n, double *fret, | #ifdef LINMINORIGINAL |
| void linmin(double p[], double xi[], int n, double *fret, | |
| double (*func)(double [])); | double (*func)(double [])); |
| #else | |
| void linmin(double p[], double xi[], int n, double *fret, | |
| double (*func)(double []),int *flat); | |
| #endif | |
| int i,ibig,j; | int i,ibig,j; |
| double del,t,*pt,*ptt,*xit; | double del,t,*pt,*ptt,*xit; |
| double directest; | double directest; |
| double fp,fptt; | double fp,fptt; |
| double *xits; | double *xits; |
| int niterf, itmp; | int niterf, itmp; |
| #ifdef LINMINORIGINAL | |
| #else | |
| flatdir=ivector(1,n); | |
| for (j=1;j<=n;j++) flatdir[j]=0; | |
| #endif | |
| pt=vector(1,n); | pt=vector(1,n); |
| ptt=vector(1,n); | ptt=vector(1,n); |
| Line 1841 void powell(double p[], double **xi, int | Line 1990 void powell(double p[], double **xi, int |
| rforecast_time=rcurr_time; | rforecast_time=rcurr_time; |
| itmp = strlen(strcurr); | itmp = strlen(strcurr); |
| if(strcurr[itmp-1]=='\n') /* Windows outputs with a new line */ | if(strcurr[itmp-1]=='\n') /* Windows outputs with a new line */ |
| strcurr[itmp-1]='\0'; | strcurr[itmp-1]='\0'; |
| printf("\nConsidering the time needed for the last iteration #%d: %ld seconds,\n",*iter,rcurr_time-rlast_time); | printf("\nConsidering the time needed for the last iteration #%d: %ld seconds,\n",*iter,rcurr_time-rlast_time); |
| fprintf(ficlog,"\nConsidering the time needed for this last iteration #%d: %ld seconds,\n",*iter,rcurr_time-rlast_time); | fprintf(ficlog,"\nConsidering the time needed for this last iteration #%d: %ld seconds,\n",*iter,rcurr_time-rlast_time); |
| for(niterf=10;niterf<=30;niterf+=10){ | for(niterf=10;niterf<=30;niterf+=10){ |
| rforecast_time=rcurr_time+(niterf-*iter)*(rcurr_time-rlast_time); | rforecast_time=rcurr_time+(niterf-*iter)*(rcurr_time-rlast_time); |
| forecast_time = *localtime(&rforecast_time); | forecast_time = *localtime(&rforecast_time); |
| strcpy(strfor,asctime(&forecast_time)); | strcpy(strfor,asctime(&forecast_time)); |
| itmp = strlen(strfor); | itmp = strlen(strfor); |
| if(strfor[itmp-1]=='\n') | if(strfor[itmp-1]=='\n') |
| strfor[itmp-1]='\0'; | strfor[itmp-1]='\0'; |
| printf(" - if your program needs %d iterations to converge, convergence will be \n reached in %s i.e.\n on %s (current time is %s);\n",niterf, asc_diff_time(rforecast_time-rcurr_time,tmpout),strfor,strcurr); | printf(" - if your program needs %d iterations to converge, convergence will be \n reached in %s i.e.\n on %s (current time is %s);\n",niterf, asc_diff_time(rforecast_time-rcurr_time,tmpout),strfor,strcurr); |
| fprintf(ficlog," - if your program needs %d iterations to converge, convergence will be \n reached in %s i.e.\n on %s (current time is %s);\n",niterf, asc_diff_time(rforecast_time-rcurr_time,tmpout),strfor,strcurr); | fprintf(ficlog," - if your program needs %d iterations to converge, convergence will be \n reached in %s i.e.\n on %s (current time is %s);\n",niterf, asc_diff_time(rforecast_time-rcurr_time,tmpout),strfor,strcurr); |
| } | } |
| } | } |
| for (i=1;i<=n;i++) { /* For each direction i */ | for (i=1;i<=n;i++) { /* For each direction i */ |
| Line 1864 void powell(double p[], double **xi, int | Line 2013 void powell(double p[], double **xi, int |
| #endif | #endif |
| printf("%d",i);fflush(stdout); /* print direction (parameter) i */ | printf("%d",i);fflush(stdout); /* print direction (parameter) i */ |
| fprintf(ficlog,"%d",i);fflush(ficlog); | fprintf(ficlog,"%d",i);fflush(ficlog); |
| #ifdef LINMINORIGINAL | |
| linmin(p,xit,n,fret,func); /* Point p[n]. xit[n] has been loaded for direction i as input.*/ | linmin(p,xit,n,fret,func); /* Point p[n]. xit[n] has been loaded for direction i as input.*/ |
| /* Outputs are fret(new point p) p is updated and xit rescaled */ | #else |
| linmin(p,xit,n,fret,func,&flat); /* Point p[n]. xit[n] has been loaded for direction i as input.*/ | |
| flatdir[i]=flat; /* Function is vanishing in that direction i */ | |
| #endif | |
| /* Outputs are fret(new point p) p is updated and xit rescaled */ | |
| if (fabs(fptt-(*fret)) > del) { /* We are keeping the max gain on each of the n directions */ | if (fabs(fptt-(*fret)) > del) { /* We are keeping the max gain on each of the n directions */ |
| /* because that direction will be replaced unless the gain del is small */ | /* because that direction will be replaced unless the gain del is small */ |
| /* in comparison with the 'probable' gain, mu^2, with the last average direction. */ | /* in comparison with the 'probable' gain, mu^2, with the last average direction. */ |
| /* Unless the n directions are conjugate some gain in the determinant may be obtained */ | /* Unless the n directions are conjugate some gain in the determinant may be obtained */ |
| /* with the new direction. */ | /* with the new direction. */ |
| del=fabs(fptt-(*fret)); | del=fabs(fptt-(*fret)); |
| ibig=i; | ibig=i; |
| } | } |
| #ifdef DEBUG | #ifdef DEBUG |
| printf("%d %.12e",i,(*fret)); | printf("%d %.12e",i,(*fret)); |
| fprintf(ficlog,"%d %.12e",i,(*fret)); | fprintf(ficlog,"%d %.12e",i,(*fret)); |
| for (j=1;j<=n;j++) { | for (j=1;j<=n;j++) { |
| xits[j]=FMAX(fabs(p[j]-pt[j]),1.e-5); | xits[j]=FMAX(fabs(p[j]-pt[j]),1.e-5); |
| printf(" x(%d)=%.12e",j,xit[j]); | printf(" x(%d)=%.12e",j,xit[j]); |
| fprintf(ficlog," x(%d)=%.12e",j,xit[j]); | fprintf(ficlog," x(%d)=%.12e",j,xit[j]); |
| } | } |
| for(j=1;j<=n;j++) { | for(j=1;j<=n;j++) { |
| printf(" p(%d)=%.12e",j,p[j]); | printf(" p(%d)=%.12e",j,p[j]); |
| fprintf(ficlog," p(%d)=%.12e",j,p[j]); | fprintf(ficlog," p(%d)=%.12e",j,p[j]); |
| } | } |
| printf("\n"); | printf("\n"); |
| fprintf(ficlog,"\n"); | fprintf(ficlog,"\n"); |
| Line 1893 void powell(double p[], double **xi, int | Line 2047 void powell(double p[], double **xi, int |
| /* Convergence test will use last linmin estimation (fret) and compare former iteration (fp) */ | /* Convergence test will use last linmin estimation (fret) and compare former iteration (fp) */ |
| /* But p and xit have been updated at the end of linmin, *fret corresponds to new p, xit */ | /* But p and xit have been updated at the end of linmin, *fret corresponds to new p, xit */ |
| /* New value of last point Pn is not computed, P(n-1) */ | /* New value of last point Pn is not computed, P(n-1) */ |
| for(j=1;j<=n;j++) { | |
| if(flatdir[j] >0){ | |
| printf(" p(%d)=%lf flat=%d ",j,p[j],flatdir[j]); | |
| fprintf(ficlog," p(%d)=%lf flat=%d ",j,p[j],flatdir[j]); | |
| } | |
| /* printf("\n"); */ | |
| /* fprintf(ficlog,"\n"); */ | |
| } | |
| if (2.0*fabs(fp-(*fret)) <= ftol*(fabs(fp)+fabs(*fret))) { /* Did we reach enough precision? */ | if (2.0*fabs(fp-(*fret)) <= ftol*(fabs(fp)+fabs(*fret))) { /* Did we reach enough precision? */ |
| /* We could compare with a chi^2. chisquare(0.95,ddl=1)=3.84 */ | /* We could compare with a chi^2. chisquare(0.95,ddl=1)=3.84 */ |
| /* By adding age*age in a model, the new -2LL should be lower and the difference follows a */ | /* By adding age*age in a model, the new -2LL should be lower and the difference follows a */ |
| Line 1901 void powell(double p[], double **xi, int | Line 2063 void powell(double p[], double **xi, int |
| /* By adding age*age and V1*age the gain (-2LL) should be more than 5.99 (ddl=2) */ | /* By adding age*age and V1*age the gain (-2LL) should be more than 5.99 (ddl=2) */ |
| /* By using V1+V2+V3, the gain should be 7.82, compared with basic 1+age. */ | /* By using V1+V2+V3, the gain should be 7.82, compared with basic 1+age. */ |
| /* By adding 10 parameters more the gain should be 18.31 */ | /* By adding 10 parameters more the gain should be 18.31 */ |
| /* Starting the program with initial values given by a former maximization will simply change */ | /* Starting the program with initial values given by a former maximization will simply change */ |
| /* the scales of the directions and the directions, because the are reset to canonical directions */ | /* the scales of the directions and the directions, because the are reset to canonical directions */ |
| /* Thus the first calls to linmin will give new points and better maximizations until fp-(*fret) is */ | /* Thus the first calls to linmin will give new points and better maximizations until fp-(*fret) is */ |
| Line 1929 void powell(double p[], double **xi, int | Line 2091 void powell(double p[], double **xi, int |
| } | } |
| #endif | #endif |
| #ifdef LINMINORIGINAL | |
| #else | |
| free_ivector(flatdir,1,n); | |
| #endif | |
| free_vector(xit,1,n); | free_vector(xit,1,n); |
| free_vector(xits,1,n); | free_vector(xits,1,n); |
| free_vector(ptt,1,n); | free_vector(ptt,1,n); |
| Line 1943 void powell(double p[], double **xi, int | Line 2108 void powell(double p[], double **xi, int |
| pt[j]=p[j]; | pt[j]=p[j]; |
| } | } |
| fptt=(*func)(ptt); /* f_3 */ | fptt=(*func)(ptt); /* f_3 */ |
| #ifdef POWELLF1F3 | #ifdef NODIRECTIONCHANGEDUNTILNITER /* No change in drections until some iterations are done */ |
| if (*iter <=4) { | |
| #else | |
| #endif | |
| #ifdef POWELLNOF3INFF1TEST /* skips test F3 <F1 */ | |
| #else | #else |
| if (fptt < fp) { /* If extrapolated point is better, decide if we keep that new direction or not */ | if (fptt < fp) { /* If extrapolated point is better, decide if we keep that new direction or not */ |
| #endif | #endif |
| Line 1952 void powell(double p[], double **xi, int | Line 2121 void powell(double p[], double **xi, int |
| /* Let f"(x2) be the 2nd derivative equal everywhere. */ | /* Let f"(x2) be the 2nd derivative equal everywhere. */ |
| /* Then the parabolic through (x1,f1), (x2,f2) and (x3,f3) */ | /* Then the parabolic through (x1,f1), (x2,f2) and (x3,f3) */ |
| /* will reach at f3 = fm + h^2/2 f"m ; f" = (f1 -2f2 +f3 ) / h**2 */ | /* will reach at f3 = fm + h^2/2 f"m ; f" = (f1 -2f2 +f3 ) / h**2 */ |
| /* Conditional for using this new direction is that mu^2 = (f1-2f2+f3)^2 /2 < del */ | /* Conditional for using this new direction is that mu^2 = (f1-2f2+f3)^2 /2 < del or directest <0 */ |
| /* also lamda^2=(f1-f2)^2/mu² is a parasite solution of powell */ | |
| /* For powell, inclusion of this average direction is only if t(del)<0 or del inbetween mu^2 and lambda^2 */ | |
| /* t=2.0*(fp-2.0*(*fret)+fptt)*SQR(fp-(*fret)-del)-del*SQR(fp-fptt); */ | /* t=2.0*(fp-2.0*(*fret)+fptt)*SQR(fp-(*fret)-del)-del*SQR(fp-fptt); */ |
| /* Even if f3 <f1, directest can be negative and t >0 */ | |
| /* mu² and del² are equal when f3=f1 */ | |
| /* f3 < f1 : mu² < del <= lambda^2 both test are equivalent */ | |
| /* f3 < f1 : mu² < lambda^2 < del then directtest is negative and powell t is positive */ | |
| /* f3 > f1 : lambda² < mu^2 < del then t is negative and directest >0 */ | |
| /* f3 > f1 : lambda² < del < mu^2 then t is positive and directest >0 */ | |
| #ifdef NRCORIGINAL | #ifdef NRCORIGINAL |
| t=2.0*(fp-2.0*(*fret)+fptt)*SQR(fp-(*fret)-del)- del*SQR(fp-fptt); /* Original Numerical Recipes in C*/ | t=2.0*(fp-2.0*(*fret)+fptt)*SQR(fp-(*fret)-del)- del*SQR(fp-fptt); /* Original Numerical Recipes in C*/ |
| #else | #else |
| Line 1975 void powell(double p[], double **xi, int | Line 2152 void powell(double p[], double **xi, int |
| if (t < 0.0) { /* Then we use it for new direction */ | if (t < 0.0) { /* Then we use it for new direction */ |
| #else | #else |
| if (directest*t < 0.0) { /* Contradiction between both tests */ | if (directest*t < 0.0) { /* Contradiction between both tests */ |
| printf("directest= %.12lf (if <0 we include P0 Pn as new direction), t= %.12lf, f1= %.12lf,f2= %.12lf,f3= %.12lf, del= %.12lf\n",directest, t, fp,(*fret),fptt,del); | printf("directest= %.12lf (if <0 we include P0 Pn as new direction), t= %.12lf, f1= %.12lf,f2= %.12lf,f3= %.12lf, del= %.12lf\n",directest, t, fp,(*fret),fptt,del); |
| printf("f1-2f2+f3= %.12lf, f1-f2-del= %.12lf, f1-f3= %.12lf\n",fp-2.0*(*fret)+fptt, fp -(*fret) -del, fp-fptt); | printf("f1-2f2+f3= %.12lf, f1-f2-del= %.12lf, f1-f3= %.12lf\n",fp-2.0*(*fret)+fptt, fp -(*fret) -del, fp-fptt); |
| fprintf(ficlog,"directest= %.12lf (if <0 we include P0 Pn as new direction), t= %.12lf, f1= %.12lf,f2= %.12lf,f3= %.12lf, del= %.12lf\n",directest, t, fp,(*fret),fptt, del); | fprintf(ficlog,"directest= %.12lf (if directest<0 or t<0 we include P0 Pn as new direction), t= %.12lf, f1= %.12lf,f2= %.12lf,f3= %.12lf, del= %.12lf\n",directest, t, fp,(*fret),fptt, del); |
| fprintf(ficlog,"f1-2f2+f3= %.12lf, f1-f2-del= %.12lf, f1-f3= %.12lf\n",fp-2.0*(*fret)+fptt, fp -(*fret) -del, fp-fptt); | fprintf(ficlog,"f1-2f2+f3= %.12lf, f1-f2-del= %.12lf, f1-f3= %.12lf\n",fp-2.0*(*fret)+fptt, fp -(*fret) -del, fp-fptt); |
| } | } |
| if (directest < 0.0) { /* Then we use it for new direction */ | if (directest < 0.0) { /* Then we use it for new direction */ |
| #endif | #endif |
| #ifdef DEBUGLINMIN | #ifdef DEBUGLINMIN |
| printf("Before linmin in direction P%d-P0\n",n); | printf("Before linmin in direction P%d-P0\n",n); |
| for (j=1;j<=n;j++) { | for (j=1;j<=n;j++) { |
| printf(" Before xit[%d]= %12.7f p[%d]= %12.7f",j,xit[j],j,p[j]); | printf(" Before xit[%d]= %12.7f p[%d]= %12.7f",j,xit[j],j,p[j]); |
| fprintf(ficlog," Before xit[%d]= %12.7f p[%d]= %12.7f",j,xit[j],j,p[j]); | fprintf(ficlog," Before xit[%d]= %12.7f p[%d]= %12.7f",j,xit[j],j,p[j]); |
| if(j % ncovmodel == 0){ | if(j % ncovmodel == 0){ |
| printf("\n"); | printf("\n"); |
| fprintf(ficlog,"\n"); | fprintf(ficlog,"\n"); |
| } | } |
| } | } |
| #endif | #endif |
| linmin(p,xit,n,fret,func); /* computes minimum on the extrapolated direction: changes p and rescales xit.*/ | #ifdef LINMINORIGINAL |
| #ifdef DEBUGLINMIN | linmin(p,xit,n,fret,func); /* computes minimum on the extrapolated direction: changes p and rescales xit.*/ |
| for (j=1;j<=n;j++) { | #else |
| printf("After xit[%d]= %12.7f p[%d]= %12.7f",j,xit[j],j,p[j]); | linmin(p,xit,n,fret,func,&flat); /* computes minimum on the extrapolated direction: changes p and rescales xit.*/ |
| fprintf(ficlog,"After xit[%d]= %12.7f p[%d]= %12.7f",j,xit[j],j,p[j]); | flatdir[i]=flat; /* Function is vanishing in that direction i */ |
| if(j % ncovmodel == 0){ | |
| printf("\n"); | |
| fprintf(ficlog,"\n"); | |
| } | |
| } | |
| #endif | #endif |
| for (j=1;j<=n;j++) { | |
| xi[j][ibig]=xi[j][n]; /* Replace direction with biggest decrease by last direction n */ | |
| xi[j][n]=xit[j]; /* and this nth direction by the by the average p_0 p_n */ | |
| } | |
| printf("Gaining to use new average direction of P0 P%d instead of biggest increase direction %d :\n",n,ibig); | |
| fprintf(ficlog,"Gaining to use new average direction of P0 P%d instead of biggest increase direction %d :\n",n,ibig); | |
| #ifdef DEBUGLINMIN | |
| for (j=1;j<=n;j++) { | |
| printf("After xit[%d]= %12.7f p[%d]= %12.7f",j,xit[j],j,p[j]); | |
| fprintf(ficlog,"After xit[%d]= %12.7f p[%d]= %12.7f",j,xit[j],j,p[j]); | |
| if(j % ncovmodel == 0){ | |
| printf("\n"); | |
| fprintf(ficlog,"\n"); | |
| } | |
| } | |
| #endif | |
| for (j=1;j<=n;j++) { | |
| xi[j][ibig]=xi[j][n]; /* Replace direction with biggest decrease by last direction n */ | |
| xi[j][n]=xit[j]; /* and this nth direction by the by the average p_0 p_n */ | |
| } | |
| #ifdef LINMINORIGINAL | |
| #else | |
| for (j=1, flatd=0;j<=n;j++) { | |
| if(flatdir[j]>0) | |
| flatd++; | |
| } | |
| if(flatd >0){ | |
| printf("%d flat directions\n",flatd); | |
| fprintf(ficlog,"%d flat directions\n",flatd); | |
| for (j=1;j<=n;j++) { | |
| if(flatdir[j]>0){ | |
| printf("%d ",j); | |
| fprintf(ficlog,"%d ",j); | |
| } | |
| } | |
| printf("\n"); | |
| fprintf(ficlog,"\n"); | |
| } | |
| #endif | |
| printf("Gaining to use new average direction of P0 P%d instead of biggest increase direction %d :\n",n,ibig); | |
| fprintf(ficlog,"Gaining to use new average direction of P0 P%d instead of biggest increase direction %d :\n",n,ibig); | |
| #ifdef DEBUG | #ifdef DEBUG |
| printf("Direction changed last moved %d in place of ibig=%d, new last is the average:\n",n,ibig); | printf("Direction changed last moved %d in place of ibig=%d, new last is the average:\n",n,ibig); |
| fprintf(ficlog,"Direction changed last moved %d in place of ibig=%d, new last is the average:\n",n,ibig); | fprintf(ficlog,"Direction changed last moved %d in place of ibig=%d, new last is the average:\n",n,ibig); |
| for(j=1;j<=n;j++){ | for(j=1;j<=n;j++){ |
| printf(" %.12e",xit[j]); | printf(" %lf",xit[j]); |
| fprintf(ficlog," %.12e",xit[j]); | fprintf(ficlog," %lf",xit[j]); |
| } | } |
| printf("\n"); | printf("\n"); |
| fprintf(ficlog,"\n"); | fprintf(ficlog,"\n"); |
| #endif | #endif |
| } /* end of t or directest negative */ | } /* end of t or directest negative */ |
| #ifdef POWELLF1F3 | #ifdef POWELLNOF3INFF1TEST |
| #else | #else |
| } /* end if (fptt < fp) */ | } /* end if (fptt < fp) */ |
| #endif | #endif |
| #ifdef NODIRECTIONCHANGEDUNTILNITER /* No change in drections until some iterations are done */ | |
| } /*NODIRECTIONCHANGEDUNTILNITER No change in drections until some iterations are done */ | |
| #else | |
| #endif | |
| } /* loop iteration */ | } /* loop iteration */ |
| } | } |
| Line 2033 void powell(double p[], double **xi, int | Line 2239 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) | double **prevalim(double **prlim, int nlstate, double x[], double age, double **oldm, double **savm, double ftolpl, int *ncvyear, int ij) |
| { | { |
| /* Computes the prevalence limit in each live state at age x by left multiplying the unit | /* Computes the prevalence limit in each live state at age x and for covariate ij by left multiplying the unit |
| matrix by transitions matrix until convergence is reached with precision ftolpl */ | 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= 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 */ | /* Wx is row vector: population in state 1, population in state 2, population dead */ |
| Line 2056 double **prevalim(double **prlim, int nl | Line 2262 double **prevalim(double **prlim, int nl |
| int i, ii,j,k; | int i, ii,j,k; |
| double *min, *max, *meandiff, maxmax,sumnew=0.; | double *min, *max, *meandiff, maxmax,sumnew=0.; |
| /* double **matprod2(); */ /* test */ | /* double **matprod2(); */ /* test */ |
| double **out, cov[NCOVMAX+1], **pmij(); | double **out, cov[NCOVMAX+1], **pmij(); /* **pmmij is a global variable feeded with oldms etc */ |
| double **newm; | double **newm; |
| double agefin, delaymax=200. ; /* 100 Max number of years to converge */ | double agefin, delaymax=200. ; /* 100 Max number of years to converge */ |
| int ncvloop=0; | int ncvloop=0; |
| Line 2065 double **prevalim(double **prlim, int nl | Line 2271 double **prevalim(double **prlim, int nl |
| max=vector(1,nlstate); | max=vector(1,nlstate); |
| meandiff=vector(1,nlstate); | meandiff=vector(1,nlstate); |
| /* Starting with matrix unity */ | |
| for (ii=1;ii<=nlstate+ndeath;ii++) | for (ii=1;ii<=nlstate+ndeath;ii++) |
| for (j=1;j<=nlstate+ndeath;j++){ | for (j=1;j<=nlstate+ndeath;j++){ |
| oldm[ii][j]=(ii==j ? 1.0 : 0.0); | oldm[ii][j]=(ii==j ? 1.0 : 0.0); |
| Line 2083 double **prevalim(double **prlim, int nl | Line 2290 double **prevalim(double **prlim, int nl |
| cov[3]= agefin*agefin;; | cov[3]= agefin*agefin;; |
| for (k=1; k<=cptcovn;k++) { | for (k=1; k<=cptcovn;k++) { |
| /* cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(ij,Tvar[k])]; */ | /* cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(ij,Tvar[k])]; */ |
| /* Here comes the value of the covariate 'ij' */ | |
| cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(ij,k)]; | cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(ij,k)]; |
| /* printf("prevalim ij=%d k=%d Tvar[%d]=%d nbcode=%d cov=%lf codtabm(%d,Tvar[%d])=%d \n",ij,k, k, Tvar[k],nbcode[Tvar[k]][codtabm(ij,Tvar[k])],cov[2+k], ij, k, codtabm(ij,Tvar[k])]); */ | /* printf("prevalim ij=%d k=%d Tvar[%d]=%d nbcode=%d cov=%lf codtabm(%d,Tvar[%d])=%d \n",ij,k, k, Tvar[k],nbcode[Tvar[k]][codtabm(ij,Tvar[k])],cov[2+k], ij, k, codtabm(ij,Tvar[k])]); */ |
| } | } |
| Line 2098 double **prevalim(double **prlim, int nl | Line 2306 double **prevalim(double **prlim, int nl |
| /*printf("ij=%d cov[3]=%lf \n",ij, cov[3]);*/ | /*printf("ij=%d cov[3]=%lf \n",ij, cov[3]);*/ |
| /* savm=pmij(pmmij,cov,ncovmodel,x,nlstate); */ | /* savm=pmij(pmmij,cov,ncovmodel,x,nlstate); */ |
| /* out=matprod2(newm, pmij(pmmij,cov,ncovmodel,x,nlstate),1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, oldm); /\* Bug Valgrind *\/ */ | /* out=matprod2(newm, pmij(pmmij,cov,ncovmodel,x,nlstate),1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, oldm); /\* Bug Valgrind *\/ */ |
| /* age and covariate values of ij are in 'cov' */ | |
| out=matprod2(newm, pmij(pmmij,cov,ncovmodel,x,nlstate),1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, oldm); /* Bug Valgrind */ | out=matprod2(newm, pmij(pmmij,cov,ncovmodel,x,nlstate),1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, oldm); /* Bug Valgrind */ |
| savm=oldm; | savm=oldm; |
| Line 2147 Earliest age to start was %d-%d=%d, ncvl | Line 2356 Earliest age to start was %d-%d=%d, ncvl |
| /**** Back Prevalence limit (stable or period prevalence) ****************/ | /**** Back Prevalence limit (stable or period prevalence) ****************/ |
| double **bprevalim(double **bprlim, int nlstate, double x[], double age, double **oldm, double **savm, double ftolpl, int *ncvyear, int ij) | /* double **bprevalim(double **bprlim, double ***prevacurrent, int nlstate, double x[], double age, double ageminpar, double agemaxpar, double **oldm, double **savm, double **dnewm, double **doldm, double **dsavm, double ftolpl, int *ncvyear, int ij) */ |
| /* double **bprevalim(double **bprlim, double ***prevacurrent, int nlstate, double x[], double age, double **oldm, double **savm, double **dnewm, double **doldm, double **dsavm, double ftolpl, int *ncvyear, int ij) */ | |
| double **bprevalim(double **bprlim, double ***prevacurrent, int nlstate, double x[], double age, double ftolpl, int *ncvyear, int ij) | |
| { | { |
| /* Computes the prevalence limit in each live state at age x by left multiplying the unit | /* Computes the prevalence limit in each live state at age x and covariate ij by left multiplying the unit |
| matrix by transitions matrix until convergence is reached with precision ftolpl */ | 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= 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 */ | /* Wx is row vector: population in state 1, population in state 2, population dead */ |
| Line 2174 double **bprevalim(double **bprlim, int | Line 2385 double **bprevalim(double **bprlim, int |
| /* double **matprod2(); */ /* test */ | /* double **matprod2(); */ /* test */ |
| double **out, cov[NCOVMAX+1], **bmij(); | double **out, cov[NCOVMAX+1], **bmij(); |
| double **newm; | double **newm; |
| double **dnewm, **doldm, **dsavm; /* for use */ | |
| double **oldm, **savm; /* for use */ | |
| double agefin, delaymax=200. ; /* 100 Max number of years to converge */ | double agefin, delaymax=200. ; /* 100 Max number of years to converge */ |
| int ncvloop=0; | int ncvloop=0; |
| Line 2181 double **bprevalim(double **bprlim, int | Line 2395 double **bprevalim(double **bprlim, int |
| max=vector(1,nlstate); | max=vector(1,nlstate); |
| meandiff=vector(1,nlstate); | meandiff=vector(1,nlstate); |
| for (ii=1;ii<=nlstate+ndeath;ii++) | dnewm=ddnewms; doldm=ddoldms; dsavm=ddsavms; |
| for (j=1;j<=nlstate+ndeath;j++){ | 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); | oldm[ii][j]=(ii==j ? 1.0 : 0.0); |
| } | } |
| Line 2190 double **bprevalim(double **bprlim, int | Line 2408 double **bprevalim(double **bprlim, int |
| /* Even if hstepm = 1, at least one multiplication by the unit matrix */ | /* Even if hstepm = 1, at least one multiplication by the unit matrix */ |
| /* Start at agefin= age, computes the matrix of passage and loops decreasing agefin until convergence is reached */ | /* Start at agefin= age, computes the matrix of passage and loops decreasing agefin until convergence is reached */ |
| for(agefin=age+stepm/YEARM; agefin<=age+delaymax; agefin=agefin+stepm/YEARM){ | /* for(agefin=age+stepm/YEARM; agefin<=age+delaymax; agefin=agefin+stepm/YEARM){ /\* A changer en age *\/ */ |
| for(agefin=age; agefin<AGESUP; agefin=agefin+stepm/YEARM){ /* A changer en age */ | |
| ncvloop++; | ncvloop++; |
| newm=savm; | newm=savm; /* oldm should be kept from previous iteration or unity at start */ |
| /* newm points to the allocated table savm passed by the function it can be written, savm could be reallocated */ | |
| /* Covariates have to be included here again */ | /* Covariates have to be included here again */ |
| cov[2]=agefin; | cov[2]=agefin; |
| if(nagesqr==1) | if(nagesqr==1) |
| Line 2214 double **bprevalim(double **bprlim, int | Line 2434 double **bprevalim(double **bprlim, int |
| /*printf("ij=%d cov[3]=%lf \n",ij, cov[3]);*/ | /*printf("ij=%d cov[3]=%lf \n",ij, cov[3]);*/ |
| /* savm=pmij(pmmij,cov,ncovmodel,x,nlstate); */ | /* savm=pmij(pmmij,cov,ncovmodel,x,nlstate); */ |
| /* out=matprod2(newm, pmij(pmmij,cov,ncovmodel,x,nlstate),1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, oldm); /\* Bug Valgrind *\/ */ | /* out=matprod2(newm, pmij(pmmij,cov,ncovmodel,x,nlstate),1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, oldm); /\* Bug Valgrind *\/ */ |
| out=matprod2(newm, oldm ,1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, bmij(pmmij,cov,ncovmodel,x,nlstate)); /* Bug Valgrind */ | /* ij should be linked to the correct index of cov */ |
| /* age and covariate values ij are in 'cov', but we need to pass | |
| * ij for the observed prevalence at age and status and covariate | |
| * number: prevacurrent[(int)agefin][ii][ij] | |
| */ | |
| /* 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 */ | |
| savm=oldm; | savm=oldm; |
| oldm=newm; | oldm=newm; |
| for(j=1; j<=nlstate; j++){ | for(j=1; j<=nlstate; j++){ |
| max[j]=0.; | max[j]=0.; |
| min[j]=1.; | min[j]=1.; |
| } | } |
| /* sumnew=0; */ | |
| /* for(k=1; k<=ndeath; k++) sumnew+=newm[i][nlstate+k]; */ | |
| for(j=1; j<=nlstate; j++){ | for(j=1; j<=nlstate; j++){ |
| for(i=1;i<=nlstate;i++){ | for(i=1;i<=nlstate;i++){ |
| /* bprlim[i][j]= newm[i][j]/(1-sumnew); */ | /* bprlim[i][j]= newm[i][j]/(1-sumnew); */ |
| bprlim[i][j]= newm[i][j]; | bprlim[i][j]= newm[i][j]; |
| max[i]=FMAX(max[i],bprlim[i][j]); | max[i]=FMAX(max[i],bprlim[i][j]); /* Max in line */ |
| min[i]=FMIN(min[i],bprlim[i][j]); | min[i]=FMIN(min[i],bprlim[i][j]); |
| } | } |
| } | } |
| maxmax=0.; | maxmax=0.; |
| for(i=1; i<=nlstate; i++){ | for(i=1; i<=nlstate; i++){ |
| meandiff[i]=(max[i]-min[i])/(max[i]+min[i])*2.; /* mean difference for each column */ | meandiff[i]=(max[i]-min[i])/(max[i]+min[i])*2.; /* mean difference for each column */ |
| Line 2241 double **bprevalim(double **bprlim, int | Line 2464 double **bprevalim(double **bprlim, int |
| /* 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); */ | /* 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 */ | } /* j loop */ |
| *ncvyear= -( (int)age- (int)agefin); | *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){ | if(maxmax < ftolpl){ |
| printf("OK Back maxmax=%lf ncvloop=%d, age=%d, agefin=%d ncvyear=%d \n", maxmax, ncvloop, (int)age, (int)agefin, *ncvyear); | /* 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); | free_vector(min,1,nlstate); |
| free_vector(max,1,nlstate); | free_vector(max,1,nlstate); |
| free_vector(meandiff,1,nlstate); | free_vector(meandiff,1,nlstate); |
| Line 2282 double **pmij(double **ps, double *cov, | Line 2505 double **pmij(double **ps, double *cov, |
| /*double t34;*/ | /*double t34;*/ |
| int i,j, nc, ii, jj; | int i,j, nc, ii, jj; |
| for(i=1; i<= nlstate; i++){ | for(i=1; i<= nlstate; i++){ |
| for(j=1; j<i;j++){ | for(j=1; j<i;j++){ |
| for (nc=1, lnpijopii=0.;nc <=ncovmodel; nc++){ | for (nc=1, lnpijopii=0.;nc <=ncovmodel; nc++){ |
| /*lnpijopii += param[i][j][nc]*cov[nc];*/ | /*lnpijopii += param[i][j][nc]*cov[nc];*/ |
| lnpijopii += x[nc+((i-1)*(nlstate+ndeath-1)+j-1)*ncovmodel]*cov[nc]; | lnpijopii += x[nc+((i-1)*(nlstate+ndeath-1)+j-1)*ncovmodel]*cov[nc]; |
| /* printf("Int j<i s1=%.17e, lnpijopii=%.17e\n",s1,lnpijopii); */ | /* printf("Int j<i s1=%.17e, lnpijopii=%.17e\n",s1,lnpijopii); */ |
| } | |
| ps[i][j]=lnpijopii; /* In fact ln(pij/pii) */ | |
| /* printf("s1=%.17e, lnpijopii=%.17e\n",s1,lnpijopii); */ | |
| } | |
| for(j=i+1; j<=nlstate+ndeath;j++){ | |
| for (nc=1, lnpijopii=0.;nc <=ncovmodel; nc++){ | |
| /*lnpijopii += x[(i-1)*nlstate*ncovmodel+(j-2)*ncovmodel+nc+(i-1)*(ndeath-1)*ncovmodel]*cov[nc];*/ | |
| lnpijopii += x[nc + ((i-1)*(nlstate+ndeath-1)+(j-2))*ncovmodel]*cov[nc]; | |
| /* printf("Int j>i s1=%.17e, lnpijopii=%.17e %lx %lx\n",s1,lnpijopii,s1,lnpijopii); */ | |
| } | |
| ps[i][j]=lnpijopii; /* In fact ln(pij/pii) */ | |
| } | } |
| ps[i][j]=lnpijopii; /* In fact ln(pij/pii) */ | |
| /* printf("s1=%.17e, lnpijopii=%.17e\n",s1,lnpijopii); */ | |
| } | } |
| for(j=i+1; j<=nlstate+ndeath;j++){ | |
| for(i=1; i<= nlstate; i++){ | for (nc=1, lnpijopii=0.;nc <=ncovmodel; nc++){ |
| s1=0; | /*lnpijopii += x[(i-1)*nlstate*ncovmodel+(j-2)*ncovmodel+nc+(i-1)*(ndeath-1)*ncovmodel]*cov[nc];*/ |
| for(j=1; j<i; j++){ | lnpijopii += x[nc + ((i-1)*(nlstate+ndeath-1)+(j-2))*ncovmodel]*cov[nc]; |
| s1+=exp(ps[i][j]); /* In fact sums pij/pii */ | /* printf("Int j>i s1=%.17e, lnpijopii=%.17e %lx %lx\n",s1,lnpijopii,s1,lnpijopii); */ |
| /*printf("debug1 %d %d ps=%lf exp(ps)=%lf s1+=%lf\n",i,j,ps[i][j],exp(ps[i][j]),s1); */ | |
| } | |
| for(j=i+1; j<=nlstate+ndeath; j++){ | |
| s1+=exp(ps[i][j]); /* In fact sums pij/pii */ | |
| /*printf("debug2 %d %d ps=%lf exp(ps)=%lf s1+=%lf\n",i,j,ps[i][j],exp(ps[i][j]),s1); */ | |
| } | |
| /* s1= sum_{j<>i} pij/pii=(1-pii)/pii and thus pii is known from s1 */ | |
| ps[i][i]=1./(s1+1.); | |
| /* Computing other pijs */ | |
| for(j=1; j<i; j++) | |
| ps[i][j]= exp(ps[i][j])*ps[i][i]; | |
| for(j=i+1; j<=nlstate+ndeath; j++) | |
| ps[i][j]= exp(ps[i][j])*ps[i][i]; | |
| /* ps[i][nlstate+1]=1.-s1- ps[i][i];*/ /* Sum should be 1 */ | |
| } /* end i */ | |
| for(ii=nlstate+1; ii<= nlstate+ndeath; ii++){ | |
| for(jj=1; jj<= nlstate+ndeath; jj++){ | |
| ps[ii][jj]=0; | |
| ps[ii][ii]=1; | |
| } | } |
| ps[i][j]=lnpijopii; /* In fact ln(pij/pii) */ | |
| } | } |
| } | |
| /* for(ii=1; ii<= nlstate+ndeath; ii++){ */ | for(i=1; i<= nlstate; i++){ |
| /* for(jj=1; jj<= nlstate+ndeath; jj++){ */ | s1=0; |
| /* printf(" pmij ps[%d][%d]=%lf ",ii,jj,ps[ii][jj]); */ | for(j=1; j<i; j++){ |
| /* } */ | s1+=exp(ps[i][j]); /* In fact sums pij/pii */ |
| /* printf("\n "); */ | /*printf("debug1 %d %d ps=%lf exp(ps)=%lf s1+=%lf\n",i,j,ps[i][j],exp(ps[i][j]),s1); */ |
| /* } */ | } |
| /* printf("\n ");printf("%lf ",cov[2]);*/ | for(j=i+1; j<=nlstate+ndeath; j++){ |
| /* | s1+=exp(ps[i][j]); /* In fact sums pij/pii */ |
| for(i=1; i<= npar; i++) printf("%f ",x[i]); | /*printf("debug2 %d %d ps=%lf exp(ps)=%lf s1+=%lf\n",i,j,ps[i][j],exp(ps[i][j]),s1); */ |
| goto end;*/ | } |
| return ps; | /* s1= sum_{j<>i} pij/pii=(1-pii)/pii and thus pii is known from s1 */ |
| ps[i][i]=1./(s1+1.); | |
| /* Computing other pijs */ | |
| for(j=1; j<i; j++) | |
| ps[i][j]= exp(ps[i][j])*ps[i][i]; | |
| for(j=i+1; j<=nlstate+ndeath; j++) | |
| ps[i][j]= exp(ps[i][j])*ps[i][i]; | |
| /* ps[i][nlstate+1]=1.-s1- ps[i][i];*/ /* Sum should be 1 */ | |
| } /* end i */ | |
| for(ii=nlstate+1; ii<= nlstate+ndeath; ii++){ | |
| for(jj=1; jj<= nlstate+ndeath; jj++){ | |
| ps[ii][jj]=0; | |
| ps[ii][ii]=1; | |
| } | |
| } | |
| /* for(ii=1; ii<= nlstate+ndeath; ii++){ */ | |
| /* for(jj=1; jj<= nlstate+ndeath; jj++){ */ | |
| /* printf(" pmij ps[%d][%d]=%lf ",ii,jj,ps[ii][jj]); */ | |
| /* } */ | |
| /* printf("\n "); */ | |
| /* } */ | |
| /* printf("\n ");printf("%lf ",cov[2]);*/ | |
| /* | |
| for(i=1; i<= npar; i++) printf("%f ",x[i]); | |
| goto end;*/ | |
| return ps; | |
| } | } |
| /*************** backward transition probabilities ***************/ | |
| /* double **bmij(double **ps, double *cov, int ncovmodel, double *x, int nlstate, double ***prevacurrent, double ageminpar, double agemaxpar, double ***dnewm, double **doldm, double **dsavm, int ij ) */ | |
| /* 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. | |
| */ | |
| int i, ii, j,k; | |
| double **out, **pmij(); | |
| double sumnew=0.; | |
| double agefin; | |
| double **dnewm, **dsavm, **doldm; | |
| double **bbmij; | |
| doldm=ddoldms; /* global pointers */ | |
| dnewm=ddnewms; | |
| dsavm=ddsavms; | |
| agefin=cov[2]; | |
| /* 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 */ | |
| for (j=1;j<=nlstate+ndeath;j++){ | |
| sumnew=0.; /* w1 p11 + w2 p21 only on live states */ | |
| for (ii=1;ii<=nlstate;ii++){ | |
| sumnew+=dsavm[ii][j]*prevacurrent[(int)agefin][ii][ij]; | |
| } /* 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); */ | |
| /* }else if(agefin >= agemaxpar+stepm/YEARM){ */ | |
| /* doldm[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); | |
| } | |
| } /*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 bmij */ | |
| return ps; | |
| } | |
| /*************** transition probabilities ***************/ | /*************** transition probabilities ***************/ |
| double **bmij(double **ps, double *cov, int ncovmodel, double *x, int nlstate ) | double **bpmij(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, | /* 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 being in state i by appying the |
| Line 2364 double **bmij(double **ps, double *cov, | Line 2648 double **bmij(double **ps, double *cov, |
| /*double t34;*/ | /*double t34;*/ |
| int i,j, nc, ii, jj; | int i,j, nc, ii, jj; |
| for(i=1; i<= nlstate; i++){ | for(i=1; i<= nlstate; i++){ |
| for(j=1; j<i;j++){ | for(j=1; j<i;j++){ |
| for (nc=1, lnpijopii=0.;nc <=ncovmodel; nc++){ | for (nc=1, lnpijopii=0.;nc <=ncovmodel; nc++){ |
| /*lnpijopii += param[i][j][nc]*cov[nc];*/ | /*lnpijopii += param[i][j][nc]*cov[nc];*/ |
| lnpijopii += x[nc+((i-1)*(nlstate+ndeath-1)+j-1)*ncovmodel]*cov[nc]; | lnpijopii += x[nc+((i-1)*(nlstate+ndeath-1)+j-1)*ncovmodel]*cov[nc]; |
| /* printf("Int j<i s1=%.17e, lnpijopii=%.17e\n",s1,lnpijopii); */ | /* printf("Int j<i s1=%.17e, lnpijopii=%.17e\n",s1,lnpijopii); */ |
| } | } |
| ps[i][j]=lnpijopii; /* In fact ln(pij/pii) */ | ps[i][j]=lnpijopii; /* In fact ln(pij/pii) */ |
| /* printf("s1=%.17e, lnpijopii=%.17e\n",s1,lnpijopii); */ | /* printf("s1=%.17e, lnpijopii=%.17e\n",s1,lnpijopii); */ |
| } | } |
| for(j=i+1; j<=nlstate+ndeath;j++){ | for(j=i+1; j<=nlstate+ndeath;j++){ |
| for (nc=1, lnpijopii=0.;nc <=ncovmodel; nc++){ | for (nc=1, lnpijopii=0.;nc <=ncovmodel; nc++){ |
| /*lnpijopii += x[(i-1)*nlstate*ncovmodel+(j-2)*ncovmodel+nc+(i-1)*(ndeath-1)*ncovmodel]*cov[nc];*/ | /*lnpijopii += x[(i-1)*nlstate*ncovmodel+(j-2)*ncovmodel+nc+(i-1)*(ndeath-1)*ncovmodel]*cov[nc];*/ |
| lnpijopii += x[nc + ((i-1)*(nlstate+ndeath-1)+(j-2))*ncovmodel]*cov[nc]; | lnpijopii += x[nc + ((i-1)*(nlstate+ndeath-1)+(j-2))*ncovmodel]*cov[nc]; |
| /* printf("Int j>i s1=%.17e, lnpijopii=%.17e %lx %lx\n",s1,lnpijopii,s1,lnpijopii); */ | /* printf("Int j>i s1=%.17e, lnpijopii=%.17e %lx %lx\n",s1,lnpijopii,s1,lnpijopii); */ |
| } | } |
| ps[i][j]=lnpijopii; /* In fact ln(pij/pii) */ | ps[i][j]=lnpijopii; /* In fact ln(pij/pii) */ |
| } | } |
| } | } |
| for(i=1; i<= nlstate; i++){ | for(i=1; i<= nlstate; i++){ |
| s1=0; | s1=0; |
| for(j=1; j<i; j++){ | for(j=1; j<i; j++){ |
| s1+=exp(ps[i][j]); /* In fact sums pij/pii */ | s1+=exp(ps[i][j]); /* In fact sums pij/pii */ |
| /*printf("debug1 %d %d ps=%lf exp(ps)=%lf s1+=%lf\n",i,j,ps[i][j],exp(ps[i][j]),s1); */ | /*printf("debug1 %d %d ps=%lf exp(ps)=%lf s1+=%lf\n",i,j,ps[i][j],exp(ps[i][j]),s1); */ |
| } | } |
| for(j=i+1; j<=nlstate+ndeath; j++){ | for(j=i+1; j<=nlstate+ndeath; j++){ |
| s1+=exp(ps[i][j]); /* In fact sums pij/pii */ | s1+=exp(ps[i][j]); /* In fact sums pij/pii */ |
| /*printf("debug2 %d %d ps=%lf exp(ps)=%lf s1+=%lf\n",i,j,ps[i][j],exp(ps[i][j]),s1); */ | /*printf("debug2 %d %d ps=%lf exp(ps)=%lf s1+=%lf\n",i,j,ps[i][j],exp(ps[i][j]),s1); */ |
| } | } |
| /* s1= sum_{j<>i} pij/pii=(1-pii)/pii and thus pii is known from s1 */ | /* s1= sum_{j<>i} pij/pii=(1-pii)/pii and thus pii is known from s1 */ |
| ps[i][i]=1./(s1+1.); | ps[i][i]=1./(s1+1.); |
| /* Computing other pijs */ | /* Computing other pijs */ |
| for(j=1; j<i; j++) | for(j=1; j<i; j++) |
| ps[i][j]= exp(ps[i][j])*ps[i][i]; | ps[i][j]= exp(ps[i][j])*ps[i][i]; |
| for(j=i+1; j<=nlstate+ndeath; j++) | for(j=i+1; j<=nlstate+ndeath; j++) |
| ps[i][j]= exp(ps[i][j])*ps[i][i]; | ps[i][j]= exp(ps[i][j])*ps[i][i]; |
| /* ps[i][nlstate+1]=1.-s1- ps[i][i];*/ /* Sum should be 1 */ | /* ps[i][nlstate+1]=1.-s1- ps[i][i];*/ /* Sum should be 1 */ |
| } /* end i */ | } /* end i */ |
| for(ii=nlstate+1; ii<= nlstate+ndeath; ii++){ | for(ii=nlstate+1; ii<= nlstate+ndeath; ii++){ |
| for(jj=1; jj<= nlstate+ndeath; jj++){ | for(jj=1; jj<= nlstate+ndeath; jj++){ |
| ps[ii][jj]=0; | ps[ii][jj]=0; |
| ps[ii][ii]=1; | ps[ii][ii]=1; |
| } | } |
| } | } |
| /* Added for backcast */ | /* Added for backcast */ /* Transposed matrix too */ |
| for(jj=1; jj<= nlstate; jj++){ | for(jj=1; jj<= nlstate+ndeath; jj++){ |
| s1=0.; | s1=0.; |
| for(ii=1; ii<= nlstate; ii++){ | for(ii=1; ii<= nlstate+ndeath; ii++){ |
| s1+=ps[ii][jj]; | s1+=ps[ii][jj]; |
| } | } |
| for(ii=1; ii<= nlstate; ii++){ | for(ii=1; ii<= nlstate; ii++){ |
| ps[ii][jj]=ps[ii][jj]/s1; | ps[ii][jj]=ps[ii][jj]/s1; |
| } | } |
| } | } |
| /* Transposition */ | |
| /* for(ii=1; ii<= nlstate+ndeath; ii++){ */ | for(jj=1; jj<= nlstate+ndeath; jj++){ |
| /* for(jj=1; jj<= nlstate+ndeath; jj++){ */ | for(ii=jj; ii<= nlstate+ndeath; ii++){ |
| /* printf(" pmij ps[%d][%d]=%lf ",ii,jj,ps[ii][jj]); */ | s1=ps[ii][jj]; |
| /* } */ | ps[ii][jj]=ps[jj][ii]; |
| /* printf("\n "); */ | ps[jj][ii]=s1; |
| /* } */ | } |
| /* printf("\n ");printf("%lf ",cov[2]);*/ | } |
| /* | /* for(ii=1; ii<= nlstate+ndeath; ii++){ */ |
| for(i=1; i<= npar; i++) printf("%f ",x[i]); | /* for(jj=1; jj<= nlstate+ndeath; jj++){ */ |
| goto end;*/ | /* printf(" pmij ps[%d][%d]=%lf ",ii,jj,ps[ii][jj]); */ |
| return ps; | /* } */ |
| /* printf("\n "); */ | |
| /* } */ | |
| /* printf("\n ");printf("%lf ",cov[2]);*/ | |
| /* | |
| for(i=1; i<= npar; i++) printf("%f ",x[i]); | |
| goto end;*/ | |
| return ps; | |
| } | } |
| Line 2459 double **matprod2(double **out, double * | Line 2750 double **matprod2(double **out, double * |
| double ***hpxij(double ***po, int nhstepm, double age, int hstepm, double *x, int nlstate, int stepm, double **oldm, double **savm, int ij ) | double ***hpxij(double ***po, int nhstepm, double age, int hstepm, double *x, int nlstate, int stepm, double **oldm, double **savm, int ij ) |
| { | { |
| /* Computes the transition matrix starting at age 'age' over | /* Computes the transition matrix starting at age 'age' and combination of covariate values corresponding to ij over |
| 'nhstepm*hstepm*stepm' months (i.e. until | 'nhstepm*hstepm*stepm' months (i.e. until |
| age (in years) age+nhstepm*hstepm*stepm/12) by multiplying | age (in years) age+nhstepm*hstepm*stepm/12) by multiplying |
| nhstepm*hstepm matrices. | nhstepm*hstepm matrices. |
| Line 2495 double ***hpxij(double ***po, int nhstep | Line 2786 double ***hpxij(double ***po, int nhstep |
| cov[3]= agexact*agexact; | cov[3]= agexact*agexact; |
| for (k=1; k<=cptcovn;k++) | 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,k)]; |
| /* cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(ij,Tvar[k])]; */ | /* cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(ij,Tvar[k])]; */ |
| for (k=1; k<=cptcovage;k++) /* Should start at cptcovn+1 */ | for (k=1; k<=cptcovage;k++) /* Should start at cptcovn+1 */ |
| /* cov[2+Tage[k]]=cov[2+Tage[k]]*cov[2]; */ | /* 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,k)]*cov[2]; |
| /* cov[2+nagesqr+Tage[k]]=nbcode[Tvar[Tage[k]]][codtabm(ij,Tvar[Tage[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<=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,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])]; */ | /* 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("hxi cptcov=%d cptcode=%d\n",cptcov,cptcode);*/ |
| /*printf("h=%d d=%d age=%f cov=%f\n",h,d,age,cov[2]);*/ | /*printf("h=%d d=%d age=%f cov=%f\n",h,d,age,cov[2]);*/ |
| /* right multiplication of oldm by the current matrix */ | |
| out=matprod2(newm,oldm,1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, | out=matprod2(newm,oldm,1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, |
| pmij(pmmij,cov,ncovmodel,x,nlstate)); | pmij(pmmij,cov,ncovmodel,x,nlstate)); |
| /* if((int)age == 70){ */ | /* if((int)age == 70){ */ |
| Line 2528 double ***hpxij(double ***po, int nhstep | Line 2820 double ***hpxij(double ***po, int nhstep |
| } | } |
| for(i=1; i<=nlstate+ndeath; i++) | for(i=1; i<=nlstate+ndeath; i++) |
| for(j=1;j<=nlstate+ndeath;j++) { | for(j=1;j<=nlstate+ndeath;j++) { |
| po[i][j][h]=newm[i][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 ",h);*/ |
| } /* end h */ | } /* end h */ |
| /* printf("\n H=%d \n",h); */ | /* printf("\n H=%d \n",h); */ |
| return po; | return po; |
| } | } |
| /************* Higher Back Matrix Product ***************/ | /************* 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, int nlstate, int stepm, double **oldm, double **savm, int ij ) | double ***hbxij(double ***po, int nhstepm, double age, int hstepm, double *x, double ***prevacurrent, int nlstate, int stepm, int ij ) |
| { | { |
| /* Computes the transition matrix starting at age 'age' over | /* Computes the transition matrix starting at age 'age' over |
| 'nhstepm*hstepm*stepm' months (i.e. until | 'nhstepm*hstepm*stepm' months (i.e. until |
| age (in years) age+nhstepm*hstepm*stepm/12) by multiplying | age (in years) age+nhstepm*hstepm*stepm/12) by multiplying |
| nhstepm*hstepm matrices. | nhstepm*hstepm matrices. |
| Output is stored in matrix po[i][j][h] for h every 'hstepm' step | Output is stored in matrix po[i][j][h] for h every 'hstepm' step |
| (typically every 2 years instead of every month which is too big | (typically every 2 years instead of every month which is too big |
| for the memory). | for the memory). |
| Model is determined by parameters x and covariates have to be | Model is determined by parameters x and covariates have to be |
| included manually here. | included manually here. |
| */ | */ |
| int i, j, d, h, k; | int i, j, d, h, k; |
| double **out, cov[NCOVMAX+1]; | double **out, cov[NCOVMAX+1]; |
| double **newm; | double **newm; |
| double agexact; | double agexact; |
| double agebegin, ageend; | double agebegin, ageend; |
| double **oldm, **savm; | |
| oldm=oldms;savm=savms; | |
| /* Hstepm could be zero and should return the unit matrix */ | /* Hstepm could be zero and should return the unit matrix */ |
| for (i=1;i<=nlstate+ndeath;i++) | for (i=1;i<=nlstate+ndeath;i++) |
| for (j=1;j<=nlstate+ndeath;j++){ | for (j=1;j<=nlstate+ndeath;j++){ |
| Line 2576 double ***hbxij(double ***po, int nhstep | Line 2870 double ***hbxij(double ***po, int nhstep |
| cov[2]=agexact; | cov[2]=agexact; |
| if(nagesqr==1) | if(nagesqr==1) |
| cov[3]= agexact*agexact; | cov[3]= agexact*agexact; |
| for (k=1; k<=cptcovn;k++) | 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,k)]; |
| /* cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(ij,Tvar[k])]; */ | /* cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(ij,Tvar[k])]; */ |
| for (k=1; k<=cptcovage;k++) /* Should start at cptcovn+1 */ | for (k=1; k<=cptcovage;k++) /* Should start at cptcovn+1 */ |
| /* cov[2+Tage[k]]=cov[2+Tage[k]]*cov[2]; */ | /* 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,k)]*cov[2]; |
| /* cov[2+nagesqr+Tage[k]]=nbcode[Tvar[Tage[k]]][codtabm(ij,Tvar[Tage[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<=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,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])]; */ | /* 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("hxi cptcov=%d cptcode=%d\n",cptcov,cptcode);*/ |
| /*printf("h=%d d=%d age=%f cov=%f\n",h,d,age,cov[2]);*/ | /*printf("h=%d d=%d age=%f cov=%f\n",h,d,age,cov[2]);*/ |
| out=matprod2(newm, bmij(pmmij,cov,ncovmodel,x,nlstate),1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, | /* Careful transposed matrix */ |
| oldm); | /* age is in cov[2] */ |
| /* 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),\ | |
| 1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, oldm); | |
| /* if((int)age == 70){ */ | /* if((int)age == 70){ */ |
| /* printf(" Backward hbxij age=%d agexact=%f d=%d nhstepm=%d hstepm=%d\n", (int) age, agexact, d, nhstepm, hstepm); */ | /* printf(" Backward hbxij age=%d agexact=%f d=%d nhstepm=%d hstepm=%d\n", (int) age, agexact, d, nhstepm, hstepm); */ |
| /* for(i=1; i<=nlstate+ndeath; i++) { */ | /* for(i=1; i<=nlstate+ndeath; i++) { */ |
| Line 2616 double ***hbxij(double ***po, int nhstep | Line 2914 double ***hbxij(double ***po, int nhstep |
| } | } |
| /*printf("h=%d ",h);*/ | /*printf("h=%d ",h);*/ |
| } /* end h */ | } /* end h */ |
| /* printf("\n H=%d \n",h); */ | /* printf("\n H=%d \n",h); */ |
| return po; | return po; |
| } | } |
| Line 2645 double ***hbxij(double ***po, int nhstep | Line 2943 double ***hbxij(double ***po, int nhstep |
| double func( double *x) | double func( double *x) |
| { | { |
| int i, ii, j, k, mi, d, kk; | int i, ii, j, k, mi, d, kk; |
| int ioffset=0; | |
| double l, ll[NLSTATEMAX+1], cov[NCOVMAX+1]; | double l, ll[NLSTATEMAX+1], cov[NCOVMAX+1]; |
| double **out; | double **out; |
| double sw; /* Sum of weights */ | double sw; /* Sum of weights */ |
| double lli; /* Individual log likelihood */ | double lli; /* Individual log likelihood */ |
| int s1, s2; | int s1, s2; |
| int iv=0, iqv=0, itv=0, iqtv=0 ; /* Index of varying covariate, fixed quantitative cov, time varying covariate, quatitative time varying covariate */ | |
| double bbh, survp; | double bbh, survp; |
| long ipmx; | long ipmx; |
| double agexact; | double agexact; |
| Line 2665 double func( double *x) | Line 2965 double func( double *x) |
| cov[1]=1.; | cov[1]=1.; |
| for(k=1; k<=nlstate; k++) ll[k]=0.; | for(k=1; k<=nlstate; k++) ll[k]=0.; |
| ioffset=0; | |
| if(mle==1){ | if(mle==1){ |
| for (i=1,ipmx=0, sw=0.; i<=imx; i++){ | for (i=1,ipmx=0, sw=0.; i<=imx; i++){ |
| /* Computes the values of the ncovmodel covariates of the model | /* Computes the values of the ncovmodel covariates of the model |
| depending if the covariates are fixed or variying (age dependent) and stores them in cov[] | depending if the covariates are fixed or varying (age dependent) and stores them in cov[] |
| Then computes with function pmij which return a matrix p[i][j] giving the elementary probability | Then computes with function pmij which return a matrix p[i][j] giving the elementary probability |
| to be observed in j being in i according to the model. | to be observed in j being in i according to the model. |
| */ | */ |
| for (k=1; k<=cptcovn;k++){ /* Simple and product covariates without age* products */ | ioffset=2+nagesqr+cptcovage; |
| cov[2+nagesqr+k]=covar[Tvar[k]][i]; | /* for (k=1; k<=cptcovn;k++){ /\* Simple and product covariates without age* products *\/ */ |
| for (k=1; k<=ncoveff;k++){ /* Simple and product covariates without age* products */ | |
| cov[++ioffset]=covar[Tvar[k]][i]; | |
| } | |
| for(iqv=1; iqv <= nqfveff; iqv++){ /* Quantitatives and Fixed covariates */ | |
| cov[++ioffset]=coqvar[iqv][i]; | |
| } | } |
| /* In model V2+V1*V4+age*V3+V3*V2 Tvar[1] is V2, Tvar[2=V1*V4] | /* In model V2+V1*V4+age*V3+V3*V2 Tvar[1] is V2, Tvar[2=V1*V4] |
| is 6, Tvar[3=age*V3] should not be computed because of age Tvar[4=V3*V2] | is 6, Tvar[3=age*V3] should not be computed because of age Tvar[4=V3*V2] |
| has been calculated etc */ | has been calculated etc */ |
| /* For an individual i, wav[i] gives the number of effective waves */ | |
| /* We compute the contribution to Likelihood of each effective transition | |
| mw[mi][i] is real wave of the mi th effectve wave */ | |
| /* Then statuses are computed at each begin and end of an effective wave s1=s[ mw[mi][i] ][i]; | |
| s2=s[mw[mi+1][i]][i]; | |
| And the iv th varying covariate is the cotvar[mw[mi+1][i]][iv][i] | |
| But if the variable is not in the model TTvar[iv] is the real variable effective in the model: | |
| meaning that decodemodel should be used cotvar[mw[mi+1][i]][TTvar[iv]][i] | |
| */ | |
| for(mi=1; mi<= wav[i]-1; mi++){ | for(mi=1; mi<= wav[i]-1; mi++){ |
| for(itv=1; itv <= ntveff; itv++){ /* Varying dummy covariates */ | |
| cov[ioffset+itv]=cotvar[mw[mi][i]][itv][i]; | |
| } | |
| for(iqtv=1; iqtv <= nqtveff; iqtv++){ /* Varying quantitatives covariates */ | |
| if(cotqvar[mw[mi][i]][iqtv][i] == -1){ | |
| printf("i=%d, mi=%d, iqtv=%d, cotqvar[mw[mi][i]][iqtv][i]=%f",i,mi,iqtv,cotqvar[mw[mi][i]][iqtv][i]); | |
| } | |
| cov[ioffset+ntveff+iqtv]=cotqvar[mw[mi][i]][iqtv][i]; | |
| } | |
| /* ioffset=2+nagesqr+cptcovn+nqv+ntv+nqtv; */ | |
| for (ii=1;ii<=nlstate+ndeath;ii++) | for (ii=1;ii<=nlstate+ndeath;ii++) |
| for (j=1;j<=nlstate+ndeath;j++){ | for (j=1;j<=nlstate+ndeath;j++){ |
| oldm[ii][j]=(ii==j ? 1.0 : 0.0); | oldm[ii][j]=(ii==j ? 1.0 : 0.0); |
| Line 2690 double func( double *x) | Line 3015 double func( double *x) |
| agexact=agev[mw[mi][i]][i]+d*stepm/YEARM; | agexact=agev[mw[mi][i]][i]+d*stepm/YEARM; |
| cov[2]=agexact; | cov[2]=agexact; |
| if(nagesqr==1) | if(nagesqr==1) |
| cov[3]= agexact*agexact; | cov[3]= agexact*agexact; /* Should be changed here */ |
| for (kk=1; kk<=cptcovage;kk++) { | for (kk=1; kk<=cptcovage;kk++) { |
| cov[Tage[kk]+2+nagesqr]=covar[Tvar[Tage[kk]]][i]*agexact; /* Tage[kk] gives the data-covariate associated with age */ | cov[Tage[kk]+2+nagesqr]=covar[Tvar[Tage[kk]]][i]*agexact; /* Tage[kk] gives the data-covariate associated with age */ |
| } | } |
| Line 2699 double func( double *x) | Line 3024 double func( double *x) |
| savm=oldm; | savm=oldm; |
| oldm=newm; | oldm=newm; |
| } /* end mult */ | } /* end mult */ |
| /*lli=log(out[s[mw[mi][i]][i]][s[mw[mi+1][i]][i]]);*/ /* Original formula */ | /*lli=log(out[s[mw[mi][i]][i]][s[mw[mi+1][i]][i]]);*/ /* Original formula */ |
| /* But now since version 0.9 we anticipate for bias at large stepm. | /* But now since version 0.9 we anticipate for bias at large stepm. |
| * If stepm is larger than one month (smallest stepm) and if the exact delay | * If stepm is larger than one month (smallest stepm) and if the exact delay |
| Line 2727 double func( double *x) | Line 3052 double func( double *x) |
| which is also equal to probability to die before dh | which is also equal to probability to die before dh |
| minus probability to die before dh-stepm . | minus probability to die before dh-stepm . |
| In version up to 0.92 likelihood was computed | In version up to 0.92 likelihood was computed |
| as if date of death was unknown. Death was treated as any other | as if date of death was unknown. Death was treated as any other |
| health state: the date of the interview describes the actual state | health state: the date of the interview describes the actual state |
| and not the date of a change in health state. The former idea was | and not the date of a change in health state. The former idea was |
| to consider that at each interview the state was recorded | to consider that at each interview the state was recorded |
| (healthy, disable or death) and IMaCh was corrected; but when we | (healthy, disable or death) and IMaCh was corrected; but when we |
| introduced the exact date of death then we should have modified | introduced the exact date of death then we should have modified |
| the contribution of an exact death to the likelihood. This new | the contribution of an exact death to the likelihood. This new |
| contribution is smaller and very dependent of the step unit | contribution is smaller and very dependent of the step unit |
| stepm. It is no more the probability to die between last interview | stepm. It is no more the probability to die between last interview |
| and month of death but the probability to survive from last | and month of death but the probability to survive from last |
| interview up to one month before death multiplied by the | interview up to one month before death multiplied by the |
| probability to die within a month. Thanks to Chris | probability to die within a month. Thanks to Chris |
| Jackson for correcting this bug. Former versions increased | Jackson for correcting this bug. Former versions increased |
| mortality artificially. The bad side is that we add another loop | mortality artificially. The bad side is that we add another loop |
| which slows down the processing. The difference can be up to 10% | which slows down the processing. The difference can be up to 10% |
| lower mortality. | lower mortality. |
| */ | |
| /* If, at the beginning of the maximization mostly, the | |
| cumulative probability or probability to be dead is | |
| constant (ie = 1) over time d, the difference is equal to | |
| 0. out[s1][3] = savm[s1][3]: probability, being at state | |
| s1 at precedent wave, to be dead a month before current | |
| wave is equal to probability, being at state s1 at | |
| precedent wave, to be dead at mont of the current | |
| wave. Then the observed probability (that this person died) | |
| is null according to current estimated parameter. In fact, | |
| it should be very low but not zero otherwise the log go to | |
| infinity. | |
| */ | */ |
| /* If, at the beginning of the maximization mostly, the | |
| cumulative probability or probability to be dead is | |
| constant (ie = 1) over time d, the difference is equal to | |
| 0. out[s1][3] = savm[s1][3]: probability, being at state | |
| s1 at precedent wave, to be dead a month before current | |
| wave is equal to probability, being at state s1 at | |
| precedent wave, to be dead at mont of the current | |
| wave. Then the observed probability (that this person died) | |
| is null according to current estimated parameter. In fact, | |
| it should be very low but not zero otherwise the log go to | |
| infinity. | |
| */ | |
| /* #ifdef INFINITYORIGINAL */ | /* #ifdef INFINITYORIGINAL */ |
| /* lli=log(out[s1][s2] - savm[s1][s2]); */ | /* lli=log(out[s1][s2] - savm[s1][s2]); */ |
| /* #else */ | /* #else */ |
| Line 2772 double func( double *x) | Line 3097 double func( double *x) |
| /*survp += out[s1][j]; */ | /*survp += out[s1][j]; */ |
| lli= log(survp); | lli= log(survp); |
| } | } |
| else if (s2==-4) { | else if (s2==-4) { |
| for (j=3,survp=0. ; j<=nlstate; j++) | for (j=3,survp=0. ; j<=nlstate; j++) |
| survp += (1.+bbh)*out[s1][j]- bbh*savm[s1][j]; | survp += (1.+bbh)*out[s1][j]- bbh*savm[s1][j]; |
| lli= log(survp); | lli= log(survp); |
| } | } |
| else if (s2==-5) { | else if (s2==-5) { |
| for (j=1,survp=0. ; j<=2; j++) | for (j=1,survp=0. ; j<=2; j++) |
| survp += (1.+bbh)*out[s1][j]- bbh*savm[s1][j]; | survp += (1.+bbh)*out[s1][j]- bbh*savm[s1][j]; |
| lli= log(survp); | lli= log(survp); |
| } | } |
| else{ | else{ |
| lli= log((1.+bbh)*out[s1][s2]- bbh*savm[s1][s2]); /* linear interpolation */ | lli= log((1.+bbh)*out[s1][s2]- bbh*savm[s1][s2]); /* linear interpolation */ |
| /* lli= (savm[s1][s2]>(double)1.e-8 ?log((1.+bbh)*out[s1][s2]- bbh*(savm[s1][s2])):log((1.+bbh)*out[s1][s2]));*/ /* linear interpolation */ | /* lli= (savm[s1][s2]>(double)1.e-8 ?log((1.+bbh)*out[s1][s2]- bbh*(savm[s1][s2])):log((1.+bbh)*out[s1][s2]));*/ /* linear interpolation */ |
| Line 2789 double func( double *x) | Line 3114 double func( double *x) |
| /*lli=(1.+bbh)*log(out[s1][s2])- bbh*log(savm[s1][s2]);*/ | /*lli=(1.+bbh)*log(out[s1][s2])- bbh*log(savm[s1][s2]);*/ |
| /*if(lli ==000.0)*/ | /*if(lli ==000.0)*/ |
| /*printf("bbh= %f lli=%f savm=%f out=%f %d\n",bbh,lli,savm[s1][s2], out[s[mw[mi][i]][i]][s[mw[mi+1][i]][i]],i); */ | /*printf("bbh= %f lli=%f savm=%f out=%f %d\n",bbh,lli,savm[s1][s2], out[s[mw[mi][i]][i]][s[mw[mi+1][i]][i]],i); */ |
| ipmx +=1; | ipmx +=1; |
| sw += weight[i]; | sw += weight[i]; |
| ll[s[mw[mi][i]][i]] += 2*weight[i]*lli; | ll[s[mw[mi][i]][i]] += 2*weight[i]*lli; |
| /* if (lli < log(mytinydouble)){ */ | /* if (lli < log(mytinydouble)){ */ |
| Line 2952 double funcone( double *x) | Line 3277 double funcone( double *x) |
| { | { |
| /* Same as likeli but slower because of a lot of printf and if */ | /* Same as likeli but slower because of a lot of printf and if */ |
| int i, ii, j, k, mi, d, kk; | int i, ii, j, k, mi, d, kk; |
| int ioffset=0; | |
| double l, ll[NLSTATEMAX+1], cov[NCOVMAX+1]; | double l, ll[NLSTATEMAX+1], cov[NCOVMAX+1]; |
| double **out; | double **out; |
| double lli; /* Individual log likelihood */ | double lli; /* Individual log likelihood */ |
| double llt; | double llt; |
| int s1, s2; | int s1, s2; |
| int iv=0, iqv=0, itv=0, iqtv=0 ; /* Index of varying covariate, fixed quantitative cov, time varying covariate */ | |
| double bbh, survp; | double bbh, survp; |
| double agexact; | double agexact; |
| double agebegin, ageend; | double agebegin, ageend; |
| Line 2969 double funcone( double *x) | Line 3296 double funcone( double *x) |
| cov[1]=1.; | cov[1]=1.; |
| for(k=1; k<=nlstate; k++) ll[k]=0.; | for(k=1; k<=nlstate; k++) ll[k]=0.; |
| ioffset=0; | |
| for (i=1,ipmx=0, sw=0.; i<=imx; i++){ | for (i=1,ipmx=0, sw=0.; i<=imx; i++){ |
| for (k=1; k<=cptcovn;k++) cov[2+nagesqr+k]=covar[Tvar[k]][i]; | ioffset=2+nagesqr+cptcovage; |
| for(mi=1; mi<= wav[i]-1; mi++){ | /* for (k=1; k<=cptcovn;k++) cov[2+nagesqr+k]=covar[Tvar[k]][i]; */ |
| for (k=1; k<=ncoveff+nqfveff;k++){ /* Simple and product fixed covariates without age* products */ | |
| cov[++ioffset]=covar[Tvar[k]][i]; | |
| } | |
| for(iqv=1; iqv <= nqfveff; iqv++){ /* Quantitative fixed covariates */ | |
| cov[++ioffset]=coqvar[Tvar[iqv]][i]; | |
| } | |
| for(mi=1; mi<= wav[i]-1; mi++){ /* Varying with waves */ | |
| for(itv=1; itv <= ntveff; itv++){ /* Varying dummy covariates */ | |
| cov[ioffset+itv]=cotvar[mw[mi][i]][itv][i]; | |
| } | |
| for(iqtv=1; iqtv <= nqtveff; iqtv++){ /* Varying quantitatives covariates */ | |
| cov[ioffset+ntveff+iqtv]=cotqvar[mw[mi][i]][iqtv][i]; | |
| } | |
| for (ii=1;ii<=nlstate+ndeath;ii++) | for (ii=1;ii<=nlstate+ndeath;ii++) |
| for (j=1;j<=nlstate+ndeath;j++){ | for (j=1;j<=nlstate+ndeath;j++){ |
| oldm[ii][j]=(ii==j ? 1.0 : 0.0); | oldm[ii][j]=(ii==j ? 1.0 : 0.0); |
| Line 2992 double funcone( double *x) | Line 3333 double funcone( double *x) |
| for (kk=1; kk<=cptcovage;kk++) { | for (kk=1; kk<=cptcovage;kk++) { |
| cov[Tage[kk]+2+nagesqr]=covar[Tvar[Tage[kk]]][i]*agexact; | cov[Tage[kk]+2+nagesqr]=covar[Tvar[Tage[kk]]][i]*agexact; |
| } | } |
| /* printf("i=%d,mi=%d,d=%d,mw[mi][i]=%d\n",i, mi,d,mw[mi][i]); */ | |
| /* savm=pmij(pmmij,cov,ncovmodel,x,nlstate); */ | /* savm=pmij(pmmij,cov,ncovmodel,x,nlstate); */ |
| out=matprod2(newm,oldm,1,nlstate+ndeath,1,nlstate+ndeath, | out=matprod2(newm,oldm,1,nlstate+ndeath,1,nlstate+ndeath, |
| 1,nlstate+ndeath,pmij(pmmij,cov,ncovmodel,x,nlstate)); | 1,nlstate+ndeath,pmij(pmmij,cov,ncovmodel,x,nlstate)); |
| Line 3035 double funcone( double *x) | Line 3376 double funcone( double *x) |
| ll[s[mw[mi][i]][i]] += 2*weight[i]*lli; | ll[s[mw[mi][i]][i]] += 2*weight[i]*lli; |
| /*printf("i=%6d s1=%1d s2=%1d mi=%1d mw=%1d dh=%3d prob=%10.6f w=%6.4f out=%10.6f sav=%10.6f\n",i,s1,s2,mi,mw[mi][i],dh[mi][i],exp(lli),weight[i],out[s1][s2],savm[s1][s2]); */ | /*printf("i=%6d s1=%1d s2=%1d mi=%1d mw=%1d dh=%3d prob=%10.6f w=%6.4f out=%10.6f sav=%10.6f\n",i,s1,s2,mi,mw[mi][i],dh[mi][i],exp(lli),weight[i],out[s1][s2],savm[s1][s2]); */ |
| if(globpr){ | if(globpr){ |
| fprintf(ficresilk,"%9ld %6.1f %6.1f %6d %2d %2d %2d %2d %3d %11.6f %8.4f %8.3f\ | fprintf(ficresilk,"%9ld %6.1f %6.1f %6d %2d %2d %2d %2d %3d %15.6f %8.4f %8.3f\ |
| %11.6f %11.6f %11.6f ", \ | %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, | 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,out[s1][s2],savm[s1][s2]); |
| Line 3393 double hessij( double x[], double **hess | Line 3734 double hessij( double x[], double **hess |
| kmax=kmax+10; | kmax=kmax+10; |
| } | } |
| if(kmax >=10 || firstime ==1){ | if(kmax >=10 || firstime ==1){ |
| printf("Warning: directions %d-%d, you are not estimating the Hessian at the exact maximum likelihood; increase ftol=%.2e\n",thetai,thetaj, ftol); | printf("Warning: directions %d-%d, you are not estimating the Hessian at the exact maximum likelihood; you may increase ftol=%.2e\n",thetai,thetaj, ftol); |
| fprintf(ficlog,"Warning: directions %d-%d, you are not estimating the Hessian at the exact maximum likelihood; increase ftol=%.2e\n",thetai,thetaj, ftol); | fprintf(ficlog,"Warning: directions %d-%d, you are not estimating the Hessian at the exact maximum likelihood; you may increase ftol=%.2e\n",thetai,thetaj, ftol); |
| printf("%d %d k=%d, k1=%.12e k2=%.12e k3=%.12e k4=%.12e delti*k=%.12e deltj*k=%.12e, xi-de*k=%.12e xj-de*k=%.12e res=%.12e k1234=%.12e,k1-2=%.12e,k3-4=%.12e\n",thetai,thetaj,k,k1,k2,k3,k4,delti[thetai]/k,delti[thetaj]/k,x[thetai]-delti[thetai]/k,x[thetaj]-delti[thetaj]/k, res,k1-k2-k3+k4,k1-k2,k3-k4); | printf("%d %d k=%d, k1=%.12e k2=%.12e k3=%.12e k4=%.12e delti*k=%.12e deltj*k=%.12e, xi-de*k=%.12e xj-de*k=%.12e res=%.12e k1234=%.12e,k1-2=%.12e,k3-4=%.12e\n",thetai,thetaj,k,k1,k2,k3,k4,delti[thetai]/k,delti[thetaj]/k,x[thetai]-delti[thetai]/k,x[thetaj]-delti[thetaj]/k, res,k1-k2-k3+k4,k1-k2,k3-k4); |
| fprintf(ficlog,"%d %d k=%d, k1=%.12e k2=%.12e k3=%.12e k4=%.12e delti*k=%.12e deltj*k=%.12e, xi-de*k=%.12e xj-de*k=%.12e res=%.12e k1234=%.12e,k1-2=%.12e,k3-4=%.12e\n",thetai,thetaj,k,k1,k2,k3,k4,delti[thetai]/k,delti[thetaj]/k,x[thetai]-delti[thetai]/k,x[thetaj]-delti[thetaj]/k, res,k1-k2-k3+k4,k1-k2,k3-k4); | fprintf(ficlog,"%d %d k=%d, k1=%.12e k2=%.12e k3=%.12e k4=%.12e delti*k=%.12e deltj*k=%.12e, xi-de*k=%.12e xj-de*k=%.12e res=%.12e k1234=%.12e,k1-2=%.12e,k3-4=%.12e\n",thetai,thetaj,k,k1,k2,k3,k4,delti[thetai]/k,delti[thetaj]/k,x[thetai]-delti[thetai]/k,x[thetaj]-delti[thetaj]/k, res,k1-k2-k3+k4,k1-k2,k3-k4); |
| } | } |
| Line 3551 void pstamp(FILE *fichier) | Line 3892 void pstamp(FILE *fichier) |
| /************ Frequencies ********************/ | /************ Frequencies ********************/ |
| void freqsummary(char fileres[], int iagemin, int iagemax, int **s, double **agev, int nlstate, int imx, \ | void freqsummary(char fileres[], int iagemin, int iagemax, int **s, double **agev, int nlstate, int imx, \ |
| int *Tvaraff, int **nbcode, int *ncodemax,double **mint,double **anint, char strstart[],\ | int *Tvaraff, int *invalidvarcomb, int **nbcode, int *ncodemax,double **mint,double **anint, char strstart[], \ |
| int firstpass, int lastpass, int stepm, int weightopt, char model[]) | int firstpass, int lastpass, int stepm, int weightopt, char model[]) |
| { /* Some frequencies */ | { /* Some frequencies */ |
| int i, m, jk, j1, bool, z1,j; | int i, m, jk, j1, bool, z1,j, k, iv; |
| int iind=0, iage=0; | |
| int mi; /* Effective wave */ | int mi; /* Effective wave */ |
| int first; | int first; |
| double ***freq; /* Frequencies */ | double ***freq; /* Frequencies */ |
| double *pp, **prop; | double *meanq; |
| double pos,posprop, k2, dateintsum=0,k2cpt=0; | double **meanqt; |
| double *pp, **prop, *posprop, *pospropt; | |
| double pos=0., posproptt=0., pospropta=0., k2, dateintsum=0,k2cpt=0; | |
| char fileresp[FILENAMELENGTH], fileresphtm[FILENAMELENGTH], fileresphtmfr[FILENAMELENGTH]; | char fileresp[FILENAMELENGTH], fileresphtm[FILENAMELENGTH], fileresphtmfr[FILENAMELENGTH]; |
| double agebegin, ageend; | double agebegin, ageend; |
| pp=vector(1,nlstate); | pp=vector(1,nlstate); |
| prop=matrix(1,nlstate,iagemin,iagemax+3); | prop=matrix(1,nlstate,iagemin-AGEMARGE,iagemax+3+AGEMARGE); |
| posprop=vector(1,nlstate); /* Counting the number of transition starting from a live state per age */ | |
| pospropt=vector(1,nlstate); /* Counting the number of transition starting from a live state */ | |
| /* prop=matrix(1,nlstate,iagemin,iagemax+3); */ | |
| meanq=vector(1,nqfveff); /* Number of Quantitative Fixed Variables Effective */ | |
| meanqt=matrix(1,lastpass,1,nqtveff); | |
| strcpy(fileresp,"P_"); | strcpy(fileresp,"P_"); |
| strcat(fileresp,fileresu); | strcat(fileresp,fileresu); |
| /*strcat(fileresphtm,fileresu);*/ | /*strcat(fileresphtm,fileresu);*/ |
| Line 3586 void freqsummary(char fileres[], int ia | Line 3935 void freqsummary(char fileres[], int ia |
| fprintf(ficresphtm,"<html><head>\n<title>IMaCh PHTM_ %s</title></head>\n <body><font size=\"2\">%s <br> %s</font> \ | fprintf(ficresphtm,"<html><head>\n<title>IMaCh PHTM_ %s</title></head>\n <body><font size=\"2\">%s <br> %s</font> \ |
| <hr size=\"2\" color=\"#EC5E5E\"> \n\ | <hr size=\"2\" color=\"#EC5E5E\"> \n\ |
| Title=%s <br>Datafile=%s Firstpass=%d Lastpass=%d Stepm=%d Weight=%d Model=1+age+%s<br>\n",\ | Title=%s <br>Datafile=%s Firstpass=%d Lastpass=%d Stepm=%d Weight=%d Model=1+age+%s<br>\n",\ |
| fileresphtm,version,fullversion,title,datafile,firstpass,lastpass,stepm, weightopt, model); | fileresphtm,version,fullversion,title,datafile,firstpass,lastpass,stepm, weightopt, model); |
| } | } |
| fprintf(ficresphtm,"Current page is file <a href=\"%s\">%s</a><br>\n\n<h4>Frequencies and prevalence by age at begin of transition</h4>\n",fileresphtm, fileresphtm); | fprintf(ficresphtm,"Current page is file <a href=\"%s\">%s</a><br>\n\n<h4>Frequencies and prevalence by age at begin of transition</h4>\n",fileresphtm, fileresphtm); |
| strcpy(fileresphtmfr,subdirfext(optionfilefiname,"PHTMFR_",".htm")); | strcpy(fileresphtmfr,subdirfext(optionfilefiname,"PHTMFR_",".htm")); |
| if((ficresphtmfr=fopen(fileresphtmfr,"w"))==NULL) { | if((ficresphtmfr=fopen(fileresphtmfr,"w"))==NULL) { |
| Line 3601 Title=%s <br>Datafile=%s Firstpass=%d La | Line 3950 Title=%s <br>Datafile=%s Firstpass=%d La |
| fprintf(ficresphtmfr,"<html><head>\n<title>IMaCh PHTM_Frequency table %s</title></head>\n <body><font size=\"2\">%s <br> %s</font> \ | fprintf(ficresphtmfr,"<html><head>\n<title>IMaCh PHTM_Frequency table %s</title></head>\n <body><font size=\"2\">%s <br> %s</font> \ |
| <hr size=\"2\" color=\"#EC5E5E\"> \n\ | <hr size=\"2\" color=\"#EC5E5E\"> \n\ |
| Title=%s <br>Datafile=%s Firstpass=%d Lastpass=%d Stepm=%d Weight=%d Model=1+age+%s<br>\n",\ | Title=%s <br>Datafile=%s Firstpass=%d Lastpass=%d Stepm=%d Weight=%d Model=1+age+%s<br>\n",\ |
| fileresphtmfr,version,fullversion,title,datafile,firstpass,lastpass,stepm, weightopt, model); | fileresphtmfr,version,fullversion,title,datafile,firstpass,lastpass,stepm, weightopt, model); |
| } | } |
| fprintf(ficresphtmfr,"Current page is file <a href=\"%s\">%s</a><br>\n\n<h4>Frequencies of all effective transitions by age at begin of transition </h4>Unknown status is -1<br/>\n",fileresphtmfr, fileresphtmfr); | fprintf(ficresphtmfr,"Current page is file <a href=\"%s\">%s</a><br>\n\n<h4>Frequencies of all effective transitions by age at begin of transition </h4>Unknown status is -1<br/>\n",fileresphtmfr, fileresphtmfr); |
| freq= ma3x(-5,nlstate+ndeath,-5,nlstate+ndeath,iagemin,iagemax+3); | freq= ma3x(-5,nlstate+ndeath,-5,nlstate+ndeath,iagemin-AGEMARGE,iagemax+3+AGEMARGE); |
| j1=0; | j1=0; |
| j=cptcoveff; | /* j=ncoveff; /\* Only fixed dummy covariates *\/ */ |
| j=cptcoveff; /* Only dummy covariates of the model */ | |
| if (cptcovn<1) {j=1;ncodemax[1]=1;} | if (cptcovn<1) {j=1;ncodemax[1]=1;} |
| first=1; | first=1; |
| for (j1 = 1; j1 <= (int) pow(2,cptcoveff); j1++){ /* Loop on covariates combination */ | /* Detects if a combination j1 is empty: for a multinomial variable like 3 education levels: |
| /*printf("cptcoveff=%d Tvaraff=%d", cptcoveff,Tvaraff[1]); | reference=low_education V1=0,V2=0 |
| scanf("%d", i);*/ | med_educ V1=1 V2=0, |
| for (i=-5; i<=nlstate+ndeath; i++) | high_educ V1=0 V2=1 |
| for (jk=-5; jk<=nlstate+ndeath; jk++) | Then V1=1 and V2=1 is a noisy combination that we want to exclude for the list 2**cptcoveff |
| for(m=iagemin; m <= iagemax+3; m++) | */ |
| freq[i][jk][m]=0; | |
| 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 (i=1; i<=nlstate; i++) | 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(m=iagemin; m <= iagemax+3; m++) | for(m=iagemin; m <= iagemax+3; m++) |
| prop[i][m]=0; | freq[i][jk][m]=0; |
| dateintsum=0; | for (i=1; i<=nlstate; i++) { |
| k2cpt=0; | for(m=iagemin; m <= iagemax+3; m++) |
| for (i=1; i<=imx; i++) { /* For each individual i */ | prop[i][m]=0; |
| bool=1; | posprop[i]=0; |
| if (cptcovn>0) { /* Filter is here: Must be looked at for model=V1+V2+V3+V4 */ | pospropt[i]=0; |
| for (z1=1; z1<=cptcoveff; z1++) | } |
| if (covar[Tvaraff[z1]][i]!= nbcode[Tvaraff[z1]][codtabm(j1,z1)]){ | /* for (z1=1; z1<= nqfveff; z1++) { */ |
| /* Tests if the value of each of the covariates of i is equal to filter j1 */ | /* meanq[z1]+=0.; */ |
| bool=0; | /* for(m=1;m<=lastpass;m++){ */ |
| /* 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", | /* meanqt[m][z1]=0.; */ |
| bool,i,z1, z1, Tvaraff[z1],i,covar[Tvaraff[z1]][i],j1,z1,codtabm(j1,z1), | /* } */ |
| j1,z1,nbcode[Tvaraff[z1]][codtabm(j1,z1)],j1);*/ | /* } */ |
| /* For j1=7 in V1+V2+V3+V4 = 0 1 1 0 and codtabm(7,3)=1 and nbcde[3][?]=1*/ | |
| } | dateintsum=0; |
| k2cpt=0; | |
| /* For that combination of covariate j1, we count and print the frequencies in one pass */ | |
| for (iind=1; iind<=imx; iind++) { /* For each individual iind */ | |
| bool=1; | |
| if(anyvaryingduminmodel==0){ /* If All fixed covariates */ | |
| if (cptcoveff >0) { /* Filter is here: Must be looked at for model=V1+V2+V3+V4 */ | |
| /* for (z1=1; z1<= nqfveff; z1++) { */ | |
| /* meanq[z1]+=coqvar[Tvar[z1]][iind]; /\* Computes mean of quantitative with selected filter *\/ */ | |
| /* } */ | |
| for (z1=1; z1<=cptcoveff; z1++) { | |
| /* if(Tvaraff[z1] ==-20){ */ | |
| /* /\* sumnew+=cotvar[mw[mi][iind]][z1][iind]; *\/ */ | |
| /* }else if(Tvaraff[z1] ==-10){ */ | |
| /* /\* sumnew+=coqvar[z1][iind]; *\/ */ | |
| /* }else */ | |
| if (covar[Tvaraff[z1]][iind]!= nbcode[Tvaraff[z1]][codtabm(j1,z1)]){ | |
| /* Tests if this individual iind responded to j1 (V4=1 V3=0) */ | |
| bool=0; | |
| /* printf("bool=%d i=%d, z1=%d, Tvaraff[%d]=%d, covar[Tvarff][%d]=%2f, codtabm(%d,%d)=%d, nbcode[Tvaraff][codtabm(%d,%d)=%d, j1=%d\n", | |
| bool,i,z1, z1, Tvaraff[z1],i,covar[Tvaraff[z1]][i],j1,z1,codtabm(j1,z1), | |
| j1,z1,nbcode[Tvaraff[z1]][codtabm(j1,z1)],j1);*/ | |
| /* For j1=7 in V1+V2+V3+V4 = 0 1 1 0 and codtabm(7,3)=1 and nbcde[3][?]=1*/ | |
| } /* Onlyf fixed */ | |
| } /* end z1 */ | |
| } /* cptcovn > 0 */ | } /* cptcovn > 0 */ |
| } /* end any */ | |
| if (bool==1){ | if (bool==1){ /* We selected an individual iind satisfying combination j1 or all fixed */ |
| /* for(m=firstpass; m<=lastpass; m++){ */ | /* for(m=firstpass; m<=lastpass; m++){ */ |
| for(mi=1; mi<wav[i];mi++){ | for(mi=1; mi<wav[iind];mi++){ /* For that wave */ |
| m=mw[mi][i]; | m=mw[mi][iind]; |
| /* dh[m][i] or dh[mw[mi][i]][i] is the delay between two effective (mi) waves m=mw[mi][i] | if(anyvaryingduminmodel==1){ /* Some are varying covariates */ |
| and mw[mi+1][i]. dh depends on stepm. */ | for (z1=1; z1<=cptcoveff; z1++) { |
| agebegin=agev[m][i]; /* Age at beginning of wave before transition*/ | if( Fixed[Tmodelind[z1]]==1){ |
| ageend=agev[m][i]+(dh[m][i])*stepm/YEARM; /* Age at end of wave and transition */ | iv= Tvar[Tmodelind[z1]]-ncovcol-nqv; |
| if (cotvar[m][iv][iind]!= nbcode[Tvaraff[z1]][codtabm(j1,z1)]) /* iv=1 to ntv, right modality */ | |
| bool=0; | |
| }else if( Fixed[Tmodelind[z1]]== 0) { /* fixed */ | |
| if (covar[Tvaraff[z1]][iind]!= nbcode[Tvaraff[z1]][codtabm(j1,z1)]) { | |
| bool=0; | |
| } | |
| } | |
| } | |
| }/* Some are varying covariates, we tried to speed up if all fixed covariates in the model, avoiding waves loop */ | |
| /* bool =0 we keep that guy which corresponds to the combination of dummy values */ | |
| if(bool==1){ | |
| /* dh[m][iind] or dh[mw[mi][iind]][iind] is the delay between two effective (mi) waves m=mw[mi][iind] | |
| and mw[mi+1][iind]. dh depends on stepm. */ | |
| agebegin=agev[m][iind]; /* Age at beginning of wave before transition*/ | |
| ageend=agev[m][iind]+(dh[m][iind])*stepm/YEARM; /* Age at end of wave and transition */ | |
| if(m >=firstpass && m <=lastpass){ | if(m >=firstpass && m <=lastpass){ |
| k2=anint[m][i]+(mint[m][i]/12.); | k2=anint[m][iind]+(mint[m][iind]/12.); |
| /*if ((k2>=dateprev1) && (k2<=dateprev2)) {*/ | /*if ((k2>=dateprev1) && (k2<=dateprev2)) {*/ |
| if(agev[m][i]==0) agev[m][i]=iagemax+1; /* All ages equal to 0 are in iagemax+1 */ | if(agev[m][iind]==0) agev[m][iind]=iagemax+1; /* All ages equal to 0 are in iagemax+1 */ |
| if(agev[m][i]==1) agev[m][i]=iagemax+2; /* All ages equal to 1 are in iagemax+2 */ | if(agev[m][iind]==1) agev[m][iind]=iagemax+2; /* All ages equal to 1 are in iagemax+2 */ |
| if (s[m][i]>0 && s[m][i]<=nlstate) /* If status at wave m is known and a live state */ | if (s[m][iind]>0 && s[m][iind]<=nlstate) /* If status at wave m is known and a live state */ |
| prop[s[m][i]][(int)agev[m][i]] += weight[i]; /* At age of beginning of transition, where status is known */ | prop[s[m][iind]][(int)agev[m][iind]] += weight[iind]; /* At age of beginning of transition, where status is known */ |
| if (m<lastpass) { | if (m<lastpass) { |
| /* if(s[m][i]==4 && s[m+1][i]==4) */ | /* if(s[m][iind]==4 && s[m+1][iind]==4) */ |
| /* printf(" num=%ld m=%d, i=%d s1=%d s2=%d agev at m=%d\n", num[i], m, i,s[m][i],s[m+1][i], (int)agev[m][i]); */ | /* printf(" num=%ld m=%d, iind=%d s1=%d s2=%d agev at m=%d\n", num[iind], m, iind,s[m][iind],s[m+1][iind], (int)agev[m][iind]); */ |
| if(s[m][i]==-1) | if(s[m][iind]==-1) |
| printf(" num=%ld m=%d, i=%d s1=%d s2=%d agev at m=%d agebegin=%.2f ageend=%.2f, agemed=%d\n", num[i], m, i,s[m][i],s[m+1][i], (int)agev[m][i],agebegin, ageend, (int)((agebegin+ageend)/2.)); | printf(" num=%ld m=%d, iind=%d s1=%d s2=%d agev at m=%d agebegin=%.2f ageend=%.2f, agemed=%d\n", num[iind], m, iind,s[m][iind],s[m+1][iind], (int)agev[m][iind],agebegin, ageend, (int)((agebegin+ageend)/2.)); |
| freq[s[m][i]][s[m+1][i]][(int)agev[m][i]] += weight[i]; /* At age of beginning of transition, where status is known */ | freq[s[m][iind]][s[m+1][iind]][(int)agev[m][iind]] += weight[iind]; /* At age of beginning of transition, where status is known */ |
| /* freq[s[m][i]][s[m+1][i]][(int)((agebegin+ageend)/2.)] += weight[i]; */ | /* freq[s[m][iind]][s[m+1][iind]][(int)((agebegin+ageend)/2.)] += weight[iind]; */ |
| freq[s[m][i]][s[m+1][i]][iagemax+3] += weight[i]; /* Total is in iagemax+3 *//* At age of beginning of transition, where status is known */ | freq[s[m][iind]][s[m+1][iind]][iagemax+3] += weight[iind]; /* Total is in iagemax+3 *//* At age of beginning of transition, where status is known */ |
| } | } |
| } | } /* end if between passes */ |
| if ((agev[m][i]>1) && (agev[m][i]< (iagemax+3)) && (anint[m][i]!=9999) && (mint[m][i]!=99)) { | if ((agev[m][iind]>1) && (agev[m][iind]< (iagemax+3)) && (anint[m][iind]!=9999) && (mint[m][iind]!=99)) { |
| dateintsum=dateintsum+k2; | dateintsum=dateintsum+k2; |
| k2cpt++; | k2cpt++; |
| /* printf("i=%ld dateintmean = %lf dateintsum=%lf k2cpt=%lf k2=%lf\n",i, dateintsum/k2cpt, dateintsum,k2cpt, k2); */ | /* printf("iind=%ld dateintmean = %lf dateintsum=%lf k2cpt=%lf k2=%lf\n",iind, dateintsum/k2cpt, dateintsum,k2cpt, k2); */ |
| } | } |
| /*}*/ | } /* end bool 2 */ |
| } /* end m */ | } /* end m */ |
| } /* end bool */ | } /* end bool */ |
| } /* end i = 1 to imx */ | } /* end iind = 1 to imx */ |
| /* prop[s][age] is feeded for any initial and valid live state as well as | |
| /* fprintf(ficresp, "#Count between %.lf/%.lf/%.lf and %.lf/%.lf/%.lf\n",jprev1, mprev1,anprev1,jprev2, mprev2,anprev2);*/ | freq[s1][s2][age] at single age of beginning the transition, for a combination j1 */ |
| pstamp(ficresp); | |
| if (cptcovn>0) { | |
| fprintf(ficresp, "\n#********** Variable "); | /* fprintf(ficresp, "#Count between %.lf/%.lf/%.lf and %.lf/%.lf/%.lf\n",jprev1, mprev1,anprev1,jprev2, mprev2,anprev2);*/ |
| fprintf(ficresphtm, "\n<br/><br/><h3>********** Variable "); | pstamp(ficresp); |
| fprintf(ficresphtmfr, "\n<br/><br/><h3>********** Variable "); | /* if (ncoveff>0) { */ |
| for (z1=1; z1<=cptcoveff; z1++){ | if (cptcoveff>0) { |
| fprintf(ficresp, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); | fprintf(ficresp, "\n#********** Variable "); |
| fprintf(ficresphtm, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); | fprintf(ficresphtm, "\n<br/><br/><h3>********** Variable "); |
| fprintf(ficresphtmfr, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); | fprintf(ficresphtmfr, "\n<br/><br/><h3>********** Variable "); |
| } | for (z1=1; z1<=cptcoveff; z1++){ |
| fprintf(ficresp, "**********\n#"); | fprintf(ficresp, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); |
| fprintf(ficresphtm, "**********</h3>\n"); | fprintf(ficresphtm, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); |
| fprintf(ficresphtmfr, "**********</h3>\n"); | fprintf(ficresphtmfr, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); |
| fprintf(ficlog, "\n#********** Variable "); | } |
| for (z1=1; z1<=cptcoveff; z1++) fprintf(ficlog, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); | fprintf(ficresp, "**********\n#"); |
| fprintf(ficlog, "**********\n"); | fprintf(ficresphtm, "**********</h3>\n"); |
| } | fprintf(ficresphtmfr, "**********</h3>\n"); |
| fprintf(ficresphtm,"<table style=\"text-align:center; border: 1px solid\">"); | fprintf(ficlog, "\n#********** Variable "); |
| for(i=1; i<=nlstate;i++) { | for (z1=1; z1<=cptcoveff; z1++) fprintf(ficlog, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); |
| fprintf(ficresp, " Age Prev(%d) N(%d) N",i,i); | fprintf(ficlog, "**********\n"); |
| fprintf(ficresphtm, "<th>Age</th><th>Prev(%d)</th><th>N(%d)</th><th>N</th>",i,i); | } |
| } | fprintf(ficresphtm,"<table style=\"text-align:center; border: 1px solid\">"); |
| fprintf(ficresp, "\n"); | for(i=1; i<=nlstate;i++) { |
| fprintf(ficresphtm, "\n"); | fprintf(ficresp, " Age Prev(%d) N(%d) N",i,i); |
| fprintf(ficresphtm, "<th>Age</th><th>Prev(%d)</th><th>N(%d)</th><th>N</th>",i,i); | |
| /* Header of frequency table by age */ | } |
| fprintf(ficresphtmfr,"<table style=\"text-align:center; border: 1px solid\">"); | fprintf(ficresp, "\n"); |
| fprintf(ficresphtmfr,"<th>Age</th> "); | fprintf(ficresphtm, "\n"); |
| for(jk=-1; jk <=nlstate+ndeath; jk++){ | |
| for(m=-1; m <=nlstate+ndeath; m++){ | /* Header of frequency table by age */ |
| if(jk!=0 && m!=0) | fprintf(ficresphtmfr,"<table style=\"text-align:center; border: 1px solid\">"); |
| fprintf(ficresphtmfr,"<th>%d%d</th> ",jk,m); | fprintf(ficresphtmfr,"<th>Age</th> "); |
| } | for(jk=-1; jk <=nlstate+ndeath; jk++){ |
| } | for(m=-1; m <=nlstate+ndeath; m++){ |
| fprintf(ficresphtmfr, "\n"); | if(jk!=0 && m!=0) |
| fprintf(ficresphtmfr,"<th>%d%d</th> ",jk,m); | |
| /* For each age */ | } |
| for(i=iagemin; i <= iagemax+3; i++){ | } |
| fprintf(ficresphtm,"<tr>"); | fprintf(ficresphtmfr, "\n"); |
| if(i==iagemax+1){ | |
| fprintf(ficlog,"1"); | /* For each age */ |
| fprintf(ficresphtmfr,"<tr><th>0</th> "); | for(iage=iagemin; iage <= iagemax+3; iage++){ |
| }else if(i==iagemax+2){ | fprintf(ficresphtm,"<tr>"); |
| fprintf(ficlog,"0"); | if(iage==iagemax+1){ |
| fprintf(ficresphtmfr,"<tr><th>Unknown</th> "); | fprintf(ficlog,"1"); |
| }else if(i==iagemax+3){ | fprintf(ficresphtmfr,"<tr><th>0</th> "); |
| fprintf(ficlog,"Total"); | }else if(iage==iagemax+2){ |
| fprintf(ficresphtmfr,"<tr><th>Total</th> "); | fprintf(ficlog,"0"); |
| }else{ | fprintf(ficresphtmfr,"<tr><th>Unknown</th> "); |
| }else if(iage==iagemax+3){ | |
| fprintf(ficlog,"Total"); | |
| fprintf(ficresphtmfr,"<tr><th>Total</th> "); | |
| }else{ | |
| if(first==1){ | |
| first=0; | |
| printf("See log file for details...\n"); | |
| } | |
| fprintf(ficresphtmfr,"<tr><th>%d</th> ",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(jk=1; jk <=nlstate ; jk++){ | |
| for(m=-1, pos=0; m <=0 ; m++) | |
| pos += freq[jk][m][iage]; | |
| if(pp[jk]>=1.e-10){ | |
| if(first==1){ | if(first==1){ |
| first=0; | printf(" %d.=%.0f loss[%d]=%.1f%%",jk,pp[jk],jk,100*pos/pp[jk]); |
| printf("See log file for details...\n"); | |
| } | |
| fprintf(ficresphtmfr,"<tr><th>%d</th> ",i); | |
| fprintf(ficlog,"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]; | |
| } | |
| for(jk=1; jk <=nlstate ; jk++){ | |
| for(m=-1, pos=0; m <=0 ; m++) | |
| pos += freq[jk][m][i]; | |
| if(pp[jk]>=1.e-10){ | |
| if(first==1){ | |
| printf(" %d.=%.0f loss[%d]=%.1f%%",jk,pp[jk],jk,100*pos/pp[jk]); | |
| } | |
| fprintf(ficlog," %d.=%.0f loss[%d]=%.1f%%",jk,pp[jk],jk,100*pos/pp[jk]); | |
| }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); | |
| } | } |
| fprintf(ficlog," %d.=%.0f loss[%d]=%.1f%%",jk,pp[jk],jk,100*pos/pp[jk]); | |
| }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); | |
| } | } |
| } | |
| for(jk=1; jk <=nlstate ; jk++){ | for(jk=1; jk <=nlstate ; jk++){ |
| for(m=0, pp[jk]=0; m <=nlstate+ndeath; m++) | /* posprop[jk]=0; */ |
| pp[jk] += freq[jk][m][i]; | for(m=0, pp[jk]=0; m <=nlstate+ndeath; m++)/* Summing on all ages */ |
| } | pp[jk] += freq[jk][m][iage]; |
| for(jk=1,pos=0,posprop=0; jk <=nlstate ; jk++){ | } /* pp[jk] is the total number of transitions starting from state jk and any ending status until this age */ |
| pos += pp[jk]; | |
| posprop += prop[jk][i]; | 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(jk=1; jk <=nlstate ; jk++){ | |
| 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); | |
| }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); | |
| } | } |
| for(jk=1; jk <=nlstate ; jk++){ | if( iage <= iagemax){ |
| if(pos>=1.e-5){ | if(pos>=1.e-5){ |
| if(first==1) | fprintf(ficresp," %d %.5f %.0f %.0f",iage,prop[jk][iage]/pospropta, prop[jk][iage],pospropta); |
| printf(" %d.=%.0f prev[%d]=%.1f%%",jk,pp[jk],jk,100*pp[jk]/pos); | fprintf(ficresphtm,"<th>%d</th><td>%.5f</td><td>%.0f</td><td>%.0f</td>",iage,prop[jk][iage]/pospropta, prop[jk][iage],pospropta); |
| fprintf(ficlog," %d.=%.0f prev[%d]=%.1f%%",jk,pp[jk],jk,100*pp[jk]/pos); | /*probs[iage][jk][j1]= pp[jk]/pos;*/ |
| }else{ | /*printf("\niage=%d jk=%d j1=%d %.5f %.0f %.0f %f",iage,jk,j1,pp[jk]/pos, pp[jk],pos,probs[iage][jk][j1]);*/ |
| if(first==1) | } |
| printf(" %d.=%.0f prev[%d]=NaNQ%%",jk,pp[jk],jk); | else{ |
| fprintf(ficlog," %d.=%.0f prev[%d]=NaNQ%%",jk,pp[jk],jk); | fprintf(ficresp," %d NaNq %.0f %.0f",iage,prop[jk][iage],pospropta); |
| } | fprintf(ficresphtm,"<th>%d</th><td>NaNq</td><td>%.0f</td><td>%.0f</td>",iage, prop[jk][iage],pospropta); |
| if( i <= iagemax){ | |
| if(pos>=1.e-5){ | |
| fprintf(ficresp," %d %.5f %.0f %.0f",i,prop[jk][i]/posprop, prop[jk][i],posprop); | |
| fprintf(ficresphtm,"<th>%d</th><td>%.5f</td><td>%.0f</td><td>%.0f</td>",i,prop[jk][i]/posprop, prop[jk][i],posprop); | |
| /*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,prop[jk][i],posprop); | |
| fprintf(ficresphtm,"<th>%d</th><td>NaNq</td><td>%.0f</td><td>%.0f</td>",i, prop[jk][i],posprop); | |
| } | |
| } | } |
| } | } |
| pospropt[jk] +=posprop[jk]; | |
| for(jk=-1; jk <=nlstate+ndeath; jk++){ | } /* end loop jk */ |
| for(m=-1; m <=nlstate+ndeath; m++){ | /* pospropt=0.; */ |
| if(freq[jk][m][i] !=0 ) { /* minimizing output */ | for(jk=-1; jk <=nlstate+ndeath; jk++){ |
| if(first==1){ | for(m=-1; m <=nlstate+ndeath; m++){ |
| printf(" %d%d=%.0f",jk,m,freq[jk][m][i]); | if(freq[jk][m][iage] !=0 ) { /* minimizing output */ |
| } | if(first==1){ |
| fprintf(ficlog," %d%d=%.0f",jk,m,freq[jk][m][i]); | printf(" %d%d=%.0f",jk,m,freq[jk][m][iage]); |
| } | } |
| if(jk!=0 && m!=0) | fprintf(ficlog," %d%d=%.0f",jk,m,freq[jk][m][iage]); |
| fprintf(ficresphtmfr,"<td>%.0f</td> ",freq[jk][m][i]); | |
| } | } |
| if(jk!=0 && m!=0) | |
| fprintf(ficresphtmfr,"<td>%.0f</td> ",freq[jk][m][iage]); | |
| } | } |
| fprintf(ficresphtmfr,"</tr>\n "); | } /* end loop jk */ |
| if(i <= iagemax){ | posproptt=0.; |
| fprintf(ficresp,"\n"); | for(jk=1; jk <=nlstate; jk++){ |
| fprintf(ficresphtm,"</tr>\n"); | posproptt += pospropt[jk]; |
| } | } |
| if(first==1) | fprintf(ficresphtmfr,"</tr>\n "); |
| printf("Others in log...\n"); | if(iage <= iagemax){ |
| fprintf(ficlog,"\n"); | fprintf(ficresp,"\n"); |
| } /* end loop i */ | fprintf(ficresphtm,"</tr>\n"); |
| fprintf(ficresphtm,"</table>\n"); | } |
| fprintf(ficresphtmfr,"</table>\n"); | if(first==1) |
| /*}*/ | printf("Others in log...\n"); |
| } /* end j1 */ | fprintf(ficlog,"\n"); |
| } /* end loop age iage */ | |
| fprintf(ficresphtm,"<tr><th>Tot</th>"); | |
| for(jk=1; jk <=nlstate ; jk++){ | |
| if(posproptt < 1.e-5){ | |
| fprintf(ficresphtm,"<td>Nanq</td><td>%.0f</td><td>%.0f</td>",pospropt[jk],posproptt); | |
| }else{ | |
| fprintf(ficresphtm,"<td>%.5f</td><td>%.0f</td><td>%.0f</td>",pospropt[jk]/posproptt,pospropt[jk],posproptt); | |
| } | |
| } | |
| fprintf(ficresphtm,"</tr>\n"); | |
| fprintf(ficresphtm,"</table>\n"); | |
| fprintf(ficresphtmfr,"</table>\n"); | |
| if(posproptt < 1.e-5){ | |
| fprintf(ficresphtm,"\n <p><b> This combination (%d) is not valid and no result will be produced</b></p>",j1); | |
| fprintf(ficresphtmfr,"\n <p><b> This combination (%d) is not valid and no result will be produced</b></p>",j1); | |
| fprintf(ficres,"\n This combination (%d) is not valid and no result will be produced\n\n",j1); | |
| invalidvarcomb[j1]=1; | |
| }else{ | |
| fprintf(ficresphtm,"\n <p> This combination (%d) is valid and result will be produced.</p>",j1); | |
| invalidvarcomb[j1]=0; | |
| } | |
| fprintf(ficresphtmfr,"</table>\n"); | |
| } /* end selected combination of covariate j1 */ | |
| dateintmean=dateintsum/k2cpt; | dateintmean=dateintsum/k2cpt; |
| fclose(ficresp); | fclose(ficresp); |
| fclose(ficresphtm); | fclose(ficresphtm); |
| fclose(ficresphtmfr); | fclose(ficresphtmfr); |
| free_ma3x(freq,-5,nlstate+ndeath,-5,nlstate+ndeath, iagemin, iagemax+3); | free_vector(meanq,1,nqfveff); |
| free_matrix(meanqt,1,lastpass,1,nqtveff); | |
| free_ma3x(freq,-5,nlstate+ndeath,-5,nlstate+ndeath, iagemin-AGEMARGE, iagemax+3+AGEMARGE); | |
| free_vector(pospropt,1,nlstate); | |
| free_vector(posprop,1,nlstate); | |
| free_matrix(prop,1,nlstate,iagemin-AGEMARGE, iagemax+3+AGEMARGE); | |
| free_vector(pp,1,nlstate); | free_vector(pp,1,nlstate); |
| free_matrix(prop,1,nlstate,iagemin, iagemax+3); | /* End of freqsummary */ |
| /* End of Freq */ | |
| } | } |
| /************ Prevalence ********************/ | /************ Prevalence ********************/ |
| Line 3828 void prevalence(double ***probs, double | Line 4257 void prevalence(double ***probs, double |
| We still use firstpass and lastpass as another selection. | We still use firstpass and lastpass as another selection. |
| */ | */ |
| int i, m, jk, j1, bool, z1,j; | int i, m, jk, j1, bool, z1,j, iv; |
| int mi; /* Effective wave */ | int mi; /* Effective wave */ |
| int iage; | int iage; |
| double agebegin, ageend; | double agebegin, ageend; |
| Line 3842 void prevalence(double ***probs, double | Line 4271 void prevalence(double ***probs, double |
| iagemin= (int) agemin; | iagemin= (int) agemin; |
| iagemax= (int) agemax; | iagemax= (int) agemax; |
| /*pp=vector(1,nlstate);*/ | /*pp=vector(1,nlstate);*/ |
| prop=matrix(1,nlstate,iagemin,iagemax+3); | prop=matrix(1,nlstate,iagemin-AGEMARGE,iagemax+3+AGEMARGE); |
| /* freq=ma3x(-1,nlstate+ndeath,-1,nlstate+ndeath,iagemin,iagemax+3);*/ | /* freq=ma3x(-1,nlstate+ndeath,-1,nlstate+ndeath,iagemin,iagemax+3);*/ |
| j1=0; | j1=0; |
| Line 3850 void prevalence(double ***probs, double | Line 4279 void prevalence(double ***probs, double |
| if (cptcovn<1) {j=1;ncodemax[1]=1;} | if (cptcovn<1) {j=1;ncodemax[1]=1;} |
| first=1; | first=1; |
| for(j1=1; j1<= (int) pow(2,cptcoveff);j1++){ | for(j1=1; j1<= (int) pow(2,cptcoveff);j1++){ /* For each combination of covariate */ |
| for (i=1; i<=nlstate; i++) | for (i=1; i<=nlstate; i++) |
| for(iage=iagemin; iage <= iagemax+3; iage++) | for(iage=iagemin-AGEMARGE; iage <= iagemax+3+AGEMARGE; iage++) |
| prop[i][iage]=0.0; | prop[i][iage]=0.0; |
| printf("Prevalence combination of varying and fixed dummies %d\n",j1); | |
| /* fprintf(ficlog," V%d=%d ",Tvaraff[j1],nbcode[Tvaraff[j1]][codtabm(k,j1)]); */ | |
| fprintf(ficlog,"Prevalence combination of varying and fixed dummies %d\n",j1); | |
| for (i=1; i<=imx; i++) { /* Each individual */ | for (i=1; i<=imx; i++) { /* Each individual */ |
| bool=1; | bool=1; |
| if (cptcovn>0) { /* Filter is here: Must be looked at for model=V1+V2+V3+V4 */ | /* for(m=firstpass; m<=lastpass; m++){/\* Other selection (we can limit to certain interviews*\/ */ |
| for (z1=1; z1<=cptcoveff; z1++) | for(mi=1; mi<wav[i];mi++){ /* For this wave too look where individual can be counted V4=0 V3=0 */ |
| if (covar[Tvaraff[z1]][i]!= nbcode[Tvaraff[z1]][codtabm(j1,z1)]) | m=mw[mi][i]; |
| bool=0; | /* Tmodelind[z1]=k is the position of the varying covariate in the model, but which # within 1 to ntv? */ |
| } | /* Tvar[Tmodelind[z1]] is the n of Vn; n-ncovcol-nqv is the first time varying covariate or iv */ |
| if (bool==1) { | for (z1=1; z1<=cptcoveff; z1++){ |
| /* for(m=firstpass; m<=lastpass; m++){/\* Other selection (we can limit to certain interviews*\/ */ | if( Fixed[Tmodelind[z1]]==1){ |
| for(mi=1; mi<wav[i];mi++){ | iv= Tvar[Tmodelind[z1]]-ncovcol-nqv; |
| m=mw[mi][i]; | if (cotvar[m][iv][i]!= nbcode[Tvaraff[z1]][codtabm(j1,z1)]) /* iv=1 to ntv, right modality */ |
| bool=0; | |
| }else if( Fixed[Tmodelind[z1]]== 0) /* fixed */ | |
| if (covar[Tvaraff[z1]][i]!= nbcode[Tvaraff[z1]][codtabm(j1,z1)]) { | |
| bool=0; | |
| } | |
| } | |
| if(bool==1){ /* Otherwise we skip that wave/person */ | |
| agebegin=agev[m][i]; /* Age at beginning of wave before transition*/ | agebegin=agev[m][i]; /* Age at beginning of wave before transition*/ |
| /* ageend=agev[m][i]+(dh[m][i])*stepm/YEARM; /\* Age at end of wave and transition *\/ */ | /* ageend=agev[m][i]+(dh[m][i])*stepm/YEARM; /\* Age at end of wave and transition *\/ */ |
| if(m >=firstpass && m <=lastpass){ | if(m >=firstpass && m <=lastpass){ |
| Line 3873 void prevalence(double ***probs, double | Line 4312 void prevalence(double ***probs, double |
| if ((y2>=dateprev1) && (y2<=dateprev2)) { /* Here is the main selection (fractional years) */ | if ((y2>=dateprev1) && (y2<=dateprev2)) { /* Here is the main selection (fractional years) */ |
| if(agev[m][i]==0) agev[m][i]=iagemax+1; | if(agev[m][i]==0) agev[m][i]=iagemax+1; |
| if(agev[m][i]==1) agev[m][i]=iagemax+2; | if(agev[m][i]==1) agev[m][i]=iagemax+2; |
| if((int)agev[m][i] <iagemin || (int)agev[m][i] >iagemax+3) printf("Error on individual =%d agev[m][i]=%f m=%d\n",i, agev[m][i],m); | if((int)agev[m][i] <iagemin-AGEMARGE || (int)agev[m][i] >iagemax+3+AGEMARGE){ |
| printf("Error on individual # %d agev[m][i]=%f <%d-%d or > %d+3+%d m=%d; either change agemin or agemax or fix data\n",i, agev[m][i],iagemin,AGEMARGE, iagemax,AGEMARGE,m); | |
| exit(1); | |
| } | |
| if (s[m][i]>0 && s[m][i]<=nlstate) { | if (s[m][i]>0 && s[m][i]<=nlstate) { |
| /*if(i>4620) printf(" i=%d m=%d s[m][i]=%d (int)agev[m][i]=%d weight[i]=%f prop=%f\n",i,m,s[m][i],(int)agev[m][m],weight[i],prop[s[m][i]][(int)agev[m][i]]);*/ | /*if(i>4620) printf(" i=%d m=%d s[m][i]=%d (int)agev[m][i]=%d weight[i]=%f prop=%f\n",i,m,s[m][i],(int)agev[m][m],weight[i],prop[s[m][i]][(int)agev[m][i]]);*/ |
| prop[s[m][i]][(int)agev[m][i]] += weight[i];/* At age of beginning of transition, where status is known */ | prop[s[m][i]][(int)agev[m][i]] += weight[i];/* At age of beginning of transition, where status is known */ |
| Line 3881 void prevalence(double ***probs, double | Line 4323 void prevalence(double ***probs, double |
| } /* end valid statuses */ | } /* end valid statuses */ |
| } /* end selection of dates */ | } /* end selection of dates */ |
| } /* end selection of waves */ | } /* end selection of waves */ |
| } /* end effective waves */ | } /* end bool */ |
| } /* end bool */ | } /* end wave */ |
| } | } /* end individual */ |
| for(i=iagemin; i <= iagemax+3; i++){ | for(i=iagemin; i <= iagemax+3; i++){ |
| for(jk=1,posprop=0; jk <=nlstate ; jk++) { | for(jk=1,posprop=0; jk <=nlstate ; jk++) { |
| posprop += prop[jk][i]; | posprop += prop[jk][i]; |
| Line 3896 void prevalence(double ***probs, double | Line 4338 void prevalence(double ***probs, double |
| } else{ | } else{ |
| if(first==1){ | if(first==1){ |
| first=0; | first=0; |
| printf("Warning Observed prevalence probs[%d][%d][%d]=%lf because of lack of cases\nSee others on log file...\n",jk,i,j1,probs[i][jk][j1]); | 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]); |
| } | } |
| } | } |
| } | } |
| }/* end jk */ | }/* end jk */ |
| }/* end i */ | }/* end i */ |
| /*} *//* end i1 */ | /*} *//* end i1 */ |
| } /* end j1 */ | } /* end j1 */ |
| /* free_ma3x(freq,-1,nlstate+ndeath,-1,nlstate+ndeath, iagemin, iagemax+3);*/ | /* free_ma3x(freq,-1,nlstate+ndeath,-1,nlstate+ndeath, iagemin, iagemax+3);*/ |
| /*free_vector(pp,1,nlstate);*/ | /*free_vector(pp,1,nlstate);*/ |
| free_matrix(prop,1,nlstate, iagemin,iagemax+3); | free_matrix(prop,1,nlstate, iagemin-AGEMARGE,iagemax+3+AGEMARGE); |
| } /* End of prevalence */ | } /* End of prevalence */ |
| /************* Waves Concatenation ***************/ | /************* Waves Concatenation ***************/ |
| Line 3919 void concatwav(int wav[], int **dh, int | Line 4361 void concatwav(int wav[], int **dh, int |
| mw[mi][i] is the mi (mi=1 to wav[i]) effective wave of individual i | mw[mi][i] is the mi (mi=1 to wav[i]) effective wave of individual i |
| dh[m][i] or dh[mw[mi][i]][i] is the delay between two effective waves m=mw[mi][i] | dh[m][i] or dh[mw[mi][i]][i] is the delay between two effective waves m=mw[mi][i] |
| and mw[mi+1][i]. dh depends on stepm. | and mw[mi+1][i]. dh depends on stepm. |
| */ | */ |
| int i, mi, m; | int i=0, mi=0, m=0, mli=0; |
| /* int j, k=0,jk, ju, jl,jmin=1e+5, jmax=-1; | /* int j, k=0,jk, ju, jl,jmin=1e+5, jmax=-1; |
| double sum=0., jmean=0.;*/ | double sum=0., jmean=0.;*/ |
| int first, firstwo, firsthree; | int first=0, firstwo=0, firsthree=0, firstfour=0, firstfiv=0; |
| int j, k=0,jk, ju, jl; | int j, k=0,jk, ju, jl; |
| double sum=0.; | double sum=0.; |
| first=0; | first=0; |
| firstwo=0; | firstwo=0; |
| firsthree=0; | firsthree=0; |
| firstfour=0; | |
| jmin=100000; | jmin=100000; |
| jmax=-1; | jmax=-1; |
| jmean=0.; | jmean=0.; |
| /* Treating live states */ | |
| for(i=1; i<=imx; i++){ /* For simple cases and if state is death */ | for(i=1; i<=imx; i++){ /* For simple cases and if state is death */ |
| mi=0; | mi=0; /* First valid wave */ |
| mli=0; /* Last valid wave */ | |
| m=firstpass; | m=firstpass; |
| while(s[m][i] <= nlstate){ /* a live state */ | while(s[m][i] <= nlstate){ /* a live state */ |
| if(s[m][i]>=1 || s[m][i]==-4 || s[m][i]==-5){ /* Since 0.98r4 if status=-2 vital status is really unknown, wave should be skipped */ | if(m >firstpass && s[m][i]==s[m-1][i] && mint[m][i]==mint[m-1][i] && anint[m][i]==anint[m-1][i]){/* Two succesive identical information on wave m */ |
| mli=m-1;/* mw[++mi][i]=m-1; */ | |
| }else if(s[m][i]>=1 || s[m][i]==-4 || s[m][i]==-5){ /* Since 0.98r4 if status=-2 vital status is really unknown, wave should be skipped */ | |
| mw[++mi][i]=m; | mw[++mi][i]=m; |
| mli=m; | |
| } /* else might be a useless wave -1 and mi is not incremented and mw[mi] not updated */ | |
| if(m < lastpass){ /* m < lastpass, standard case */ | |
| m++; /* mi gives the "effective" current wave, m the current wave, go to next wave by incrementing m */ | |
| } | } |
| if(m >=lastpass){ | else{ /* m >= lastpass, eventual special issue with warning */ |
| #ifdef UNKNOWNSTATUSNOTCONTRIBUTING | |
| break; | |
| #else | |
| if(s[m][i]==-1 && (int) andc[i] == 9999 && (int)anint[m][i] != 9999){ | if(s[m][i]==-1 && (int) andc[i] == 9999 && (int)anint[m][i] != 9999){ |
| if(firsthree == 0){ | if(firsthree == 0){ |
| printf("Information! Unknown health status for individual %ld line=%d occurred at last wave %d at known date %d/%d. Please, check if your unknown date of death %d/%d means a live state %d at wave %d. This case(%d)/wave(%d) contributes to the likelihood.\nOthers in log file only\n",num[i],i,lastpass,(int)mint[m][i],(int)anint[m][i], (int) moisdc[i], (int) andc[i], s[m][i], m, i, m); | printf("Information! Unknown status for individual %ld line=%d occurred at last wave %d at known date %d/%d. Please, check if your unknown date of death %d/%d means a live state %d at wave %d. This case(%d)/wave(%d) contributes to the likelihood as pi. .\nOthers in log file only\n",num[i],i,lastpass,(int)mint[m][i],(int)anint[m][i], (int) moisdc[i], (int) andc[i], s[m][i], m, i, m); |
| fprintf(ficlog,"Information! Unknown status for individual %ld line=%d occurred at last wave %d at known date %d/%d. Please, check if your unknown date of death %d/%d means a live state %d at wave %d. This case(%d)/wave(%d) contributes to the likelihood.\nOthers in log file only\n",num[i],i,lastpass,(int)mint[m][i],(int)anint[m][i], (int) moisdc[i], (int) andc[i], s[m][i], m, i, m); | |
| firsthree=1; | firsthree=1; |
| }else{ | |
| fprintf(ficlog,"Information! Unknown status for individual %ld line=%d occurred at last wave %d at known date %d/%d. Please, check if your unknown date of death %d/%d means a live state %d at wave %d. This case(%d)/wave(%d) contributes to the likelihood.\nOthers in log file only\n",num[i],i,lastpass,(int)mint[m][i],(int)anint[m][i], (int) moisdc[i], (int) andc[i], s[m][i], m, i, m); | |
| } | } |
| fprintf(ficlog,"Information! Unknown status for individual %ld line=%d occurred at last wave %d at known date %d/%d. Please, check if your unknown date of death %d/%d means a live state %d at wave %d. This case(%d)/wave(%d) contributes to the likelihood as pi. .\n",num[i],i,lastpass,(int)mint[m][i],(int)anint[m][i], (int) moisdc[i], (int) andc[i], s[m][i], m, i, m); | |
| mw[++mi][i]=m; | mw[++mi][i]=m; |
| mli=m; | |
| } | } |
| if(s[m][i]==-2){ /* Vital status is really unknown */ | if(s[m][i]==-2){ /* Vital status is really unknown */ |
| nbwarn++; | nbwarn++; |
| if((int)anint[m][i] == 9999){ /* Has the vital status really been verified? */ | if((int)anint[m][i] == 9999){ /* Has the vital status really been verified? */ |
| printf("Warning! Vital status for individual %ld (line=%d) at last wave %d interviewed at date %d/%d is unknown %d. Please, check if the vital status and the date of death %d/%d are really unknown. This case (%d)/wave (%d) is skipped, no contribution to likelihood.\nOthers in log file only\n",num[i],i,lastpass,(int)mint[m][i],(int)anint[m][i], s[m][i], (int) moisdc[i], (int) andc[i], i, m); | printf("Warning! Vital status for individual %ld (line=%d) at last wave %d interviewed at date %d/%d is unknown %d. Please, check if the vital status and the date of death %d/%d are really unknown. This case (%d)/wave (%d) is skipped, no contribution to likelihood.\nOthers in log file only\n",num[i],i,lastpass,(int)mint[m][i],(int)anint[m][i], s[m][i], (int) moisdc[i], (int) andc[i], i, m); |
| fprintf(ficlog,"Warning! Vital status for individual %ld (line=%d) at last wave %d interviewed at date %d/%d is unknown %d. Please, check if the vital status and the date of death %d/%d are really unknown. This case (%d)/wave (%d) is skipped, no contribution to likelihood.\nOthers in log file only\n",num[i],i,lastpass,(int)mint[m][i],(int)anint[m][i], s[m][i], (int) moisdc[i], (int) andc[i], i, m); | fprintf(ficlog,"Warning! Vital status for individual %ld (line=%d) at last wave %d interviewed at date %d/%d is unknown %d. Please, check if the vital status and the date of death %d/%d are really unknown. This case (%d)/wave (%d) is skipped, no contribution to likelihood.\n",num[i],i,lastpass,(int)mint[m][i],(int)anint[m][i], s[m][i], (int) moisdc[i], (int) andc[i], i, m); |
| } | } |
| break; | break; |
| } | } |
| break; | break; |
| } | #endif |
| else | }/* End m >= lastpass */ |
| m++; | |
| }/* end while */ | }/* end while */ |
| /* mi is the last effective wave, m is lastpass, mw[j][i] gives the # of j-th effective wave for individual i */ | |
| /* After last pass */ | /* After last pass */ |
| /* Treating death states */ | |
| if (s[m][i] > nlstate){ /* In a death state */ | if (s[m][i] > nlstate){ /* In a death state */ |
| /* if( mint[m][i]==mdc[m][i] && anint[m][i]==andc[m][i]){ /\* same date of death and date of interview *\/ */ | |
| /* } */ | |
| mi++; /* Death is another wave */ | mi++; /* Death is another wave */ |
| /* if(mi==0) never been interviewed correctly before death */ | /* if(mi==0) never been interviewed correctly before death */ |
| /* Only death is a correct wave */ | /* Only death is a correct wave */ |
| mw[mi][i]=m; | mw[mi][i]=m; |
| }else if ((int) andc[i] != 9999) { /* Status is either death or negative. A death occured after lastpass, we can't take it into account because of potential bias */ | } |
| #ifndef DISPATCHINGKNOWNDEATHAFTERLASTWAVE | |
| else if ((int) andc[i] != 9999) { /* Status is negative. A death occured after lastpass, we can't take it into account because of potential bias */ | |
| /* m++; */ | /* m++; */ |
| /* mi++; */ | /* mi++; */ |
| /* s[m][i]=nlstate+1; /\* We are setting the status to the last of non live state *\/ */ | /* s[m][i]=nlstate+1; /\* We are setting the status to the last of non live state *\/ */ |
| /* mw[mi][i]=m; */ | /* mw[mi][i]=m; */ |
| nberr++; | if ((int)anint[m][i]!= 9999) { /* date of last interview is known */ |
| if(firstwo==0){ | if((andc[i]+moisdc[i]/12.) <=(anint[m][i]+mint[m][i]/12.)){ /* death occured before last wave and status should have been death instead of -1 */ |
| printf("Error! Death for individual %ld line=%d occurred %d/%d after last wave %d interviewed at %d/%d. Potential bias if other individuals are still alive at this date but ignored. This case (%d)/wave (%d) is skipped, no contribution to likelihood.\nOthers in log file only\n",num[i],i,(int) moisdc[i], (int) andc[i], lastpass,(int)mint[m][i],(int)anint[m][i], i,m ); | nbwarn++; |
| fprintf(ficlog,"Error! Death for individual %ld line=%d occurred %d/%d after last wave %d interviewed at %d/%d. Potential bias if other individuals are still alive at this date but ignored. This case (%d)/wave (%d) is skipped, no contribution to likelihood.\nOthers in log file only\n",num[i],i,(int) moisdc[i], (int) andc[i], lastpass,(int)mint[m][i],(int)anint[m][i], i,m ); | if(firstfiv==0){ |
| firstwo=1; | printf("Warning! Death for individual %ld line=%d occurred at %d/%d before last wave %d interviewed at %d/%d and should have been coded as death instead of '%d'. This case (%d)/wave (%d) is contributing to likelihood.\nOthers in log file only\n",num[i],i,(int) moisdc[i], (int) andc[i], lastpass,(int)mint[m][i],(int)anint[m][i], s[m][i], i,m ); |
| }else if(firstwo==1){ | firstfiv=1; |
| fprintf(ficlog,"Error! Death for individual %ld line=%d occurred %d/%d after last wave %d interviewed at %d/%d. Potential bias if other individuals are still alive at this date but ignored. This case (%d)/wave (%d) is skipped, no contribution to likelihood.\nOthers in log file only\n",num[i],i,(int) moisdc[i], (int) andc[i], lastpass,(int)mint[m][i],(int)anint[m][i], i,m ); | }else{ |
| fprintf(ficlog,"Warning! Death for individual %ld line=%d occurred at %d/%d before last wave %d interviewed at %d/%d and should have been coded as death instead of '%d'. This case (%d)/wave (%d) is contributing to likelihood.\n",num[i],i,(int) moisdc[i], (int) andc[i], lastpass,(int)mint[m][i],(int)anint[m][i], s[m][i], i,m ); | |
| } | |
| }else{ /* Death occured afer last wave potential bias */ | |
| nberr++; | |
| if(firstwo==0){ | |
| printf("Error! Death for individual %ld line=%d occurred at %d/%d after last wave %d interviewed at %d/%d. Potential bias if other individuals are still alive at this date but ignored. This case (%d)/wave (%d) is skipped, no contribution to likelihood.\nOthers in log file only\n",num[i],i,(int) moisdc[i], (int) andc[i], lastpass,(int)mint[m][i],(int)anint[m][i], i,m ); | |
| firstwo=1; | |
| } | |
| fprintf(ficlog,"Error! Death for individual %ld line=%d occurred at %d/%d after last wave %d interviewed at %d/%d. Potential bias if other individuals are still alive at this date but ignored. This case (%d)/wave (%d) is skipped, no contribution to likelihood.\n",num[i],i,(int) moisdc[i], (int) andc[i], lastpass,(int)mint[m][i],(int)anint[m][i], i,m ); | |
| } | |
| }else{ /* end date of interview is known */ | |
| /* death is known but not confirmed by death status at any wave */ | |
| if(firstfour==0){ | |
| printf("Error! Death for individual %ld line=%d occurred %d/%d but not confirmed by any death status for any wave, including last wave %d at unknown date %d/%d. Potential bias if other individuals are still alive at this date but ignored. This case (%d)/wave (%d) is skipped, no contribution to likelihood.\nOthers in log file only\n",num[i],i,(int) moisdc[i], (int) andc[i], lastpass,(int)mint[m][i],(int)anint[m][i], i,m ); | |
| firstfour=1; | |
| } | |
| fprintf(ficlog,"Error! Death for individual %ld line=%d occurred %d/%d but not confirmed by any death status for any wave, including last wave %d at unknown date %d/%d. Potential bias if other individuals are still alive at this date but ignored. This case (%d)/wave (%d) is skipped, no contribution to likelihood.\n",num[i],i,(int) moisdc[i], (int) andc[i], lastpass,(int)mint[m][i],(int)anint[m][i], i,m ); | |
| } | } |
| } | } /* end if date of death is known */ |
| wav[i]=mi; | #endif |
| wav[i]=mi; /* mi should be the last effective wave (or mli) */ | |
| /* wav[i]=mw[mi][i]; */ | |
| if(mi==0){ | if(mi==0){ |
| nbwarn++; | nbwarn++; |
| if(first==0){ | if(first==0){ |
| Line 3998 void concatwav(int wav[], int **dh, int | Line 4476 void concatwav(int wav[], int **dh, int |
| } /* end mi==0 */ | } /* end mi==0 */ |
| } /* End individuals */ | } /* End individuals */ |
| /* wav and mw are no more changed */ | /* wav and mw are no more changed */ |
| for(i=1; i<=imx; i++){ | for(i=1; i<=imx; i++){ |
| for(mi=1; mi<wav[i];mi++){ | for(mi=1; mi<wav[i];mi++){ |
| Line 4034 void concatwav(int wav[], int **dh, int | Line 4512 void concatwav(int wav[], int **dh, int |
| else{ | else{ |
| j= rint( (agev[mw[mi+1][i]][i]*12 - agev[mw[mi][i]][i]*12)); | j= rint( (agev[mw[mi+1][i]][i]*12 - agev[mw[mi][i]][i]*12)); |
| /* if (j<0) printf("%d %lf %lf %d %d %d\n", i,agev[mw[mi+1][i]][i], agev[mw[mi][i]][i],j,s[mw[mi][i]][i] ,s[mw[mi+1][i]][i]); */ | /* if (j<0) printf("%d %lf %lf %d %d %d\n", i,agev[mw[mi+1][i]][i], agev[mw[mi][i]][i],j,s[mw[mi][i]][i] ,s[mw[mi+1][i]][i]); */ |
| k=k+1; | k=k+1; |
| if (j >= jmax) { | if (j >= jmax) { |
| jmax=j; | jmax=j; |
| Line 4088 void concatwav(int wav[], int **dh, int | Line 4566 void concatwav(int wav[], int **dh, int |
| jmean=sum/k; | jmean=sum/k; |
| printf("Delay (in months) between two waves Min=%d (for indiviudal %ld) Max=%d (%ld) Mean=%f\n\n ",jmin, num[ijmin], jmax, num[ijmax], jmean); | printf("Delay (in months) between two waves Min=%d (for indiviudal %ld) Max=%d (%ld) Mean=%f\n\n ",jmin, num[ijmin], jmax, num[ijmax], jmean); |
| fprintf(ficlog,"Delay (in months) between two waves Min=%d (for indiviudal %d) Max=%d (%d) Mean=%f\n\n ",jmin, ijmin, jmax, ijmax, jmean); | fprintf(ficlog,"Delay (in months) between two waves Min=%d (for indiviudal %d) Max=%d (%d) Mean=%f\n\n ",jmin, ijmin, jmax, ijmax, jmean); |
| } | } |
| /*********** Tricode ****************************/ | /*********** Tricode ****************************/ |
| void tricode(int *Tvar, int **nbcode, int imx, int *Ndum) | void tricode(int *cptcov, int *Tvar, int **nbcode, int imx, int *Ndum) |
| { | { |
| /**< Uses cptcovn+2*cptcovprod as the number of covariates */ | /**< Uses cptcovn+2*cptcovprod as the number of covariates */ |
| /* Tvar[i]=atoi(stre); find 'n' in Vn and stores in Tvar. If model=V2+V1 Tvar[1]=2 and Tvar[2]=1 | /* Tvar[i]=atoi(stre); find 'n' in Vn and stores in Tvar. If model=V2+V1 Tvar[1]=2 and Tvar[2]=1 |
| * Boring subroutine which should only output nbcode[Tvar[j]][k] | * Boring subroutine which should only output nbcode[Tvar[j]][k] |
| * Tvar[5] in V2+V1+V3*age+V2*V4 is 2 (V2) | * Tvar[5] in V2+V1+V3*age+V2*V4 is 4 (V4) even it is a time varying or quantitative variable |
| * nbcode[Tvar[j]][1]= | * nbcode[Tvar[5]][1]= nbcode[4][1]=0, nbcode[4][2]=1 (usually); |
| */ | */ |
| int ij=1, k=0, j=0, i=0, maxncov=NCOVMAX; | int ij=1, k=0, j=0, i=0, maxncov=NCOVMAX; |
| Line 4106 void tricode(int *Tvar, int **nbcode, in | Line 4584 void tricode(int *Tvar, int **nbcode, in |
| int modmincovj=0; /* Modality min of covariates j */ | int modmincovj=0; /* Modality min of covariates j */ |
| cptcoveff=0; | /* cptcoveff=0; */ |
| /* *cptcov=0; */ | |
| for (k=1; k <= maxncov; k++) ncodemax[k]=0; /* Horrible constant again replaced by NCOVMAX */ | for (k=1; k <= maxncov; k++) ncodemax[k]=0; /* Horrible constant again replaced by NCOVMAX */ |
| /* Loop on covariates without age and products */ | /* Loop on covariates without age and products and no quantitative variable */ |
| for (j=1; j<=(cptcovs); j++) { /* From model V1 + V2*age+ V3 + V3*V4 keeps V1 + V3 = 2 only */ | /* for (j=1; j<=(cptcovs); j++) { /\* From model V1 + V2*age+ V3 + V3*V4 keeps V1 + V3 = 2 only *\/ */ |
| for (k=-1; k < maxncov; k++) Ndum[k]=0; | for (k=1; k<=cptcovt; k++) { /* From model V1 + V2*age + V3 + V3*V4 keeps V1 + V3 = 2 only */ |
| for (i=1; i<=imx; i++) { /* Loop on individuals: reads the data file to get the maximum value of the | for (j=-1; (j < maxncov); j++) Ndum[j]=0; |
| modality of this covariate Vj*/ | if(Dummy[k]==0 && Typevar[k] !=1){ /* Dummy covariate and not age product */ |
| ij=(int)(covar[Tvar[j]][i]); /* ij=0 or 1 or -1. Value of the covariate Tvar[j] for individual i | switch(Fixed[k]) { |
| * If product of Vn*Vm, still boolean *: | case 0: /* Testing on fixed dummy covariate, simple or product of fixed */ |
| * If it was coded 1, 2, 3, 4 should be splitted into 3 boolean variables | for (i=1; i<=imx; i++) { /* Loop on individuals: reads the data file to get the maximum value of the modality of this covariate Vj*/ |
| * 1 => 0 0 0, 2 => 0 0 1, 3 => 0 1 1, 4=1 0 0 */ | ij=(int)(covar[Tvar[k]][i]); |
| /* Finds for covariate j, n=Tvar[j] of Vn . ij is the | /* ij=0 or 1 or -1. Value of the covariate Tvar[j] for individual i |
| modality of the nth covariate of individual i. */ | * If product of Vn*Vm, still boolean *: |
| if (ij > modmaxcovj) | * If it was coded 1, 2, 3, 4 should be splitted into 3 boolean variables |
| modmaxcovj=ij; | * 1 => 0 0 0, 2 => 0 0 1, 3 => 0 1 1, 4=1 0 0 */ |
| else if (ij < modmincovj) | /* Finds for covariate j, n=Tvar[j] of Vn . ij is the |
| modmincovj=ij; | modality of the nth covariate of individual i. */ |
| if ((ij < -1) && (ij > NCOVMAX)){ | if (ij > modmaxcovj) |
| printf( "Error: minimal is less than -1 or maximal is bigger than %d. Exiting. \n", NCOVMAX ); | modmaxcovj=ij; |
| exit(1); | else if (ij < modmincovj) |
| }else | modmincovj=ij; |
| Ndum[ij]++; /*counts and stores the occurence of this modality 0, 1, -1*/ | if ((ij < -1) && (ij > NCOVMAX)){ |
| /* If coded 1, 2, 3 , counts the number of 1 Ndum[1], number of 2, Ndum[2], etc */ | printf( "Error: minimal is less than -1 or maximal is bigger than %d. Exiting. \n", NCOVMAX ); |
| /*printf("i=%d ij=%d Ndum[ij]=%d imx=%d",i,ij,Ndum[ij],imx);*/ | exit(1); |
| /* getting the maximum value of the modality of the covariate | }else |
| (should be 0 or 1 now) Tvar[j]. If V=sex and male is coded 0 and | Ndum[ij]++; /*counts and stores the occurence of this modality 0, 1, -1*/ |
| female is 1, then modmaxcovj=1.*/ | /* If coded 1, 2, 3 , counts the number of 1 Ndum[1], number of 2, Ndum[2], etc */ |
| } /* end for loop on individuals i */ | /*printf("i=%d ij=%d Ndum[ij]=%d imx=%d",i,ij,Ndum[ij],imx);*/ |
| printf(" Minimal and maximal values of %d th covariate V%d: min=%d max=%d \n", j, Tvar[j], modmincovj, modmaxcovj); | /* getting the maximum value of the modality of the covariate |
| fprintf(ficlog," Minimal and maximal values of %d th covariate V%d: min=%d max=%d \n", j, Tvar[j], modmincovj, modmaxcovj); | (should be 0 or 1 now) Tvar[j]. If V=sex and male is coded 0 and |
| cptcode=modmaxcovj; | female ies 1, then modmaxcovj=1. |
| /* Ndum[0] = frequency of 0 for model-covariate j, Ndum[1] frequency of 1 etc. */ | */ |
| /*for (i=0; i<=cptcode; i++) {*/ | } /* end for loop on individuals i */ |
| for (k=modmincovj; k<=modmaxcovj; k++) { /* k=-1 ? 0 and 1*//* For each value k of the modality of model-cov j */ | printf(" Minimal and maximal values of %d th covariate V%d: min=%d max=%d \n", k, Tvar[k], modmincovj, modmaxcovj); |
| printf("Frequencies of covariates %d ie V%d with value %d: %d\n", j, Tvar[j], k, Ndum[k]); | fprintf(ficlog," Minimal and maximal values of %d th covariate V%d: min=%d max=%d \n", k, Tvar[k], modmincovj, modmaxcovj); |
| fprintf(ficlog, "Frequencies of covariates %d ie V%d with value %d: %d\n", j, Tvar[j], k, Ndum[k]); | cptcode=modmaxcovj; |
| if( Ndum[k] != 0 ){ /* Counts if nobody answered modality k ie empty modality, we skip it and reorder */ | /* Ndum[0] = frequency of 0 for model-covariate j, Ndum[1] frequency of 1 etc. */ |
| if( k != -1){ | /*for (i=0; i<=cptcode; i++) {*/ |
| ncodemax[j]++; /* ncodemax[j]= Number of modalities of the j th | for (j=modmincovj; j<=modmaxcovj; j++) { /* j=-1 ? 0 and 1*//* For each value j of the modality of model-cov k */ |
| covariate for which somebody answered excluding | printf("Frequencies of covariates %d ie V%d with value %d: %d\n", k, Tvar[k], j, Ndum[j]); |
| undefined. Usually 2: 0 and 1. */ | fprintf(ficlog, "Frequencies of covariates %d ie V%d with value %d: %d\n", k, Tvar[k], j, Ndum[j]); |
| } | if( Ndum[j] != 0 ){ /* Counts if nobody answered modality j ie empty modality, we skip it and reorder */ |
| ncodemaxwundef[j]++; /* ncodemax[j]= Number of modalities of the j th | if( j != -1){ |
| covariate for which somebody answered including | ncodemax[k]++; /* ncodemax[k]= Number of modalities of the k th |
| undefined. Usually 3: -1, 0 and 1. */ | covariate for which somebody answered excluding |
| } | undefined. Usually 2: 0 and 1. */ |
| /* In fact ncodemax[j]=2 (dichotom. variables only) but it could be more for | } |
| historical reasons: 3 if coded 1, 2, 3 and 4 and Ndum[2]=0 */ | ncodemaxwundef[k]++; /* ncodemax[j]= Number of modalities of the k th |
| } /* Ndum[-1] number of undefined modalities */ | covariate for which somebody answered including |
| undefined. Usually 3: -1, 0 and 1. */ | |
| /* j is a covariate, n=Tvar[j] of Vn; Fills nbcode */ | } |
| /* For covariate j, modalities could be 1, 2, 3, 4, 5, 6, 7. | /* In fact ncodemax[k]=2 (dichotom. variables only) but it could be more for |
| If Ndum[1]=0, Ndum[2]=0, Ndum[3]= 635, Ndum[4]=0, Ndum[5]=0, Ndum[6]=27, Ndum[7]=125; | * historical reasons: 3 if coded 1, 2, 3 and 4 and Ndum[2]=0 */ |
| modmincovj=3; modmaxcovj = 7; | } /* Ndum[-1] number of undefined modalities */ |
| There are only 3 modalities non empty 3, 6, 7 (or 2 if 27 is too few) : ncodemax[j]=3; | |
| which will be coded 0, 1, 2 which in binary on 2=3-1 digits are 0=00 1=01, 2=10; | /* j is a covariate, n=Tvar[j] of Vn; Fills nbcode */ |
| defining two dummy variables: variables V1_1 and V1_2. | /* For covariate j, modalities could be 1, 2, 3, 4, 5, 6, 7. |
| nbcode[Tvar[j]][ij]=k; | If Ndum[1]=0, Ndum[2]=0, Ndum[3]= 635, Ndum[4]=0, Ndum[5]=0, Ndum[6]=27, Ndum[7]=125; |
| nbcode[Tvar[j]][1]=0; | modmincovj=3; modmaxcovj = 7; |
| nbcode[Tvar[j]][2]=1; | There are only 3 modalities non empty 3, 6, 7 (or 2 if 27 is too few) : ncodemax[j]=3; |
| nbcode[Tvar[j]][3]=2; | which will be coded 0, 1, 2 which in binary on 2=3-1 digits are 0=00 1=01, 2=10; |
| To be continued (not working yet). | defining two dummy variables: variables V1_1 and V1_2. |
| */ | nbcode[Tvar[j]][ij]=k; |
| ij=0; /* ij is similar to i but can jump over null modalities */ | nbcode[Tvar[j]][1]=0; |
| for (i=modmincovj; i<=modmaxcovj; i++) { /* i= 1 to 2 for dichotomous, or from 1 to 3 or from -1 or 0 to 1 currently*/ | nbcode[Tvar[j]][2]=1; |
| if (Ndum[i] == 0) { /* If nobody responded to this modality k */ | nbcode[Tvar[j]][3]=2; |
| break; | To be continued (not working yet). |
| */ | |
| ij=0; /* ij is similar to i but can jump over null modalities */ | |
| for (i=modmincovj; i<=modmaxcovj; i++) { /* i= 1 to 2 for dichotomous, or from 1 to 3 or from -1 or 0 to 1 currently*/ | |
| if (Ndum[i] == 0) { /* If nobody responded to this modality k */ | |
| break; | |
| } | |
| ij++; | |
| nbcode[Tvar[k]][ij]=i; /* stores the original value of modality i in an array nbcode, ij modality from 1 to last non-nul modality. nbcode[1][1]=0 nbcode[1][2]=1*/ | |
| cptcode = ij; /* New max modality for covar j */ | |
| } /* end of loop on modality i=-1 to 1 or more */ | |
| break; | |
| case 1: /* Testing on varying covariate, could be simple and | |
| * should look at waves or product of fixed * | |
| * varying. No time to test -1, assuming 0 and 1 only */ | |
| ij=0; | |
| for(i=0; i<=1;i++){ | |
| nbcode[Tvar[k]][++ij]=i; | |
| } | } |
| ij++; | break; |
| nbcode[Tvar[j]][ij]=i; /* stores the original value of modality i in an array nbcode, ij modality from 1 to last non-nul modality.*/ | default: |
| cptcode = ij; /* New max modality for covar j */ | break; |
| } /* end of loop on modality i=-1 to 1 or more */ | } /* end switch */ |
| } /* end dummy test */ | |
| /* for (k=0; k<= cptcode; k++) { /\* k=-1 ? k=0 to 1 *\//\* Could be 1 to 4 *\//\* cptcode=modmaxcovj *\/ */ | /* for (k=0; k<= cptcode; k++) { /\* k=-1 ? k=0 to 1 *\//\* Could be 1 to 4 *\//\* cptcode=modmaxcovj *\/ */ |
| /* /\*recode from 0 *\/ */ | /* /\*recode from 0 *\/ */ |
| /* k is a modality. If we have model=V1+V1*sex */ | /* k is a modality. If we have model=V1+V1*sex */ |
| Line 4196 void tricode(int *Tvar, int **nbcode, in | Line 4693 void tricode(int *Tvar, int **nbcode, in |
| /* } /\* end of loop on modality k *\/ */ | /* } /\* end of loop on modality k *\/ */ |
| } /* end of loop on model-covariate j. nbcode[Tvarj][1]=0 and nbcode[Tvarj][2]=1 sets the value of covariate j*/ | } /* end of loop on model-covariate j. nbcode[Tvarj][1]=0 and nbcode[Tvarj][2]=1 sets the value of covariate j*/ |
| for (k=-1; k< maxncov; k++) Ndum[k]=0; | for (k=-1; k< maxncov; k++) Ndum[k]=0; |
| /* Look at fixed dummy (single or product) covariates to check empty modalities */ | |
| for (i=1; i<=ncovmodel-2-nagesqr; i++) { /* -2, cste and age and eventually age*age */ | for (i=1; i<=ncovmodel-2-nagesqr; i++) { /* -2, cste and age and eventually age*age */ |
| /* Listing of all covariables in statement model to see if some covariates appear twice. For example, V1 appears twice in V1+V1*V2.*/ | /* Listing of all covariables in statement model to see if some covariates appear twice. For example, V1 appears twice in V1+V1*V2.*/ |
| ij=Tvar[i]; /* Tvar might be -1 if status was unknown */ | ij=Tvar[i]; /* Tvar 5,4,3,6,5,7,1,4 in V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V4*age */ |
| Ndum[ij]++; /* Might be supersed V1 + V1*age */ | Ndum[ij]++; /* Count the # of 1, 2 etc: {1,1,1,2,2,1,1} because V1 once, V2 once, two V4 and V5 in above */ |
| } | /* V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1, {2, 1, 1, 1, 2, 1, 1, 0, 0} */ |
| } /* V4+V3+V5, Ndum[1]@5={0, 0, 1, 1, 1} */ | |
| ij=0; | |
| for (i=0; i<= maxncov-1; i++) { /* modmaxcovj is unknown here. Only Ndum[2(V2),3(age*V3), 5(V3*V2) 6(V1*V4) */ | ij=0; |
| /*printf("Ndum[%d]=%d\n",i, Ndum[i]);*/ | /* for (i=0; i<= maxncov-1; i++) { /\* modmaxcovj is unknown here. Only Ndum[2(V2),3(age*V3), 5(V3*V2) 6(V1*V4) *\/ */ |
| if((Ndum[i]!=0) && (i<=ncovcol)){ | for (k=1; k<= cptcovt; k++) { /* modmaxcovj is unknown here. Only Ndum[2(V2),3(age*V3), 5(V3*V2) 6(V1*V4) */ |
| ij++; | /*printf("Ndum[%d]=%d\n",i, Ndum[i]);*/ |
| /*printf("diff Ndum[%d]=%d\n",i, Ndum[i]);*/ | /* if((Ndum[i]!=0) && (i<=ncovcol)){ /\* Tvar[i] <= ncovmodel ? *\/ */ |
| Tvaraff[ij]=i; /*For printing (unclear) */ | if(Ndum[Tvar[k]]!=0 && Dummy[k] == 0 && Typevar[k]==0){ /* Only Dummy and non empty in the model */ |
| }else{ | /* If product not in single variable we don't print results */ |
| /* Tvaraff[ij]=0; */ | /*printf("diff Ndum[%d]=%d\n",i, Ndum[i]);*/ |
| } | ++ij; |
| } | Tvaraff[ij]=Tvar[k]; /*For printing */ |
| /* ij--; */ | Tmodelind[ij]=k; |
| cptcoveff=ij; /*Number of total covariates*/ | if(Fixed[k]!=0) |
| anyvaryingduminmodel=1; | |
| /* }else if((Ndum[i]!=0) && (i<=ncovcol+nqv)){ */ | |
| /* Tvaraff[++ij]=-10; /\* Dont'n know how to treat quantitative variables yet *\/ */ | |
| /* }else if((Ndum[i]!=0) && (i<=ncovcol+nqv+ntv)){ */ | |
| /* Tvaraff[++ij]=i; /\*For printing (unclear) *\/ */ | |
| /* }else if((Ndum[i]!=0) && (i<=ncovcol+nqv+ntv+nqtv)){ */ | |
| /* Tvaraff[++ij]=-20; /\* Dont'n know how to treat quantitative variables yet *\/ */ | |
| } | |
| } /* Tvaraff[1]@5 {3, 4, -20, 0, 0} Very strange */ | |
| /* ij--; */ | |
| /* cptcoveff=ij; /\*Number of total covariates*\/ */ | |
| *cptcov=ij; /*Number of total real effective covariates: effective | |
| * because they can be excluded from the model and real | |
| * if in the model but excluded because missing values, but how to get k from ij?*/ | |
| for(j=ij+1; j<= cptcovt; j++){ | |
| Tvaraff[j]=0; | |
| Tmodelind[j]=0; | |
| } | |
| /* To be sorted */ | |
| ; | |
| } | } |
| Line 4335 void cvevsij(double ***eij, double x[], | Line 4851 void cvevsij(double ***eij, double x[], |
| { | { |
| /* Covariances of health expectancies eij and of total life expectancies according | /* Covariances of health expectancies eij and of total life expectancies according |
| to initial status i, ei. . | to initial status i, ei. . |
| */ | */ |
| int i, j, nhstepm, hstepm, h, nstepm, k, cptj, cptj2, i2, j2, ij, ji; | int i, j, nhstepm, hstepm, h, nstepm, k, cptj, cptj2, i2, j2, ij, ji; |
| int nhstepma, nstepma; /* Decreasing with age */ | int nhstepma, nstepma; /* Decreasing with age */ |
| Line 4429 void cvevsij(double ***eij, double x[], | Line 4945 void cvevsij(double ***eij, double x[], |
| /* Typically if 20 years nstepm = 20*12/6=40 stepm */ | /* Typically if 20 years nstepm = 20*12/6=40 stepm */ |
| /* if (stepm >= YEARM) hstepm=1;*/ | /* if (stepm >= YEARM) hstepm=1;*/ |
| nhstepma = nstepma/hstepm;/* Expressed in hstepm, typically nhstepma=40/4=10 */ | nhstepma = nstepma/hstepm;/* Expressed in hstepm, typically nhstepma=40/4=10 */ |
| /* If stepm=6 months */ | /* If stepm=6 months */ |
| /* Computed by stepm unit matrices, product of hstepma matrices, stored | /* Computed by stepm unit matrices, product of hstepma matrices, stored |
| in an array of nhstepma length: nhstepma=10, hstepm=4, stepm=6 months */ | in an array of nhstepma length: nhstepma=10, hstepm=4, stepm=6 months */ |
| hf=hstepm*stepm/YEARM; /* Duration of hstepm expressed in year unit. */ | hf=hstepm*stepm/YEARM; /* Duration of hstepm expressed in year unit. */ |
| /* Computing Variances of health expectancies */ | /* Computing Variances of health expectancies */ |
| /* Gradient is computed with plus gp and minus gm. Code is duplicated in order to | /* Gradient is computed with plus gp and minus gm. Code is duplicated in order to |
| decrease memory allocation */ | decrease memory allocation */ |
| Line 4446 void cvevsij(double ***eij, double x[], | Line 4962 void cvevsij(double ***eij, double x[], |
| } | } |
| hpxij(p3matp,nhstepm,age,hstepm,xp,nlstate,stepm,oldm,savm, cij); | hpxij(p3matp,nhstepm,age,hstepm,xp,nlstate,stepm,oldm,savm, cij); |
| hpxij(p3matm,nhstepm,age,hstepm,xm,nlstate,stepm,oldm,savm, cij); | hpxij(p3matm,nhstepm,age,hstepm,xm,nlstate,stepm,oldm,savm, cij); |
| for(j=1; j<= nlstate; j++){ | for(j=1; j<= nlstate; j++){ |
| for(i=1; i<=nlstate; i++){ | for(i=1; i<=nlstate; i++){ |
| for(h=0; h<=nhstepm-1; h++){ | for(h=0; h<=nhstepm-1; h++){ |
| Line 4455 void cvevsij(double ***eij, double x[], | Line 4971 void cvevsij(double ***eij, double x[], |
| } | } |
| } | } |
| } | } |
| for(ij=1; ij<= nlstate*nlstate; ij++) | for(ij=1; ij<= nlstate*nlstate; ij++) |
| for(h=0; h<=nhstepm-1; h++){ | for(h=0; h<=nhstepm-1; h++){ |
| gradg[h][theta][ij]= (gp[h][ij]-gm[h][ij])/2./delti[theta]; | gradg[h][theta][ij]= (gp[h][ij]-gm[h][ij])/2./delti[theta]; |
| Line 4468 void cvevsij(double ***eij, double x[], | Line 4984 void cvevsij(double ***eij, double x[], |
| for(theta=1; theta <=npar; theta++) | for(theta=1; theta <=npar; theta++) |
| trgradg[h][j][theta]=gradg[h][theta][j]; | trgradg[h][j][theta]=gradg[h][theta][j]; |
| for(ij=1;ij<=nlstate*nlstate;ij++) | for(ij=1;ij<=nlstate*nlstate;ij++) |
| for(ji=1;ji<=nlstate*nlstate;ji++) | for(ji=1;ji<=nlstate*nlstate;ji++) |
| varhe[ij][ji][(int)age] =0.; | varhe[ij][ji][(int)age] =0.; |
| printf("%d|",(int)age);fflush(stdout); | printf("%d|",(int)age);fflush(stdout); |
| fprintf(ficlog,"%d|",(int)age);fflush(ficlog); | fprintf(ficlog,"%d|",(int)age);fflush(ficlog); |
| for(h=0;h<=nhstepm-1;h++){ | for(h=0;h<=nhstepm-1;h++){ |
| for(k=0;k<=nhstepm-1;k++){ | for(k=0;k<=nhstepm-1;k++){ |
| matprod2(dnewm,trgradg[h],1,nlstate*nlstate,1,npar,1,npar,matcov); | matprod2(dnewm,trgradg[h],1,nlstate*nlstate,1,npar,1,npar,matcov); |
| matprod2(doldm,dnewm,1,nlstate*nlstate,1,npar,1,nlstate*nlstate,gradg[k]); | matprod2(doldm,dnewm,1,nlstate*nlstate,1,npar,1,nlstate*nlstate,gradg[k]); |
| Line 4484 void cvevsij(double ***eij, double x[], | Line 5000 void cvevsij(double ***eij, double x[], |
| varhe[ij][ji][(int)age] += doldm[ij][ji]*hf*hf; | varhe[ij][ji][(int)age] += doldm[ij][ji]*hf*hf; |
| } | } |
| } | } |
| /* Computing expectancies */ | /* Computing expectancies */ |
| hpxij(p3matm,nhstepm,age,hstepm,x,nlstate,stepm,oldm, savm, cij); | hpxij(p3matm,nhstepm,age,hstepm,x,nlstate,stepm,oldm, savm, cij); |
| for(i=1; i<=nlstate;i++) | for(i=1; i<=nlstate;i++) |
| for(j=1; j<=nlstate;j++) | for(j=1; j<=nlstate;j++) |
| for (h=0, eij[i][j][(int)age]=0; h<=nhstepm-1; h++){ | for (h=0, eij[i][j][(int)age]=0; h<=nhstepm-1; h++){ |
| eij[i][j][(int)age] += (p3matm[i][j][h]+p3matm[i][j][h+1])/2.0*hf; | eij[i][j][(int)age] += (p3matm[i][j][h]+p3matm[i][j][h+1])/2.0*hf; |
| /* 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]);*/ | /* 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]);*/ |
| } | } |
| fprintf(ficresstdeij,"%3.0f",age ); | fprintf(ficresstdeij,"%3.0f",age ); |
| for(i=1; i<=nlstate;i++){ | for(i=1; i<=nlstate;i++){ |
| eip=0.; | eip=0.; |
| Line 4509 void cvevsij(double ***eij, double x[], | Line 5025 void cvevsij(double ***eij, double x[], |
| fprintf(ficresstdeij," %9.4f (%.4f)", eip, sqrt(vip)); | fprintf(ficresstdeij," %9.4f (%.4f)", eip, sqrt(vip)); |
| } | } |
| fprintf(ficresstdeij,"\n"); | fprintf(ficresstdeij,"\n"); |
| fprintf(ficrescveij,"%3.0f",age ); | fprintf(ficrescveij,"%3.0f",age ); |
| for(i=1; i<=nlstate;i++) | for(i=1; i<=nlstate;i++) |
| for(j=1; j<=nlstate;j++){ | for(j=1; j<=nlstate;j++){ |
| Line 4522 void cvevsij(double ***eij, double x[], | Line 5038 void cvevsij(double ***eij, double x[], |
| } | } |
| } | } |
| fprintf(ficrescveij,"\n"); | fprintf(ficrescveij,"\n"); |
| } | } |
| free_matrix(gm,0,nhstepm,1,nlstate*nlstate); | free_matrix(gm,0,nhstepm,1,nlstate*nlstate); |
| free_matrix(gp,0,nhstepm,1,nlstate*nlstate); | free_matrix(gp,0,nhstepm,1,nlstate*nlstate); |
| Line 4532 void cvevsij(double ***eij, double x[], | Line 5048 void cvevsij(double ***eij, double x[], |
| free_ma3x(p3matp,1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); | free_ma3x(p3matp,1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); |
| printf("\n"); | printf("\n"); |
| fprintf(ficlog,"\n"); | fprintf(ficlog,"\n"); |
| free_vector(xm,1,npar); | free_vector(xm,1,npar); |
| free_vector(xp,1,npar); | free_vector(xp,1,npar); |
| free_matrix(dnewm,1,nlstate*nlstate,1,npar); | free_matrix(dnewm,1,nlstate*nlstate,1,npar); |
| free_matrix(doldm,1,nlstate*nlstate,1,nlstate*nlstate); | free_matrix(doldm,1,nlstate*nlstate,1,nlstate*nlstate); |
| free_ma3x(varhe,1,nlstate*nlstate,1,nlstate*nlstate,(int) bage, (int)fage); | free_ma3x(varhe,1,nlstate*nlstate,1,nlstate*nlstate,(int) bage, (int)fage); |
| } | } |
| /************ Variance ******************/ | /************ 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[]) | 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[]) |
| { | { |
| /* Variance of health expectancies */ | /* Variance of health expectancies */ |
| /* double **prevalim(double **prlim, int nlstate, double *xp, double age, double **oldm, double ** savm,double ftolpl);*/ | /* double **prevalim(double **prlim, int nlstate, double *xp, double age, double **oldm, double ** savm,double ftolpl);*/ |
| /* double **newm;*/ | /* double **newm;*/ |
| /* int movingaverage(double ***probs, double bage,double fage, double ***mobaverage, int mobilav)*/ | /* int movingaverage(double ***probs, double bage,double fage, double ***mobaverage, int mobilav)*/ |
| int movingaverage(); | /* int movingaverage(); */ |
| double **dnewm,**doldm; | double **dnewm,**doldm; |
| double **dnewmp,**doldmp; | double **dnewmp,**doldmp; |
| int i, j, nhstepm, hstepm, h, nstepm ; | int i, j, nhstepm, hstepm, h, nstepm ; |
| int k; | int k; |
| double *xp; | double *xp; |
| double **gp, **gm; /* for var eij */ | double **gp, **gm; /* for var eij */ |
| double ***gradg, ***trgradg; /*for var eij */ | double ***gradg, ***trgradg; /*for var eij */ |
| double **gradgp, **trgradgp; /* for var p point j */ | double **gradgp, **trgradgp; /* for var p point j */ |
| double *gpp, *gmp; /* 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 **varppt; /* for var p point j nlstate to nlstate+ndeath */ |
| double ***p3mat; | double ***p3mat; |
| double age,agelim, hf; | double age,agelim, hf; |
| double ***mobaverage; | /* double ***mobaverage; */ |
| int theta; | int theta; |
| char digit[4]; | char digit[4]; |
| char digitp[25]; | char digitp[25]; |
| char fileresprobmorprev[FILENAMELENGTH]; | char fileresprobmorprev[FILENAMELENGTH]; |
| if(popbased==1){ | if(popbased==1){ |
| if(mobilav!=0) | if(mobilav!=0) |
| strcpy(digitp,"-POPULBASED-MOBILAV_"); | strcpy(digitp,"-POPULBASED-MOBILAV_"); |
| else strcpy(digitp,"-POPULBASED-NOMOBIL_"); | else strcpy(digitp,"-POPULBASED-NOMOBIL_"); |
| } | } |
| else | else |
| strcpy(digitp,"-STABLBASED_"); | strcpy(digitp,"-STABLBASED_"); |
| if (mobilav!=0) { | |
| mobaverage= ma3x(1, AGESUP,1,NCOVMAX, 1,NCOVMAX); | |
| if (movingaverage(probs, bage, fage, mobaverage,mobilav)!=0){ | |
| fprintf(ficlog," Error in movingaverage mobilav=%d\n",mobilav); | |
| printf(" Error in movingaverage mobilav=%d\n",mobilav); | |
| } | |
| } | |
| strcpy(fileresprobmorprev,"PRMORPREV-"); | |
| sprintf(digit,"%-d",ij); | |
| /*printf("DIGIT=%s, ij=%d ijr=%-d|\n",digit, ij,ij);*/ | |
| strcat(fileresprobmorprev,digit); /* Tvar to be done */ | |
| strcat(fileresprobmorprev,digitp); /* Popbased or not, mobilav or not */ | |
| strcat(fileresprobmorprev,fileresu); | |
| if((ficresprobmorprev=fopen(fileresprobmorprev,"w"))==NULL) { | |
| printf("Problem with resultfile: %s\n", fileresprobmorprev); | |
| fprintf(ficlog,"Problem with resultfile: %s\n", fileresprobmorprev); | |
| } | |
| printf("Computing total mortality p.j=w1*p1j+w2*p2j+..: result on file '%s' \n",fileresprobmorprev); | |
| fprintf(ficlog,"Computing total mortality p.j=w1*p1j+w2*p2j+..: result on file '%s' \n",fileresprobmorprev); | |
| pstamp(ficresprobmorprev); | |
| fprintf(ficresprobmorprev,"# probabilities of dying before estepm=%d months for people of exact age and weighted probabilities w1*p1j+w2*p2j+... stand dev in()\n",estepm); | |
| fprintf(ficresprobmorprev,"# Age cov=%-d",ij); | |
| for(j=nlstate+1; j<=(nlstate+ndeath);j++){ | |
| fprintf(ficresprobmorprev," p.%-d SE",j); | |
| for(i=1; i<=nlstate;i++) | |
| fprintf(ficresprobmorprev," w%1d p%-d%-d",i,i,j); | |
| } | |
| fprintf(ficresprobmorprev,"\n"); | |
| fprintf(ficgp,"\n# Routine varevsij"); | |
| fprintf(ficgp,"\nunset title \n"); | |
| /* fprintf(fichtm, "#Local time at start: %s", strstart);*/ | |
| fprintf(fichtm,"\n<li><h4> Computing probabilities of dying over estepm months as a weighted average (i.e global mortality independent of initial healh state)</h4></li>\n"); | |
| fprintf(fichtm,"\n<br>%s <br>\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 "); | |
| if(popbased==1) | |
| fprintf(ficresvij,"the age specific prevalence observed (cross-sectionally) in the population i.e cross-sectionally\n in each health state (popbased=1) (mobilav=%d\n",mobilav); | |
| else | |
| fprintf(ficresvij,"the age specific period (stable) prevalences in each health state \n"); | |
| fprintf(ficresvij,"# Age"); | |
| for(i=1; i<=nlstate;i++) | |
| for(j=1; j<=nlstate;j++) | |
| fprintf(ficresvij," Cov(e.%1d, e.%1d)",i,j); | |
| fprintf(ficresvij,"\n"); | |
| xp=vector(1,npar); | |
| dnewm=matrix(1,nlstate,1,npar); | |
| doldm=matrix(1,nlstate,1,nlstate); | |
| dnewmp= matrix(nlstate+1,nlstate+ndeath,1,npar); | |
| doldmp= matrix(nlstate+1,nlstate+ndeath,nlstate+1,nlstate+ndeath); | |
| gradgp=matrix(1,npar,nlstate+1,nlstate+ndeath); | |
| gpp=vector(nlstate+1,nlstate+ndeath); | |
| gmp=vector(nlstate+1,nlstate+ndeath); | |
| trgradgp =matrix(nlstate+1,nlstate+ndeath,1,npar); /* mu or p point j*/ | |
| if(estepm < stepm){ | |
| printf ("Problem %d lower than %d\n",estepm, stepm); | |
| } | |
| else hstepm=estepm; | |
| /* For example we decided to compute the life expectancy with the smallest unit */ | |
| /* 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 agelim. | |
| Look at function hpijx to understand why because of memory size limitations, | |
| we decided (b) to get a life expectancy respecting the most precise curvature of the | |
| survival function given by stepm (the optimization length). Unfortunately it | |
| means that if the survival funtion is printed every two years of age and if | |
| you sum them up and add 1 year (area under the trapezoids) you won't get the same | |
| results. So we changed our mind and took the option of the best precision. | |
| */ | |
| hstepm=hstepm/stepm; /* Typically in stepm units, if stepm=6 & estepm=24 , = 24/6 months = 4 */ | |
| agelim = AGESUP; | |
| for (age=bage; age<=fage; age ++){ /* If stepm=6 months */ | |
| nstepm=(int) rint((agelim-age)*YEARM/stepm); /* Typically 20 years = 20*12/6=40 */ | |
| nhstepm = nstepm/hstepm;/* Expressed in hstepm, typically nhstepm=40/4=10 */ | |
| p3mat=ma3x(1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); | |
| gradg=ma3x(0,nhstepm,1,npar,1,nlstate); | |
| gp=matrix(0,nhstepm,1,nlstate); | |
| gm=matrix(0,nhstepm,1,nlstate); | |
| for(theta=1; theta <=npar; theta++){ | |
| for(i=1; i<=npar; i++){ /* Computes gradient x + delta*/ | |
| xp[i] = x[i] + (i==theta ?delti[theta]:0); | |
| } | |
| prevalim(prlim,nlstate,xp,age,oldm,savm,ftolpl,ncvyearp,ij); | |
| if (popbased==1) { | |
| if(mobilav ==0){ | |
| for(i=1; i<=nlstate;i++) | |
| prlim[i][i]=probs[(int)age][i][ij]; | |
| }else{ /* mobilav */ | |
| for(i=1; i<=nlstate;i++) | |
| prlim[i][i]=mobaverage[(int)age][i][ij]; | |
| } | |
| } | |
| hpxij(p3mat,nhstepm,age,hstepm,xp,nlstate,stepm,oldm,savm, ij); /* Returns p3mat[i][j][h] for h=1 to nhstepm */ | |
| 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 | |
| computed over hstepm matrices product = hstepm*stepm months) | |
| as a weighted average of prlim. | |
| */ | |
| 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 */ | |
| for(i=1; i<=npar; i++) /* Computes gradient x - delta */ | |
| xp[i] = x[i] - (i==theta ?delti[theta]:0); | |
| prevalim(prlim,nlstate,xp,age,oldm,savm,ftolpl,ncvyearp, ij); | |
| if (popbased==1) { | |
| if(mobilav ==0){ | |
| for(i=1; i<=nlstate;i++) | |
| prlim[i][i]=probs[(int)age][i][ij]; | |
| }else{ /* mobilav */ | |
| for(i=1; i<=nlstate;i++) | |
| prlim[i][i]=mobaverage[(int)age][i][ij]; | |
| } | |
| } | |
| hpxij(p3mat,nhstepm,age,hstepm,xp,nlstate,stepm,oldm,savm, ij); | |
| for(j=1; j<= nlstate; j++){ /* Sum of wi * eij = e.j */ | |
| for(h=0; h<=nhstepm; h++){ | |
| for(i=1, gm[h][j]=0.;i<=nlstate;i++) | |
| gm[h][j] += prlim[i][i]*p3mat[i][j][h]; | |
| } | |
| } | |
| /* This for computing probability of death (h=1 means | |
| computed over hstepm matrices product = hstepm*stepm months) | |
| as a weighted average of prlim. | |
| */ | |
| for(j=nlstate+1;j<=nlstate+ndeath;j++){ | |
| for(i=1,gmp[j]=0.; i<= nlstate; i++) | |
| gmp[j] += prlim[i][i]*p3mat[i][j][1]; | |
| } | |
| /* end probability of death */ | |
| 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 */ | |
| gradgp[theta][j]= (gpp[j]-gmp[j])/2./delti[theta]; | |
| } | |
| } /* End theta */ | |
| trgradg =ma3x(0,nhstepm,1,nlstate,1,npar); /* veij */ | |
| for(h=0; h<=nhstepm; h++) /* veij */ | |
| for(j=1; j<=nlstate;j++) | |
| for(theta=1; theta <=npar; theta++) | |
| trgradg[h][j][theta]=gradg[h][theta][j]; | |
| for(j=nlstate+1; j<=nlstate+ndeath;j++) /* mu */ | |
| for(theta=1; theta <=npar; theta++) | |
| trgradgp[j][theta]=gradgp[theta][j]; | |
| 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.; | |
| for(h=0;h<=nhstepm;h++){ | /* if (mobilav!=0) { */ |
| for(k=0;k<=nhstepm;k++){ | /* mobaverage= ma3x(1, AGESUP,1,NCOVMAX, 1,NCOVMAX); */ |
| matprod2(dnewm,trgradg[h],1,nlstate,1,npar,1,npar,matcov); | /* if (movingaverage(probs, bage, fage, mobaverage,mobilav)!=0){ */ |
| matprod2(doldm,dnewm,1,nlstate,1,npar,1,nlstate,gradg[k]); | /* fprintf(ficlog," Error in movingaverage mobilav=%d\n",mobilav); */ |
| for(i=1;i<=nlstate;i++) | /* printf(" Error in movingaverage mobilav=%d\n",mobilav); */ |
| for(j=1;j<=nlstate;j++) | /* } */ |
| vareij[i][j][(int)age] += doldm[i][j]*hf*hf; | /* } */ |
| } | |
| } | strcpy(fileresprobmorprev,"PRMORPREV-"); |
| sprintf(digit,"%-d",ij); | |
| /*printf("DIGIT=%s, ij=%d ijr=%-d|\n",digit, ij,ij);*/ | |
| strcat(fileresprobmorprev,digit); /* Tvar to be done */ | |
| strcat(fileresprobmorprev,digitp); /* Popbased or not, mobilav or not */ | |
| strcat(fileresprobmorprev,fileresu); | |
| if((ficresprobmorprev=fopen(fileresprobmorprev,"w"))==NULL) { | |
| printf("Problem with resultfile: %s\n", fileresprobmorprev); | |
| fprintf(ficlog,"Problem with resultfile: %s\n", fileresprobmorprev); | |
| } | |
| printf("Computing total mortality p.j=w1*p1j+w2*p2j+..: result on file '%s' \n",fileresprobmorprev); | |
| fprintf(ficlog,"Computing total mortality p.j=w1*p1j+w2*p2j+..: result on file '%s' \n",fileresprobmorprev); | |
| pstamp(ficresprobmorprev); | |
| fprintf(ficresprobmorprev,"# probabilities of dying before estepm=%d months for people of exact age and weighted probabilities w1*p1j+w2*p2j+... stand dev in()\n",estepm); | |
| fprintf(ficresprobmorprev,"# Age cov=%-d",ij); | |
| for(j=nlstate+1; j<=(nlstate+ndeath);j++){ | |
| fprintf(ficresprobmorprev," p.%-d SE",j); | |
| for(i=1; i<=nlstate;i++) | |
| fprintf(ficresprobmorprev," w%1d p%-d%-d",i,i,j); | |
| } | |
| fprintf(ficresprobmorprev,"\n"); | |
| fprintf(ficgp,"\n# Routine varevsij"); | |
| fprintf(ficgp,"\nunset title \n"); | |
| /* fprintf(fichtm, "#Local time at start: %s", strstart);*/ | |
| fprintf(fichtm,"\n<li><h4> Computing probabilities of dying over estepm months as a weighted average (i.e global mortality independent of initial healh state)</h4></li>\n"); | |
| fprintf(fichtm,"\n<br>%s <br>\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 "); | |
| if(popbased==1) | |
| fprintf(ficresvij,"the age specific prevalence observed (cross-sectionally) in the population i.e cross-sectionally\n in each health state (popbased=1) (mobilav=%d\n",mobilav); | |
| else | |
| fprintf(ficresvij,"the age specific period (stable) prevalences in each health state \n"); | |
| fprintf(ficresvij,"# Age"); | |
| for(i=1; i<=nlstate;i++) | |
| for(j=1; j<=nlstate;j++) | |
| fprintf(ficresvij," Cov(e.%1d, e.%1d)",i,j); | |
| fprintf(ficresvij,"\n"); | |
| xp=vector(1,npar); | |
| dnewm=matrix(1,nlstate,1,npar); | |
| doldm=matrix(1,nlstate,1,nlstate); | |
| dnewmp= matrix(nlstate+1,nlstate+ndeath,1,npar); | |
| doldmp= matrix(nlstate+1,nlstate+ndeath,nlstate+1,nlstate+ndeath); | |
| gradgp=matrix(1,npar,nlstate+1,nlstate+ndeath); | |
| gpp=vector(nlstate+1,nlstate+ndeath); | |
| gmp=vector(nlstate+1,nlstate+ndeath); | |
| trgradgp =matrix(nlstate+1,nlstate+ndeath,1,npar); /* mu or p point j*/ | |
| /* pptj */ | if(estepm < stepm){ |
| matprod2(dnewmp,trgradgp,nlstate+1,nlstate+ndeath,1,npar,1,npar,matcov); | printf ("Problem %d lower than %d\n",estepm, stepm); |
| matprod2(doldmp,dnewmp,nlstate+1,nlstate+ndeath,1,npar,nlstate+1,nlstate+ndeath,gradgp); | } |
| for(j=nlstate+1;j<=nlstate+ndeath;j++) | else hstepm=estepm; |
| for(i=nlstate+1;i<=nlstate+ndeath;i++) | /* For example we decided to compute the life expectancy with the smallest unit */ |
| varppt[j][i]=doldmp[j][i]; | /* hstepm beeing the number of stepms, if hstepm=1 the length of hstepm is stepm. |
| /* end ppptj */ | nhstepm is the number of hstepm from age to agelim |
| /* x centered again */ | nstepm is the number of stepm from age to agelim. |
| Look at function hpijx to understand why because of memory size limitations, | |
| prevalim(prlim,nlstate,x,age,oldm,savm,ftolpl,ncvyearp,ij); | 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 | |
| if (popbased==1) { | means that if the survival funtion is printed every two years of age and if |
| if(mobilav ==0){ | you sum them up and add 1 year (area under the trapezoids) you won't get the same |
| for(i=1; i<=nlstate;i++) | results. So we changed our mind and took the option of the best precision. |
| prlim[i][i]=probs[(int)age][i][ij]; | */ |
| }else{ /* mobilav */ | hstepm=hstepm/stepm; /* Typically in stepm units, if stepm=6 & estepm=24 , = 24/6 months = 4 */ |
| for(i=1; i<=nlstate;i++) | agelim = AGESUP; |
| prlim[i][i]=mobaverage[(int)age][i][ij]; | for (age=bage; age<=fage; age ++){ /* If stepm=6 months */ |
| } | nstepm=(int) rint((agelim-age)*YEARM/stepm); /* Typically 20 years = 20*12/6=40 */ |
| } | nhstepm = nstepm/hstepm;/* Expressed in hstepm, typically nhstepm=40/4=10 */ |
| p3mat=ma3x(1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); | |
| /* This for computing probability of death (h=1 means | gradg=ma3x(0,nhstepm,1,npar,1,nlstate); |
| computed over hstepm (estepm) matrices product = hstepm*stepm months) | gp=matrix(0,nhstepm,1,nlstate); |
| as a weighted average of prlim. | gm=matrix(0,nhstepm,1,nlstate); |
| for(theta=1; theta <=npar; theta++){ | |
| for(i=1; i<=npar; i++){ /* Computes gradient x + delta*/ | |
| xp[i] = x[i] + (i==theta ?delti[theta]:0); | |
| } | |
| prevalim(prlim,nlstate,xp,age,oldm,savm,ftolpl,ncvyearp,ij); | |
| if (popbased==1) { | |
| if(mobilav ==0){ | |
| for(i=1; i<=nlstate;i++) | |
| prlim[i][i]=probs[(int)age][i][ij]; | |
| }else{ /* mobilav */ | |
| for(i=1; i<=nlstate;i++) | |
| prlim[i][i]=mobaverage[(int)age][i][ij]; | |
| } | |
| } | |
| hpxij(p3mat,nhstepm,age,hstepm,xp,nlstate,stepm,oldm,savm, ij); /* Returns p3mat[i][j][h] for h=1 to nhstepm */ | |
| 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 | |
| computed over hstepm matrices product = hstepm*stepm months) | |
| as a weighted average of prlim. | |
| */ | |
| 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 */ | |
| for(i=1; i<=npar; i++) /* Computes gradient x - delta */ | |
| xp[i] = x[i] - (i==theta ?delti[theta]:0); | |
| prevalim(prlim,nlstate,xp,age,oldm,savm,ftolpl,ncvyearp, ij); | |
| if (popbased==1) { | |
| if(mobilav ==0){ | |
| for(i=1; i<=nlstate;i++) | |
| prlim[i][i]=probs[(int)age][i][ij]; | |
| }else{ /* mobilav */ | |
| for(i=1; i<=nlstate;i++) | |
| prlim[i][i]=mobaverage[(int)age][i][ij]; | |
| } | |
| } | |
| hpxij(p3mat,nhstepm,age,hstepm,xp,nlstate,stepm,oldm,savm, ij); | |
| for(j=1; j<= nlstate; j++){ /* Sum of wi * eij = e.j */ | |
| for(h=0; h<=nhstepm; h++){ | |
| for(i=1, gm[h][j]=0.;i<=nlstate;i++) | |
| gm[h][j] += prlim[i][i]*p3mat[i][j][h]; | |
| } | |
| } | |
| /* This for computing probability of death (h=1 means | |
| computed over hstepm matrices product = hstepm*stepm months) | |
| as a weighted average of prlim. | |
| */ | |
| for(j=nlstate+1;j<=nlstate+ndeath;j++){ | |
| for(i=1,gmp[j]=0.; i<= nlstate; i++) | |
| gmp[j] += prlim[i][i]*p3mat[i][j][1]; | |
| } | |
| /* end probability of death */ | |
| 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 */ | |
| gradgp[theta][j]= (gpp[j]-gmp[j])/2./delti[theta]; | |
| } | |
| } /* End theta */ | |
| trgradg =ma3x(0,nhstepm,1,nlstate,1,npar); /* veij */ | |
| for(h=0; h<=nhstepm; h++) /* veij */ | |
| for(j=1; j<=nlstate;j++) | |
| for(theta=1; theta <=npar; theta++) | |
| trgradg[h][j][theta]=gradg[h][theta][j]; | |
| for(j=nlstate+1; j<=nlstate+ndeath;j++) /* mu */ | |
| for(theta=1; theta <=npar; theta++) | |
| trgradgp[j][theta]=gradgp[theta][j]; | |
| 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.; | |
| for(h=0;h<=nhstepm;h++){ | |
| for(k=0;k<=nhstepm;k++){ | |
| matprod2(dnewm,trgradg[h],1,nlstate,1,npar,1,npar,matcov); | |
| matprod2(doldm,dnewm,1,nlstate,1,npar,1,nlstate,gradg[k]); | |
| for(i=1;i<=nlstate;i++) | |
| for(j=1;j<=nlstate;j++) | |
| vareij[i][j][(int)age] += doldm[i][j]*hf*hf; | |
| } | |
| } | |
| /* pptj */ | |
| 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++) | |
| for(i=nlstate+1;i<=nlstate+ndeath;i++) | |
| varppt[j][i]=doldmp[j][i]; | |
| /* end ppptj */ | |
| /* x centered again */ | |
| prevalim(prlim,nlstate,x,age,oldm,savm,ftolpl,ncvyearp,ij); | |
| if (popbased==1) { | |
| if(mobilav ==0){ | |
| for(i=1; i<=nlstate;i++) | |
| prlim[i][i]=probs[(int)age][i][ij]; | |
| }else{ /* mobilav */ | |
| for(i=1; i<=nlstate;i++) | |
| prlim[i][i]=mobaverage[(int)age][i][ij]; | |
| } | |
| } | |
| /* This for computing probability of death (h=1 means | |
| computed over hstepm (estepm) matrices product = hstepm*stepm months) | |
| as a weighted average of prlim. | |
| */ | |
| hpxij(p3mat,nhstepm,age,hstepm,x,nlstate,stepm,oldm,savm, ij); | |
| for(j=nlstate+1;j<=nlstate+ndeath;j++){ | |
| for(i=1,gmp[j]=0.;i<= nlstate; i++) | |
| gmp[j] += prlim[i][i]*p3mat[i][j][1]; | |
| } | |
| /* end probability of death */ | |
| fprintf(ficresprobmorprev,"%3d %d ",(int) age, ij); | |
| for(j=nlstate+1; j<=(nlstate+ndeath);j++){ | |
| fprintf(ficresprobmorprev," %11.3e %11.3e",gmp[j], sqrt(varppt[j][j])); | |
| for(i=1; i<=nlstate;i++){ | |
| fprintf(ficresprobmorprev," %11.3e %11.3e ",prlim[i][i],p3mat[i][j][1]); | |
| } | |
| } | |
| fprintf(ficresprobmorprev,"\n"); | |
| fprintf(ficresvij,"%.0f ",age ); | |
| for(i=1; i<=nlstate;i++) | |
| for(j=1; j<=nlstate;j++){ | |
| fprintf(ficresvij," %.4f", vareij[i][j][(int)age]); | |
| } | |
| fprintf(ficresvij,"\n"); | |
| free_matrix(gp,0,nhstepm,1,nlstate); | |
| free_matrix(gm,0,nhstepm,1,nlstate); | |
| free_ma3x(gradg,0,nhstepm,1,npar,1,nlstate); | |
| free_ma3x(trgradg,0,nhstepm,1,nlstate,1,npar); | |
| free_ma3x(p3mat,1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); | |
| } /* End age */ | |
| free_vector(gpp,nlstate+1,nlstate+ndeath); | |
| free_vector(gmp,nlstate+1,nlstate+ndeath); | |
| free_matrix(gradgp,1,npar,nlstate+1,nlstate+ndeath); | |
| free_matrix(trgradgp,nlstate+1,nlstate+ndeath,1,npar); /* mu or p point j*/ | |
| /* fprintf(ficgp,"\nunset parametric;unset label; set ter png small size 320, 240"); */ | |
| fprintf(ficgp,"\nunset parametric;unset label; set ter svg size 640, 480"); | |
| /* for(j=nlstate+1; j<= nlstate+ndeath; j++){ *//* Only the first actually */ | |
| fprintf(ficgp,"\n set log y; unset log x;set xlabel \"Age\"; set ylabel \"Force of mortality (year-1)\";"); | |
| fprintf(ficgp,"\nset out \"%s%s.svg\";",subdirf3(optionfilefiname,"VARMUPTJGR-",digitp),digit); | |
| /* fprintf(ficgp,"\n plot \"%s\" u 1:($3*%6.3f) not w l 1 ",fileresprobmorprev,YEARM/estepm); */ | |
| /* fprintf(ficgp,"\n replot \"%s\" u 1:(($3+1.96*$4)*%6.3f) t \"95\%% interval\" w l 2 ",fileresprobmorprev,YEARM/estepm); */ | |
| /* fprintf(ficgp,"\n replot \"%s\" u 1:(($3-1.96*$4)*%6.3f) not w l 2 ",fileresprobmorprev,YEARM/estepm); */ | |
| fprintf(ficgp,"\n plot \"%s\" u 1:($3) not w l lt 1 ",subdirf(fileresprobmorprev)); | |
| fprintf(ficgp,"\n replot \"%s\" u 1:(($3+1.96*$4)) t \"95%% interval\" w l lt 2 ",subdirf(fileresprobmorprev)); | |
| fprintf(ficgp,"\n replot \"%s\" u 1:(($3-1.96*$4)) not w l lt 2 ",subdirf(fileresprobmorprev)); | |
| fprintf(fichtm,"\n<br> File (multiple files are possible if covariates are present): <A href=\"%s\">%s</a>\n",subdirf(fileresprobmorprev),subdirf(fileresprobmorprev)); | |
| fprintf(fichtm,"\n<br> Probability is computed over estepm=%d months. <br> <img src=\"%s%s.svg\"> <br>\n", estepm,subdirf3(optionfilefiname,"VARMUPTJGR-",digitp),digit); | |
| /* fprintf(fichtm,"\n<br> Probability is computed over estepm=%d months and then divided by estepm and multiplied by %.0f in order to have the probability to die over a year <br> <img src=\"varmuptjgr%s%s.svg\"> <br>\n", stepm,YEARM,digitp,digit); | |
| */ | */ |
| hpxij(p3mat,nhstepm,age,hstepm,x,nlstate,stepm,oldm,savm, ij); | /* fprintf(ficgp,"\nset out \"varmuptjgr%s%s%s.svg\";replot;",digitp,optionfilefiname,digit); */ |
| for(j=nlstate+1;j<=nlstate+ndeath;j++){ | fprintf(ficgp,"\nset out;\nset out \"%s%s.svg\";replot;set out;\n",subdirf3(optionfilefiname,"VARMUPTJGR-",digitp),digit); |
| for(i=1,gmp[j]=0.;i<= nlstate; i++) | |
| gmp[j] += prlim[i][i]*p3mat[i][j][1]; | |
| } | |
| /* end probability of death */ | |
| fprintf(ficresprobmorprev,"%3d %d ",(int) age, ij); | |
| for(j=nlstate+1; j<=(nlstate+ndeath);j++){ | |
| fprintf(ficresprobmorprev," %11.3e %11.3e",gmp[j], sqrt(varppt[j][j])); | |
| for(i=1; i<=nlstate;i++){ | |
| fprintf(ficresprobmorprev," %11.3e %11.3e ",prlim[i][i],p3mat[i][j][1]); | |
| } | |
| } | |
| fprintf(ficresprobmorprev,"\n"); | |
| fprintf(ficresvij,"%.0f ",age ); | |
| for(i=1; i<=nlstate;i++) | |
| for(j=1; j<=nlstate;j++){ | |
| fprintf(ficresvij," %.4f", vareij[i][j][(int)age]); | |
| } | |
| fprintf(ficresvij,"\n"); | |
| free_matrix(gp,0,nhstepm,1,nlstate); | |
| free_matrix(gm,0,nhstepm,1,nlstate); | |
| free_ma3x(gradg,0,nhstepm,1,npar,1,nlstate); | |
| free_ma3x(trgradg,0,nhstepm,1,nlstate,1,npar); | |
| free_ma3x(p3mat,1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); | |
| } /* End age */ | |
| free_vector(gpp,nlstate+1,nlstate+ndeath); | |
| free_vector(gmp,nlstate+1,nlstate+ndeath); | |
| free_matrix(gradgp,1,npar,nlstate+1,nlstate+ndeath); | |
| free_matrix(trgradgp,nlstate+1,nlstate+ndeath,1,npar); /* mu or p point j*/ | |
| /* fprintf(ficgp,"\nunset parametric;unset label; set ter png small size 320, 240"); */ | |
| fprintf(ficgp,"\nunset parametric;unset label; set ter svg size 640, 480"); | |
| /* for(j=nlstate+1; j<= nlstate+ndeath; j++){ *//* Only the first actually */ | |
| fprintf(ficgp,"\n set log y; unset log x;set xlabel \"Age\"; set ylabel \"Force of mortality (year-1)\";"); | |
| fprintf(ficgp,"\nset out \"%s%s.svg\";",subdirf3(optionfilefiname,"VARMUPTJGR-",digitp),digit); | |
| /* fprintf(ficgp,"\n plot \"%s\" u 1:($3*%6.3f) not w l 1 ",fileresprobmorprev,YEARM/estepm); */ | |
| /* fprintf(ficgp,"\n replot \"%s\" u 1:(($3+1.96*$4)*%6.3f) t \"95\%% interval\" w l 2 ",fileresprobmorprev,YEARM/estepm); */ | |
| /* fprintf(ficgp,"\n replot \"%s\" u 1:(($3-1.96*$4)*%6.3f) not w l 2 ",fileresprobmorprev,YEARM/estepm); */ | |
| fprintf(ficgp,"\n plot \"%s\" u 1:($3) not w l lt 1 ",subdirf(fileresprobmorprev)); | |
| fprintf(ficgp,"\n replot \"%s\" u 1:(($3+1.96*$4)) t \"95%% interval\" w l lt 2 ",subdirf(fileresprobmorprev)); | |
| fprintf(ficgp,"\n replot \"%s\" u 1:(($3-1.96*$4)) not w l lt 2 ",subdirf(fileresprobmorprev)); | |
| fprintf(fichtm,"\n<br> File (multiple files are possible if covariates are present): <A href=\"%s\">%s</a>\n",subdirf(fileresprobmorprev),subdirf(fileresprobmorprev)); | |
| fprintf(fichtm,"\n<br> Probability is computed over estepm=%d months. <br> <img src=\"%s%s.svg\"> <br>\n", estepm,subdirf3(optionfilefiname,"VARMUPTJGR-",digitp),digit); | |
| /* fprintf(fichtm,"\n<br> Probability is computed over estepm=%d months and then divided by estepm and multiplied by %.0f in order to have the probability to die over a year <br> <img src=\"varmuptjgr%s%s.svg\"> <br>\n", stepm,YEARM,digitp,digit); | |
| */ | |
| /* fprintf(ficgp,"\nset out \"varmuptjgr%s%s%s.svg\";replot;",digitp,optionfilefiname,digit); */ | |
| fprintf(ficgp,"\nset out;\nset out \"%s%s.svg\";replot;set out;\n",subdirf3(optionfilefiname,"VARMUPTJGR-",digitp),digit); | |
| free_vector(xp,1,npar); | free_vector(xp,1,npar); |
| free_matrix(doldm,1,nlstate,1,nlstate); | free_matrix(doldm,1,nlstate,1,nlstate); |
| free_matrix(dnewm,1,nlstate,1,npar); | free_matrix(dnewm,1,nlstate,1,npar); |
| free_matrix(doldmp,nlstate+1,nlstate+ndeath,nlstate+1,nlstate+ndeath); | free_matrix(doldmp,nlstate+1,nlstate+ndeath,nlstate+1,nlstate+ndeath); |
| free_matrix(dnewmp,nlstate+1,nlstate+ndeath,1,npar); | free_matrix(dnewmp,nlstate+1,nlstate+ndeath,1,npar); |
| free_matrix(varppt,nlstate+1,nlstate+ndeath,nlstate+1,nlstate+ndeath); | free_matrix(varppt,nlstate+1,nlstate+ndeath,nlstate+1,nlstate+ndeath); |
| if (mobilav!=0) free_ma3x(mobaverage,1, AGESUP,1,NCOVMAX, 1,NCOVMAX); | /* if (mobilav!=0) free_ma3x(mobaverage,1, AGESUP,1,NCOVMAX, 1,NCOVMAX); */ |
| fclose(ficresprobmorprev); | fclose(ficresprobmorprev); |
| fflush(ficgp); | fflush(ficgp); |
| fflush(fichtm); | fflush(fichtm); |
| } /* end varevsij */ | } /* end varevsij */ |
| /************ Variance of prevlim ******************/ | /************ 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[]) | 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[]) |
| Line 4976 void cvevsij(double ***eij, double x[], | Line 5492 void cvevsij(double ***eij, double x[], |
| /************ Variance of one-step probabilities ******************/ | /************ 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[]) | 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 i, j=0, k1, l1, tj; |
| int k2, l2, j1, z1; | int k2, l2, j1, z1; |
| int k=0, l; | int k=0, l; |
| int first=1, first1, first2; | int first=1, first1, first2; |
| double cv12, mu1, mu2, lc1, lc2, v12, v21, v11, v22,v1,v2, c12, tnalp; | double cv12, mu1, mu2, lc1, lc2, v12, v21, v11, v22,v1,v2, c12, tnalp; |
| double **dnewm,**doldm; | double **dnewm,**doldm; |
| double *xp; | double *xp; |
| double *gp, *gm; | double *gp, *gm; |
| double **gradg, **trgradg; | double **gradg, **trgradg; |
| double **mu; | double **mu; |
| double age, cov[NCOVMAX+1]; | double age, cov[NCOVMAX+1]; |
| double std=2.0; /* Number of standard deviation wide of confidence ellipsoids */ | double std=2.0; /* Number of standard deviation wide of confidence ellipsoids */ |
| int theta; | int theta; |
| char fileresprob[FILENAMELENGTH]; | char fileresprob[FILENAMELENGTH]; |
| char fileresprobcov[FILENAMELENGTH]; | char fileresprobcov[FILENAMELENGTH]; |
| char fileresprobcor[FILENAMELENGTH]; | char fileresprobcor[FILENAMELENGTH]; |
| double ***varpij; | double ***varpij; |
| strcpy(fileresprob,"PROB_"); | strcpy(fileresprob,"PROB_"); |
| strcat(fileresprob,fileres); | strcat(fileresprob,fileres); |
| if((ficresprob=fopen(fileresprob,"w"))==NULL) { | if((ficresprob=fopen(fileresprob,"w"))==NULL) { |
| printf("Problem with resultfile: %s\n", fileresprob); | printf("Problem with resultfile: %s\n", fileresprob); |
| fprintf(ficlog,"Problem with resultfile: %s\n", fileresprob); | fprintf(ficlog,"Problem with resultfile: %s\n", fileresprob); |
| } | } |
| strcpy(fileresprobcov,"PROBCOV_"); | strcpy(fileresprobcov,"PROBCOV_"); |
| strcat(fileresprobcov,fileresu); | strcat(fileresprobcov,fileresu); |
| if((ficresprobcov=fopen(fileresprobcov,"w"))==NULL) { | if((ficresprobcov=fopen(fileresprobcov,"w"))==NULL) { |
| printf("Problem with resultfile: %s\n", fileresprobcov); | printf("Problem with resultfile: %s\n", fileresprobcov); |
| fprintf(ficlog,"Problem with resultfile: %s\n", fileresprobcov); | fprintf(ficlog,"Problem with resultfile: %s\n", fileresprobcov); |
| } | } |
| strcpy(fileresprobcor,"PROBCOR_"); | strcpy(fileresprobcor,"PROBCOR_"); |
| strcat(fileresprobcor,fileresu); | strcat(fileresprobcor,fileresu); |
| if((ficresprobcor=fopen(fileresprobcor,"w"))==NULL) { | if((ficresprobcor=fopen(fileresprobcor,"w"))==NULL) { |
| printf("Problem with resultfile: %s\n", fileresprobcor); | printf("Problem with resultfile: %s\n", fileresprobcor); |
| fprintf(ficlog,"Problem with resultfile: %s\n", fileresprobcor); | fprintf(ficlog,"Problem with resultfile: %s\n", fileresprobcor); |
| } | } |
| printf("Computing standard deviation of one-step probabilities: result on file '%s' \n",fileresprob); | printf("Computing standard deviation of one-step probabilities: result on file '%s' \n",fileresprob); |
| fprintf(ficlog,"Computing standard deviation of one-step probabilities: result on file '%s' \n",fileresprob); | fprintf(ficlog,"Computing standard deviation of one-step probabilities: result on file '%s' \n",fileresprob); |
| printf("Computing matrix of variance covariance of one-step probabilities: result on file '%s' \n",fileresprobcov); | printf("Computing matrix of variance covariance of one-step probabilities: result on file '%s' \n",fileresprobcov); |
| fprintf(ficlog,"Computing matrix of variance covariance of one-step probabilities: result on file '%s' \n",fileresprobcov); | fprintf(ficlog,"Computing matrix of variance covariance of one-step probabilities: result on file '%s' \n",fileresprobcov); |
| printf("and correlation matrix of one-step probabilities: result on file '%s' \n",fileresprobcor); | printf("and correlation matrix of one-step probabilities: result on file '%s' \n",fileresprobcor); |
| fprintf(ficlog,"and correlation matrix of one-step probabilities: result on file '%s' \n",fileresprobcor); | fprintf(ficlog,"and correlation matrix of one-step probabilities: result on file '%s' \n",fileresprobcor); |
| pstamp(ficresprob); | pstamp(ficresprob); |
| fprintf(ficresprob,"#One-step probabilities and stand. devi in ()\n"); | fprintf(ficresprob,"#One-step probabilities and stand. devi in ()\n"); |
| fprintf(ficresprob,"# Age"); | fprintf(ficresprob,"# Age"); |
| pstamp(ficresprobcov); | pstamp(ficresprobcov); |
| fprintf(ficresprobcov,"#One-step probabilities and covariance matrix\n"); | fprintf(ficresprobcov,"#One-step probabilities and covariance matrix\n"); |
| fprintf(ficresprobcov,"# Age"); | fprintf(ficresprobcov,"# Age"); |
| pstamp(ficresprobcor); | pstamp(ficresprobcor); |
| fprintf(ficresprobcor,"#One-step probabilities and correlation matrix\n"); | fprintf(ficresprobcor,"#One-step probabilities and correlation matrix\n"); |
| fprintf(ficresprobcor,"# Age"); | fprintf(ficresprobcor,"# Age"); |
| for(i=1; i<=nlstate;i++) | for(i=1; i<=nlstate;i++) |
| for(j=1; j<=(nlstate+ndeath);j++){ | for(j=1; j<=(nlstate+ndeath);j++){ |
| fprintf(ficresprob," p%1d-%1d (SE)",i,j); | fprintf(ficresprob," p%1d-%1d (SE)",i,j); |
| fprintf(ficresprobcov," p%1d-%1d ",i,j); | fprintf(ficresprobcov," p%1d-%1d ",i,j); |
| fprintf(ficresprobcor," p%1d-%1d ",i,j); | fprintf(ficresprobcor," p%1d-%1d ",i,j); |
| } | } |
| /* fprintf(ficresprob,"\n"); | /* fprintf(ficresprob,"\n"); |
| fprintf(ficresprobcov,"\n"); | fprintf(ficresprobcov,"\n"); |
| fprintf(ficresprobcor,"\n"); | fprintf(ficresprobcor,"\n"); |
| */ | */ |
| xp=vector(1,npar); | xp=vector(1,npar); |
| dnewm=matrix(1,(nlstate)*(nlstate+ndeath),1,npar); | dnewm=matrix(1,(nlstate)*(nlstate+ndeath),1,npar); |
| doldm=matrix(1,(nlstate)*(nlstate+ndeath),1,(nlstate)*(nlstate+ndeath)); | doldm=matrix(1,(nlstate)*(nlstate+ndeath),1,(nlstate)*(nlstate+ndeath)); |
| mu=matrix(1,(nlstate)*(nlstate+ndeath), (int) bage, (int)fage); | mu=matrix(1,(nlstate)*(nlstate+ndeath), (int) bage, (int)fage); |
| varpij=ma3x(1,nlstate*(nlstate+ndeath),1,nlstate*(nlstate+ndeath),(int) bage, (int) fage); | varpij=ma3x(1,nlstate*(nlstate+ndeath),1,nlstate*(nlstate+ndeath),(int) bage, (int) fage); |
| first=1; | first=1; |
| fprintf(ficgp,"\n# Routine varprob"); | fprintf(ficgp,"\n# Routine varprob"); |
| fprintf(fichtm,"\n<li><h4> Computing and drawing one step probabilities with their confidence intervals</h4></li>\n"); | fprintf(fichtm,"\n<li><h4> Computing and drawing one step probabilities with their confidence intervals</h4></li>\n"); |
| fprintf(fichtm,"\n"); | fprintf(fichtm,"\n"); |
| fprintf(fichtm,"\n<li><h4> <a href=\"%s\">Matrix of variance-covariance of one-step probabilities (drawings)</a></h4> 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.</li>\n",optionfilehtmcov); | fprintf(fichtm,"\n<li><h4> <a href=\"%s\">Matrix of variance-covariance of one-step probabilities (drawings)</a></h4> 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.</li>\n",optionfilehtmcov); |
| fprintf(fichtmcov,"Current page is file <a href=\"%s\">%s</a><br>\n\n<h4>Matrix of variance-covariance of pairs of step probabilities</h4>\n",optionfilehtmcov, optionfilehtmcov); | fprintf(fichtmcov,"Current page is file <a href=\"%s\">%s</a><br>\n\n<h4>Matrix of variance-covariance of pairs of step probabilities</h4>\n",optionfilehtmcov, optionfilehtmcov); |
| fprintf(fichtmcov,"\nEllipsoids of confidence centered on point (p<inf>ij</inf>, p<inf>kl</inf>) are estimated \ | fprintf(fichtmcov,"\nEllipsoids of confidence centered on point (p<inf>ij</inf>, p<inf>kl</inf>) are estimated \ |
| and drawn. It helps understanding how is the covariance between two incidences.\ | and drawn. It helps understanding how is the covariance between two incidences.\ |
| They are expressed in year<sup>-1</sup> in order to be less dependent of stepm.<br>\n"); | They are expressed in year<sup>-1</sup> in order to be less dependent of stepm.<br>\n"); |
| fprintf(fichtmcov,"\n<br> Contour plot corresponding to x'cov<sup>-1</sup>x = 4 (where x is the column vector (pij,pkl)) are drawn. \ | fprintf(fichtmcov,"\n<br> Contour plot corresponding to x'cov<sup>-1</sup>x = 4 (where x is the column vector (pij,pkl)) are drawn. \ |
| It can be understood this way: if pij and pkl where uncorrelated the (2x2) matrix of covariance \ | It can be understood this way: if pij and pkl where uncorrelated the (2x2) matrix of covariance \ |
| would have been (1/(var pij), 0 , 0, 1/(var pkl)), and the confidence interval would be 2 \ | would have been (1/(var pij), 0 , 0, 1/(var pkl)), and the confidence interval would be 2 \ |
| standard deviations wide on each axis. <br>\ | standard deviations wide on each axis. <br>\ |
| Line 5063 standard deviations wide on each axis. < | Line 5579 standard deviations wide on each axis. < |
| and made the appropriate rotation to look at the uncorrelated principal directions.<br>\ | and made the appropriate rotation to look at the uncorrelated principal directions.<br>\ |
| To be simple, these graphs help to understand the significativity of each parameter in relation to a second other one.<br> \n"); | To be simple, these graphs help to understand the significativity of each parameter in relation to a second other one.<br> \n"); |
| cov[1]=1; | cov[1]=1; |
| /* tj=cptcoveff; */ | /* tj=cptcoveff; */ |
| tj = (int) pow(2,cptcoveff); | tj = (int) pow(2,cptcoveff); |
| if (cptcovn<1) {tj=1;ncodemax[1]=1;} | if (cptcovn<1) {tj=1;ncodemax[1]=1;} |
| j1=0; | j1=0; |
| for(j1=1; j1<=tj;j1++){ | for(j1=1; j1<=tj;j1++){ /* For each valid combination of covariates or only once*/ |
| /*for(i1=1; i1<=ncodemax[t];i1++){ */ | if (cptcovn>0) { |
| /*j1++;*/ | fprintf(ficresprob, "\n#********** Variable "); |
| if (cptcovn>0) { | for (z1=1; z1<=cptcoveff; z1++) fprintf(ficresprob, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); |
| fprintf(ficresprob, "\n#********** Variable "); | fprintf(ficresprob, "**********\n#\n"); |
| for (z1=1; z1<=cptcoveff; z1++) fprintf(ficresprob, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); | fprintf(ficresprobcov, "\n#********** Variable "); |
| fprintf(ficresprob, "**********\n#\n"); | for (z1=1; z1<=cptcoveff; z1++) fprintf(ficresprobcov, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); |
| fprintf(ficresprobcov, "\n#********** Variable "); | fprintf(ficresprobcov, "**********\n#\n"); |
| for (z1=1; z1<=cptcoveff; z1++) fprintf(ficresprobcov, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); | |
| fprintf(ficresprobcov, "**********\n#\n"); | fprintf(ficgp, "\n#********** Variable "); |
| for (z1=1; z1<=cptcoveff; z1++) fprintf(ficgp, " V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); | |
| fprintf(ficgp, "\n#********** Variable "); | fprintf(ficgp, "**********\n#\n"); |
| for (z1=1; z1<=cptcoveff; z1++) fprintf(ficgp, " V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); | |
| fprintf(ficgp, "**********\n#\n"); | |
| fprintf(fichtmcov, "\n<hr size=\"2\" color=\"#EC5E5E\">********** Variable "); | |
| for (z1=1; z1<=cptcoveff; z1++) fprintf(fichtm, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); | |
| fprintf(fichtmcov, "\n<hr size=\"2\" color=\"#EC5E5E\">********** Variable "); | fprintf(fichtmcov, "**********\n<hr size=\"2\" color=\"#EC5E5E\">"); |
| for (z1=1; z1<=cptcoveff; z1++) fprintf(fichtm, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); | |
| fprintf(fichtmcov, "**********\n<hr size=\"2\" color=\"#EC5E5E\">"); | fprintf(ficresprobcor, "\n#********** Variable "); |
| for (z1=1; z1<=cptcoveff; z1++) fprintf(ficresprobcor, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); | |
| fprintf(ficresprobcor, "\n#********** Variable "); | fprintf(ficresprobcor, "**********\n#"); |
| for (z1=1; z1<=cptcoveff; z1++) fprintf(ficresprobcor, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); | if(invalidvarcomb[j1]){ |
| fprintf(ficresprobcor, "**********\n#"); | fprintf(ficgp,"\n#Combination (%d) ignored because no cases \n",j1); |
| } | fprintf(fichtmcov,"\n<h3>Combination (%d) ignored because no cases </h3>\n",j1); |
| continue; | |
| gradg=matrix(1,npar,1,(nlstate)*(nlstate+ndeath)); | } |
| trgradg=matrix(1,(nlstate)*(nlstate+ndeath),1,npar); | } |
| gp=vector(1,(nlstate)*(nlstate+ndeath)); | gradg=matrix(1,npar,1,(nlstate)*(nlstate+ndeath)); |
| gm=vector(1,(nlstate)*(nlstate+ndeath)); | trgradg=matrix(1,(nlstate)*(nlstate+ndeath),1,npar); |
| for (age=bage; age<=fage; age ++){ | gp=vector(1,(nlstate)*(nlstate+ndeath)); |
| cov[2]=age; | gm=vector(1,(nlstate)*(nlstate+ndeath)); |
| if(nagesqr==1) | for (age=bage; age<=fage; age ++){ |
| cov[3]= age*age; | cov[2]=age; |
| for (k=1; k<=cptcovn;k++) { | if(nagesqr==1) |
| cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(j1,k)]; | cov[3]= age*age; |
| /*cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(j1,Tvar[k])];*//* j1 1 2 3 4 | for (k=1; k<=cptcovn;k++) { |
| * 1 1 1 1 1 | cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(j1,k)]; |
| * 2 2 1 1 1 | /*cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(j1,Tvar[k])];*//* j1 1 2 3 4 |
| * 3 1 2 1 1 | * 1 1 1 1 1 |
| */ | * 2 2 1 1 1 |
| /* nbcode[1][1]=0 nbcode[1][2]=1;*/ | * 3 1 2 1 1 |
| } | */ |
| /* for (k=1; k<=cptcovage;k++) cov[2+Tage[k]]=cov[2+Tage[k]]*cov[2]; */ | /* nbcode[1][1]=0 nbcode[1][2]=1;*/ |
| for (k=1; k<=cptcovage;k++) cov[2+Tage[k]]=nbcode[Tvar[Tage[k]]][codtabm(ij,k)]*cov[2]; | } |
| for (k=1; k<=cptcovprod;k++) | /* for (k=1; k<=cptcovage;k++) cov[2+Tage[k]]=cov[2+Tage[k]]*cov[2]; */ |
| cov[2+nagesqr+Tprod[k]]=nbcode[Tvard[k][1]][codtabm(ij,k)]*nbcode[Tvard[k][2]][codtabm(ij,k)]; | for (k=1; k<=cptcovage;k++) cov[2+Tage[k]]=nbcode[Tvar[Tage[k]]][codtabm(ij,k)]*cov[2]; |
| for (k=1; k<=cptcovprod;k++) | |
| cov[2+nagesqr+Tprod[k]]=nbcode[Tvard[k][1]][codtabm(ij,k)]*nbcode[Tvard[k][2]][codtabm(ij,k)]; | |
| for(theta=1; theta <=npar; theta++){ | |
| for(i=1; i<=npar; i++) | |
| xp[i] = x[i] + (i==theta ?delti[theta]:(double)0); | for(theta=1; theta <=npar; theta++){ |
| for(i=1; i<=npar; i++) | |
| pmij(pmmij,cov,ncovmodel,xp,nlstate); | xp[i] = x[i] + (i==theta ?delti[theta]:(double)0); |
| k=0; | pmij(pmmij,cov,ncovmodel,xp,nlstate); |
| for(i=1; i<= (nlstate); i++){ | |
| for(j=1; j<=(nlstate+ndeath);j++){ | k=0; |
| k=k+1; | for(i=1; i<= (nlstate); i++){ |
| gp[k]=pmmij[i][j]; | 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]:(double)0); | |
| for(i=1; i<=npar; i++) | |
| pmij(pmmij,cov,ncovmodel,xp,nlstate); | xp[i] = x[i] - (i==theta ?delti[theta]:(double)0); |
| k=0; | |
| for(i=1; i<=(nlstate); i++){ | pmij(pmmij,cov,ncovmodel,xp,nlstate); |
| for(j=1; j<=(nlstate+ndeath);j++){ | k=0; |
| k=k+1; | for(i=1; i<=(nlstate); i++){ |
| gm[k]=pmmij[i][j]; | for(j=1; j<=(nlstate+ndeath);j++){ |
| } | k=k+1; |
| } | gm[k]=pmmij[i][j]; |
| } | |
| for(i=1; i<= (nlstate)*(nlstate+ndeath); i++) | } |
| gradg[theta][i]=(gp[i]-gm[i])/(double)2./delti[theta]; | |
| } | for(i=1; i<= (nlstate)*(nlstate+ndeath); i++) |
| gradg[theta][i]=(gp[i]-gm[i])/(double)2./delti[theta]; | |
| for(j=1; j<=(nlstate)*(nlstate+ndeath);j++) | } |
| for(theta=1; theta <=npar; theta++) | |
| trgradg[j][theta]=gradg[theta][j]; | |
| matprod2(dnewm,trgradg,1,(nlstate)*(nlstate+ndeath),1,npar,1,npar,matcov); | |
| matprod2(doldm,dnewm,1,(nlstate)*(nlstate+ndeath),1,npar,1,(nlstate)*(nlstate+ndeath),gradg); | |
| pmij(pmmij,cov,ncovmodel,x,nlstate); | |
| k=0; | |
| for(i=1; i<=(nlstate); i++){ | |
| for(j=1; j<=(nlstate+ndeath);j++){ | |
| k=k+1; | |
| mu[k][(int) age]=pmmij[i][j]; | |
| } | |
| } | |
| for(i=1;i<=(nlstate)*(nlstate+ndeath);i++) | |
| for(j=1;j<=(nlstate)*(nlstate+ndeath);j++) | |
| varpij[i][j][(int)age] = doldm[i][j]; | |
| /*printf("\n%d ",(int)age); | |
| for (i=1; i<=(nlstate)*(nlstate+ndeath);i++){ | |
| printf("%e [%e ;%e] ",gm[i],gm[i]-2*sqrt(doldm[i][i]),gm[i]+2*sqrt(doldm[i][i])); | |
| fprintf(ficlog,"%e [%e ;%e] ",gm[i],gm[i]-2*sqrt(doldm[i][i]),gm[i]+2*sqrt(doldm[i][i])); | |
| }*/ | |
| fprintf(ficresprob,"\n%d ",(int)age); | |
| fprintf(ficresprobcov,"\n%d ",(int)age); | |
| fprintf(ficresprobcor,"\n%d ",(int)age); | |
| for (i=1; i<=(nlstate)*(nlstate+ndeath);i++) | |
| fprintf(ficresprob,"%11.3e (%11.3e) ",mu[i][(int) age],sqrt(varpij[i][i][(int)age])); | |
| for (i=1; i<=(nlstate)*(nlstate+ndeath);i++){ | |
| fprintf(ficresprobcov,"%11.3e ",mu[i][(int) age]); | |
| fprintf(ficresprobcor,"%11.3e ",mu[i][(int) age]); | |
| } | |
| i=0; | |
| for (k=1; k<=(nlstate);k++){ | |
| for (l=1; l<=(nlstate+ndeath);l++){ | |
| i++; | |
| fprintf(ficresprobcov,"\n%d %d-%d",(int)age,k,l); | |
| fprintf(ficresprobcor,"\n%d %d-%d",(int)age,k,l); | |
| for (j=1; j<=i;j++){ | |
| /* printf(" k=%d l=%d i=%d j=%d\n",k,l,i,j);fflush(stdout); */ | |
| fprintf(ficresprobcov," %11.3e",varpij[i][j][(int)age]); | |
| fprintf(ficresprobcor," %11.3e",varpij[i][j][(int) age]/sqrt(varpij[i][i][(int) age])/sqrt(varpij[j][j][(int)age])); | |
| } | |
| } | |
| }/* end of loop for state */ | |
| } /* end of loop for age */ | |
| 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); | |
| /* Confidence intervalle of pij */ | |
| /* | |
| fprintf(ficgp,"\nunset parametric;unset label"); | |
| fprintf(ficgp,"\nset log y;unset log x; set xlabel \"Age\";set ylabel \"probability (year-1)\""); | |
| fprintf(ficgp,"\nset ter png small\nset size 0.65,0.65"); | |
| fprintf(fichtm,"\n<br>Probability with confidence intervals expressed in year<sup>-1</sup> :<a href=\"pijgr%s.png\">pijgr%s.png</A>, ",optionfilefiname,optionfilefiname); | |
| fprintf(fichtm,"\n<br><img src=\"pijgr%s.png\"> ",optionfilefiname); | |
| fprintf(ficgp,"\nset out \"pijgr%s.png\"",optionfilefiname); | |
| fprintf(ficgp,"\nplot \"%s\" every :::%d::%d u 1:2 \"\%%lf",k1,k2,xfilevarprob); | |
| */ | |
| /* Drawing ellipsoids of confidence of two variables p(k1-l1,k2-l2)*/ | |
| first1=1;first2=2; | |
| for (k2=1; k2<=(nlstate);k2++){ | |
| for (l2=1; l2<=(nlstate+ndeath);l2++){ | |
| if(l2==k2) continue; | |
| j=(k2-1)*(nlstate+ndeath)+l2; | |
| for (k1=1; k1<=(nlstate);k1++){ | |
| for (l1=1; l1<=(nlstate+ndeath);l1++){ | |
| if(l1==k1) continue; | |
| i=(k1-1)*(nlstate+ndeath)+l1; | |
| if(i<=j) continue; | |
| for (age=bage; age<=fage; age ++){ | |
| if ((int)age %5==0){ | |
| v1=varpij[i][i][(int)age]/stepm*YEARM/stepm*YEARM; | |
| v2=varpij[j][j][(int)age]/stepm*YEARM/stepm*YEARM; | |
| cv12=varpij[i][j][(int)age]/stepm*YEARM/stepm*YEARM; | |
| mu1=mu[i][(int) age]/stepm*YEARM ; | |
| mu2=mu[j][(int) age]/stepm*YEARM; | |
| c12=cv12/sqrt(v1*v2); | |
| /* Computing eigen value of matrix of covariance */ | |
| lc1=((v1+v2)+sqrt((v1+v2)*(v1+v2) - 4*(v1*v2-cv12*cv12)))/2.; | |
| lc2=((v1+v2)-sqrt((v1+v2)*(v1+v2) - 4*(v1*v2-cv12*cv12)))/2.; | |
| if ((lc2 <0) || (lc1 <0) ){ | |
| if(first2==1){ | |
| first1=0; | |
| printf("Strange: j1=%d One eigen value of 2x2 matrix of covariance is negative, lc1=%11.3e, lc2=%11.3e, v1=%11.3e, v2=%11.3e, cv12=%11.3e.\n It means that the matrix was not well estimated (varpij), for i=%2d, j=%2d, age=%4d .\n See files %s and %s. Probably WRONG RESULTS. See log file for details...\n", j1, lc1, lc2, v1, v2, cv12, i, j, (int)age,fileresprobcov, fileresprobcor); | |
| } | |
| fprintf(ficlog,"Strange: j1=%d One eigen value of 2x2 matrix of covariance is negative, lc1=%11.3e, lc2=%11.3e, v1=%11.3e, v2=%11.3e, cv12=%11.3e.\n It means that the matrix was not well estimated (varpij), for i=%2d, j=%2d, age=%4d .\n See files %s and %s. Probably WRONG RESULTS.\n", j1, lc1, lc2, v1, v2, cv12, i, j, (int)age,fileresprobcov, fileresprobcor);fflush(ficlog); | |
| /* lc1=fabs(lc1); */ /* If we want to have them positive */ | |
| /* lc2=fabs(lc2); */ | |
| } | |
| /* Eigen vectors */ | for(j=1; j<=(nlstate)*(nlstate+ndeath);j++) |
| v11=(1./sqrt(1+(v1-lc1)*(v1-lc1)/cv12/cv12)); | for(theta=1; theta <=npar; theta++) |
| /*v21=sqrt(1.-v11*v11); *//* error */ | trgradg[j][theta]=gradg[theta][j]; |
| v21=(lc1-v1)/cv12*v11; | |
| v12=-v21; | matprod2(dnewm,trgradg,1,(nlstate)*(nlstate+ndeath),1,npar,1,npar,matcov); |
| v22=v11; | matprod2(doldm,dnewm,1,(nlstate)*(nlstate+ndeath),1,npar,1,(nlstate)*(nlstate+ndeath),gradg); |
| tnalp=v21/v11; | |
| if(first1==1){ | pmij(pmmij,cov,ncovmodel,x,nlstate); |
| first1=0; | |
| printf("%d %d%d-%d%d mu %.4e %.4e Var %.4e %.4e cor %.3f cov %.4e Eig %.3e %.3e 1stv %.3f %.3f tang %.3f\nOthers in log...\n",(int) age,k1,l1,k2,l2,mu1,mu2,v1,v2,c12,cv12,lc1,lc2,v11,v21,tnalp); | k=0; |
| } | for(i=1; i<=(nlstate); i++){ |
| fprintf(ficlog,"%d %d%d-%d%d mu %.4e %.4e Var %.4e %.4e cor %.3f cov %.4e Eig %.3e %.3e 1stv %.3f %.3f tan %.3f\n",(int) age,k1,l1,k2,l2,mu1,mu2,v1,v2,c12,cv12,lc1,lc2,v11,v21,tnalp); | for(j=1; j<=(nlstate+ndeath);j++){ |
| /*printf(fignu*/ | k=k+1; |
| /* mu1+ v11*lc1*cost + v12*lc2*sin(t) */ | mu[k][(int) age]=pmmij[i][j]; |
| /* mu2+ v21*lc1*cost + v22*lc2*sin(t) */ | } |
| if(first==1){ | } |
| first=0; | for(i=1;i<=(nlstate)*(nlstate+ndeath);i++) |
| fprintf(ficgp,"\n# Ellipsoids of confidence\n#\n"); | for(j=1;j<=(nlstate)*(nlstate+ndeath);j++) |
| fprintf(ficgp,"\nset parametric;unset label"); | varpij[i][j][(int)age] = doldm[i][j]; |
| 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"); | /*printf("\n%d ",(int)age); |
| fprintf(fichtmcov,"\n<br>Ellipsoids of confidence cov(p%1d%1d,p%1d%1d) expressed in year<sup>-1</sup>\ | for (i=1; i<=(nlstate)*(nlstate+ndeath);i++){ |
| :<a href=\"%s_%d%1d%1d-%1d%1d.svg\">\ | printf("%e [%e ;%e] ",gm[i],gm[i]-2*sqrt(doldm[i][i]),gm[i]+2*sqrt(doldm[i][i])); |
| fprintf(ficlog,"%e [%e ;%e] ",gm[i],gm[i]-2*sqrt(doldm[i][i]),gm[i]+2*sqrt(doldm[i][i])); | |
| }*/ | |
| fprintf(ficresprob,"\n%d ",(int)age); | |
| fprintf(ficresprobcov,"\n%d ",(int)age); | |
| fprintf(ficresprobcor,"\n%d ",(int)age); | |
| for (i=1; i<=(nlstate)*(nlstate+ndeath);i++) | |
| fprintf(ficresprob,"%11.3e (%11.3e) ",mu[i][(int) age],sqrt(varpij[i][i][(int)age])); | |
| for (i=1; i<=(nlstate)*(nlstate+ndeath);i++){ | |
| fprintf(ficresprobcov,"%11.3e ",mu[i][(int) age]); | |
| fprintf(ficresprobcor,"%11.3e ",mu[i][(int) age]); | |
| } | |
| i=0; | |
| for (k=1; k<=(nlstate);k++){ | |
| for (l=1; l<=(nlstate+ndeath);l++){ | |
| i++; | |
| fprintf(ficresprobcov,"\n%d %d-%d",(int)age,k,l); | |
| fprintf(ficresprobcor,"\n%d %d-%d",(int)age,k,l); | |
| for (j=1; j<=i;j++){ | |
| /* printf(" k=%d l=%d i=%d j=%d\n",k,l,i,j);fflush(stdout); */ | |
| fprintf(ficresprobcov," %11.3e",varpij[i][j][(int)age]); | |
| fprintf(ficresprobcor," %11.3e",varpij[i][j][(int) age]/sqrt(varpij[i][i][(int) age])/sqrt(varpij[j][j][(int)age])); | |
| } | |
| } | |
| }/* end of loop for state */ | |
| } /* end of loop for age */ | |
| 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); | |
| /* Confidence intervalle of pij */ | |
| /* | |
| fprintf(ficgp,"\nunset parametric;unset label"); | |
| fprintf(ficgp,"\nset log y;unset log x; set xlabel \"Age\";set ylabel \"probability (year-1)\""); | |
| fprintf(ficgp,"\nset ter png small\nset size 0.65,0.65"); | |
| fprintf(fichtm,"\n<br>Probability with confidence intervals expressed in year<sup>-1</sup> :<a href=\"pijgr%s.png\">pijgr%s.png</A>, ",optionfilefiname,optionfilefiname); | |
| fprintf(fichtm,"\n<br><img src=\"pijgr%s.png\"> ",optionfilefiname); | |
| fprintf(ficgp,"\nset out \"pijgr%s.png\"",optionfilefiname); | |
| fprintf(ficgp,"\nplot \"%s\" every :::%d::%d u 1:2 \"\%%lf",k1,k2,xfilevarprob); | |
| */ | |
| /* Drawing ellipsoids of confidence of two variables p(k1-l1,k2-l2)*/ | |
| first1=1;first2=2; | |
| for (k2=1; k2<=(nlstate);k2++){ | |
| for (l2=1; l2<=(nlstate+ndeath);l2++){ | |
| if(l2==k2) continue; | |
| j=(k2-1)*(nlstate+ndeath)+l2; | |
| for (k1=1; k1<=(nlstate);k1++){ | |
| for (l1=1; l1<=(nlstate+ndeath);l1++){ | |
| if(l1==k1) continue; | |
| i=(k1-1)*(nlstate+ndeath)+l1; | |
| if(i<=j) continue; | |
| for (age=bage; age<=fage; age ++){ | |
| if ((int)age %5==0){ | |
| v1=varpij[i][i][(int)age]/stepm*YEARM/stepm*YEARM; | |
| v2=varpij[j][j][(int)age]/stepm*YEARM/stepm*YEARM; | |
| cv12=varpij[i][j][(int)age]/stepm*YEARM/stepm*YEARM; | |
| mu1=mu[i][(int) age]/stepm*YEARM ; | |
| mu2=mu[j][(int) age]/stepm*YEARM; | |
| c12=cv12/sqrt(v1*v2); | |
| /* Computing eigen value of matrix of covariance */ | |
| lc1=((v1+v2)+sqrt((v1+v2)*(v1+v2) - 4*(v1*v2-cv12*cv12)))/2.; | |
| lc2=((v1+v2)-sqrt((v1+v2)*(v1+v2) - 4*(v1*v2-cv12*cv12)))/2.; | |
| if ((lc2 <0) || (lc1 <0) ){ | |
| if(first2==1){ | |
| first1=0; | |
| printf("Strange: j1=%d One eigen value of 2x2 matrix of covariance is negative, lc1=%11.3e, lc2=%11.3e, v1=%11.3e, v2=%11.3e, cv12=%11.3e.\n It means that the matrix was not well estimated (varpij), for i=%2d, j=%2d, age=%4d .\n See files %s and %s. Probably WRONG RESULTS. See log file for details...\n", j1, lc1, lc2, v1, v2, cv12, i, j, (int)age,fileresprobcov, fileresprobcor); | |
| } | |
| fprintf(ficlog,"Strange: j1=%d One eigen value of 2x2 matrix of covariance is negative, lc1=%11.3e, lc2=%11.3e, v1=%11.3e, v2=%11.3e, cv12=%11.3e.\n It means that the matrix was not well estimated (varpij), for i=%2d, j=%2d, age=%4d .\n See files %s and %s. Probably WRONG RESULTS.\n", j1, lc1, lc2, v1, v2, cv12, i, j, (int)age,fileresprobcov, fileresprobcor);fflush(ficlog); | |
| /* lc1=fabs(lc1); */ /* If we want to have them positive */ | |
| /* lc2=fabs(lc2); */ | |
| } | |
| /* Eigen vectors */ | |
| v11=(1./sqrt(1+(v1-lc1)*(v1-lc1)/cv12/cv12)); | |
| /*v21=sqrt(1.-v11*v11); *//* error */ | |
| v21=(lc1-v1)/cv12*v11; | |
| v12=-v21; | |
| v22=v11; | |
| tnalp=v21/v11; | |
| if(first1==1){ | |
| first1=0; | |
| printf("%d %d%d-%d%d mu %.4e %.4e Var %.4e %.4e cor %.3f cov %.4e Eig %.3e %.3e 1stv %.3f %.3f tang %.3f\nOthers in log...\n",(int) age,k1,l1,k2,l2,mu1,mu2,v1,v2,c12,cv12,lc1,lc2,v11,v21,tnalp); | |
| } | |
| fprintf(ficlog,"%d %d%d-%d%d mu %.4e %.4e Var %.4e %.4e cor %.3f cov %.4e Eig %.3e %.3e 1stv %.3f %.3f tan %.3f\n",(int) age,k1,l1,k2,l2,mu1,mu2,v1,v2,c12,cv12,lc1,lc2,v11,v21,tnalp); | |
| /*printf(fignu*/ | |
| /* mu1+ v11*lc1*cost + v12*lc2*sin(t) */ | |
| /* mu2+ v21*lc1*cost + v22*lc2*sin(t) */ | |
| if(first==1){ | |
| first=0; | |
| fprintf(ficgp,"\n# Ellipsoids of confidence\n#\n"); | |
| 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<br>Ellipsoids of confidence cov(p%1d%1d,p%1d%1d) expressed in year<sup>-1</sup>\ | |
| :<a href=\"%s_%d%1d%1d-%1d%1d.svg\"> \ | |
| %s_%d%1d%1d-%1d%1d.svg</A>, ",k1,l1,k2,l2,\ | %s_%d%1d%1d-%1d%1d.svg</A>, ",k1,l1,k2,l2,\ |
| subdirf2(optionfilefiname,"VARPIJGR_"), j1,k1,l1,k2,l2,\ | subdirf2(optionfilefiname,"VARPIJGR_"), j1,k1,l1,k2,l2, \ |
| subdirf2(optionfilefiname,"VARPIJGR_"), j1,k1,l1,k2,l2); | subdirf2(optionfilefiname,"VARPIJGR_"), j1,k1,l1,k2,l2); |
| fprintf(fichtmcov,"\n<br><img src=\"%s_%d%1d%1d-%1d%1d.svg\"> ",subdirf2(optionfilefiname,"VARPIJGR_"), j1,k1,l1,k2,l2); | fprintf(fichtmcov,"\n<br><img src=\"%s_%d%1d%1d-%1d%1d.svg\"> ",subdirf2(optionfilefiname,"VARPIJGR_"), j1,k1,l1,k2,l2); |
| fprintf(fichtmcov,"\n<br> Correlation at age %d (%.3f),",(int) age, c12); | fprintf(fichtmcov,"\n<br> Correlation at age %d (%.3f),",(int) age, c12); |
| fprintf(ficgp,"\nset out \"%s_%d%1d%1d-%1d%1d.svg\"",subdirf2(optionfilefiname,"VARPIJGR_"), j1,k1,l1,k2,l2); | fprintf(ficgp,"\nset out \"%s_%d%1d%1d-%1d%1d.svg\"",subdirf2(optionfilefiname,"VARPIJGR_"), j1,k1,l1,k2,l2); |
| fprintf(ficgp,"\nset label \"%d\" at %11.3e,%11.3e center",(int) age, mu1,mu2); | 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,"\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",\ | 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),\ | mu1,std,v11,sqrt(lc1),v12,sqrt(lc2), \ |
| mu2,std,v21,sqrt(lc1),v22,sqrt(lc2)); | mu2,std,v21,sqrt(lc1),v22,sqrt(lc2)); |
| }else{ | }else{ |
| first=0; | first=0; |
| fprintf(fichtmcov," %d (%.3f),",(int) age, c12); | 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,"\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,"\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",\ | 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),\ | mu1,std,v11,sqrt(lc1),v12,sqrt(lc2), \ |
| mu2,std,v21,sqrt(lc1),v22,sqrt(lc2)); | mu2,std,v21,sqrt(lc1),v22,sqrt(lc2)); |
| }/* if first */ | }/* if first */ |
| } /* age mod 5 */ | } /* age mod 5 */ |
| } /* end loop age */ | } /* end loop age */ |
| fprintf(ficgp,"\nset out;\nset out \"%s_%d%1d%1d-%1d%1d.svg\";replot;set out;",subdirf2(optionfilefiname,"VARPIJGR_"), j1,k1,l1,k2,l2); | fprintf(ficgp,"\nset out;\nset out \"%s_%d%1d%1d-%1d%1d.svg\";replot;set out;",subdirf2(optionfilefiname,"VARPIJGR_"), j1,k1,l1,k2,l2); |
| first=1; | first=1; |
| } /*l12 */ | } /*l12 */ |
| } /* k12 */ | } /* k12 */ |
| } /*l1 */ | } /*l1 */ |
| }/* k1 */ | }/* k1 */ |
| /* } */ /* loop covariates */ | } /* loop on combination of covariates j1 */ |
| } | free_ma3x(varpij,1,nlstate,1,nlstate+ndeath,(int) bage, (int)fage); |
| free_ma3x(varpij,1,nlstate,1,nlstate+ndeath,(int) bage, (int)fage); | free_matrix(mu,1,(nlstate+ndeath)*(nlstate+ndeath),(int) bage, (int)fage); |
| free_matrix(mu,1,(nlstate+ndeath)*(nlstate+ndeath),(int) bage, (int)fage); | free_matrix(doldm,1,(nlstate)*(nlstate+ndeath),1,(nlstate)*(nlstate+ndeath)); |
| free_matrix(doldm,1,(nlstate)*(nlstate+ndeath),1,(nlstate)*(nlstate+ndeath)); | free_matrix(dnewm,1,(nlstate)*(nlstate+ndeath),1,npar); |
| free_matrix(dnewm,1,(nlstate)*(nlstate+ndeath),1,npar); | free_vector(xp,1,npar); |
| free_vector(xp,1,npar); | fclose(ficresprob); |
| fclose(ficresprob); | fclose(ficresprobcov); |
| fclose(ficresprobcov); | fclose(ficresprobcor); |
| fclose(ficresprobcor); | fflush(ficgp); |
| fflush(ficgp); | fflush(fichtmcov); |
| fflush(fichtmcov); | } |
| } | |
| /******************* Printing html file ***********/ | /******************* Printing html file ***********/ |
| Line 5350 void printinghtml(char fileresu[], char | Line 5867 void printinghtml(char fileresu[], char |
| <a href=\"%s\">%s</a> <br>\n</li>", subdirf2(fileresu,"F_"),subdirf2(fileresu,"F_")); | <a href=\"%s\">%s</a> <br>\n</li>", subdirf2(fileresu,"F_"),subdirf2(fileresu,"F_")); |
| } | } |
| fprintf(fichtm," \n<ul><li><b>Graphs</b></li><p>"); | fprintf(fichtm," \n<ul><li><b>Graphs</b></li><p>"); |
| m=pow(2,cptcoveff); | m=pow(2,cptcoveff); |
| if (cptcovn < 1) {m=1;ncodemax[1]=1;} | if (cptcovn < 1) {m=1;ncodemax[1]=1;} |
| jj1=0; | jj1=0; |
| for(k1=1; k1<=m;k1++){ | for(k1=1; k1<=m;k1++){ |
| /* for(i1=1; i1<=ncodemax[k1];i1++){ */ | |
| /* for(i1=1; i1<=ncodemax[k1];i1++){ */ | |
| jj1++; | jj1++; |
| if (cptcovn > 0) { | if (cptcovn > 0) { |
| fprintf(fichtm,"<hr size=\"2\" color=\"#EC5E5E\">************ Results for covariates"); | fprintf(fichtm,"<hr size=\"2\" color=\"#EC5E5E\">************ Results for covariates"); |
| Line 5366 fprintf(fichtm," \n<ul><li><b>Graphs</b> | Line 5884 fprintf(fichtm," \n<ul><li><b>Graphs</b> |
| printf(" V%d=%d ",Tvaraff[cpt],nbcode[Tvaraff[cpt]][codtabm(jj1,cpt)]);fflush(stdout); | printf(" V%d=%d ",Tvaraff[cpt],nbcode[Tvaraff[cpt]][codtabm(jj1,cpt)]);fflush(stdout); |
| } | } |
| fprintf(fichtm," ************\n<hr size=\"2\" color=\"#EC5E5E\">"); | fprintf(fichtm," ************\n<hr size=\"2\" color=\"#EC5E5E\">"); |
| if(invalidvarcomb[k1]){ | |
| fprintf(fichtm,"\n<h3>Combination (%d) ignored because no cases </h3>\n",k1); | |
| printf("\nCombination (%d) ignored because no cases \n",k1); | |
| continue; | |
| } | |
| } | } |
| /* aij, bij */ | /* aij, bij */ |
| fprintf(fichtm,"<br>- Logit model (yours is: 1+age+%s), for example: logit(pij)=log(pij/pii)= aij+ bij age + V1 age + etc. as a function of age: <a href=\"%s_%d-1.svg\">%s_%d-1.svg</a><br> \ | fprintf(fichtm,"<br>- Logit model (yours is: 1+age+%s), for example: logit(pij)=log(pij/pii)= aij+ bij age + V1 age + etc. as a function of age: <a href=\"%s_%d-1.svg\">%s_%d-1.svg</a><br> \ |
| Line 5375 fprintf(fichtm," \n<ul><li><b>Graphs</b> | Line 5898 fprintf(fichtm," \n<ul><li><b>Graphs</b> |
| <img src=\"%s_%d-2.svg\">",stepm,subdirf2(optionfilefiname,"PE_"),jj1,subdirf2(optionfilefiname,"PE_"),jj1,subdirf2(optionfilefiname,"PE_"),jj1); | <img src=\"%s_%d-2.svg\">",stepm,subdirf2(optionfilefiname,"PE_"),jj1,subdirf2(optionfilefiname,"PE_"),jj1,subdirf2(optionfilefiname,"PE_"),jj1); |
| /* Quasi-incidences */ | /* Quasi-incidences */ |
| fprintf(fichtm,"<br>\n- I<sub>ij</sub> or Conditional probabilities to be observed in state j being in state i %d (stepm) months\ | fprintf(fichtm,"<br>\n- I<sub>ij</sub> or Conditional probabilities to be observed in state j being in state i %d (stepm) months\ |
| before but expressed in per year i.e. quasi incidences if stepm is small and probabilities too,\ | before but expressed in per year i.e. quasi incidences if stepm is small and probabilities too, \ |
| incidence (rates) are the limit when h tends to zero of the ratio of the probability <sub>h</sub>P<sub>ij</sub> \ | incidence (rates) are the limit when h tends to zero of the ratio of the probability <sub>h</sub>P<sub>ij</sub> \ |
| divided by h: <sub>h</sub>P<sub>ij</sub>/h : <a href=\"%s_%d-3.svg\">%s_%d-3.svg</a><br> \ | divided by h: <sub>h</sub>P<sub>ij</sub>/h : <a href=\"%s_%d-3.svg\">%s_%d-3.svg</a><br> \ |
| <img src=\"%s_%d-3.svg\">",stepm,subdirf2(optionfilefiname,"PE_"),jj1,subdirf2(optionfilefiname,"PE_"),jj1,subdirf2(optionfilefiname,"PE_"),jj1); | <img src=\"%s_%d-3.svg\">",stepm,subdirf2(optionfilefiname,"PE_"),jj1,subdirf2(optionfilefiname,"PE_"),jj1,subdirf2(optionfilefiname,"PE_"),jj1); |
| Line 5387 divided by h: <sub>h</sub>P<sub>ij</sub> | Line 5910 divided by h: <sub>h</sub>P<sub>ij</sub> |
| /* State specific survival functions (period) */ | /* State specific survival functions (period) */ |
| for(cpt=1; cpt<=nlstate;cpt++){ | for(cpt=1; cpt<=nlstate;cpt++){ |
| fprintf(fichtm,"<br>\n- Survival functions from state %d in each live state and total.\ | fprintf(fichtm,"<br>\n- Survival functions from state %d in each live state and total.\ |
| Or probability to survive in various states (1 to %d) being in state %d at different ages.\ | Or probability to survive in various states (1 to %d) being in state %d at different ages. \ |
| <a href=\"%s%d_%d.svg\">%s%d_%d.svg</a><br> <img src=\"%s_%d-%d.svg\">", cpt, nlstate, cpt, subdirf2(optionfilefiname,"LIJT_"),cpt,jj1,subdirf2(optionfilefiname,"LIJT_"),cpt,jj1,subdirf2(optionfilefiname,"LIJT_"),cpt,jj1); | <a href=\"%s%d_%d.svg\">%s%d_%d.svg</a><br> <img src=\"%s_%d-%d.svg\">", cpt, nlstate, cpt, subdirf2(optionfilefiname,"LIJT_"),cpt,jj1,subdirf2(optionfilefiname,"LIJT_"),cpt,jj1,subdirf2(optionfilefiname,"LIJT_"),cpt,jj1); |
| } | } |
| /* Period (stable) prevalence in each health state */ | /* Period (stable) prevalence in each health state */ |
| Line 5395 divided by h: <sub>h</sub>P<sub>ij</sub> | Line 5918 divided by h: <sub>h</sub>P<sub>ij</sub> |
| fprintf(fichtm,"<br>\n- Convergence to period (stable) prevalence in state %d. Or probability to be in state %d being in state (1 to %d) at different ages. <a href=\"%s_%d-%d.svg\">%s_%d-%d.svg</a><br> \ | fprintf(fichtm,"<br>\n- Convergence to period (stable) prevalence in state %d. Or probability to be in state %d being in state (1 to %d) at different ages. <a href=\"%s_%d-%d.svg\">%s_%d-%d.svg</a><br> \ |
| <img src=\"%s_%d-%d.svg\">", cpt, cpt, nlstate, subdirf2(optionfilefiname,"P_"),cpt,jj1,subdirf2(optionfilefiname,"P_"),cpt,jj1,subdirf2(optionfilefiname,"P_"),cpt,jj1); | <img src=\"%s_%d-%d.svg\">", cpt, cpt, nlstate, subdirf2(optionfilefiname,"P_"),cpt,jj1,subdirf2(optionfilefiname,"P_"),cpt,jj1,subdirf2(optionfilefiname,"P_"),cpt,jj1); |
| } | } |
| if(backcast==1){ | if(backcast==1){ |
| /* Period (stable) back prevalence in each health state */ | /* Period (stable) back prevalence in each health state */ |
| for(cpt=1; cpt<=nlstate;cpt++){ | for(cpt=1; cpt<=nlstate;cpt++){ |
| fprintf(fichtm,"<br>\n- Convergence to period (stable) back prevalence in state %d. Or probability to be in state %d being in state (1 to %d) at different ages. <a href=\"%s_%d-%d.svg\">%s_%d-%d.svg</a><br> \ | fprintf(fichtm,"<br>\n- Convergence to period (stable) back prevalence in state %d. Or probability to be in state %d being in state (1 to %d) at different ages. <a href=\"%s_%d-%d.svg\">%s_%d-%d.svg</a><br> \ |
| <img src=\"%s_%d-%d.svg\">", cpt, cpt, nlstate, subdirf2(optionfilefiname,"PB_"),cpt,jj1,subdirf2(optionfilefiname,"PB_"),cpt,jj1,subdirf2(optionfilefiname,"PB_"),cpt,jj1); | <img src=\"%s_%d-%d.svg\">", cpt, cpt, nlstate, subdirf2(optionfilefiname,"PB_"),cpt,jj1,subdirf2(optionfilefiname,"PB_"),cpt,jj1,subdirf2(optionfilefiname,"PB_"),cpt,jj1); |
| } | |
| } | } |
| } | if(prevfcast==1){ |
| if(prevfcast==1){ | /* Projection of prevalence up to period (stable) prevalence in each health state */ |
| /* Projection of prevalence up to period (stable) prevalence in each health state */ | for(cpt=1; cpt<=nlstate;cpt++){ |
| for(cpt=1; cpt<=nlstate;cpt++){ | fprintf(fichtm,"<br>\n- Projection of cross-sectional prevalence (estimated with cases observed from %.1f to %.1f) up to period (stable) prevalence in state %d. Or probability to be in state %d being in state (1 to %d) at different ages. <a href=\"%s%d_%d.svg\">%s%d_%d.svg</a><br> \ |
| fprintf(fichtm,"<br>\n- Projection of cross-sectional prevalence (estimated with cases observed from %.1f to %.1f) up to period (stable) prevalence in state %d. Or probability to be in state %d being in state (1 to %d) at different ages. <a href=\"%s%d_%d.svg\">%s%d_%d.svg</a><br> \ | |
| <img src=\"%s_%d-%d.svg\">", dateprev1, dateprev2, cpt, cpt, nlstate, subdirf2(optionfilefiname,"PROJ_"),cpt,jj1,subdirf2(optionfilefiname,"PROJ_"),cpt,jj1,subdirf2(optionfilefiname,"PROJ_"),cpt,jj1); | <img src=\"%s_%d-%d.svg\">", dateprev1, dateprev2, cpt, cpt, nlstate, subdirf2(optionfilefiname,"PROJ_"),cpt,jj1,subdirf2(optionfilefiname,"PROJ_"),cpt,jj1,subdirf2(optionfilefiname,"PROJ_"),cpt,jj1); |
| } | } |
| } | } |
| for(cpt=1; cpt<=nlstate;cpt++) { | for(cpt=1; cpt<=nlstate;cpt++) { |
| fprintf(fichtm,"\n<br>- Life expectancy by health state (%d) at initial age and its decomposition into health expectancies in each alive state (1 to %d) (or area under each survival functions): <a href=\"%s_%d%d.svg\">%s_%d%d.svg</a> <br> \ | fprintf(fichtm,"\n<br>- Life expectancy by health state (%d) at initial age and its decomposition into health expectancies in each alive state (1 to %d) (or area under each survival functions): <a href=\"%s_%d%d.svg\">%s_%d%d.svg</a> <br> \ |
| <img src=\"%s_%d%d.svg\">",cpt,nlstate,subdirf2(optionfilefiname,"EXP_"),cpt,jj1,subdirf2(optionfilefiname,"EXP_"),cpt,jj1,subdirf2(optionfilefiname,"EXP_"),cpt,jj1); | <img src=\"%s_%d%d.svg\">",cpt,nlstate,subdirf2(optionfilefiname,"EXP_"),cpt,jj1,subdirf2(optionfilefiname,"EXP_"),cpt,jj1,subdirf2(optionfilefiname,"EXP_"),cpt,jj1); |
| } | } |
| /* } /\* end i1 *\/ */ | /* } /\* end i1 *\/ */ |
| }/* End k1 */ | }/* End k1 */ |
| fprintf(fichtm,"</ul>"); | fprintf(fichtm,"</ul>"); |
| fprintf(fichtm,"\ | fprintf(fichtm,"\ |
| \n<br><li><h4> <a name='secondorder'>Result files (second order: variances)</a></h4>\n\ | \n<br><li><h4> <a name='secondorder'>Result files (second order: variances)</a></h4>\n\ |
| - Parameter file with estimated parameters and covariance matrix: <a href=\"%s\">%s</a> <br> \ | - Parameter file with estimated parameters and covariance matrix: <a href=\"%s\">%s</a> <br> \ |
| - 95%% confidence intervals and Wald tests of the estimated parameters are in the log file if optimization has been done (mle != 0).<br> \ | - 95%% confidence intervals and Wald tests of the estimated parameters are in the log file if optimization has been done (mle != 0).<br> \ |
| Line 5430 variances but at the covariance matrix. | Line 5953 variances but at the covariance matrix. |
| covariance matrix of the one-step probabilities. \ | covariance matrix of the one-step probabilities. \ |
| See page 'Matrix of variance-covariance of one-step probabilities' below. \n", rfileres,rfileres); | See page 'Matrix of variance-covariance of one-step probabilities' below. \n", rfileres,rfileres); |
| fprintf(fichtm," - Standard deviation of one-step probabilities: <a href=\"%s\">%s</a> <br>\n", | fprintf(fichtm," - Standard deviation of one-step probabilities: <a href=\"%s\">%s</a> <br>\n", |
| subdirf2(fileresu,"PROB_"),subdirf2(fileresu,"PROB_")); | subdirf2(fileresu,"PROB_"),subdirf2(fileresu,"PROB_")); |
| fprintf(fichtm,"\ | fprintf(fichtm,"\ |
| - Variance-covariance of one-step probabilities: <a href=\"%s\">%s</a> <br>\n", | - Variance-covariance of one-step probabilities: <a href=\"%s\">%s</a> <br>\n", |
| subdirf2(fileresu,"PROBCOV_"),subdirf2(fileresu,"PROBCOV_")); | subdirf2(fileresu,"PROBCOV_"),subdirf2(fileresu,"PROBCOV_")); |
| fprintf(fichtm,"\ | fprintf(fichtm,"\ |
| - Correlation matrix of one-step probabilities: <a href=\"%s\">%s</a> <br>\n", | - Correlation matrix of one-step probabilities: <a href=\"%s\">%s</a> <br>\n", |
| subdirf2(fileresu,"PROBCOR_"),subdirf2(fileresu,"PROBCOR_")); | subdirf2(fileresu,"PROBCOR_"),subdirf2(fileresu,"PROBCOR_")); |
| fprintf(fichtm,"\ | fprintf(fichtm,"\ |
| - Variances and covariances of health expectancies by age and <b>initial health status</b> (cov(e<sup>ij</sup>,e<sup>kl</sup>)(estepm=%2d months): \ | - Variances and covariances of health expectancies by age and <b>initial health status</b> (cov(e<sup>ij</sup>,e<sup>kl</sup>)(estepm=%2d months): \ |
| <a href=\"%s\">%s</a> <br>\n</li>", | <a href=\"%s\">%s</a> <br>\n</li>", |
| estepm,subdirf2(fileresu,"CVE_"),subdirf2(fileresu,"CVE_")); | estepm,subdirf2(fileresu,"CVE_"),subdirf2(fileresu,"CVE_")); |
| fprintf(fichtm,"\ | fprintf(fichtm,"\ |
| - (a) Health expectancies by health status at initial age (e<sup>ij</sup>) and standard errors (in parentheses) (b) life expectancies and standard errors (e<sup>i.</sup>=e<sup>i1</sup>+e<sup>i2</sup>+...)(estepm=%2d months): \ | - (a) Health expectancies by health status at initial age (e<sup>ij</sup>) and standard errors (in parentheses) (b) life expectancies and standard errors (e<sup>i.</sup>=e<sup>i1</sup>+e<sup>i2</sup>+...)(estepm=%2d months): \ |
| <a href=\"%s\">%s</a> <br>\n</li>", | <a href=\"%s\">%s</a> <br>\n</li>", |
| estepm,subdirf2(fileresu,"STDE_"),subdirf2(fileresu,"STDE_")); | estepm,subdirf2(fileresu,"STDE_"),subdirf2(fileresu,"STDE_")); |
| fprintf(fichtm,"\ | fprintf(fichtm,"\ |
| - Variances and covariances of health expectancies by age. Status (i) based health expectancies (in state j), e<sup>ij</sup> are weighted by the period prevalences in each state i (if popbased=1, an additional computation is done using the cross-sectional prevalences, i.e population based) (estepm=%d months): <a href=\"%s\">%s</a><br>\n", | - Variances and covariances of health expectancies by age. Status (i) based health expectancies (in state j), e<sup>ij</sup> are weighted by the period prevalences in each state i (if popbased=1, an additional computation is done using the cross-sectional prevalences, i.e population based) (estepm=%d months): <a href=\"%s\">%s</a><br>\n", |
| estepm, subdirf2(fileresu,"V_"),subdirf2(fileresu,"V_")); | estepm, subdirf2(fileresu,"V_"),subdirf2(fileresu,"V_")); |
| fprintf(fichtm,"\ | fprintf(fichtm,"\ |
| - Total life expectancy and total health expectancies to be spent in each health state e<sup>.j</sup> with their standard errors (if popbased=1, an additional computation is done using the cross-sectional prevalences, i.e population based) (estepm=%d months): <a href=\"%s\">%s</a> <br>\n", | - Total life expectancy and total health expectancies to be spent in each health state e<sup>.j</sup> with their standard errors (if popbased=1, an additional computation is done using the cross-sectional prevalences, i.e population based) (estepm=%d months): <a href=\"%s\">%s</a> <br>\n", |
| estepm, subdirf2(fileresu,"T_"),subdirf2(fileresu,"T_")); | estepm, subdirf2(fileresu,"T_"),subdirf2(fileresu,"T_")); |
| fprintf(fichtm,"\ | fprintf(fichtm,"\ |
| - Standard deviation of period (stable) prevalences: <a href=\"%s\">%s</a> <br>\n",\ | - Standard deviation of period (stable) prevalences: <a href=\"%s\">%s</a> <br>\n",\ |
| subdirf2(fileresu,"VPL_"),subdirf2(fileresu,"VPL_")); | subdirf2(fileresu,"VPL_"),subdirf2(fileresu,"VPL_")); |
| /* if(popforecast==1) fprintf(fichtm,"\n */ | /* if(popforecast==1) fprintf(fichtm,"\n */ |
| /* - Prevalences forecasting: <a href=\"f%s\">f%s</a> <br>\n */ | /* - Prevalences forecasting: <a href=\"f%s\">f%s</a> <br>\n */ |
| Line 5463 See page 'Matrix of variance-covariance | Line 5986 See page 'Matrix of variance-covariance |
| /* <br>",fileres,fileres,fileres,fileres); */ | /* <br>",fileres,fileres,fileres,fileres); */ |
| /* else */ | /* else */ |
| /* fprintf(fichtm,"\n No population forecast: popforecast = %d (instead of 1) or stepm = %d (instead of 1) or model=%s (instead of .)<br><br></li>\n",popforecast, stepm, model); */ | /* fprintf(fichtm,"\n No population forecast: popforecast = %d (instead of 1) or stepm = %d (instead of 1) or model=%s (instead of .)<br><br></li>\n",popforecast, stepm, model); */ |
| fflush(fichtm); | fflush(fichtm); |
| fprintf(fichtm," <ul><li><b>Graphs</b></li><p>"); | fprintf(fichtm," <ul><li><b>Graphs</b></li><p>"); |
| m=pow(2,cptcoveff); | m=pow(2,cptcoveff); |
| if (cptcovn < 1) {m=1;ncodemax[1]=1;} | if (cptcovn < 1) {m=1;ncodemax[1]=1;} |
| jj1=0; | jj1=0; |
| for(k1=1; k1<=m;k1++){ | for(k1=1; k1<=m;k1++){ |
| /* for(i1=1; i1<=ncodemax[k1];i1++){ */ | /* for(i1=1; i1<=ncodemax[k1];i1++){ */ |
| jj1++; | jj1++; |
| if (cptcovn > 0) { | if (cptcovn > 0) { |
| fprintf(fichtm,"<hr size=\"2\" color=\"#EC5E5E\">************ Results for covariates"); | fprintf(fichtm,"<hr size=\"2\" color=\"#EC5E5E\">************ Results for covariates"); |
| for (cpt=1; cpt<=cptcoveff;cpt++) | for (cpt=1; cpt<=cptcoveff;cpt++) /**< cptcoveff number of variables */ |
| fprintf(fichtm," V%d=%d ",Tvaraff[cpt],nbcode[Tvaraff[cpt]][codtabm(jj1,cpt)]); | fprintf(fichtm," V%d=%d ",Tvaraff[cpt],nbcode[Tvaraff[cpt]][codtabm(jj1,cpt)]); |
| fprintf(fichtm," ************\n<hr size=\"2\" color=\"#EC5E5E\">"); | fprintf(fichtm," ************\n<hr size=\"2\" color=\"#EC5E5E\">"); |
| if(invalidvarcomb[k1]){ | |
| fprintf(fichtm,"\n<h4>Combination (%d) ignored because no cases </h4>\n",k1); | |
| continue; | |
| } | |
| } | } |
| for(cpt=1; cpt<=nlstate;cpt++) { | for(cpt=1; cpt<=nlstate;cpt++) { |
| fprintf(fichtm,"<br>- Observed (cross-sectional) and period (incidence based) \ | fprintf(fichtm,"\n<br>- Observed (cross-sectional) and period (incidence based) \ |
| prevalence (with 95%% confidence interval) in state (%d): <a href=\"%s_%d%d.svg\"> %s_%d-%d.svg <br>\ | prevalence (with 95%% confidence interval) in state (%d): <a href=\"%s_%d-%d.svg\"> %s_%d-%d.svg</a>\n <br>\ |
| <img src=\"%s_%d-%d.svg\">",cpt,subdirf2(optionfilefiname,"V_"),cpt,jj1,subdirf2(optionfilefiname,"V_"),cpt,jj1,subdirf2(optionfilefiname,"V_"),cpt,jj1); | <img src=\"%s_%d-%d.svg\">",cpt,subdirf2(optionfilefiname,"V_"),cpt,jj1,subdirf2(optionfilefiname,"V_"),cpt,jj1,subdirf2(optionfilefiname,"V_"),cpt,jj1); |
| } | } |
| fprintf(fichtm,"\n<br>- Total life expectancy by age and \ | fprintf(fichtm,"\n<br>- Total life expectancy by age and \ |
| health expectancies in states (1) and (2). If popbased=1 the smooth (due to the model) \ | health expectancies in states (1) and (2). If popbased=1 the smooth (due to the model) \ |
| true period expectancies (those weighted with period prevalences are also\ | true period expectancies (those weighted with period prevalences are also\ |
| drawn in addition to the population based expectancies computed using\ | drawn in addition to the population based expectancies computed using\ |
| observed and cahotic prevalences: <a href=\"%s_%d.svg\">%s_%d.svg<br>\ | observed and cahotic prevalences: <a href=\"%s_%d.svg\">%s_%d.svg</a>\n<br>\ |
| <img src=\"%s_%d.svg\">",subdirf2(optionfilefiname,"E_"),jj1,subdirf2(optionfilefiname,"E_"),jj1,subdirf2(optionfilefiname,"E_"),jj1); | <img src=\"%s_%d.svg\">",subdirf2(optionfilefiname,"E_"),jj1,subdirf2(optionfilefiname,"E_"),jj1,subdirf2(optionfilefiname,"E_"),jj1); |
| /* } /\* end i1 *\/ */ | /* } /\* end i1 *\/ */ |
| }/* End k1 */ | }/* End k1 */ |
| fprintf(fichtm,"</ul>"); | fprintf(fichtm,"</ul>"); |
| fflush(fichtm); | fflush(fichtm); |
| } | } |
| /******************* Gnuplot file **************/ | /******************* Gnuplot file **************/ |
| void printinggnuplot(char fileresu[], char optionfilefiname[], double ageminpar, double agemaxpar, double fage , int prevfcast, char pathc[], double p[]){ | void printinggnuplot(char fileresu[], char optionfilefiname[], double ageminpar, double agemaxpar, double fage , int prevfcast, int backcast, char pathc[], double p[]){ |
| char dirfileres[132],optfileres[132]; | char dirfileres[132],optfileres[132]; |
| char gplotcondition[132]; | |
| int cpt=0,k1=0,i=0,k=0,j=0,jk=0,k2=0,k3=0,ij=0,l=0; | int cpt=0,k1=0,i=0,k=0,j=0,jk=0,k2=0,k3=0,ij=0,l=0; |
| int lv=0, vlv=0, kl=0; | int lv=0, vlv=0, kl=0; |
| int ng=0; | int ng=0; |
| int vpopbased; | int vpopbased; |
| int ioffset; /* variable offset for columns */ | |
| /* if((ficgp=fopen(optionfilegnuplot,"a"))==NULL) { */ | /* if((ficgp=fopen(optionfilegnuplot,"a"))==NULL) { */ |
| /* printf("Problem with file %s",optionfilegnuplot); */ | /* printf("Problem with file %s",optionfilegnuplot); */ |
| /* fprintf(ficlog,"Problem with file %s",optionfilegnuplot); */ | /* fprintf(ficlog,"Problem with file %s",optionfilegnuplot); */ |
| Line 5511 true period expectancies (those weighted | Line 6042 true period expectancies (those weighted |
| /*#ifdef windows */ | /*#ifdef windows */ |
| fprintf(ficgp,"cd \"%s\" \n",pathc); | fprintf(ficgp,"cd \"%s\" \n",pathc); |
| /*#endif */ | /*#endif */ |
| m=pow(2,cptcoveff); | m=pow(2,cptcoveff); |
| /* Contribution to likelihood */ | /* Contribution to likelihood */ |
| /* Plot the probability implied in the likelihood */ | /* Plot the probability implied in the likelihood */ |
| fprintf(ficgp,"\n# Contributions to the Likelihood, mle >=1. For mle=4 no interpolation, pure matrix products.\n#\n"); | fprintf(ficgp,"\n# Contributions to the Likelihood, mle >=1. For mle=4 no interpolation, pure matrix products.\n#\n"); |
| fprintf(ficgp,"\n set log y; unset log x;set xlabel \"Age\"; set ylabel \"Likelihood (-2Log(L))\";"); | fprintf(ficgp,"\n set log y; unset log x;set xlabel \"Age\"; set ylabel \"Likelihood (-2Log(L))\";"); |
| /* fprintf(ficgp,"\nset ter svg size 640, 480"); */ /* Too big for svg */ | /* fprintf(ficgp,"\nset ter svg size 640, 480"); */ /* Too big for svg */ |
| fprintf(ficgp,"\nset ter pngcairo size 640, 480"); | fprintf(ficgp,"\nset ter pngcairo size 640, 480"); |
| /* nice for mle=4 plot by number of matrix products. | /* nice for mle=4 plot by number of matrix products. |
| replot "rrtest1/toto.txt" u 2:($4 == 1 && $5==2 ? $9 : 1/0):5 t "p12" with point lc 1 */ | replot "rrtest1/toto.txt" u 2:($4 == 1 && $5==2 ? $9 : 1/0):5 t "p12" with point lc 1 */ |
| /* replot exp(p1+p2*x)/(1+exp(p1+p2*x)+exp(p3+p4*x)+exp(p5+p6*x)) t "p12(x)" */ | /* replot exp(p1+p2*x)/(1+exp(p1+p2*x)+exp(p3+p4*x)+exp(p5+p6*x)) t "p12(x)" */ |
| /* fprintf(ficgp,"\nset out \"%s.svg\";",subdirf2(optionfilefiname,"ILK_")); */ | /* fprintf(ficgp,"\nset out \"%s.svg\";",subdirf2(optionfilefiname,"ILK_")); */ |
| fprintf(ficgp,"\nset out \"%s-dest.png\";",subdirf2(optionfilefiname,"ILK_")); | fprintf(ficgp,"\nset out \"%s-dest.png\";",subdirf2(optionfilefiname,"ILK_")); |
| fprintf(ficgp,"\nset log y;plot \"%s\" u 2:(-$13):6 t \"All sample, transitions colored by destination\" with dots lc variable; set out;\n",subdirf(fileresilk)); | fprintf(ficgp,"\nset log y;plot \"%s\" u 2:(-$13):6 t \"All sample, transitions colored by destination\" with dots lc variable; set out;\n",subdirf(fileresilk)); |
| fprintf(ficgp,"\nset out \"%s-ori.png\";",subdirf2(optionfilefiname,"ILK_")); | fprintf(ficgp,"\nset out \"%s-ori.png\";",subdirf2(optionfilefiname,"ILK_")); |
| fprintf(ficgp,"\nset log y;plot \"%s\" u 2:(-$13):5 t \"All sample, transitions colored by origin\" with dots lc variable; set out;\n\n",subdirf(fileresilk)); | fprintf(ficgp,"\nset log y;plot \"%s\" u 2:(-$13):5 t \"All sample, transitions colored by origin\" with dots lc variable; set out;\n\n",subdirf(fileresilk)); |
| for (i=1; i<= nlstate ; i ++) { | for (i=1; i<= nlstate ; i ++) { |
| fprintf(ficgp,"\nset out \"%s-p%dj.png\";set ylabel \"Probability for each individual/wave\";",subdirf2(optionfilefiname,"ILK_"),i); | fprintf(ficgp,"\nset out \"%s-p%dj.png\";set ylabel \"Probability for each individual/wave\";",subdirf2(optionfilefiname,"ILK_"),i); |
| fprintf(ficgp,"unset log;\n# plot weighted, mean weight should have point size of 0.5\n plot \"%s\"",subdirf(fileresilk)); | fprintf(ficgp,"unset log;\n# plot weighted, mean weight should have point size of 0.5\n plot \"%s\"",subdirf(fileresilk)); |
| fprintf(ficgp," u 2:($5 == %d && $6==%d ? $10 : 1/0):($12/4.):6 t \"p%d%d\" with points pointtype 7 ps variable lc variable \\\n",i,1,i,1); | fprintf(ficgp," u 2:($5 == %d && $6==%d ? $10 : 1/0):($12/4.):6 t \"p%d%d\" with points pointtype 7 ps variable lc variable \\\n",i,1,i,1); |
| for (j=2; j<= nlstate+ndeath ; j ++) { | for (j=2; j<= nlstate+ndeath ; j ++) { |
| fprintf(ficgp,",\\\n \"\" u 2:($5 == %d && $6==%d ? $10 : 1/0):($12/4.):6 t \"p%d%d\" with points pointtype 7 ps variable lc variable ",i,j,i,j); | fprintf(ficgp,",\\\n \"\" u 2:($5 == %d && $6==%d ? $10 : 1/0):($12/4.):6 t \"p%d%d\" with points pointtype 7 ps variable lc variable ",i,j,i,j); |
| } | } |
| fprintf(ficgp,";\nset out; unset ylabel;\n"); | fprintf(ficgp,";\nset out; unset ylabel;\n"); |
| } | } |
| /* unset log; plot "rrtest1_sorted_4/ILK_rrtest1_sorted_4.txt" u 2:($4 == 1 && $5==2 ? $9 : 1/0):5 t "p12" with points lc variable */ | /* unset log; plot "rrtest1_sorted_4/ILK_rrtest1_sorted_4.txt" u 2:($4 == 1 && $5==2 ? $9 : 1/0):5 t "p12" with points lc variable */ |
| /* fprintf(ficgp,"\nset log y;plot \"%s\" u 2:(-$11):3 t \"All sample, all transitions\" with dots lc variable",subdirf(fileresilk)); */ | /* fprintf(ficgp,"\nset log y;plot \"%s\" u 2:(-$11):3 t \"All sample, all transitions\" with dots lc variable",subdirf(fileresilk)); */ |
| /* fprintf(ficgp,"\nreplot \"%s\" u 2:($3 <= 3 ? -$11 : 1/0):3 t \"First 3 individuals\" with line lc variable", subdirf(fileresilk)); */ | /* fprintf(ficgp,"\nreplot \"%s\" u 2:($3 <= 3 ? -$11 : 1/0):3 t \"First 3 individuals\" with line lc variable", subdirf(fileresilk)); */ |
| fprintf(ficgp,"\nset out;unset log\n"); | fprintf(ficgp,"\nset out;unset log\n"); |
| /* fprintf(ficgp,"\nset out \"%s.svg\"; replot; set out; # bug gnuplot",subdirf2(optionfilefiname,"ILK_")); */ | /* fprintf(ficgp,"\nset out \"%s.svg\"; replot; set out; # bug gnuplot",subdirf2(optionfilefiname,"ILK_")); */ |
| strcpy(dirfileres,optionfilefiname); | strcpy(dirfileres,optionfilefiname); |
| strcpy(optfileres,"vpl"); | strcpy(optfileres,"vpl"); |
| /* 1eme*/ | /* 1eme*/ |
| for (cpt=1; cpt<= nlstate ; cpt ++) { /* For each live state */ | for (cpt=1; cpt<= nlstate ; cpt ++) { /* For each live state */ |
| for (k1=1; k1<= m ; k1 ++) { /* For each combination of covariate */ | for (k1=1; k1<= m ; k1 ++) { /* For each valid combination of covariate */ |
| /* plot [100000000000000000000:-100000000000000000000] "mysbiaspar/vplrmysbiaspar.txt to check */ | /* plot [100000000000000000000:-100000000000000000000] "mysbiaspar/vplrmysbiaspar.txt to check */ |
| fprintf(ficgp,"\n# 1st: Period (stable) prevalence with CI: 'VPL_' files "); | fprintf(ficgp,"\n# 1st: Period (stable) prevalence with CI: 'VPL_' files "); |
| for (k=1; k<=cptcoveff; k++){ /* For each covariate and each value */ | for (k=1; k<=cptcoveff; k++){ /* For each covariate k get corresponding value lv for combination k1 */ |
| lv= decodtabm(k1,k,cptcoveff); /* Should be the covariate number corresponding to k1 combination */ | lv= decodtabm(k1,k,cptcoveff); /* Should be the value of the covariate corresponding to k1 combination */ |
| /* decodtabm(1,1,4) = 1 because h=1 k= (1) 1 1 1 */ | /* decodtabm(1,1,4) = 1 because h=1 k= (1) 1 1 1 */ |
| /* decodtabm(1,2,4) = 1 because h=1 k= 1 (1) 1 1 */ | /* decodtabm(1,2,4) = 1 because h=1 k= 1 (1) 1 1 */ |
| /* decodtabm(13,3,4)= 2 because h=13 k= 1 1 (2) 2 */ | /* decodtabm(13,3,4)= 2 because h=13 k= 1 1 (2) 2 */ |
| vlv= nbcode[Tvaraff[lv]][lv]; | vlv= nbcode[Tvaraff[k]][lv]; /* vlv is the value of the covariate lv, 0 or 1 */ |
| fprintf(ficgp," V%d=%d ",k,vlv); | /* For each combination of covariate k1 (V1=1, V3=0), we printed the current covariate k and its value vlv */ |
| fprintf(ficgp," V%d=%d ",Tvaraff[k],vlv); | |
| } | } |
| fprintf(ficgp,"\n#\n"); | fprintf(ficgp,"\n#\n"); |
| if(invalidvarcomb[k1]){ | |
| fprintf(ficgp,"#Combination (%d) ignored because no cases \n",k1); | |
| continue; | |
| } | |
| fprintf(ficgp,"\nset out \"%s_%d-%d.svg\" \n",subdirf2(optionfilefiname,"V_"),cpt,k1); | fprintf(ficgp,"\nset out \"%s_%d-%d.svg\" \n",subdirf2(optionfilefiname,"V_"),cpt,k1); |
| fprintf(ficgp,"\n#set out \"V_%s_%d-%d.svg\" \n",optionfilefiname,cpt,k1); | fprintf(ficgp,"\n#set out \"V_%s_%d-%d.svg\" \n",optionfilefiname,cpt,k1); |
| fprintf(ficgp,"set xlabel \"Age\" \n\ | fprintf(ficgp,"set xlabel \"Age\" \n\ |
| set ylabel \"Probability\" \n\ | set ylabel \"Probability\" \n \ |
| set ter svg size 640, 480\n\ | set ter svg size 640, 480\n \ |
| plot [%.f:%.f] \"%s\" every :::%d::%d u 1:2 \"%%lf",ageminpar,fage,subdirf2(fileresu,"VPL_"),k1-1,k1-1); | plot [%.f:%.f] \"%s\" every :::%d::%d u 1:2 \"%%lf",ageminpar,fage,subdirf2(fileresu,"VPL_"),k1-1,k1-1); |
| for (i=1; i<= nlstate ; i ++) { | for (i=1; i<= nlstate ; i ++) { |
| if (i==cpt) fprintf(ficgp," %%lf (%%lf)"); | if (i==cpt) fprintf(ficgp," %%lf (%%lf)"); |
| else fprintf(ficgp," %%*lf (%%*lf)"); | else fprintf(ficgp," %%*lf (%%*lf)"); |
| } | } |
| fprintf(ficgp,"\" t\"Period (stable) prevalence\" w l lt 0,\"%s\" every :::%d::%d u 1:($2+1.96*$3) \"%%lf",subdirf2(fileresu,"VPL_"),k1-1,k1-1); | fprintf(ficgp,"\" t\"Period (stable) prevalence\" w l lt 0,\"%s\" every :::%d::%d u 1:($2+1.96*$3) \"%%lf",subdirf2(fileresu,"VPL_"),k1-1,k1-1); |
| for (i=1; i<= nlstate ; i ++) { | for (i=1; i<= nlstate ; i ++) { |
| if (i==cpt) fprintf(ficgp," %%lf (%%lf)"); | if (i==cpt) fprintf(ficgp," %%lf (%%lf)"); |
| else fprintf(ficgp," %%*lf (%%*lf)"); | else fprintf(ficgp," %%*lf (%%*lf)"); |
| } | } |
| fprintf(ficgp,"\" t\"95%% CI\" w l lt 1,\"%s\" every :::%d::%d u 1:($2-1.96*$3) \"%%lf",subdirf2(fileresu,"VPL_"),k1-1,k1-1); | fprintf(ficgp,"\" t\"95%% CI\" w l lt 1,\"%s\" every :::%d::%d u 1:($2-1.96*$3) \"%%lf",subdirf2(fileresu,"VPL_"),k1-1,k1-1); |
| for (i=1; i<= nlstate ; i ++) { | for (i=1; i<= nlstate ; i ++) { |
| if (i==cpt) fprintf(ficgp," %%lf (%%lf)"); | if (i==cpt) fprintf(ficgp," %%lf (%%lf)"); |
| else fprintf(ficgp," %%*lf (%%*lf)"); | else fprintf(ficgp," %%*lf (%%*lf)"); |
| } | } |
| fprintf(ficgp,"\" t\"\" w l lt 1,\"%s\" every :::%d::%d u 1:($%d) t\"Observed prevalence \" w l lt 2",subdirf2(fileresu,"P_"),k1-1,k1-1,2+4*(cpt-1)); | fprintf(ficgp,"\" t\"\" w l lt 1,\"%s\" every :::%d::%d u 1:($%d) t\"Observed prevalence\" w l lt 2",subdirf2(fileresu,"P_"),k1-1,k1-1,2+4*(cpt-1)); |
| fprintf(ficgp,"\nset out \n"); | if(backcast==1){ /* We need to get the corresponding values of the covariates involved in this combination k1 */ |
| /* fprintf(ficgp,",\"%s\" every :::%d::%d u 1:($%d) t\"Backward stable prevalence\" w l lt 3",subdirf2(fileresu,"PLB_"),k1-1,k1-1,1+cpt); */ | |
| fprintf(ficgp,",\"%s\" u 1:((",subdirf2(fileresu,"PLB_")); /* Age is in 1 */ | |
| if(cptcoveff ==0){ | |
| fprintf(ficgp,"$%d)) t 'Backward prevalence in state %d' with line ", 2+(cpt-1), cpt ); | |
| }else{ | |
| kl=0; | |
| for (k=1; k<=cptcoveff; k++){ /* For each combination of covariate */ | |
| lv= decodtabm(k1,k,cptcoveff); /* Should be the covariate value corresponding to k1 combination and kth covariate */ | |
| /* decodtabm(1,1,4) = 1 because h=1 k= (1) 1 1 1 */ | |
| /* decodtabm(1,2,4) = 1 because h=1 k= 1 (1) 1 1 */ | |
| /* decodtabm(13,3,4)= 2 because h=13 k= 1 1 (2) 2 */ | |
| vlv= nbcode[Tvaraff[k]][lv]; | |
| kl++; | |
| /* kl=6+(cpt-1)*(nlstate+1)+1+(i-1); /\* 6+(1-1)*(2+1)+1+(1-1)=7, 6+(2-1)(2+1)+1+(1-1)=10 *\/ */ | |
| /*6+(cpt-1)*(nlstate+1)+1+(i-1)+(nlstate+1)*nlstate; 6+(1-1)*(2+1)+1+(1-1) +(2+1)*2=13 */ | |
| /*6+1+(i-1)+(nlstate+1)*nlstate; 6+1+(1-1) +(2+1)*2=13 */ | |
| /* '' u 6:(($1==1 && $2==0 && $3==2 && $4==0)? $9/(1.-$15) : 1/0):($5==2000? 3:2) t 'p.1' with line lc variable*/ | |
| if(k==cptcoveff){ | |
| fprintf(ficgp,"$%d==%d && $%d==%d)? $%d : 1/0) t 'Backward prevalence in state %d' ",kl+1, Tvaraff[k],kl+1+1,nbcode[Tvaraff[k]][lv], \ | |
| 4+(cpt-1), cpt ); /* 4 or 6 ?*/ | |
| }else{ | |
| fprintf(ficgp,"$%d==%d && $%d==%d && ",kl+1, Tvaraff[k],kl+1+1,nbcode[Tvaraff[k]][lv]); | |
| kl++; | |
| } | |
| } /* end covariate */ | |
| } /* end if no covariate */ | |
| } /* end if backcast */ | |
| fprintf(ficgp,"\nset out \n"); | |
| } /* k1 */ | } /* k1 */ |
| } /* cpt */ | } /* cpt */ |
| /*2 eme*/ | /*2 eme*/ |
| for (k1=1; k1<= m ; k1 ++) { | for (k1=1; k1<= m ; k1 ++) { |
| fprintf(ficgp,"\n# 2nd: Total life expectancy with CI: 't' files "); | |
| for (k=1; k<=cptcoveff; k++){ /* For each covariate and each value */ | |
| lv= decodtabm(k1,k,cptcoveff); /* Should be the covariate number corresponding to k1 combination */ | |
| /* decodtabm(1,1,4) = 1 because h=1 k= (1) 1 1 1 */ | |
| /* decodtabm(1,2,4) = 1 because h=1 k= 1 (1) 1 1 */ | |
| /* decodtabm(13,3,4)= 2 because h=13 k= 1 1 (2) 2 */ | |
| vlv= nbcode[Tvaraff[lv]][lv]; | |
| fprintf(ficgp," V%d=%d ",k,vlv); | |
| } | |
| fprintf(ficgp,"\n#\n"); | |
| fprintf(ficgp,"\n# 2nd: Total life expectancy with CI: 't' files "); | |
| for (k=1; k<=cptcoveff; k++){ /* For each covariate and each value */ | |
| lv= decodtabm(k1,k,cptcoveff); /* Should be the covariate number corresponding to k1 combination */ | |
| /* decodtabm(1,1,4) = 1 because h=1 k= (1) 1 1 1 */ | |
| /* decodtabm(1,2,4) = 1 because h=1 k= 1 (1) 1 1 */ | |
| /* decodtabm(13,3,4)= 2 because h=13 k= 1 1 (2) 2 */ | |
| vlv= nbcode[Tvaraff[k]][lv]; | |
| fprintf(ficgp," V%d=%d ",Tvaraff[k],vlv); | |
| } | |
| fprintf(ficgp,"\n#\n"); | |
| if(invalidvarcomb[k1]){ | |
| fprintf(ficgp,"#Combination (%d) ignored because no cases \n",k1); | |
| continue; | |
| } | |
| fprintf(ficgp,"\nset out \"%s_%d.svg\" \n",subdirf2(optionfilefiname,"E_"),k1); | fprintf(ficgp,"\nset out \"%s_%d.svg\" \n",subdirf2(optionfilefiname,"E_"),k1); |
| for(vpopbased=0; vpopbased <= popbased; vpopbased++){ /* Done for vpopbased=0 and vpopbased=1 if popbased==1*/ | for(vpopbased=0; vpopbased <= popbased; vpopbased++){ /* Done for vpopbased=0 and vpopbased=1 if popbased==1*/ |
| if(vpopbased==0) | if(vpopbased==0) |
| Line 5630 plot [%.f:%.f] \"%s\" every :::%d::%d u | Line 6199 plot [%.f:%.f] \"%s\" every :::%d::%d u |
| } /* vpopbased */ | } /* vpopbased */ |
| fprintf(ficgp,"\nset out;set out \"%s_%d.svg\"; replot; set out; \n",subdirf2(optionfilefiname,"E_"),k1); /* Buggy gnuplot */ | fprintf(ficgp,"\nset out;set out \"%s_%d.svg\"; replot; set out; \n",subdirf2(optionfilefiname,"E_"),k1); /* Buggy gnuplot */ |
| } /* k1 */ | } /* k1 */ |
| /*3eme*/ | /*3eme*/ |
| for (k1=1; k1<= m ; k1 ++) { | for (k1=1; k1<= m ; k1 ++) { |
| for (cpt=1; cpt<= nlstate ; cpt ++) { | for (cpt=1; cpt<= nlstate ; cpt ++) { |
| fprintf(ficgp,"\n# 3d: Life expectancy with EXP_ files: cov=%d state=%d",k1, cpt); | fprintf(ficgp,"\n# 3d: Life expectancy with EXP_ files: cov=%d state=%d",k1, cpt); |
| for (k=1; k<=cptcoveff; k++){ /* For each covariate and each value */ | for (k=1; k<=cptcoveff; k++){ /* For each covariate and each value */ |
| Line 5641 plot [%.f:%.f] \"%s\" every :::%d::%d u | Line 6211 plot [%.f:%.f] \"%s\" every :::%d::%d u |
| /* decodtabm(1,1,4) = 1 because h=1 k= (1) 1 1 1 */ | /* decodtabm(1,1,4) = 1 because h=1 k= (1) 1 1 1 */ |
| /* decodtabm(1,2,4) = 1 because h=1 k= 1 (1) 1 1 */ | /* decodtabm(1,2,4) = 1 because h=1 k= 1 (1) 1 1 */ |
| /* decodtabm(13,3,4)= 2 because h=13 k= 1 1 (2) 2 */ | /* decodtabm(13,3,4)= 2 because h=13 k= 1 1 (2) 2 */ |
| vlv= nbcode[Tvaraff[lv]][lv]; | vlv= nbcode[Tvaraff[k]][lv]; |
| fprintf(ficgp," V%d=%d ",k,vlv); | fprintf(ficgp," V%d=%d ",Tvaraff[k],vlv); |
| } | } |
| fprintf(ficgp,"\n#\n"); | fprintf(ficgp,"\n#\n"); |
| if(invalidvarcomb[k1]){ | |
| fprintf(ficgp,"#Combination (%d) ignored because no cases \n",k1); | |
| continue; | |
| } | |
| /* k=2+nlstate*(2*cpt-2); */ | /* k=2+nlstate*(2*cpt-2); */ |
| k=2+(nlstate+1)*(cpt-1); | k=2+(nlstate+1)*(cpt-1); |
| fprintf(ficgp,"\nset out \"%s_%d%d.svg\" \n",subdirf2(optionfilefiname,"EXP_"),cpt,k1); | fprintf(ficgp,"\nset out \"%s_%d%d.svg\" \n",subdirf2(optionfilefiname,"EXP_"),cpt,k1); |
| Line 5657 plot [%.f:%.f] \"%s\" every :::%d::%d u | Line 6231 plot [%.f:%.f] \"%s\" every :::%d::%d u |
| fprintf(ficgp,",\"e%s\" every :::%d::%d u 1:($%d+2*$%d) \"\%%lf ",fileres,k1-1,k1-1,k,k+1); | fprintf(ficgp,",\"e%s\" every :::%d::%d u 1:($%d+2*$%d) \"\%%lf ",fileres,k1-1,k1-1,k,k+1); |
| for (i=1; i<= nlstate*2 ; i ++) fprintf(ficgp,"\%%lf (\%%lf) "); | for (i=1; i<= nlstate*2 ; i ++) fprintf(ficgp,"\%%lf (\%%lf) "); |
| fprintf(ficgp,"\" t \"e%d1\" w l",cpt); | fprintf(ficgp,"\" t \"e%d1\" w l",cpt); |
| */ | */ |
| for (i=1; i< nlstate ; i ++) { | for (i=1; i< nlstate ; i ++) { |
| fprintf(ficgp," ,\"%s\" every :::%d::%d u 1:%d t \"e%d%d\" w l",subdirf2(fileresu,"E_"),k1-1,k1-1,k+i,cpt,i+1); | fprintf(ficgp," ,\"%s\" every :::%d::%d u 1:%d t \"e%d%d\" w l",subdirf2(fileresu,"E_"),k1-1,k1-1,k+i,cpt,i+1); |
| /* fprintf(ficgp," ,\"%s\" every :::%d::%d u 1:%d t \"e%d%d\" w l",subdirf2(fileres,"e"),k1-1,k1-1,k+2*i,cpt,i+1);*/ | /* fprintf(ficgp," ,\"%s\" every :::%d::%d u 1:%d t \"e%d%d\" w l",subdirf2(fileres,"e"),k1-1,k1-1,k+2*i,cpt,i+1);*/ |
| } | } |
| fprintf(ficgp," ,\"%s\" every :::%d::%d u 1:%d t \"e%d.\" w l",subdirf2(fileresu,"E_"),k1-1,k1-1,k+nlstate,cpt); | fprintf(ficgp," ,\"%s\" every :::%d::%d u 1:%d t \"e%d.\" w l",subdirf2(fileresu,"E_"),k1-1,k1-1,k+nlstate,cpt); |
| } | } |
| } | } |
| /* 4eme */ | |
| /* Survival functions (period) from state i in state j by initial state i */ | /* Survival functions (period) from state i in state j by initial state i */ |
| for (k1=1; k1<= m ; k1 ++) { /* For each multivariate if any */ | for (k1=1; k1<= m ; k1 ++) { /* For each multivariate if any */ |
| for (cpt=1; cpt<=nlstate ; cpt ++) { /* For each life state */ | for (cpt=1; cpt<=nlstate ; cpt ++) { /* For each life state */ |
| fprintf(ficgp,"\n#\n#\n# Survival functions in state j : 'LIJ_' files, cov=%d state=%d",k1, cpt); | fprintf(ficgp,"\n#\n#\n# Survival functions in state j : 'LIJ_' files, cov=%d state=%d",k1, cpt); |
| for (k=1; k<=cptcoveff; k++){ /* For each covariate and each value */ | for (k=1; k<=cptcoveff; k++){ /* For each covariate and each value */ |
| Line 5677 plot [%.f:%.f] \"%s\" every :::%d::%d u | Line 6253 plot [%.f:%.f] \"%s\" every :::%d::%d u |
| /* decodtabm(1,1,4) = 1 because h=1 k= (1) 1 1 1 */ | /* decodtabm(1,1,4) = 1 because h=1 k= (1) 1 1 1 */ |
| /* decodtabm(1,2,4) = 1 because h=1 k= 1 (1) 1 1 */ | /* decodtabm(1,2,4) = 1 because h=1 k= 1 (1) 1 1 */ |
| /* decodtabm(13,3,4)= 2 because h=13 k= 1 1 (2) 2 */ | /* decodtabm(13,3,4)= 2 because h=13 k= 1 1 (2) 2 */ |
| vlv= nbcode[Tvaraff[lv]][lv]; | vlv= nbcode[Tvaraff[k]][lv]; |
| fprintf(ficgp," V%d=%d ",k,vlv); | fprintf(ficgp," V%d=%d ",Tvaraff[k],vlv); |
| } | } |
| fprintf(ficgp,"\n#\n"); | fprintf(ficgp,"\n#\n"); |
| if(invalidvarcomb[k1]){ | |
| fprintf(ficgp,"#Combination (%d) ignored because no cases \n",k1); | |
| continue; | |
| } | |
| fprintf(ficgp,"\nset out \"%s_%d-%d.svg\" \n",subdirf2(optionfilefiname,"LIJ_"),cpt,k1); | fprintf(ficgp,"\nset out \"%s_%d-%d.svg\" \n",subdirf2(optionfilefiname,"LIJ_"),cpt,k1); |
| fprintf(ficgp,"set xlabel \"Age\" \nset ylabel \"Probability to be alive\" \n\ | fprintf(ficgp,"set xlabel \"Age\" \nset ylabel \"Probability to be alive\" \n\ |
| set ter svg size 640, 480\n\ | set ter svg size 640, 480\n \ |
| unset log y\n\ | unset log y\n \ |
| plot [%.f:%.f] ", ageminpar, agemaxpar); | plot [%.f:%.f] ", ageminpar, agemaxpar); |
| k=3; | k=3; |
| for (i=1; i<= nlstate ; i ++){ | for (i=1; i<= nlstate ; i ++){ |
| Line 5703 plot [%.f:%.f] ", ageminpar, agemaxpar) | Line 6283 plot [%.f:%.f] ", ageminpar, agemaxpar) |
| fprintf(ficgp,"\nset out\n"); | fprintf(ficgp,"\nset out\n"); |
| } /* end cpt state*/ | } /* end cpt state*/ |
| } /* end covariate */ | } /* end covariate */ |
| /* 5eme */ | |
| /* Survival functions (period) from state i in state j by final state j */ | /* Survival functions (period) from state i in state j by final state j */ |
| for (k1=1; k1<= m ; k1 ++) { /* For each covariate if any */ | for (k1=1; k1<= m ; k1 ++) { /* For each covariate if any */ |
| for (cpt=1; cpt<=nlstate ; cpt ++) { /* For each inital state */ | for (cpt=1; cpt<=nlstate ; cpt ++) { /* For each inital state */ |
| fprintf(ficgp,"\n#\n#\n# Survival functions in state j and all livestates from state i by final state j: 'lij' files, cov=%d state=%d",k1, cpt); | fprintf(ficgp,"\n#\n#\n# Survival functions in state j and all livestates from state i by final state j: 'lij' files, cov=%d state=%d",k1, cpt); |
| for (k=1; k<=cptcoveff; k++){ /* For each covariate and each value */ | for (k=1; k<=cptcoveff; k++){ /* For each covariate and each value */ |
| lv= decodtabm(k1,k,cptcoveff); /* Should be the covariate number corresponding to k1 combination */ | lv= decodtabm(k1,k,cptcoveff); /* Should be the covariate number corresponding to k1 combination */ |
| /* decodtabm(1,1,4) = 1 because h=1 k= (1) 1 1 1 */ | /* decodtabm(1,1,4) = 1 because h=1 k= (1) 1 1 1 */ |
| /* decodtabm(1,2,4) = 1 because h=1 k= 1 (1) 1 1 */ | /* decodtabm(1,2,4) = 1 because h=1 k= 1 (1) 1 1 */ |
| /* decodtabm(13,3,4)= 2 because h=13 k= 1 1 (2) 2 */ | /* decodtabm(13,3,4)= 2 because h=13 k= 1 1 (2) 2 */ |
| vlv= nbcode[Tvaraff[lv]][lv]; | vlv= nbcode[Tvaraff[k]][lv]; |
| fprintf(ficgp," V%d=%d ",k,vlv); | fprintf(ficgp," V%d=%d ",Tvaraff[k],vlv); |
| } | } |
| fprintf(ficgp,"\n#\n"); | fprintf(ficgp,"\n#\n"); |
| if(invalidvarcomb[k1]){ | |
| fprintf(ficgp,"#Combination (%d) ignored because no cases \n",k1); | |
| continue; | |
| } | |
| fprintf(ficgp,"\nset out \"%s_%d-%d.svg\" \n",subdirf2(optionfilefiname,"LIJT_"),cpt,k1); | fprintf(ficgp,"\nset out \"%s_%d-%d.svg\" \n",subdirf2(optionfilefiname,"LIJT_"),cpt,k1); |
| fprintf(ficgp,"set xlabel \"Age\" \nset ylabel \"Probability to be alive\" \n\ | fprintf(ficgp,"set xlabel \"Age\" \nset ylabel \"Probability to be alive\" \n\ |
| set ter svg size 640, 480\n\ | set ter svg size 640, 480\n \ |
| unset log y\n\ | unset log y\n \ |
| plot [%.f:%.f] ", ageminpar, agemaxpar); | plot [%.f:%.f] ", ageminpar, agemaxpar); |
| k=3; | k=3; |
| for (j=1; j<= nlstate ; j ++){ /* Lived in state j */ | for (j=1; j<= nlstate ; j ++){ /* Lived in state j */ |
| Line 5747 plot [%.f:%.f] ", ageminpar, agemaxpar) | Line 6333 plot [%.f:%.f] ", ageminpar, agemaxpar) |
| fprintf(ficgp,"\nset out\n"); | fprintf(ficgp,"\nset out\n"); |
| } /* end cpt state*/ | } /* end cpt state*/ |
| } /* end covariate */ | } /* end covariate */ |
| /* 6eme */ | |
| /* CV preval stable (period) for each covariate */ | /* CV preval stable (period) for each covariate */ |
| for (k1=1; k1<= m ; k1 ++) { /* For each covariate combination (1 to m=2**k), if any covariate is present */ | for (k1=1; k1<= m ; k1 ++) { /* For each covariate combination (1 to m=2**k), if any covariate is present */ |
| for (cpt=1; cpt<=nlstate ; cpt ++) { /* For each life state */ | for (cpt=1; cpt<=nlstate ; cpt ++) { /* For each life state */ |
| fprintf(ficgp,"\n#\n#\n#CV preval stable (period): 'pij' files, covariatecombination#=%d state=%d",k1, cpt); | fprintf(ficgp,"\n#\n#\n#CV preval stable (period): 'pij' files, covariatecombination#=%d state=%d",k1, cpt); |
| for (k=1; k<=cptcoveff; k++){ /* For each covariate and each value */ | for (k=1; k<=cptcoveff; k++){ /* For each covariate and each value */ |
| lv= decodtabm(k1,k,cptcoveff); /* Should be the covariate number corresponding to k1 combination */ | lv= decodtabm(k1,k,cptcoveff); /* Should be the covariate number corresponding to k1 combination */ |
| /* decodtabm(1,1,4) = 1 because h=1 k= (1) 1 1 1 */ | /* decodtabm(1,1,4) = 1 because h=1 k= (1) 1 1 1 */ |
| /* decodtabm(1,2,4) = 1 because h=1 k= 1 (1) 1 1 */ | /* decodtabm(1,2,4) = 1 because h=1 k= 1 (1) 1 1 */ |
| /* decodtabm(13,3,4)= 2 because h=13 k= 1 1 (2) 2 */ | /* decodtabm(13,3,4)= 2 because h=13 k= 1 1 (2) 2 */ |
| vlv= nbcode[Tvaraff[lv]][lv]; | vlv= nbcode[Tvaraff[k]][lv]; |
| fprintf(ficgp," V%d=%d ",k,vlv); | fprintf(ficgp," V%d=%d ",Tvaraff[k],vlv); |
| } | } |
| fprintf(ficgp,"\n#\n"); | fprintf(ficgp,"\n#\n"); |
| if(invalidvarcomb[k1]){ | |
| fprintf(ficgp,"#Combination (%d) ignored because no cases \n",k1); | |
| continue; | |
| } | |
| fprintf(ficgp,"\nset out \"%s_%d-%d.svg\" \n",subdirf2(optionfilefiname,"P_"),cpt,k1); | fprintf(ficgp,"\nset out \"%s_%d-%d.svg\" \n",subdirf2(optionfilefiname,"P_"),cpt,k1); |
| fprintf(ficgp,"set xlabel \"Age\" \nset ylabel \"Probability\" \n\ | fprintf(ficgp,"set xlabel \"Age\" \nset ylabel \"Probability\" \n\ |
| set ter svg size 640, 480\n\ | set ter svg size 640, 480\n \ |
| unset log y\n\ | unset log y\n \ |
| plot [%.f:%.f] ", ageminpar, agemaxpar); | plot [%.f:%.f] ", ageminpar, agemaxpar); |
| k=3; /* Offset */ | k=3; /* Offset */ |
| for (i=1; i<= nlstate ; i ++){ | for (i=1; i<= nlstate ; i ++){ |
| Line 5782 plot [%.f:%.f] ", ageminpar, agemaxpar) | Line 6374 plot [%.f:%.f] ", ageminpar, agemaxpar) |
| fprintf(ficgp,"\nset out\n"); | fprintf(ficgp,"\nset out\n"); |
| } /* end cpt state*/ | } /* end cpt state*/ |
| } /* end covariate */ | } /* end covariate */ |
| /* 7eme */ | |
| if(backcast == 1){ | |
| /* CV back preval stable (period) for each covariate */ | /* CV back preval stable (period) for each covariate */ |
| for (k1=1; k1<= m ; k1 ++) { /* For each covariate combination (1 to m=2**k), if any covariate is present */ | for (k1=1; k1<= m ; k1 ++) { /* For each covariate combination (1 to m=2**k), if any covariate is present */ |
| for (cpt=1; cpt<=nlstate ; cpt ++) { /* For each life state */ | for (cpt=1; cpt<=nlstate ; cpt ++) { /* For each life state */ |
| fprintf(ficgp,"\n#\n#\n#CV Back preval stable (period): 'pij' files, covariatecombination#=%d state=%d",k1, cpt); | fprintf(ficgp,"\n#\n#\n#CV Back preval stable (period): 'pij' files, covariatecombination#=%d state=%d",k1, cpt); |
| for (k=1; k<=cptcoveff; k++){ /* For each covariate and each value */ | for (k=1; k<=cptcoveff; k++){ /* For each covariate and each value */ |
| lv= decodtabm(k1,k,cptcoveff); /* Should be the covariate number corresponding to k1 combination */ | lv= decodtabm(k1,k,cptcoveff); /* Should be the covariate number corresponding to k1 combination */ |
| /* decodtabm(1,1,4) = 1 because h=1 k= (1) 1 1 1 */ | /* decodtabm(1,1,4) = 1 because h=1 k= (1) 1 1 1 */ |
| /* decodtabm(1,2,4) = 1 because h=1 k= 1 (1) 1 1 */ | /* decodtabm(1,2,4) = 1 because h=1 k= 1 (1) 1 1 */ |
| /* decodtabm(13,3,4)= 2 because h=13 k= 1 1 (2) 2 */ | /* decodtabm(13,3,4)= 2 because h=13 k= 1 1 (2) 2 */ |
| vlv= nbcode[Tvaraff[lv]][lv]; | vlv= nbcode[Tvaraff[k]][lv]; |
| fprintf(ficgp," V%d=%d ",k,vlv); | fprintf(ficgp," V%d=%d ",Tvaraff[k],vlv); |
| } | } |
| fprintf(ficgp,"\n#\n"); | fprintf(ficgp,"\n#\n"); |
| if(invalidvarcomb[k1]){ | |
| fprintf(ficgp,"\nset out \"%s_%d-%d.svg\" \n",subdirf2(optionfilefiname,"PB_"),cpt,k1); | fprintf(ficgp,"#Combination (%d) ignored because no cases \n",k1); |
| fprintf(ficgp,"set xlabel \"Age\" \nset ylabel \"Probability\" \n\ | continue; |
| set ter svg size 640, 480\n\ | } |
| unset log y\n\ | |
| fprintf(ficgp,"\nset out \"%s_%d-%d.svg\" \n",subdirf2(optionfilefiname,"PB_"),cpt,k1); | |
| fprintf(ficgp,"set xlabel \"Age\" \nset ylabel \"Probability\" \n\ | |
| set ter svg size 640, 480\n \ | |
| unset log y\n \ | |
| plot [%.f:%.f] ", ageminpar, agemaxpar); | plot [%.f:%.f] ", ageminpar, agemaxpar); |
| k=3; /* Offset */ | k=3; /* Offset */ |
| for (i=1; i<= nlstate ; i ++){ | for (i=1; i<= nlstate ; i ++){ |
| if(i==1) | if(i==1) |
| fprintf(ficgp,"\"%s\"",subdirf2(fileresu,"PIJB_")); | fprintf(ficgp,"\"%s\"",subdirf2(fileresu,"PIJB_")); |
| else | else |
| fprintf(ficgp,", '' "); | fprintf(ficgp,", '' "); |
| l=(nlstate+ndeath)*(i-1)+1; | /* l=(nlstate+ndeath)*(i-1)+1; */ |
| fprintf(ficgp," u ($1==%d ? ($3):1/0):($%d/($%d",k1,k+l+(cpt-1),k+l); /* a vérifier */ | l=(nlstate+ndeath)*(cpt-1)+1; |
| for (j=2; j<= nlstate ; j ++) | /* fprintf(ficgp," u ($1==%d ? ($3):1/0):($%d/($%d",k1,k+l+(cpt-1),k+l); /\* a vérifier *\/ */ |
| fprintf(ficgp,"+$%d",k+l+j-1); | /* fprintf(ficgp," u ($1==%d ? ($3):1/0):($%d/($%d",k1,k+l+(cpt-1),k+l+(cpt-1)+i-1); /\* a vérifier *\/ */ |
| fprintf(ficgp,")) t \"prev(%d,%d)\" w l",i,cpt); | fprintf(ficgp," u ($1==%d ? ($3):1/0):($%d",k1,k+l+(cpt-1)+i-1); /* a vérifier */ |
| } /* nlstate */ | /* for (j=2; j<= nlstate ; j ++) */ |
| fprintf(ficgp,"\nset out\n"); | /* fprintf(ficgp,"+$%d",k+l+j-1); */ |
| } /* end cpt state*/ | /* /\* fprintf(ficgp,"+$%d",k+l+j-1); *\/ */ |
| } /* end covariate */ | fprintf(ficgp,") t \"bprev(%d,%d)\" w l",i,cpt); |
| } /* nlstate */ | |
| fprintf(ficgp,"\nset out\n"); | |
| } /* end cpt state*/ | |
| } /* end covariate */ | |
| } /* End if backcast */ | |
| /* 8eme */ | |
| if(prevfcast==1){ | if(prevfcast==1){ |
| /* Projection from cross-sectional to stable (period) for each covariate */ | /* Projection from cross-sectional to stable (period) for each covariate */ |
| for (k1=1; k1<= m ; k1 ++) { /* For each covariate combination (1 to m=2**k), if any covariate is present */ | for (k1=1; k1<= m ; k1 ++) { /* For each covariate combination (1 to m=2**k), if any covariate is present */ |
| for (cpt=1; cpt<=nlstate ; cpt ++) { /* For each life state */ | for (cpt=1; cpt<=nlstate ; cpt ++) { /* For each life state */ |
| fprintf(ficgp,"\n#\n#\n#Projection of prevalence to stable (period): 'PROJ_' files, covariatecombination#=%d state=%d",k1, cpt); | fprintf(ficgp,"\n#\n#\n#Projection of prevalence to stable (period): 'PROJ_' files, covariatecombination#=%d state=%d",k1, cpt); |
| Line 5829 plot [%.f:%.f] ", ageminpar, agemaxpar) | Line 6434 plot [%.f:%.f] ", ageminpar, agemaxpar) |
| /* decodtabm(1,1,4) = 1 because h=1 k= (1) 1 1 1 */ | /* decodtabm(1,1,4) = 1 because h=1 k= (1) 1 1 1 */ |
| /* decodtabm(1,2,4) = 1 because h=1 k= 1 (1) 1 1 */ | /* decodtabm(1,2,4) = 1 because h=1 k= 1 (1) 1 1 */ |
| /* decodtabm(13,3,4)= 2 because h=13 k= 1 1 (2) 2 */ | /* decodtabm(13,3,4)= 2 because h=13 k= 1 1 (2) 2 */ |
| vlv= nbcode[Tvaraff[lv]][lv]; | vlv= nbcode[Tvaraff[k]][lv]; |
| fprintf(ficgp," V%d=%d ",k,vlv); | fprintf(ficgp," V%d=%d ",Tvaraff[k],vlv); |
| } | } |
| fprintf(ficgp,"\n#\n"); | fprintf(ficgp,"\n#\n"); |
| if(invalidvarcomb[k1]){ | |
| fprintf(ficgp,"#Combination (%d) ignored because no cases \n",k1); | |
| continue; | |
| } | |
| fprintf(ficgp,"# hpijx=probability over h years, hp.jx is weighted by observed prev\n "); | fprintf(ficgp,"# hpijx=probability over h years, hp.jx is weighted by observed prev\n "); |
| fprintf(ficgp,"\nset out \"%s_%d-%d.svg\" \n",subdirf2(optionfilefiname,"PROJ_"),cpt,k1); | fprintf(ficgp,"\nset out \"%s_%d-%d.svg\" \n",subdirf2(optionfilefiname,"PROJ_"),cpt,k1); |
| fprintf(ficgp,"set xlabel \"Age\" \nset ylabel \"Prevalence\" \n\ | fprintf(ficgp,"set xlabel \"Age\" \nset ylabel \"Prevalence\" \n\ |
| set ter svg size 640, 480\n\ | set ter svg size 640, 480\n \ |
| unset log y\n\ | unset log y\n \ |
| plot [%.f:%.f] ", ageminpar, agemaxpar); | plot [%.f:%.f] ", ageminpar, agemaxpar); |
| for (i=1; i<= nlstate+1 ; i ++){ /* nlstate +1 p11 p21 p.1 */ | for (i=1; i<= nlstate+1 ; i ++){ /* nlstate +1 p11 p21 p.1 */ |
| /*# V1 = 1 V2 = 0 yearproj age p11 p21 p.1 p12 p22 p.2 p13 p23 p.3*/ | /*# V1 = 1 V2 = 0 yearproj age p11 p21 p.1 p12 p22 p.2 p13 p23 p.3*/ |
| Line 5851 plot [%.f:%.f] ", ageminpar, agemaxpar) | Line 6460 plot [%.f:%.f] ", ageminpar, agemaxpar) |
| fprintf(ficgp,",\\\n '' "); | fprintf(ficgp,",\\\n '' "); |
| } | } |
| if(cptcoveff ==0){ /* No covariate */ | if(cptcoveff ==0){ /* No covariate */ |
| fprintf(ficgp," u 2:("); /* Age is in 2 */ | ioffset=2; /* Age is in 2 */ |
| /*# yearproj age p11 p21 p31 p.1 p12 p22 p32 p.2 p13 p23 p33 p.3 p14 p24 p34 p.4*/ | /*# yearproj age p11 p21 p31 p.1 p12 p22 p32 p.2 p13 p23 p33 p.3 p14 p24 p34 p.4*/ |
| /*# 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 */ | /*# 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 */ |
| /*# V1 = 1 yearproj age p11 p21 p31 p.1 p12 p22 p32 p.2 p13 p23 p33 p.3 p14 p24 p34 p.4*/ | |
| /*# 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 */ | |
| fprintf(ficgp," u %d:(", ioffset); | |
| if(i==nlstate+1) | if(i==nlstate+1) |
| fprintf(ficgp," $%d/(1.-$%d)) t 'p.%d' with line ", \ | fprintf(ficgp," $%d/(1.-$%d)) t 'pw.%d' with line ", \ |
| 2+(cpt-1)*(nlstate+1)+1+(i-1), 2+1+(i-1)+(nlstate+1)*nlstate,cpt ); | ioffset+(cpt-1)*(nlstate+1)+1+(i-1), ioffset+1+(i-1)+(nlstate+1)*nlstate,cpt ); |
| else | else |
| fprintf(ficgp," $%d/(1.-$%d)) t 'p%d%d' with line ", \ | fprintf(ficgp," $%d/(1.-$%d)) t 'p%d%d' with line ", \ |
| 2+(cpt-1)*(nlstate+1)+1+(i-1), 2+1+(i-1)+(nlstate+1)*nlstate,i,cpt ); | ioffset+(cpt-1)*(nlstate+1)+1+(i-1), ioffset+1+(i-1)+(nlstate+1)*nlstate,i,cpt ); |
| }else{ | }else{ /* more than 2 covariates */ |
| fprintf(ficgp,"u 6:(("); /* Age is in 6 */ | if(cptcoveff ==1){ |
| /*# V1 = 1 V2 = 0 yearproj age p11 p21 p.1 p12 p22 p.2 p13 p23 p.3*/ | ioffset=4; /* Age is in 4 */ |
| /*# 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 */ | }else{ |
| ioffset=6; /* Age is in 6 */ | |
| /*# V1 = 1 V2 = 0 yearproj age p11 p21 p.1 p12 p22 p.2 p13 p23 p.3*/ | |
| /*# 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 */ | |
| } | |
| fprintf(ficgp," u %d:(",ioffset); | |
| kl=0; | kl=0; |
| for (k=1; k<=cptcoveff; k++){ /* For each covariate */ | strcpy(gplotcondition,"("); |
| lv= decodtabm(k1,k,cptcoveff); /* Should be the covariate value corresponding to k1 combination and kth covariate */ | for (k=1; k<=cptcoveff; k++){ /* For each covariate writing the chain of conditions */ |
| lv= decodtabm(k1,k,cptcoveff); /* Should be the covariate value corresponding to combination k1 and covariate k */ | |
| /* decodtabm(1,1,4) = 1 because h=1 k= (1) 1 1 1 */ | /* decodtabm(1,1,4) = 1 because h=1 k= (1) 1 1 1 */ |
| /* decodtabm(1,2,4) = 1 because h=1 k= 1 (1) 1 1 */ | /* decodtabm(1,2,4) = 1 because h=1 k= 1 (1) 1 1 */ |
| /* decodtabm(13,3,4)= 2 because h=13 k= 1 1 (2) 2 */ | /* decodtabm(13,3,4)= 2 because h=13 k= 1 1 (2) 2 */ |
| vlv= nbcode[Tvaraff[lv]][lv]; | vlv= nbcode[Tvaraff[k]][lv]; /* Value of the modality of Tvaraff[k] */ |
| kl++; | kl++; |
| /* kl=6+(cpt-1)*(nlstate+1)+1+(i-1); /\* 6+(1-1)*(2+1)+1+(1-1)=7, 6+(2-1)(2+1)+1+(1-1)=10 *\/ */ | sprintf(gplotcondition+strlen(gplotcondition),"$%d==%d && $%d==%d " ,kl,Tvaraff[k], kl+1, nbcode[Tvaraff[k]][lv]); |
| /*6+(cpt-1)*(nlstate+1)+1+(i-1)+(nlstate+1)*nlstate; 6+(1-1)*(2+1)+1+(1-1) +(2+1)*2=13 */ | kl++; |
| /*6+1+(i-1)+(nlstate+1)*nlstate; 6+1+(1-1) +(2+1)*2=13 */ | if(k <cptcoveff && cptcoveff>1) |
| /* '' u 6:(($1==1 && $2==0 && $3==2 && $4==0)? $9/(1.-$15) : 1/0):($5==2000? 3:2) t 'p.1' with line lc variable*/ | sprintf(gplotcondition+strlen(gplotcondition)," && "); |
| if(k==cptcoveff) | } |
| if(i==nlstate+1) | strcpy(gplotcondition+strlen(gplotcondition),")"); |
| fprintf(ficgp,"$%d==%d && $%d==%d)? $%d/(1.-$%d) : 1/0) t 'p.%d' with line ",kl, k,kl+1,nbcode[Tvaraff[lv]][lv], \ | /* kl=6+(cpt-1)*(nlstate+1)+1+(i-1); /\* 6+(1-1)*(2+1)+1+(1-1)=7, 6+(2-1)(2+1)+1+(1-1)=10 *\/ */ |
| 6+(cpt-1)*(nlstate+1)+1+(i-1), 6+1+(i-1)+(nlstate+1)*nlstate,cpt ); | /*6+(cpt-1)*(nlstate+1)+1+(i-1)+(nlstate+1)*nlstate; 6+(1-1)*(2+1)+1+(1-1) +(2+1)*2=13 */ |
| else | /*6+1+(i-1)+(nlstate+1)*nlstate; 6+1+(1-1) +(2+1)*2=13 */ |
| fprintf(ficgp,"$%d==%d && $%d==%d)? $%d/(1.-$%d) : 1/0) t 'p%d%d' with line ",kl, k,kl+1,nbcode[Tvaraff[lv]][lv], \ | /* '' u 6:(($1==1 && $2==0 && $3==2 && $4==0)? $9/(1.-$15) : 1/0):($5==2000? 3:2) t 'p.1' with line lc variable*/ |
| 6+(cpt-1)*(nlstate+1)+1+(i-1), 6+1+(i-1)+(nlstate+1)*nlstate,i,cpt ); | if(i==nlstate+1){ |
| else{ | fprintf(ficgp,"%s ? $%d/(1.-$%d) : 1/0) t 'p.%d' with line ", gplotcondition, \ |
| fprintf(ficgp,"$%d==%d && $%d==%d && ",kl, k,kl+1,nbcode[Tvaraff[lv]][lv]); | ioffset+(cpt-1)*(nlstate+1)+1+(i-1), ioffset+1+(i-1)+(nlstate+1)*nlstate,cpt ); |
| kl++; | }else{ |
| } | fprintf(ficgp,"%s ? $%d/(1.-$%d) : 1/0) t 'p%d%d' with line ", gplotcondition, \ |
| } /* end covariate */ | ioffset+(cpt-1)*(nlstate+1)+1+(i-1), ioffset +1+(i-1)+(nlstate+1)*nlstate,i,cpt ); |
| } | |
| } /* end if covariate */ | } /* end if covariate */ |
| } /* nlstate */ | } /* nlstate */ |
| fprintf(ficgp,"\nset out\n"); | fprintf(ficgp,"\nset out\n"); |
| } /* end cpt state*/ | } /* end cpt state*/ |
| } /* end covariate */ | } /* end covariate */ |
| } /* End if prevfcast */ | } /* End if prevfcast */ |
| /* proba elementaires */ | /* proba elementaires */ |
| fprintf(ficgp,"\n##############\n#MLE estimated parameters\n#############\n"); | fprintf(ficgp,"\n##############\n#MLE estimated parameters\n#############\n"); |
| for(i=1,jk=1; i <=nlstate; i++){ | for(i=1,jk=1; i <=nlstate; i++){ |
| Line 5910 plot [%.f:%.f] ", ageminpar, agemaxpar) | Line 6529 plot [%.f:%.f] ", ageminpar, agemaxpar) |
| fprintf(ficgp,"\n"); | fprintf(ficgp,"\n"); |
| } | } |
| } | } |
| } | } |
| fprintf(ficgp,"##############\n#\n"); | fprintf(ficgp,"##############\n#\n"); |
| /*goto avoid;*/ | /*goto avoid;*/ |
| fprintf(ficgp,"\n##############\n#Graphics of probabilities or incidences\n#############\n"); | fprintf(ficgp,"\n##############\n#Graphics of probabilities or incidences\n#############\n"); |
| fprintf(ficgp,"# logi(p12/p11)=a12+b12*age+c12age*age+d12*V1+e12*V1*age\n"); | fprintf(ficgp,"# logi(p12/p11)=a12+b12*age+c12age*age+d12*V1+e12*V1*age\n"); |
| Line 5928 plot [%.f:%.f] ", ageminpar, agemaxpar) | Line 6547 plot [%.f:%.f] ", ageminpar, agemaxpar) |
| fprintf(ficgp,"# +exp(a13+b13*age+c13age*age+d13*V1+e13*V1*age))\n"); | fprintf(ficgp,"# +exp(a13+b13*age+c13age*age+d13*V1+e13*V1*age))\n"); |
| fprintf(ficgp,"# +exp(a14+b14*age+c14age*age+d14*V1+e14*V1*age)+...)\n"); | fprintf(ficgp,"# +exp(a14+b14*age+c14age*age+d14*V1+e14*V1*age)+...)\n"); |
| fprintf(ficgp,"#\n"); | fprintf(ficgp,"#\n"); |
| for(ng=1; ng<=3;ng++){ /* Number of graphics: first is logit, 2nd is probabilities, third is incidences per year*/ | for(ng=1; ng<=3;ng++){ /* Number of graphics: first is logit, 2nd is probabilities, third is incidences per year*/ |
| fprintf(ficgp,"# ng=%d\n",ng); | fprintf(ficgp,"# ng=%d\n",ng); |
| fprintf(ficgp,"# jk=1 to 2^%d=%d\n",cptcoveff,m); | fprintf(ficgp,"# jk=1 to 2^%d=%d\n",cptcoveff,m); |
| for(jk=1; jk <=m; jk++) { | for(jk=1; jk <=m; jk++) { |
| fprintf(ficgp,"# jk=%d\n",jk); | fprintf(ficgp,"# jk=%d\n",jk); |
| fprintf(ficgp,"\nset out \"%s_%d-%d.svg\" ",subdirf2(optionfilefiname,"PE_"),jk,ng); | fprintf(ficgp,"\nset out \"%s_%d-%d.svg\" ",subdirf2(optionfilefiname,"PE_"),jk,ng); |
| fprintf(ficgp,"\nset ter svg size 640, 480 "); | fprintf(ficgp,"\nset ter svg size 640, 480 "); |
| if (ng==1){ | if (ng==1){ |
| fprintf(ficgp,"\nset ylabel \"Value of the logit of the model\"\n"); /* exp(a12+b12*x) could be nice */ | fprintf(ficgp,"\nset ylabel \"Value of the logit of the model\"\n"); /* exp(a12+b12*x) could be nice */ |
| fprintf(ficgp,"\nunset log y"); | fprintf(ficgp,"\nunset log y"); |
| }else if (ng==2){ | }else if (ng==2){ |
| fprintf(ficgp,"\nset ylabel \"Probability\"\n"); | fprintf(ficgp,"\nset ylabel \"Probability\"\n"); |
| fprintf(ficgp,"\nset log y"); | fprintf(ficgp,"\nset log y"); |
| }else if (ng==3){ | }else if (ng==3){ |
| fprintf(ficgp,"\nset ylabel \"Quasi-incidence per year\"\n"); | fprintf(ficgp,"\nset ylabel \"Quasi-incidence per year\"\n"); |
| fprintf(ficgp,"\nset log y"); | fprintf(ficgp,"\nset log y"); |
| }else | }else |
| fprintf(ficgp,"\nunset title "); | fprintf(ficgp,"\nunset title "); |
| fprintf(ficgp,"\nplot [%.f:%.f] ",ageminpar,agemaxpar); | fprintf(ficgp,"\nplot [%.f:%.f] ",ageminpar,agemaxpar); |
| i=1; | i=1; |
| for(k2=1; k2<=nlstate; k2++) { | for(k2=1; k2<=nlstate; k2++) { |
| k3=i; | k3=i; |
| for(k=1; k<=(nlstate+ndeath); k++) { | for(k=1; k<=(nlstate+ndeath); k++) { |
| if (k != k2){ | if (k != k2){ |
| switch( ng) { | switch( ng) { |
| case 1: | case 1: |
| if(nagesqr==0) | if(nagesqr==0) |
| fprintf(ficgp," p%d+p%d*x",i,i+1); | fprintf(ficgp," p%d+p%d*x",i,i+1); |
| else /* nagesqr =1 */ | else /* nagesqr =1 */ |
| fprintf(ficgp," p%d+p%d*x+p%d*x*x",i,i+1,i+1+nagesqr); | fprintf(ficgp," p%d+p%d*x+p%d*x*x",i,i+1,i+1+nagesqr); |
| break; | break; |
| case 2: /* ng=2 */ | case 2: /* ng=2 */ |
| if(nagesqr==0) | if(nagesqr==0) |
| fprintf(ficgp," exp(p%d+p%d*x",i,i+1); | fprintf(ficgp," exp(p%d+p%d*x",i,i+1); |
| else /* nagesqr =1 */ | else /* nagesqr =1 */ |
| fprintf(ficgp," exp(p%d+p%d*x+p%d*x*x",i,i+1,i+1+nagesqr); | fprintf(ficgp," exp(p%d+p%d*x+p%d*x*x",i,i+1,i+1+nagesqr); |
| break; | break; |
| case 3: | case 3: |
| if(nagesqr==0) | if(nagesqr==0) |
| fprintf(ficgp," %f*exp(p%d+p%d*x",YEARM/stepm,i,i+1); | fprintf(ficgp," %f*exp(p%d+p%d*x",YEARM/stepm,i,i+1); |
| else /* nagesqr =1 */ | else /* nagesqr =1 */ |
| fprintf(ficgp," %f*exp(p%d+p%d*x+p%d*x*x",YEARM/stepm,i,i+1,i+1+nagesqr); | fprintf(ficgp," %f*exp(p%d+p%d*x+p%d*x*x",YEARM/stepm,i,i+1,i+1+nagesqr); |
| break; | break; |
| } | } |
| ij=1;/* To be checked else nbcode[0][0] wrong */ | ij=1;/* To be checked else nbcode[0][0] wrong */ |
| for(j=3; j <=ncovmodel-nagesqr; j++) { | for(j=3; j <=ncovmodel-nagesqr; j++) { |
| /* printf("Tage[%d]=%d, j=%d\n", ij, Tage[ij], j); */ | /* printf("Tage[%d]=%d, j=%d\n", ij, Tage[ij], j); */ |
| if(ij <=cptcovage) { /* Bug valgrind */ | if(ij <=cptcovage) { /* Bug valgrind */ |
| if((j-2)==Tage[ij]) { /* Bug valgrind */ | if((j-2)==Tage[ij]) { /* Bug valgrind */ |
| fprintf(ficgp,"+p%d*%d*x",i+j+nagesqr-1,nbcode[Tvar[j-2]][codtabm(jk,j-2)]); | fprintf(ficgp,"+p%d*%d*x",i+j+nagesqr-1,nbcode[Tvar[j-2]][codtabm(jk,j-2)]); |
| /* fprintf(ficgp,"+p%d*%d*x",i+j+nagesqr-1,nbcode[Tvar[j-2]][codtabm(jk,Tvar[j-2])]); */ | /* fprintf(ficgp,"+p%d*%d*x",i+j+nagesqr-1,nbcode[Tvar[j-2]][codtabm(jk,Tvar[j-2])]); */ |
| ij++; | ij++; |
| } | |
| } | |
| else | |
| fprintf(ficgp,"+p%d*%d",i+j+nagesqr-1,nbcode[Tvar[j-2]][codtabm(jk,j-2)]); | |
| } | |
| }else{ | |
| i=i-ncovmodel; | |
| if(ng !=1 ) /* For logit formula of log p11 is more difficult to get */ | |
| fprintf(ficgp," (1."); | |
| } | |
| if(ng != 1){ | |
| fprintf(ficgp,")/(1"); | |
| for(k1=1; k1 <=nlstate; k1++){ | |
| if(nagesqr==0) | |
| fprintf(ficgp,"+exp(p%d+p%d*x",k3+(k1-1)*ncovmodel,k3+(k1-1)*ncovmodel+1); | |
| else /* nagesqr =1 */ | |
| fprintf(ficgp,"+exp(p%d+p%d*x+p%d*x*x",k3+(k1-1)*ncovmodel,k3+(k1-1)*ncovmodel+1,k3+(k1-1)*ncovmodel+1+nagesqr); | |
| ij=1; | |
| for(j=3; j <=ncovmodel-nagesqr; j++){ | |
| if(ij <=cptcovage) { /* Bug valgrind */ | |
| if((j-2)==Tage[ij]) { /* Bug valgrind */ | |
| fprintf(ficgp,"+p%d*%d*x",k3+(k1-1)*ncovmodel+1+j-2+nagesqr,nbcode[Tvar[j-2]][codtabm(jk,j-2)]); | |
| /* fprintf(ficgp,"+p%d*%d*x",k3+(k1-1)*ncovmodel+1+j-2+nagesqr,nbcode[Tvar[j-2]][codtabm(jk,Tvar[j-2])]); */ | |
| ij++; | |
| } | |
| } | |
| else | |
| fprintf(ficgp,"+p%d*%d",k3+(k1-1)*ncovmodel+1+j-2+nagesqr,nbcode[Tvar[j-2]][codtabm(jk,j-2)]); | |
| } | |
| fprintf(ficgp,")"); | |
| } | |
| fprintf(ficgp,")"); | |
| if(ng ==2) | |
| fprintf(ficgp," t \"p%d%d\" ", k2,k); | |
| else /* ng= 3 */ | |
| fprintf(ficgp," t \"i%d%d\" ", k2,k); | |
| }else{ /* end ng <> 1 */ | |
| if( k !=k2) /* logit p11 is hard to draw */ | |
| fprintf(ficgp," t \"logit(p%d%d)\" ", k2,k); | |
| } | |
| if ((k+k2)!= (nlstate*2+ndeath) && ng != 1) | |
| fprintf(ficgp,","); | |
| if (ng == 1 && k!=k2 && (k+k2)!= (nlstate*2+ndeath)) | |
| fprintf(ficgp,","); | |
| i=i+ncovmodel; | |
| } /* end k */ | |
| } /* end k2 */ | |
| fprintf(ficgp,"\n set out\n"); | |
| } /* end jk */ | |
| } /* end ng */ | |
| /* avoid: */ | |
| fflush(ficgp); | |
| } /* end gnuplot */ | |
| /*************** Moving average **************/ | |
| int movingaverage(double ***probs, double bage,double fage, double ***mobaverage, int mobilav){ | |
| int i, cpt, cptcod; | |
| int modcovmax =1; | |
| int mobilavrange, mob; | |
| double age; | |
| modcovmax=2*cptcoveff;/* Max number of modalities. We suppose | |
| a covariate has 2 modalities */ | |
| if (cptcovn<1) modcovmax=1; /* At least 1 pass */ | |
| if(mobilav==1||mobilav ==3 ||mobilav==5 ||mobilav== 7){ | |
| if(mobilav==1) mobilavrange=5; /* default */ | |
| else mobilavrange=mobilav; | |
| for (age=bage; age<=fage; age++) | |
| for (i=1; i<=nlstate;i++) | |
| for (cptcod=1;cptcod<=modcovmax;cptcod++) | |
| mobaverage[(int)age][i][cptcod]=probs[(int)age][i][cptcod]; | |
| /* We keep the original values on the extreme ages bage, fage and for | |
| fage+1 and bage-1 we use a 3 terms moving average; for fage+2 bage+2 | |
| we use a 5 terms etc. until the borders are no more concerned. | |
| */ | |
| for (mob=3;mob <=mobilavrange;mob=mob+2){ | |
| for (age=bage+(mob-1)/2; age<=fage-(mob-1)/2; age++){ | |
| for (i=1; i<=nlstate;i++){ | |
| for (cptcod=1;cptcod<=modcovmax;cptcod++){ | |
| mobaverage[(int)age][i][cptcod] =probs[(int)age][i][cptcod]; | |
| for (cpt=1;cpt<=(mob-1)/2;cpt++){ | |
| mobaverage[(int)age][i][cptcod] +=probs[(int)age-cpt][i][cptcod]; | |
| mobaverage[(int)age][i][cptcod] +=probs[(int)age+cpt][i][cptcod]; | |
| } | |
| mobaverage[(int)age][i][cptcod]=mobaverage[(int)age][i][cptcod]/mob; | |
| } | |
| } | |
| }/* end age */ | |
| }/* end mob */ | |
| }else return -1; | |
| return 0; | |
| }/* End movingaverage */ | |
| /************** Forecasting ******************/ | |
| void prevforecast(char fileres[], double anproj1, double mproj1, double jproj1, double ageminpar, double agemax, double dateprev1, double dateprev2, int mobilav, double bage, double fage, int firstpass, int lastpass, double anproj2, double p[], int cptcoveff){ | |
| /* proj1, year, month, day of starting projection | |
| agemin, agemax range of age | |
| dateprev1 dateprev2 range of dates during which prevalence is computed | |
| anproj2 year of en of projection (same day and month as proj1). | |
| */ | |
| int yearp, stepsize, hstepm, nhstepm, j, k, cptcod, i, h, i1; | |
| double agec; /* generic age */ | |
| double agelim, ppij, yp,yp1,yp2,jprojmean,mprojmean,anprojmean; | |
| double *popeffectif,*popcount; | |
| double ***p3mat; | |
| double ***mobaverage; | |
| char fileresf[FILENAMELENGTH]; | |
| agelim=AGESUP; | |
| /* Compute observed prevalence between dateprev1 and dateprev2 by counting the number of people | |
| in each health status at the date of interview (if between dateprev1 and dateprev2). | |
| We still use firstpass and lastpass as another selection. | |
| */ | |
| /* freqsummary(fileres, agemin, agemax, s, agev, nlstate, imx,Tvaraff,nbcode, ncodemax,mint,anint,strstart,\ */ | |
| /* firstpass, lastpass, stepm, weightopt, model); */ | |
| prevalence(probs, ageminpar, agemax, s, agev, nlstate, imx, Tvar, nbcode, ncodemax, mint, anint, dateprev1, dateprev2, firstpass, lastpass); | |
| strcpy(fileresf,"F_"); | |
| strcat(fileresf,fileresu); | |
| if((ficresf=fopen(fileresf,"w"))==NULL) { | |
| printf("Problem with forecast resultfile: %s\n", fileresf); | |
| fprintf(ficlog,"Problem with forecast resultfile: %s\n", fileresf); | |
| } | |
| printf("Computing forecasting: result on file '%s', please wait... \n", fileresf); | |
| fprintf(ficlog,"Computing forecasting: result on file '%s', please wait... \n", fileresf); | |
| if (cptcoveff==0) ncodemax[cptcoveff]=1; | |
| if (mobilav!=0) { | |
| mobaverage= ma3x(1, AGESUP,1,NCOVMAX, 1,NCOVMAX); | |
| if (movingaverage(probs, ageminpar, fage, mobaverage,mobilav)!=0){ | |
| fprintf(ficlog," Error in movingaverage mobilav=%d\n",mobilav); | |
| printf(" Error in movingaverage mobilav=%d\n",mobilav); | |
| } | |
| } | |
| stepsize=(int) (stepm+YEARM-1)/YEARM; | |
| if (stepm<=12) stepsize=1; | |
| if(estepm < stepm){ | |
| printf ("Problem %d lower than %d\n",estepm, stepm); | |
| } | |
| else hstepm=estepm; | |
| hstepm=hstepm/stepm; | |
| yp1=modf(dateintmean,&yp);/* extracts integral of datemean in yp and | |
| fractional in yp1 */ | |
| 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; | |
| i1=cptcoveff; | |
| if (cptcovn < 1){i1=1;} | |
| fprintf(ficresf,"# Mean day of interviews %.lf/%.lf/%.lf (%.2f) between %.2f and %.2f \n",jprojmean,mprojmean,anprojmean,dateintmean,dateprev1,dateprev2); | |
| fprintf(ficresf,"#****** Routine prevforecast **\n"); | |
| /* if (h==(int)(YEARM*yearp)){ */ | |
| for(cptcov=1, k=0;cptcov<=i1;cptcov++){ | |
| for(cptcod=1;cptcod<=ncodemax[cptcoveff];cptcod++){ | |
| k=k+1; | |
| fprintf(ficresf,"\n#****** hpijx=probability over h years, hp.jx is weighted by observed prev \n#"); | |
| for(j=1;j<=cptcoveff;j++) { | |
| fprintf(ficresf," V%d (=) %d",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); | |
| } | |
| fprintf(ficresf," yearproj age"); | |
| for(j=1; j<=nlstate+ndeath;j++){ | |
| for(i=1; i<=nlstate;i++) | |
| fprintf(ficresf," p%d%d",i,j); | |
| fprintf(ficresf," p.%d",j); | |
| } | |
| for (yearp=0; yearp<=(anproj2-anproj1);yearp +=stepsize) { | |
| fprintf(ficresf,"\n"); | |
| fprintf(ficresf,"\n# Forecasting at date %.lf/%.lf/%.lf ",jproj1,mproj1,anproj1+yearp); | |
| for (agec=fage; agec>=(ageminpar-1); agec--){ | |
| nhstepm=(int) rint((agelim-agec)*YEARM/stepm); | |
| nhstepm = nhstepm/hstepm; | |
| p3mat=ma3x(1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); | |
| oldm=oldms;savm=savms; | |
| hpxij(p3mat,nhstepm,agec,hstepm,p,nlstate,stepm,oldm,savm, k); | |
| for (h=0; h<=nhstepm; h++){ | |
| if (h*hstepm/YEARM*stepm ==yearp) { | |
| fprintf(ficresf,"\n"); | |
| for(j=1;j<=cptcoveff;j++) | |
| fprintf(ficresf,"%d %d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); | |
| fprintf(ficresf,"%.f %.f ",anproj1+yearp,agec+h*hstepm/YEARM*stepm); | |
| } | |
| for(j=1; j<=nlstate+ndeath;j++) { | |
| ppij=0.; | |
| for(i=1; i<=nlstate;i++) { | |
| if (mobilav==1) | |
| ppij=ppij+p3mat[i][j][h]*mobaverage[(int)agec][i][cptcod]; | |
| else { | |
| ppij=ppij+p3mat[i][j][h]*probs[(int)(agec)][i][cptcod]; | |
| } | } |
| if (h*hstepm/YEARM*stepm== yearp) { | } |
| fprintf(ficresf," %.3f", p3mat[i][j][h]); | else |
| fprintf(ficgp,"+p%d*%d",i+j+nagesqr-1,nbcode[Tvar[j-2]][codtabm(jk,j-2)]); /* Valgrind bug nbcode */ | |
| } | |
| }else{ | |
| i=i-ncovmodel; | |
| if(ng !=1 ) /* For logit formula of log p11 is more difficult to get */ | |
| fprintf(ficgp," (1."); | |
| } | |
| if(ng != 1){ | |
| fprintf(ficgp,")/(1"); | |
| for(k1=1; k1 <=nlstate; k1++){ | |
| if(nagesqr==0) | |
| fprintf(ficgp,"+exp(p%d+p%d*x",k3+(k1-1)*ncovmodel,k3+(k1-1)*ncovmodel+1); | |
| else /* nagesqr =1 */ | |
| fprintf(ficgp,"+exp(p%d+p%d*x+p%d*x*x",k3+(k1-1)*ncovmodel,k3+(k1-1)*ncovmodel+1,k3+(k1-1)*ncovmodel+1+nagesqr); | |
| ij=1; | |
| for(j=3; j <=ncovmodel-nagesqr; j++){ | |
| if(ij <=cptcovage) { /* Bug valgrind */ | |
| if((j-2)==Tage[ij]) { /* Bug valgrind */ | |
| fprintf(ficgp,"+p%d*%d*x",k3+(k1-1)*ncovmodel+1+j-2+nagesqr,nbcode[Tvar[j-2]][codtabm(jk,j-2)]); | |
| /* fprintf(ficgp,"+p%d*%d*x",k3+(k1-1)*ncovmodel+1+j-2+nagesqr,nbcode[Tvar[j-2]][codtabm(jk,Tvar[j-2])]); */ | |
| ij++; | |
| } | |
| } | } |
| } /* end i */ | else |
| if (h*hstepm/YEARM*stepm==yearp) { | fprintf(ficgp,"+p%d*%d",k3+(k1-1)*ncovmodel+1+j-2+nagesqr,nbcode[Tvar[j-2]][codtabm(jk,j-2)]);/* Valgrind bug nbcode */ |
| fprintf(ficresf," %.3f", ppij); | |
| } | } |
| }/* end j */ | fprintf(ficgp,")"); |
| } /* end h */ | } |
| free_ma3x(p3mat,1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); | fprintf(ficgp,")"); |
| } /* end agec */ | if(ng ==2) |
| } /* end yearp */ | fprintf(ficgp," t \"p%d%d\" ", k2,k); |
| } /* end cptcod */ | else /* ng= 3 */ |
| } /* end cptcov */ | fprintf(ficgp," t \"i%d%d\" ", k2,k); |
| }else{ /* end ng <> 1 */ | |
| if (mobilav!=0) free_ma3x(mobaverage,1, AGESUP,1,NCOVMAX, 1,NCOVMAX); | if( k !=k2) /* logit p11 is hard to draw */ |
| fprintf(ficgp," t \"logit(p%d%d)\" ", k2,k); | |
| } | |
| if ((k+k2)!= (nlstate*2+ndeath) && ng != 1) | |
| fprintf(ficgp,","); | |
| if (ng == 1 && k!=k2 && (k+k2)!= (nlstate*2+ndeath)) | |
| fprintf(ficgp,","); | |
| i=i+ncovmodel; | |
| } /* end k */ | |
| } /* end k2 */ | |
| fprintf(ficgp,"\n set out\n"); | |
| } /* end jk */ | |
| } /* end ng */ | |
| /* avoid: */ | |
| fflush(ficgp); | |
| } /* end gnuplot */ | |
| fclose(ficresf); | |
| printf("End of Computing forecasting \n"); | |
| fprintf(ficlog,"End of Computing forecasting\n"); | |
| } | /*************** Moving average **************/ |
| /* int movingaverage(double ***probs, double bage, double fage, double ***mobaverage, int mobilav, double bageout, double fageout){ */ | |
| int movingaverage(double ***probs, double bage, double fage, double ***mobaverage, int mobilav){ | |
| int i, cpt, cptcod; | |
| int modcovmax =1; | |
| int mobilavrange, mob; | |
| int iage=0; | |
| double sum=0.; | |
| double age; | |
| double *sumnewp, *sumnewm; | |
| double *agemingood, *agemaxgood; /* Currently identical for all covariates */ | |
| /* modcovmax=2*cptcoveff;/\* Max number of modalities. We suppose */ | |
| /* a covariate has 2 modalities, should be equal to ncovcombmax *\/ */ | |
| sumnewp = vector(1,ncovcombmax); | |
| sumnewm = vector(1,ncovcombmax); | |
| agemingood = vector(1,ncovcombmax); | |
| agemaxgood = vector(1,ncovcombmax); | |
| for (cptcod=1;cptcod<=ncovcombmax;cptcod++){ | |
| sumnewm[cptcod]=0.; | |
| sumnewp[cptcod]=0.; | |
| agemingood[cptcod]=0; | |
| agemaxgood[cptcod]=0; | |
| } | |
| if (cptcovn<1) ncovcombmax=1; /* At least 1 pass */ | |
| if(mobilav==1||mobilav ==3 ||mobilav==5 ||mobilav== 7){ | |
| if(mobilav==1) mobilavrange=5; /* default */ | |
| else mobilavrange=mobilav; | |
| for (age=bage; age<=fage; age++) | |
| for (i=1; i<=nlstate;i++) | |
| for (cptcod=1;cptcod<=ncovcombmax;cptcod++) | |
| mobaverage[(int)age][i][cptcod]=probs[(int)age][i][cptcod]; | |
| /* We keep the original values on the extreme ages bage, fage and for | |
| fage+1 and bage-1 we use a 3 terms moving average; for fage+2 bage+2 | |
| we use a 5 terms etc. until the borders are no more concerned. | |
| */ | |
| for (mob=3;mob <=mobilavrange;mob=mob+2){ | |
| for (age=bage+(mob-1)/2; age<=fage-(mob-1)/2; age++){ | |
| for (i=1; i<=nlstate;i++){ | |
| for (cptcod=1;cptcod<=ncovcombmax;cptcod++){ | |
| mobaverage[(int)age][i][cptcod] =probs[(int)age][i][cptcod]; | |
| for (cpt=1;cpt<=(mob-1)/2;cpt++){ | |
| mobaverage[(int)age][i][cptcod] +=probs[(int)age-cpt][i][cptcod]; | |
| mobaverage[(int)age][i][cptcod] +=probs[(int)age+cpt][i][cptcod]; | |
| } | |
| mobaverage[(int)age][i][cptcod]=mobaverage[(int)age][i][cptcod]/mob; | |
| } | |
| } | |
| }/* end age */ | |
| }/* end mob */ | |
| }else | |
| return -1; | |
| for (cptcod=1;cptcod<=ncovcombmax;cptcod++){ | |
| /* for (age=bage+(mob-1)/2; age<=fage-(mob-1)/2; age++){ */ | |
| if(invalidvarcomb[cptcod]){ | |
| printf("\nCombination (%d) ignored because no cases \n",cptcod); | |
| continue; | |
| } | |
| agemingood[cptcod]=fage-(mob-1)/2; | |
| for (age=fage-(mob-1)/2; age>=bage; age--){/* From oldest to youngest, finding the youngest wrong */ | |
| sumnewm[cptcod]=0.; | |
| for (i=1; i<=nlstate;i++){ | |
| sumnewm[cptcod]+=mobaverage[(int)age][i][cptcod]; | |
| } | |
| if(fabs(sumnewm[cptcod] - 1.) <= 1.e-3) { /* good */ | |
| agemingood[cptcod]=age; | |
| }else{ /* bad */ | |
| for (i=1; i<=nlstate;i++){ | |
| mobaverage[(int)age][i][cptcod]=mobaverage[(int)agemingood[cptcod]][i][cptcod]; | |
| } /* i */ | |
| } /* end bad */ | |
| }/* age */ | |
| sum=0.; | |
| for (i=1; i<=nlstate;i++){ | |
| sum+=mobaverage[(int)agemingood[cptcod]][i][cptcod]; | |
| } | |
| if(fabs(sum - 1.) > 1.e-3) { /* bad */ | |
| printf("For this combination of covariate cptcod=%d, we can't get a smoothed prevalence which sums to one at any descending age!\n",cptcod); | |
| /* for (i=1; i<=nlstate;i++){ */ | |
| /* mobaverage[(int)age][i][cptcod]=mobaverage[(int)agemingood[cptcod]][i][cptcod]; */ | |
| /* } /\* i *\/ */ | |
| } /* end bad */ | |
| /* else{ /\* We found some ages summing to one, we will smooth the oldest *\/ */ | |
| /* From youngest, finding the oldest wrong */ | |
| agemaxgood[cptcod]=bage+(mob-1)/2; | |
| for (age=bage+(mob-1)/2; age<=fage; age++){ | |
| sumnewm[cptcod]=0.; | |
| for (i=1; i<=nlstate;i++){ | |
| sumnewm[cptcod]+=mobaverage[(int)age][i][cptcod]; | |
| } | |
| if(fabs(sumnewm[cptcod] - 1.) <= 1.e-3) { /* good */ | |
| agemaxgood[cptcod]=age; | |
| }else{ /* bad */ | |
| for (i=1; i<=nlstate;i++){ | |
| mobaverage[(int)age][i][cptcod]=mobaverage[(int)agemaxgood[cptcod]][i][cptcod]; | |
| } /* i */ | |
| } /* end bad */ | |
| }/* age */ | |
| sum=0.; | |
| for (i=1; i<=nlstate;i++){ | |
| sum+=mobaverage[(int)agemaxgood[cptcod]][i][cptcod]; | |
| } | |
| if(fabs(sum - 1.) > 1.e-3) { /* bad */ | |
| printf("For this combination of covariate cptcod=%d, we can't get a smoothed prevalence which sums to one at any ascending age!\n",cptcod); | |
| /* for (i=1; i<=nlstate;i++){ */ | |
| /* mobaverage[(int)age][i][cptcod]=mobaverage[(int)agemingood[cptcod]][i][cptcod]; */ | |
| /* } /\* i *\/ */ | |
| } /* end bad */ | |
| for (age=bage; age<=fage; age++){ | |
| printf("%d %d ", cptcod, (int)age); | |
| sumnewp[cptcod]=0.; | |
| sumnewm[cptcod]=0.; | |
| for (i=1; i<=nlstate;i++){ | |
| sumnewp[cptcod]+=probs[(int)age][i][cptcod]; | |
| sumnewm[cptcod]+=mobaverage[(int)age][i][cptcod]; | |
| /* printf("%.4f %.4f ",probs[(int)age][i][cptcod], mobaverage[(int)age][i][cptcod]); */ | |
| } | |
| /* printf("%.4f %.4f \n",sumnewp[cptcod], sumnewm[cptcod]); */ | |
| } | |
| /* printf("\n"); */ | |
| /* } */ | |
| /* brutal averaging */ | |
| for (i=1; i<=nlstate;i++){ | |
| for (age=1; age<=bage; age++){ | |
| mobaverage[(int)age][i][cptcod]=mobaverage[(int)agemingood[cptcod]][i][cptcod]; | |
| /* printf("age=%d i=%d cptcod=%d mobaverage=%.4f \n",(int)age,i, cptcod, mobaverage[(int)age][i][cptcod]); */ | |
| } | |
| for (age=fage; age<=AGESUP; age++){ | |
| mobaverage[(int)age][i][cptcod]=mobaverage[(int)agemaxgood[cptcod]][i][cptcod]; | |
| /* printf("age=%d i=%d cptcod=%d mobaverage=%.4f \n",(int)age,i, cptcod, mobaverage[(int)age][i][cptcod]); */ | |
| } | |
| } /* end i status */ | |
| for (i=nlstate+1; i<=nlstate+ndeath;i++){ | |
| for (age=1; age<=AGESUP; age++){ | |
| /*printf("i=%d, age=%d, cptcod=%d\n",i, (int)age, cptcod);*/ | |
| mobaverage[(int)age][i][cptcod]=0.; | |
| } | |
| } | |
| }/* end cptcod */ | |
| free_vector(sumnewm,1, ncovcombmax); | |
| free_vector(sumnewp,1, ncovcombmax); | |
| free_vector(agemaxgood,1, ncovcombmax); | |
| free_vector(agemingood,1, ncovcombmax); | |
| return 0; | |
| }/* End movingaverage */ | |
| /************** Back Forecasting ******************/ | /************** Forecasting ******************/ |
| void prevbackforecast(char fileres[], double anback1, double mback1, double jback1, double ageminpar, double agemax, double dateprev1, double dateprev2, int mobilav, double bage, double fage, int firstpass, int lastpass, double anback2, double p[], int cptcoveff){ | void prevforecast(char fileres[], double anproj1, double mproj1, double jproj1, double ageminpar, double agemax, double dateprev1, double dateprev2, int mobilav, double bage, double fage, int firstpass, int lastpass, double anproj2, double p[], int cptcoveff){ |
| /* back1, year, month, day of starting backection | /* proj1, year, month, day of starting projection |
| agemin, agemax range of age | agemin, agemax range of age |
| dateprev1 dateprev2 range of dates during which prevalence is computed | dateprev1 dateprev2 range of dates during which prevalence is computed |
| anback2 year of en of backection (same day and month as back1). | anproj2 year of en of projection (same day and month as proj1). |
| */ | */ |
| int yearp, stepsize, hstepm, nhstepm, j, k, cptcod, i, h, i1; | int yearp, stepsize, hstepm, nhstepm, j, k, cptcod, i, h, i1; |
| double agec; /* generic age */ | double agec; /* generic age */ |
| double agelim, ppij, yp,yp1,yp2,jprojmean,mprojmean,anprojmean; | double agelim, ppij, yp,yp1,yp2,jprojmean,mprojmean,anprojmean; |
| double *popeffectif,*popcount; | double *popeffectif,*popcount; |
| double ***p3mat; | double ***p3mat; |
| double ***mobaverage; | /* double ***mobaverage; */ |
| char fileresfb[FILENAMELENGTH]; | char fileresf[FILENAMELENGTH]; |
| agelim=AGESUP; | agelim=AGESUP; |
| /* Compute observed prevalence between dateprev1 and dateprev2 by counting the number of people | /* Compute observed prevalence between dateprev1 and dateprev2 by counting the number of people |
| Line 6232 void prevbackforecast(char fileres[], do | Line 6834 void prevbackforecast(char fileres[], do |
| */ | */ |
| /* freqsummary(fileres, agemin, agemax, s, agev, nlstate, imx,Tvaraff,nbcode, ncodemax,mint,anint,strstart,\ */ | /* freqsummary(fileres, agemin, agemax, s, agev, nlstate, imx,Tvaraff,nbcode, ncodemax,mint,anint,strstart,\ */ |
| /* firstpass, lastpass, stepm, weightopt, model); */ | /* firstpass, lastpass, stepm, weightopt, model); */ |
| prevalence(probs, ageminpar, agemax, s, agev, nlstate, imx, Tvar, nbcode, ncodemax, mint, anint, dateprev1, dateprev2, firstpass, lastpass); | |
| strcpy(fileresfb,"FB_"); | strcpy(fileresf,"F_"); |
| strcat(fileresfb,fileresu); | strcat(fileresf,fileresu); |
| if((ficresfb=fopen(fileresfb,"w"))==NULL) { | if((ficresf=fopen(fileresf,"w"))==NULL) { |
| printf("Problem with back forecast resultfile: %s\n", fileresfb); | printf("Problem with forecast resultfile: %s\n", fileresf); |
| fprintf(ficlog,"Problem with back forecast resultfile: %s\n", fileresfb); | fprintf(ficlog,"Problem with forecast resultfile: %s\n", fileresf); |
| } | } |
| printf("Computing back forecasting: result on file '%s', please wait... \n", fileresfb); | printf("Computing forecasting: result on file '%s', please wait... \n", fileresf); |
| fprintf(ficlog,"Computing back forecasting: result on file '%s', please wait... \n", fileresfb); | fprintf(ficlog,"Computing forecasting: result on file '%s', please wait... \n", fileresf); |
| if (cptcoveff==0) ncodemax[cptcoveff]=1; | if (cptcoveff==0) ncodemax[cptcoveff]=1; |
| if (mobilav!=0) { | |
| mobaverage= ma3x(1, AGESUP,1,NCOVMAX, 1,NCOVMAX); | |
| if (movingaverage(probs, ageminpar, fage, mobaverage,mobilav)!=0){ | |
| fprintf(ficlog," Error in movingaverage mobilav=%d\n",mobilav); | |
| printf(" Error in movingaverage mobilav=%d\n",mobilav); | |
| } | |
| } | |
| stepsize=(int) (stepm+YEARM-1)/YEARM; | stepsize=(int) (stepm+YEARM-1)/YEARM; |
| if (stepm<=12) stepsize=1; | if (stepm<=12) stepsize=1; |
| Line 6271 void prevbackforecast(char fileres[], do | Line 6865 void prevbackforecast(char fileres[], do |
| if(jprojmean==0) jprojmean=1; | if(jprojmean==0) jprojmean=1; |
| if(mprojmean==0) jprojmean=1; | if(mprojmean==0) jprojmean=1; |
| i1=cptcoveff; | i1=pow(2,cptcoveff); |
| if (cptcovn < 1){i1=1;} | if (cptcovn < 1){i1=1;} |
| fprintf(ficresfb,"# Mean day of interviews %.lf/%.lf/%.lf (%.2f) between %.2f and %.2f \n",jprojmean,mprojmean,anprojmean,dateintmean,dateprev1,dateprev2); | fprintf(ficresf,"# Mean day of interviews %.lf/%.lf/%.lf (%.2f) between %.2f and %.2f \n",jprojmean,mprojmean,anprojmean,dateintmean,dateprev1,dateprev2); |
| fprintf(ficresf,"#****** Routine prevforecast **\n"); | |
| fprintf(ficresfb,"#****** Routine prevbackforecast **\n"); | |
| /* if (h==(int)(YEARM*yearp)){ */ | /* if (h==(int)(YEARM*yearp)){ */ |
| for(cptcov=1, k=0;cptcov<=i1;cptcov++){ | for(k=1;k<=i1;k++){ |
| for(cptcod=1;cptcod<=ncodemax[cptcoveff];cptcod++){ | if(invalidvarcomb[k]){ |
| k=k+1; | printf("\nCombination (%d) projection ignored because no cases \n",k); |
| fprintf(ficresfb,"\n#****** hbijx=probability over h years, hp.jx is weighted by observed prev \n#"); | continue; |
| for(j=1;j<=cptcoveff;j++) { | } |
| fprintf(ficresfb," V%d (=) %d",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); | fprintf(ficresf,"\n#****** hpijx=probability over h years, hp.jx is weighted by observed prev \n#"); |
| } | for(j=1;j<=cptcoveff;j++) { |
| fprintf(ficresfb," yearbproj age"); | fprintf(ficresf," V%d (=) %d",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); |
| for(j=1; j<=nlstate+ndeath;j++){ | } |
| for(i=1; i<=nlstate;i++) | fprintf(ficresf," yearproj age"); |
| fprintf(ficresfb," p%d%d",i,j); | for(j=1; j<=nlstate+ndeath;j++){ |
| fprintf(ficresfb," p.%d",j); | for(i=1; i<=nlstate;i++) |
| } | fprintf(ficresf," p%d%d",i,j); |
| for (yearp=0; yearp>=(anback2-anback1);yearp -=stepsize) { | fprintf(ficresf," wp.%d",j); |
| /* for (yearp=0; yearp<=(anproj2-anproj1);yearp +=stepsize) { */ | } |
| fprintf(ficresfb,"\n"); | for (yearp=0; yearp<=(anproj2-anproj1);yearp +=stepsize) { |
| fprintf(ficresfb,"\n# Back Forecasting at date %.lf/%.lf/%.lf ",jback1,mback1,anback1+yearp); | fprintf(ficresf,"\n"); |
| for (agec=fage; agec>=(ageminpar-1); agec--){ | fprintf(ficresf,"\n# Forecasting at date %.lf/%.lf/%.lf ",jproj1,mproj1,anproj1+yearp); |
| nhstepm=(int) rint((agelim-agec)*YEARM/stepm); | for (agec=fage; agec>=(ageminpar-1); agec--){ |
| nhstepm = nhstepm/hstepm; | nhstepm=(int) rint((agelim-agec)*YEARM/stepm); |
| p3mat=ma3x(1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); | nhstepm = nhstepm/hstepm; |
| oldm=oldms;savm=savms; | p3mat=ma3x(1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); |
| hbxij(p3mat,nhstepm,agec,hstepm,p,nlstate,stepm,oldm,savm, k); | oldm=oldms;savm=savms; |
| hpxij(p3mat,nhstepm,agec,hstepm,p,nlstate,stepm,oldm,savm, k); | |
| for (h=0; h<=nhstepm; h++){ | for (h=0; h<=nhstepm; h++){ |
| if (h*hstepm/YEARM*stepm ==yearp) { | if (h*hstepm/YEARM*stepm ==yearp) { |
| fprintf(ficresfb,"\n"); | fprintf(ficresf,"\n"); |
| for(j=1;j<=cptcoveff;j++) | for(j=1;j<=cptcoveff;j++) |
| fprintf(ficresfb,"%d %d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); | fprintf(ficresf,"%d %d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); |
| fprintf(ficresfb,"%.f %.f ",anback1+yearp,agec+h*hstepm/YEARM*stepm); | fprintf(ficresf,"%.f %.f ",anproj1+yearp,agec+h*hstepm/YEARM*stepm); |
| } | } |
| for(j=1; j<=nlstate+ndeath;j++) { | for(j=1; j<=nlstate+ndeath;j++) { |
| ppij=0.; | ppij=0.; |
| for(i=1; i<=nlstate;i++) { | for(i=1; i<=nlstate;i++) { |
| if (mobilav==1) | if (mobilav==1) |
| ppij=ppij+p3mat[i][j][h]*mobaverage[(int)agec][i][cptcod]; | ppij=ppij+p3mat[i][j][h]*mobaverage[(int)agec][i][k]; |
| else { | else { |
| ppij=ppij+p3mat[i][j][h]*probs[(int)(agec)][i][cptcod]; | ppij=ppij+p3mat[i][j][h]*probs[(int)(agec)][i][k]; |
| } | |
| if (h*hstepm/YEARM*stepm== yearp) { | |
| fprintf(ficresfb," %.3f", p3mat[i][j][h]); | |
| } | |
| } /* end i */ | |
| if (h*hstepm/YEARM*stepm==yearp) { | |
| fprintf(ficresfb," %.3f", ppij); | |
| } | } |
| }/* end j */ | if (h*hstepm/YEARM*stepm== yearp) { |
| } /* end h */ | fprintf(ficresf," %.3f", p3mat[i][j][h]); |
| free_ma3x(p3mat,1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); | } |
| } /* end agec */ | } /* end i */ |
| } /* end yearp */ | if (h*hstepm/YEARM*stepm==yearp) { |
| } /* end cptcod */ | fprintf(ficresf," %.3f", ppij); |
| } /* end cptcov */ | } |
| }/* end j */ | |
| if (mobilav!=0) free_ma3x(mobaverage,1, AGESUP,1,NCOVMAX, 1,NCOVMAX); | } /* end h */ |
| free_ma3x(p3mat,1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); | |
| fclose(ficresfb); | } /* end agec */ |
| printf("End of Computing Back forecasting \n"); | } /* end yearp */ |
| fprintf(ficlog,"End of Computing Back forecasting\n"); | } /* end k */ |
| fclose(ficresf); | |
| printf("End of Computing forecasting \n"); | |
| fprintf(ficlog,"End of Computing forecasting\n"); | |
| } | } |
| /************** Forecasting *****not tested NB*************/ | /* /\************** Back Forecasting ******************\/ */ |
| void populforecast(char fileres[], double anpyram,double mpyram,double jpyram,double ageminpar, double agemax,double dateprev1, double dateprev2, int mobilav, double agedeb, double fage, int popforecast, char popfile[], double anpyram1,double p[], int i2){ | /* void prevbackforecast(char fileres[], double anback1, double mback1, double jback1, double ageminpar, double agemax, double dateprev1, double dateprev2, int mobilav, double bage, double fage, int firstpass, int lastpass, double anback2, double p[], int cptcoveff){ */ |
| /* /\* back1, year, month, day of starting backection */ | |
| int cpt, stepsize, hstepm, nhstepm, j,k,c, cptcod, i,h; | /* agemin, agemax range of age */ |
| int *popage; | /* dateprev1 dateprev2 range of dates during which prevalence is computed */ |
| double calagedatem, agelim, kk1, kk2; | /* anback2 year of en of backection (same day and month as back1). */ |
| double *popeffectif,*popcount; | /* *\/ */ |
| double ***p3mat,***tabpop,***tabpopprev; | /* int yearp, stepsize, hstepm, nhstepm, j, k, cptcod, i, h, i1; */ |
| double ***mobaverage; | /* double agec; /\* generic age *\/ */ |
| char filerespop[FILENAMELENGTH]; | /* double agelim, ppij, yp,yp1,yp2,jprojmean,mprojmean,anprojmean; */ |
| /* double *popeffectif,*popcount; */ | |
| tabpop= ma3x(1, AGESUP,1,NCOVMAX, 1,NCOVMAX); | /* double ***p3mat; */ |
| tabpopprev= ma3x(1, AGESUP,1,NCOVMAX, 1,NCOVMAX); | /* /\* double ***mobaverage; *\/ */ |
| agelim=AGESUP; | /* char fileresfb[FILENAMELENGTH]; */ |
| calagedatem=(anpyram+mpyram/12.+jpyram/365.-dateintmean)*YEARM; | |
| /* agelim=AGESUP; */ | |
| /* /\* Compute observed prevalence between dateprev1 and dateprev2 by counting the number of people */ | |
| /* in each health status at the date of interview (if between dateprev1 and dateprev2). */ | |
| /* We still use firstpass and lastpass as another selection. */ | |
| /* *\/ */ | |
| /* /\* freqsummary(fileres, agemin, agemax, s, agev, nlstate, imx,Tvaraff,nbcode, ncodemax,mint,anint,strstart,\ *\/ */ | |
| /* /\* firstpass, lastpass, stepm, weightopt, model); *\/ */ | |
| /* prevalence(probs, ageminpar, agemax, s, agev, nlstate, imx, Tvar, nbcode, ncodemax, mint, anint, dateprev1, dateprev2, firstpass, lastpass); */ | |
| /* strcpy(fileresfb,"FB_"); */ | |
| /* strcat(fileresfb,fileresu); */ | |
| /* if((ficresfb=fopen(fileresfb,"w"))==NULL) { */ | |
| /* printf("Problem with back forecast resultfile: %s\n", fileresfb); */ | |
| /* fprintf(ficlog,"Problem with back forecast resultfile: %s\n", fileresfb); */ | |
| /* } */ | |
| /* printf("Computing back forecasting: result on file '%s', please wait... \n", fileresfb); */ | |
| /* fprintf(ficlog,"Computing back forecasting: result on file '%s', please wait... \n", fileresfb); */ | |
| /* if (cptcoveff==0) ncodemax[cptcoveff]=1; */ | |
| /* /\* if (mobilav!=0) { *\/ */ | |
| /* /\* mobaverage= ma3x(1, AGESUP,1,NCOVMAX, 1,NCOVMAX); *\/ */ | |
| /* /\* if (movingaverage(probs, ageminpar, fage, mobaverage,mobilav)!=0){ *\/ */ | |
| /* /\* fprintf(ficlog," Error in movingaverage mobilav=%d\n",mobilav); *\/ */ | |
| /* /\* printf(" Error in movingaverage mobilav=%d\n",mobilav); *\/ */ | |
| /* /\* } *\/ */ | |
| /* /\* } *\/ */ | |
| /* stepsize=(int) (stepm+YEARM-1)/YEARM; */ | |
| /* if (stepm<=12) stepsize=1; */ | |
| /* if(estepm < stepm){ */ | |
| /* printf ("Problem %d lower than %d\n",estepm, stepm); */ | |
| /* } */ | |
| /* else hstepm=estepm; */ | |
| /* hstepm=hstepm/stepm; */ | |
| /* yp1=modf(dateintmean,&yp);/\* extracts integral of datemean in yp and */ | |
| /* fractional in yp1 *\/ */ | |
| /* 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; */ | |
| /* i1=cptcoveff; */ | |
| /* if (cptcovn < 1){i1=1;} */ | |
| prevalence(probs, ageminpar, agemax, s, agev, nlstate, imx, Tvar, nbcode, ncodemax, mint, anint, dateprev1, dateprev2, firstpass, lastpass); | /* fprintf(ficresfb,"# Mean day of interviews %.lf/%.lf/%.lf (%.2f) between %.2f and %.2f \n",jprojmean,mprojmean,anprojmean,dateintmean,dateprev1,dateprev2); */ |
| /* fprintf(ficresfb,"#****** Routine prevbackforecast **\n"); */ | |
| /* /\* if (h==(int)(YEARM*yearp)){ *\/ */ | |
| /* for(cptcov=1, k=0;cptcov<=i1;cptcov++){ */ | |
| /* for(cptcod=1;cptcod<=ncodemax[cptcoveff];cptcod++){ */ | |
| /* k=k+1; */ | |
| /* fprintf(ficresfb,"\n#****** hbijx=probability over h years, hp.jx is weighted by observed prev \n#"); */ | |
| /* for(j=1;j<=cptcoveff;j++) { */ | |
| /* fprintf(ficresfb," V%d (=) %d",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); */ | |
| /* } */ | |
| /* fprintf(ficresfb," yearbproj age"); */ | |
| /* for(j=1; j<=nlstate+ndeath;j++){ */ | |
| /* for(i=1; i<=nlstate;i++) */ | |
| /* fprintf(ficresfb," p%d%d",i,j); */ | |
| /* fprintf(ficresfb," p.%d",j); */ | |
| /* } */ | |
| /* for (yearp=0; yearp>=(anback2-anback1);yearp -=stepsize) { */ | |
| /* /\* for (yearp=0; yearp<=(anproj2-anproj1);yearp +=stepsize) { *\/ */ | |
| /* fprintf(ficresfb,"\n"); */ | |
| /* fprintf(ficresfb,"\n# Back Forecasting at date %.lf/%.lf/%.lf ",jback1,mback1,anback1+yearp); */ | |
| /* for (agec=fage; agec>=(ageminpar-1); agec--){ */ | |
| /* nhstepm=(int) rint((agelim-agec)*YEARM/stepm); */ | |
| /* nhstepm = nhstepm/hstepm; */ | |
| /* p3mat=ma3x(1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); */ | |
| /* oldm=oldms;savm=savms; */ | |
| /* hbxij(p3mat,nhstepm,agec,hstepm,p,prevacurrent,nlstate,stepm,oldm,savm,oldm,savm, dnewm, doldm, dsavm, k); */ | |
| /* for (h=0; h<=nhstepm; h++){ */ | |
| /* if (h*hstepm/YEARM*stepm ==yearp) { */ | |
| /* fprintf(ficresfb,"\n"); */ | |
| /* for(j=1;j<=cptcoveff;j++) */ | |
| /* fprintf(ficresfb,"%d %d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); */ | |
| /* fprintf(ficresfb,"%.f %.f ",anback1+yearp,agec+h*hstepm/YEARM*stepm); */ | |
| /* } */ | |
| /* for(j=1; j<=nlstate+ndeath;j++) { */ | |
| /* ppij=0.; */ | |
| /* for(i=1; i<=nlstate;i++) { */ | |
| /* if (mobilav==1) */ | |
| /* ppij=ppij+p3mat[i][j][h]*mobaverage[(int)agec][i][cptcod]; */ | |
| /* else { */ | |
| /* ppij=ppij+p3mat[i][j][h]*probs[(int)(agec)][i][cptcod]; */ | |
| /* } */ | |
| /* if (h*hstepm/YEARM*stepm== yearp) { */ | |
| /* fprintf(ficresfb," %.3f", p3mat[i][j][h]); */ | |
| /* } */ | |
| /* } /\* end i *\/ */ | |
| /* if (h*hstepm/YEARM*stepm==yearp) { */ | |
| /* fprintf(ficresfb," %.3f", ppij); */ | |
| /* } */ | |
| /* }/\* end j *\/ */ | |
| /* } /\* end h *\/ */ | |
| /* free_ma3x(p3mat,1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); */ | |
| /* } /\* end agec *\/ */ | |
| /* } /\* end yearp *\/ */ | |
| /* } /\* end cptcod *\/ */ | |
| /* } /\* end cptcov *\/ */ | |
| /* /\* if (mobilav!=0) free_ma3x(mobaverage,1, AGESUP,1,NCOVMAX, 1,NCOVMAX); *\/ */ | |
| /* fclose(ficresfb); */ | |
| /* printf("End of Computing Back forecasting \n"); */ | |
| /* fprintf(ficlog,"End of Computing Back forecasting\n"); */ | |
| /* } */ | |
| /************** Forecasting *****not tested NB*************/ | |
| /* void populforecast(char fileres[], double anpyram,double mpyram,double jpyram,double ageminpar, double agemax,double dateprev1, double dateprev2s, int mobilav, double agedeb, double fage, int popforecast, char popfile[], double anpyram1,double p[], int i2){ */ | |
| strcpy(filerespop,"POP_"); | /* int cpt, stepsize, hstepm, nhstepm, j,k,c, cptcod, i,h; */ |
| strcat(filerespop,fileresu); | /* int *popage; */ |
| if((ficrespop=fopen(filerespop,"w"))==NULL) { | /* double calagedatem, agelim, kk1, kk2; */ |
| printf("Problem with forecast resultfile: %s\n", filerespop); | /* double *popeffectif,*popcount; */ |
| fprintf(ficlog,"Problem with forecast resultfile: %s\n", filerespop); | /* double ***p3mat,***tabpop,***tabpopprev; */ |
| } | /* /\* double ***mobaverage; *\/ */ |
| printf("Computing forecasting: result on file '%s' \n", filerespop); | /* char filerespop[FILENAMELENGTH]; */ |
| fprintf(ficlog,"Computing forecasting: result on file '%s' \n", filerespop); | |
| /* tabpop= ma3x(1, AGESUP,1,NCOVMAX, 1,NCOVMAX); */ | |
| /* tabpopprev= ma3x(1, AGESUP,1,NCOVMAX, 1,NCOVMAX); */ | |
| /* agelim=AGESUP; */ | |
| /* calagedatem=(anpyram+mpyram/12.+jpyram/365.-dateintmean)*YEARM; */ | |
| /* prevalence(probs, ageminpar, agemax, s, agev, nlstate, imx, Tvar, nbcode, ncodemax, mint, anint, dateprev1, dateprev2, firstpass, lastpass); */ | |
| /* strcpy(filerespop,"POP_"); */ | |
| /* strcat(filerespop,fileresu); */ | |
| /* if((ficrespop=fopen(filerespop,"w"))==NULL) { */ | |
| /* printf("Problem with forecast resultfile: %s\n", filerespop); */ | |
| /* fprintf(ficlog,"Problem with forecast resultfile: %s\n", filerespop); */ | |
| /* } */ | |
| /* printf("Computing forecasting: result on file '%s' \n", filerespop); */ | |
| /* fprintf(ficlog,"Computing forecasting: result on file '%s' \n", filerespop); */ | |
| if (cptcoveff==0) ncodemax[cptcoveff]=1; | /* if (cptcoveff==0) ncodemax[cptcoveff]=1; */ |
| if (mobilav!=0) { | /* /\* if (mobilav!=0) { *\/ */ |
| mobaverage= ma3x(1, AGESUP,1,NCOVMAX, 1,NCOVMAX); | /* /\* mobaverage= ma3x(1, AGESUP,1,NCOVMAX, 1,NCOVMAX); *\/ */ |
| if (movingaverage(probs, ageminpar, fage, mobaverage,mobilav)!=0){ | /* /\* if (movingaverage(probs, ageminpar, fage, mobaverage,mobilav)!=0){ *\/ */ |
| fprintf(ficlog," Error in movingaverage mobilav=%d\n",mobilav); | /* /\* fprintf(ficlog," Error in movingaverage mobilav=%d\n",mobilav); *\/ */ |
| printf(" Error in movingaverage mobilav=%d\n",mobilav); | /* /\* printf(" Error in movingaverage mobilav=%d\n",mobilav); *\/ */ |
| } | /* /\* } *\/ */ |
| } | /* /\* } *\/ */ |
| stepsize=(int) (stepm+YEARM-1)/YEARM; | /* stepsize=(int) (stepm+YEARM-1)/YEARM; */ |
| if (stepm<=12) stepsize=1; | /* if (stepm<=12) stepsize=1; */ |
| agelim=AGESUP; | |
| hstepm=1; | /* agelim=AGESUP; */ |
| hstepm=hstepm/stepm; | |
| if (popforecast==1) { | /* hstepm=1; */ |
| if((ficpop=fopen(popfile,"r"))==NULL) { | /* hstepm=hstepm/stepm; */ |
| printf("Problem with population file : %s\n",popfile);exit(0); | |
| fprintf(ficlog,"Problem with population file : %s\n",popfile);exit(0); | /* if (popforecast==1) { */ |
| } | /* if((ficpop=fopen(popfile,"r"))==NULL) { */ |
| popage=ivector(0,AGESUP); | /* printf("Problem with population file : %s\n",popfile);exit(0); */ |
| popeffectif=vector(0,AGESUP); | /* fprintf(ficlog,"Problem with population file : %s\n",popfile);exit(0); */ |
| popcount=vector(0,AGESUP); | /* } */ |
| /* popage=ivector(0,AGESUP); */ | |
| /* popeffectif=vector(0,AGESUP); */ | |
| /* popcount=vector(0,AGESUP); */ | |
| i=1; | /* i=1; */ |
| while ((c=fscanf(ficpop,"%d %lf\n",&popage[i],&popcount[i])) != EOF) i=i+1; | /* while ((c=fscanf(ficpop,"%d %lf\n",&popage[i],&popcount[i])) != EOF) i=i+1; */ |
| imx=i; | /* imx=i; */ |
| for (i=1; i<imx;i++) popeffectif[popage[i]]=popcount[i]; | /* for (i=1; i<imx;i++) popeffectif[popage[i]]=popcount[i]; */ |
| } | /* } */ |
| for(cptcov=1,k=0;cptcov<=i2;cptcov++){ | /* for(cptcov=1,k=0;cptcov<=i2;cptcov++){ */ |
| for(cptcod=1;cptcod<=ncodemax[cptcoveff];cptcod++){ | /* for(cptcod=1;cptcod<=ncodemax[cptcoveff];cptcod++){ */ |
| k=k+1; | /* k=k+1; */ |
| fprintf(ficrespop,"\n#******"); | /* fprintf(ficrespop,"\n#******"); */ |
| for(j=1;j<=cptcoveff;j++) { | /* for(j=1;j<=cptcoveff;j++) { */ |
| fprintf(ficrespop," V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); | /* fprintf(ficrespop," V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); */ |
| } | /* } */ |
| fprintf(ficrespop,"******\n"); | /* fprintf(ficrespop,"******\n"); */ |
| fprintf(ficrespop,"# Age"); | /* fprintf(ficrespop,"# Age"); */ |
| for(j=1; j<=nlstate+ndeath;j++) fprintf(ficrespop," P.%d",j); | /* for(j=1; j<=nlstate+ndeath;j++) fprintf(ficrespop," P.%d",j); */ |
| if (popforecast==1) fprintf(ficrespop," [Population]"); | /* if (popforecast==1) fprintf(ficrespop," [Population]"); */ |
| for (cpt=0; cpt<=0;cpt++) { | /* for (cpt=0; cpt<=0;cpt++) { */ |
| fprintf(ficrespop,"\n\n# Forecasting at date %.lf/%.lf/%.lf ",jpyram,mpyram,anpyram+cpt); | /* fprintf(ficrespop,"\n\n# Forecasting at date %.lf/%.lf/%.lf ",jpyram,mpyram,anpyram+cpt); */ |
| for (agedeb=(fage-((int)calagedatem %12/12.)); agedeb>=(ageminpar-((int)calagedatem %12)/12.); agedeb--){ | /* for (agedeb=(fage-((int)calagedatem %12/12.)); agedeb>=(ageminpar-((int)calagedatem %12)/12.); agedeb--){ */ |
| nhstepm=(int) rint((agelim-agedeb)*YEARM/stepm); | /* nhstepm=(int) rint((agelim-agedeb)*YEARM/stepm); */ |
| nhstepm = nhstepm/hstepm; | /* nhstepm = nhstepm/hstepm; */ |
| p3mat=ma3x(1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); | /* p3mat=ma3x(1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); */ |
| oldm=oldms;savm=savms; | /* oldm=oldms;savm=savms; */ |
| hpxij(p3mat,nhstepm,agedeb,hstepm,p,nlstate,stepm,oldm,savm, k); | /* hpxij(p3mat,nhstepm,agedeb,hstepm,p,nlstate,stepm,oldm,savm, k); */ |
| for (h=0; h<=nhstepm; h++){ | |
| if (h==(int) (calagedatem+YEARM*cpt)) { | |
| fprintf(ficrespop,"\n %3.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 (h==(int)(calagedatem+12*cpt)){ | |
| tabpop[(int)(agedeb)][j][cptcod]=kk1; | |
| /*fprintf(ficrespop," %.3f", kk1); | |
| if (popforecast==1) fprintf(ficrespop," [%.f]", kk1*popeffectif[(int)agedeb+1]);*/ | |
| } | |
| } | |
| for(i=1; i<=nlstate;i++){ | |
| kk1=0.; | |
| for(j=1; j<=nlstate;j++){ | |
| kk1= kk1+tabpop[(int)(agedeb)][j][cptcod]; | |
| } | |
| tabpopprev[(int)(agedeb)][i][cptcod]=tabpop[(int)(agedeb)][i][cptcod]/kk1*popeffectif[(int)(agedeb+(calagedatem+12*cpt)*hstepm/YEARM*stepm-1)]; | |
| } | |
| if (h==(int)(calagedatem+12*cpt)) for(j=1; j<=nlstate;j++) | |
| fprintf(ficrespop," %15.2f",tabpopprev[(int)(agedeb+1)][j][cptcod]); | |
| } | |
| free_ma3x(p3mat,1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); | |
| } | |
| } | |
| /******/ | |
| for (cpt=1; cpt<=(anpyram1-anpyram);cpt++) { | |
| fprintf(ficrespop,"\n\n# Forecasting at date %.lf/%.lf/%.lf ",jpyram,mpyram,anpyram+cpt); | |
| for (agedeb=(fage-((int)calagedatem %12/12.)); agedeb>=(ageminpar-((int)calagedatem %12)/12.); agedeb--){ | |
| nhstepm=(int) rint((agelim-agedeb)*YEARM/stepm); | |
| nhstepm = nhstepm/hstepm; | |
| p3mat=ma3x(1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); | /* for (h=0; h<=nhstepm; h++){ */ |
| oldm=oldms;savm=savms; | /* if (h==(int) (calagedatem+YEARM*cpt)) { */ |
| hpxij(p3mat,nhstepm,agedeb,hstepm,p,nlstate,stepm,oldm,savm, k); | /* fprintf(ficrespop,"\n %3.f ",agedeb+h*hstepm/YEARM*stepm); */ |
| for (h=0; h<=nhstepm; h++){ | /* } */ |
| if (h==(int) (calagedatem+YEARM*cpt)) { | /* for(j=1; j<=nlstate+ndeath;j++) { */ |
| fprintf(ficresf,"\n %3.f ",agedeb+h*hstepm/YEARM*stepm); | /* kk1=0.;kk2=0; */ |
| } | /* for(i=1; i<=nlstate;i++) { */ |
| for(j=1; j<=nlstate+ndeath;j++) { | /* if (mobilav==1) */ |
| kk1=0.;kk2=0; | /* kk1=kk1+p3mat[i][j][h]*mobaverage[(int)agedeb+1][i][cptcod]; */ |
| for(i=1; i<=nlstate;i++) { | /* else { */ |
| kk1=kk1+p3mat[i][j][h]*tabpopprev[(int)agedeb+1][i][cptcod]; | /* kk1=kk1+p3mat[i][j][h]*probs[(int)(agedeb+1)][i][cptcod]; */ |
| } | /* } */ |
| if (h==(int)(calagedatem+12*cpt)) fprintf(ficresf," %15.2f", kk1); | /* } */ |
| } | /* if (h==(int)(calagedatem+12*cpt)){ */ |
| } | /* tabpop[(int)(agedeb)][j][cptcod]=kk1; */ |
| free_ma3x(p3mat,1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); | /* /\*fprintf(ficrespop," %.3f", kk1); */ |
| } | /* if (popforecast==1) fprintf(ficrespop," [%.f]", kk1*popeffectif[(int)agedeb+1]);*\/ */ |
| } | /* } */ |
| } | /* } */ |
| } | /* for(i=1; i<=nlstate;i++){ */ |
| /* kk1=0.; */ | |
| /* for(j=1; j<=nlstate;j++){ */ | |
| /* kk1= kk1+tabpop[(int)(agedeb)][j][cptcod]; */ | |
| /* } */ | |
| /* tabpopprev[(int)(agedeb)][i][cptcod]=tabpop[(int)(agedeb)][i][cptcod]/kk1*popeffectif[(int)(agedeb+(calagedatem+12*cpt)*hstepm/YEARM*stepm-1)]; */ | |
| /* } */ | |
| /* if (h==(int)(calagedatem+12*cpt)) */ | |
| /* for(j=1; j<=nlstate;j++) */ | |
| /* fprintf(ficrespop," %15.2f",tabpopprev[(int)(agedeb+1)][j][cptcod]); */ | |
| /* } */ | |
| /* free_ma3x(p3mat,1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); */ | |
| /* } */ | |
| /* } */ | |
| /* /\******\/ */ | |
| /* for (cpt=1; cpt<=(anpyram1-anpyram);cpt++) { */ | |
| /* fprintf(ficrespop,"\n\n# Forecasting at date %.lf/%.lf/%.lf ",jpyram,mpyram,anpyram+cpt); */ | |
| /* for (agedeb=(fage-((int)calagedatem %12/12.)); agedeb>=(ageminpar-((int)calagedatem %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) (calagedatem+YEARM*cpt)) { */ | |
| /* fprintf(ficresf,"\n %3.f ",agedeb+h*hstepm/YEARM*stepm); */ | |
| /* } */ | |
| /* for(j=1; j<=nlstate+ndeath;j++) { */ | |
| /* kk1=0.;kk2=0; */ | |
| /* for(i=1; i<=nlstate;i++) { */ | |
| /* kk1=kk1+p3mat[i][j][h]*tabpopprev[(int)agedeb+1][i][cptcod]; */ | |
| /* } */ | |
| /* if (h==(int)(calagedatem+12*cpt)) fprintf(ficresf," %15.2f", kk1); */ | |
| /* } */ | |
| /* } */ | |
| /* free_ma3x(p3mat,1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); */ | |
| /* } */ | |
| /* } */ | |
| /* } */ | |
| /* } */ | |
| /* /\* if (mobilav!=0) 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_ma3x(tabpop,1, AGESUP,1,NCOVMAX, 1,NCOVMAX); */ | |
| /* free_ma3x(tabpopprev,1, AGESUP,1,NCOVMAX, 1,NCOVMAX); */ | |
| /* fclose(ficrespop); */ | |
| /* } /\* End of popforecast *\/ */ | |
| if (mobilav!=0) 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_ma3x(tabpop,1, AGESUP,1,NCOVMAX, 1,NCOVMAX); | |
| free_ma3x(tabpopprev,1, AGESUP,1,NCOVMAX, 1,NCOVMAX); | |
| fclose(ficrespop); | |
| } /* End of popforecast */ | |
| int fileappend(FILE *fichier, char *optionfich) | int fileappend(FILE *fichier, char *optionfich) |
| { | { |
| if((fichier=fopen(optionfich,"a"))==NULL) { | if((fichier=fopen(optionfich,"a"))==NULL) { |
| Line 6641 double gompertz(double x[]) | Line 7364 double gompertz(double x[]) |
| double A,B,L=0.0,sump=0.,num=0.; | double A,B,L=0.0,sump=0.,num=0.; |
| int i,n=0; /* n is the size of the sample */ | int i,n=0; /* n is the size of the sample */ |
| for (i=0;i<=imx-1 ; i++) { | for (i=1;i<=imx ; i++) { |
| sump=sump+weight[i]; | sump=sump+weight[i]; |
| /* sump=sump+1;*/ | /* sump=sump+1;*/ |
| num=num+1; | num=num+1; |
| Line 6766 int readdata(char datafile[], int firsto | Line 7489 int readdata(char datafile[], int firsto |
| /*-------- data file ----------*/ | /*-------- data file ----------*/ |
| FILE *fic; | FILE *fic; |
| char dummy[]=" "; | char dummy[]=" "; |
| int i=0, j=0, n=0; | int i=0, j=0, n=0, iv=0; |
| int lstra; | |
| int linei, month, year,iout; | int linei, month, year,iout; |
| char line[MAXLINE], linetmp[MAXLINE]; | char line[MAXLINE], linetmp[MAXLINE]; |
| char stra[MAXLINE], strb[MAXLINE]; | char stra[MAXLINE], strb[MAXLINE]; |
| char *stratrunc; | char *stratrunc; |
| int lstra; | |
| if((fic=fopen(datafile,"r"))==NULL) { | if((fic=fopen(datafile,"r"))==NULL) { |
| printf("Problem while opening datafile: %s\n", datafile);fflush(stdout); | printf("Problem while opening datafile: %s with errno='%s'\n", datafile,strerror(errno));fflush(stdout); |
| fprintf(ficlog,"Problem while opening datafile: %s\n", datafile);fflush(ficlog);return 1; | fprintf(ficlog,"Problem while opening datafile: %s with errno='%s'\n", datafile,strerror(errno));fflush(ficlog);return 1; |
| } | } |
| i=1; | i=1; |
| Line 6798 int readdata(char datafile[], int firsto | Line 7522 int readdata(char datafile[], int firsto |
| } | } |
| trimbb(linetmp,line); /* Trims multiple blanks in line */ | trimbb(linetmp,line); /* Trims multiple blanks in line */ |
| strcpy(line, linetmp); | strcpy(line, linetmp); |
| /* Loops on waves */ | |
| for (j=maxwav;j>=1;j--){ | for (j=maxwav;j>=1;j--){ |
| for (iv=nqtv;iv>=1;iv--){ /* Loop on time varying quantitative variables */ | |
| cutv(stra, strb, line, ' '); | |
| if(strb[0]=='.') { /* Missing value */ | |
| lval=-1; | |
| cotqvar[j][iv][i]=-1; /* 0.0/0.0 */ | |
| if(isalpha(strb[1])) { /* .m or .d Really Missing value */ | |
| printf("Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be the %d th quantitative value out of %d measured at wave %d. If missing, you should remove this individual or impute a value. Exiting.\n", strb, linei,i,line,iv, nqtv, j); | |
| fprintf(ficlog,"Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be the %d th quantitative value out of %d measured at wave %d. If missing, you should remove this individual or impute a value. Exiting.\n", strb, linei,i,line,iv, nqtv, j);fflush(ficlog); | |
| return 1; | |
| } | |
| }else{ | |
| errno=0; | |
| /* what_kind_of_number(strb); */ | |
| dval=strtod(strb,&endptr); | |
| /* if( strb[0]=='\0' || (*endptr != '\0')){ */ | |
| /* if(strb != endptr && *endptr == '\0') */ | |
| /* dval=dlval; */ | |
| /* if (errno == ERANGE && (lval == LONG_MAX || lval == LONG_MIN)) */ | |
| if( strb[0]=='\0' || (*endptr != '\0')){ | |
| printf("Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be the %d th quantitative value out of %d measured at wave %d. Setting maxwav=%d might be wrong. Exiting.\n", strb, linei,i,line,iv, nqtv, j,maxwav); | |
| fprintf(ficlog,"Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be the %d th quantitative value out of %d measured at wave %d. Setting maxwav=%d might be wrong. Exiting.\n", strb, linei,i,line, iv, nqtv, j,maxwav);fflush(ficlog); | |
| return 1; | |
| } | |
| cotqvar[j][iv][i]=dval; | |
| } | |
| strcpy(line,stra); | |
| }/* end loop ntqv */ | |
| for (iv=ntv;iv>=1;iv--){ /* Loop on time varying dummies */ | |
| cutv(stra, strb, line, ' '); | |
| if(strb[0]=='.') { /* Missing value */ | |
| lval=-1; | |
| }else{ | |
| errno=0; | |
| lval=strtol(strb,&endptr,10); | |
| /* if (errno == ERANGE && (lval == LONG_MAX || lval == LONG_MIN))*/ | |
| if( strb[0]=='\0' || (*endptr != '\0')){ | |
| printf("Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be the %d th dummy covariate out of %d measured at wave %d. Setting maxwav=%d might be wrong. Exiting.\n", strb, linei,i,line,iv, ntv, j,maxwav); | |
| fprintf(ficlog,"Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be the %d dummy covariate out of %d measured wave %d. Setting maxwav=%d might be wrong. Exiting.\n", strb, linei,i,line,iv, ntv,j,maxwav);fflush(ficlog); | |
| return 1; | |
| } | |
| } | |
| if(lval <-1 || lval >1){ | |
| printf("Error reading data around '%ld' at line number %d for individual %d, '%s'\n \ | |
| Should be a value of %d(nth) covariate (0 should be the value for the reference and 1\n \ | |
| for the alternative. IMaCh does not build design variables automatically, do it yourself.\n \ | |
| For example, for multinomial values like 1, 2 and 3,\n \ | |
| build V1=0 V2=0 for the reference value (1),\n \ | |
| V1=1 V2=0 for (2) \n \ | |
| and V1=0 V2=1 for (3). V1=1 V2=1 should not exist and the corresponding\n \ | |
| output of IMaCh is often meaningless.\n \ | |
| Exiting.\n",lval,linei, i,line,j); | |
| fprintf(ficlog,"Error reading data around '%ld' at line number %d for individual %d, '%s'\n \ | |
| Should be a value of %d(nth) covariate (0 should be the value for the reference and 1\n \ | |
| for the alternative. IMaCh does not build design variables automatically, do it yourself.\n \ | |
| For example, for multinomial values like 1, 2 and 3,\n \ | |
| build V1=0 V2=0 for the reference value (1),\n \ | |
| V1=1 V2=0 for (2) \n \ | |
| and V1=0 V2=1 for (3). V1=1 V2=1 should not exist and the corresponding\n \ | |
| output of IMaCh is often meaningless.\n \ | |
| Exiting.\n",lval,linei, i,line,j);fflush(ficlog); | |
| return 1; | |
| } | |
| cotvar[j][iv][i]=(double)(lval); | |
| strcpy(line,stra); | |
| }/* end loop ntv */ | |
| /* Statuses at wave */ | |
| cutv(stra, strb, line, ' '); | cutv(stra, strb, line, ' '); |
| if(strb[0]=='.') { /* Missing status */ | if(strb[0]=='.') { /* Missing value */ |
| lval=-1; | lval=-1; |
| }else{ | }else{ |
| errno=0; | errno=0; |
| lval=strtol(strb,&endptr,10); | lval=strtol(strb,&endptr,10); |
| /* if (errno == ERANGE && (lval == LONG_MAX || lval == LONG_MIN))*/ | /* if (errno == ERANGE && (lval == LONG_MAX || lval == LONG_MIN))*/ |
| if( strb[0]=='\0' || (*endptr != '\0')){ | if( strb[0]=='\0' || (*endptr != '\0')){ |
| printf("Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a status of wave %d. Setting maxwav=%d might be wrong. Exiting.\n", strb, linei,i,line,j,maxwav); | printf("Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a status of wave %d. Setting maxwav=%d might be wrong. Exiting.\n", strb, linei,i,line,j,maxwav); |
| fprintf(ficlog,"Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a status of wave %d. Setting maxwav=%d might be wrong. Exiting.\n", strb, linei,i,line,j,maxwav);fflush(ficlog); | fprintf(ficlog,"Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a status of wave %d. Setting maxwav=%d might be wrong. Exiting.\n", strb, linei,i,line,j,maxwav);fflush(ficlog); |
| return 1; | return 1; |
| } | } |
| } | } |
| s[j][i]=lval; | s[j][i]=lval; |
| /* Date of Interview */ | |
| strcpy(line,stra); | strcpy(line,stra); |
| cutv(stra, strb,line,' '); | cutv(stra, strb,line,' '); |
| if( (iout=sscanf(strb,"%d/%d",&month, &year)) != 0){ | if( (iout=sscanf(strb,"%d/%d",&month, &year)) != 0){ |
| Line 6831 int readdata(char datafile[], int firsto | Line 7625 int readdata(char datafile[], int firsto |
| anint[j][i]= (double) year; | anint[j][i]= (double) year; |
| mint[j][i]= (double)month; | mint[j][i]= (double)month; |
| strcpy(line,stra); | strcpy(line,stra); |
| } /* ENd Waves */ | } /* End loop on waves */ |
| /* Date of death */ | |
| cutv(stra, strb,line,' '); | cutv(stra, strb,line,' '); |
| if( (iout=sscanf(strb,"%d/%d",&month, &year)) != 0){ | if( (iout=sscanf(strb,"%d/%d",&month, &year)) != 0){ |
| } | } |
| Line 6841 int readdata(char datafile[], int firsto | Line 7636 int readdata(char datafile[], int firsto |
| year=9999; | year=9999; |
| }else{ | }else{ |
| printf("Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a date of death (mm/yyyy or .). Exiting.\n",strb, linei,i,line); | printf("Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a date of death (mm/yyyy or .). Exiting.\n",strb, linei,i,line); |
| fprintf(ficlog,"Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a date of death (mm/yyyy or .). Exiting.\n",strb, linei,i,line);fflush(ficlog); | fprintf(ficlog,"Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a date of death (mm/yyyy or .). Exiting.\n",strb, linei,i,line);fflush(ficlog); |
| return 1; | return 1; |
| } | } |
| andc[i]=(double) year; | andc[i]=(double) year; |
| moisdc[i]=(double) month; | moisdc[i]=(double) month; |
| strcpy(line,stra); | strcpy(line,stra); |
| /* Date of birth */ | |
| cutv(stra, strb,line,' '); | cutv(stra, strb,line,' '); |
| if( (iout=sscanf(strb,"%d/%d",&month, &year)) != 0){ | if( (iout=sscanf(strb,"%d/%d",&month, &year)) != 0){ |
| } | } |
| Line 6857 int readdata(char datafile[], int firsto | Line 7653 int readdata(char datafile[], int firsto |
| }else{ | }else{ |
| printf("Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a date of birth (mm/yyyy or .). Exiting.\n",strb, linei,i,line); | printf("Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a date of birth (mm/yyyy or .). Exiting.\n",strb, linei,i,line); |
| fprintf(ficlog,"Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a date of birth (mm/yyyy or .). Exiting.\n",strb, linei,i,line);fflush(ficlog); | fprintf(ficlog,"Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a date of birth (mm/yyyy or .). Exiting.\n",strb, linei,i,line);fflush(ficlog); |
| return 1; | return 1; |
| } | } |
| if (year==9999) { | if (year==9999) { |
| printf("Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a date of birth (mm/yyyy) but at least the year of birth should be given. Exiting.\n",strb, linei,i,line); | printf("Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a date of birth (mm/yyyy) but at least the year of birth should be given. Exiting.\n",strb, linei,i,line); |
| fprintf(ficlog,"Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a date of birth (mm/yyyy) but at least the year of birth should be given. Exiting.\n",strb, linei,i,line);fflush(ficlog); | fprintf(ficlog,"Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a date of birth (mm/yyyy) but at least the year of birth should be given. Exiting.\n",strb, linei,i,line);fflush(ficlog); |
| return 1; | return 1; |
| } | } |
| annais[i]=(double)(year); | annais[i]=(double)(year); |
| moisnais[i]=(double)(month); | moisnais[i]=(double)(month); |
| strcpy(line,stra); | strcpy(line,stra); |
| /* Sample weight */ | |
| cutv(stra, strb,line,' '); | cutv(stra, strb,line,' '); |
| errno=0; | errno=0; |
| dval=strtod(strb,&endptr); | dval=strtod(strb,&endptr); |
| Line 6881 int readdata(char datafile[], int firsto | Line 7678 int readdata(char datafile[], int firsto |
| weight[i]=dval; | weight[i]=dval; |
| strcpy(line,stra); | strcpy(line,stra); |
| for (iv=nqv;iv>=1;iv--){ /* Loop on fixed quantitative variables */ | |
| cutv(stra, strb, line, ' '); | |
| if(strb[0]=='.') { /* Missing value */ | |
| lval=-1; | |
| }else{ | |
| errno=0; | |
| /* what_kind_of_number(strb); */ | |
| dval=strtod(strb,&endptr); | |
| /* if(strb != endptr && *endptr == '\0') */ | |
| /* dval=dlval; */ | |
| /* if (errno == ERANGE && (lval == LONG_MAX || lval == LONG_MIN)) */ | |
| if( strb[0]=='\0' || (*endptr != '\0')){ | |
| printf("Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be the %d th quantitative value (out of %d) constant for all waves. Setting maxwav=%d might be wrong. Exiting.\n", strb, linei,i,line, iv, nqv, maxwav); | |
| fprintf(ficlog,"Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be the %d th quantitative value (out of %d) constant for all waves. Setting maxwav=%d might be wrong. Exiting.\n", strb, linei,i,line, iv, nqv, maxwav);fflush(ficlog); | |
| return 1; | |
| } | |
| coqvar[iv][i]=dval; | |
| covar[ncovcol+iv][i]=dval; /* including qvar in standard covar for performance reasons */ | |
| } | |
| strcpy(line,stra); | |
| }/* end loop nqv */ | |
| /* Covariate values */ | |
| for (j=ncovcol;j>=1;j--){ | for (j=ncovcol;j>=1;j--){ |
| cutv(stra, strb,line,' '); | cutv(stra, strb,line,' '); |
| if(strb[0]=='.') { /* Missing status */ | if(strb[0]=='.') { /* Missing covariate value */ |
| lval=-1; | lval=-1; |
| }else{ | }else{ |
| errno=0; | errno=0; |
| Line 6898 int readdata(char datafile[], int firsto | Line 7718 int readdata(char datafile[], int firsto |
| printf("Error reading data around '%ld' at line number %d for individual %d, '%s'\n \ | printf("Error reading data around '%ld' at line number %d for individual %d, '%s'\n \ |
| Should be a value of %d(nth) covariate (0 should be the value for the reference and 1\n \ | Should be a value of %d(nth) covariate (0 should be the value for the reference and 1\n \ |
| for the alternative. IMaCh does not build design variables automatically, do it yourself.\n \ | for the alternative. IMaCh does not build design variables automatically, do it yourself.\n \ |
| For example, for multinomial values like 1, 2 and 3,\n \ | For example, for multinomial values like 1, 2 and 3,\n \ |
| build V1=0 V2=0 for the reference value (1),\n \ | build V1=0 V2=0 for the reference value (1),\n \ |
| V1=1 V2=0 for (2) \n \ | V1=1 V2=0 for (2) \n \ |
| and V1=0 V2=1 for (3). V1=1 V2=1 should not exist and the corresponding\n \ | and V1=0 V2=1 for (3). V1=1 V2=1 should not exist and the corresponding\n \ |
| output of IMaCh is often meaningless.\n \ | output of IMaCh is often meaningless.\n \ |
| Exiting.\n",lval,linei, i,line,j); | Exiting.\n",lval,linei, i,line,j); |
| fprintf(ficlog,"Error reading data around '%ld' at line number %d for individual %d, '%s'\n \ | fprintf(ficlog,"Error reading data around '%ld' at line number %d for individual %d, '%s'\n \ |
| Should be a value of %d(nth) covariate (0 should be the value for the reference and 1\n \ | Should be a value of %d(nth) covariate (0 should be the value for the reference and 1\n \ |
| for the alternative. IMaCh does not build design variables automatically, do it yourself.\n \ | for the alternative. IMaCh does not build design variables automatically, do it yourself.\n \ |
| For example, for multinomial values like 1, 2 and 3,\n \ | For example, for multinomial values like 1, 2 and 3,\n \ |
| build V1=0 V2=0 for the reference value (1),\n \ | build V1=0 V2=0 for the reference value (1),\n \ |
| V1=1 V2=0 for (2) \n \ | V1=1 V2=0 for (2) \n \ |
| and V1=0 V2=1 for (3). V1=1 V2=1 should not exist and the corresponding\n \ | and V1=0 V2=1 for (3). V1=1 V2=1 should not exist and the corresponding\n \ |
| output of IMaCh is often meaningless.\n \ | output of IMaCh is often meaningless.\n \ |
| Exiting.\n",lval,linei, i,line,j);fflush(ficlog); | Exiting.\n",lval,linei, i,line,j);fflush(ficlog); |
| return 1; | return 1; |
| } | } |
| Line 6919 int readdata(char datafile[], int firsto | Line 7739 int readdata(char datafile[], int firsto |
| strcpy(line,stra); | strcpy(line,stra); |
| } | } |
| lstra=strlen(stra); | lstra=strlen(stra); |
| if(lstra > 9){ /* More than 2**32 or max of what printf can write with %ld */ | if(lstra > 9){ /* More than 2**32 or max of what printf can write with %ld */ |
| stratrunc = &(stra[lstra-9]); | stratrunc = &(stra[lstra-9]); |
| num[i]=atol(stratrunc); | num[i]=atol(stratrunc); |
| Line 6931 int readdata(char datafile[], int firsto | Line 7751 int readdata(char datafile[], int firsto |
| i=i+1; | i=i+1; |
| } /* End loop reading data */ | } /* End loop reading data */ |
| *imax=i-1; /* Number of individuals */ | *imax=i-1; /* Number of individuals */ |
| fclose(fic); | fclose(fic); |
| return (0); | return (0); |
| /* endread: */ | /* endread: */ |
| printf("Exiting readdata: "); | printf("Exiting readdata: "); |
| fclose(fic); | fclose(fic); |
| return (1); | return (1); |
| } | } |
| void removespace(char *str) { | void removespace(char *str) { |
| char *p1 = str, *p2 = str; | char *p1 = str, *p2 = str; |
| do | do |
| Line 6952 void removespace(char *str) { | Line 7770 void removespace(char *str) { |
| while (*p1++ == *p2++); | while (*p1++ == *p2++); |
| } | } |
| int decodemodel ( char model[], int lastobs) /**< This routine decode the model and returns: | int decodemodel ( char model[], int lastobs) |
| * Model V1+V2+V3+V8+V7*V8+V5*V6+V8*age+V3*age+age*age | /**< This routine decode the model and returns: |
| * - nagesqr = 1 if age*age in the model, otherwise 0. | * Model V1+V2+V3+V8+V7*V8+V5*V6+V8*age+V3*age+age*age |
| * - cptcovt total number of covariates of the model nbocc(+)+1 = 8 excepting constant and age and age*age | * - nagesqr = 1 if age*age in the model, otherwise 0. |
| * - cptcovn or number of covariates k of the models excluding age*products =6 and age*age | * - cptcovt total number of covariates of the model nbocc(+)+1 = 8 excepting constant and age and age*age |
| * - cptcovage number of covariates with age*products =2 | * - cptcovn or number of covariates k of the models excluding age*products =6 and age*age |
| * - cptcovs number of simple covariates | * - cptcovage number of covariates with age*products =2 |
| * - Tvar[k] is the id of the kth covariate Tvar[1]@12 {1, 2, 3, 8, 10, 11, 8, 3, 7, 8, 5, 6}, thus Tvar[5=V7*V8]=10 | * - cptcovs number of simple covariates |
| * which is a new column after the 9 (ncovcol) variables. | * - Tvar[k] is the id of the kth covariate Tvar[1]@12 {1, 2, 3, 8, 10, 11, 8, 3, 7, 8, 5, 6}, thus Tvar[5=V7*V8]=10 |
| * - if k is a product Vn*Vm covar[k][i] is filled with correct values for each individual | * which is a new column after the 9 (ncovcol) variables. |
| * - Tprod[l] gives the kth covariates of the product Vn*Vm l=1 to cptcovprod-cptcovage | * - if k is a product Vn*Vm covar[k][i] is filled with correct values for each individual |
| * Tprod[1]@2 {5, 6}: position of first product V7*V8 is 5, and second V5*V6 is 6. | * - Tprod[l] gives the kth covariates of the product Vn*Vm l=1 to cptcovprod-cptcovage |
| * - Tvard[k] p Tvard[1][1]@4 {7, 8, 5, 6} for V7*V8 and V5*V6 . | * Tprod[1]@2 {5, 6}: position of first product V7*V8 is 5, and second V5*V6 is 6. |
| */ | * - Tvard[k] p Tvard[1][1]@4 {7, 8, 5, 6} for V7*V8 and V5*V6 . |
| */ | |
| { | { |
| int i, j, k, ks; | int i, j, k, ks; |
| int j1, k1, k2; | int j1, k1, k2, k3, k4; |
| char modelsav[80]; | char modelsav[80]; |
| char stra[80], strb[80], strc[80], strd[80],stre[80]; | char stra[80], strb[80], strc[80], strd[80],stre[80]; |
| char *strpt; | char *strpt; |
| Line 6990 int decodemodel ( char model[], int last | Line 7809 int decodemodel ( char model[], int last |
| if ((strpt=strstr(model,"age*age")) !=0){ | if ((strpt=strstr(model,"age*age")) !=0){ |
| printf(" strpt=%s, model=%s\n",strpt, model); | printf(" strpt=%s, model=%s\n",strpt, model); |
| if(strpt != model){ | if(strpt != model){ |
| printf("Error in model: 'model=%s'; 'age*age' should in first place before other covariates\n \ | printf("Error in model: 'model=%s'; 'age*age' should in first place before other covariates\n \ |
| 'model=1+age+age*age+V1.' or 'model=1+age+age*age+V1+V1*age.', please swap as well as \n \ | 'model=1+age+age*age+V1.' or 'model=1+age+age*age+V1+V1*age.', please swap as well as \n \ |
| corresponding column of parameters.\n",model); | corresponding column of parameters.\n",model); |
| fprintf(ficlog,"Error in model: 'model=%s'; 'age*age' should in first place before other covariates\n \ | fprintf(ficlog,"Error in model: 'model=%s'; 'age*age' should in first place before other covariates\n \ |
| 'model=1+age+age*age+V1.' or 'model=1+age+age*age+V1+V1*age.', please swap as well as \n \ | 'model=1+age+age*age+V1.' or 'model=1+age+age*age+V1+V1*age.', please swap as well as \n \ |
| corresponding column of parameters.\n",model); fflush(ficlog); | corresponding column of parameters.\n",model); fflush(ficlog); |
| return 1; | return 1; |
| } | } |
| nagesqr=1; | nagesqr=1; |
| if (strstr(model,"+age*age") !=0) | if (strstr(model,"+age*age") !=0) |
| substrchaine(modelsav, model, "+age*age"); | substrchaine(modelsav, model, "+age*age"); |
| Line 7011 int decodemodel ( char model[], int last | Line 7829 int decodemodel ( char model[], int last |
| if (strlen(modelsav) >1){ | if (strlen(modelsav) >1){ |
| j=nbocc(modelsav,'+'); /**< j=Number of '+' */ | j=nbocc(modelsav,'+'); /**< j=Number of '+' */ |
| j1=nbocc(modelsav,'*'); /**< j1=Number of '*' */ | j1=nbocc(modelsav,'*'); /**< j1=Number of '*' */ |
| cptcovs=j+1-j1; /**< Number of simple covariates V1+V1*age+V3 +V3*V4+age*age=> V1 + V3 =2 */ | cptcovs=j+1-j1; /**< Number of simple covariates V1+V1*age+V3 +V3*V4+age*age=> V1 + V3 =5-3=2 */ |
| cptcovt= j+1; /* Number of total covariates in the model, not including | cptcovt= j+1; /* Number of total covariates in the model, not including |
| * cst, age and age*age | * cst, age and age*age |
| * V1+V1*age+ V3 + V3*V4+age*age=> 4*/ | * V1+V1*age+ V3 + V3*V4+age*age=> 3+1=4*/ |
| /* including age products which are counted in cptcovage. | /* including age products which are counted in cptcovage. |
| * but the covariates which are products must be treated | * but the covariates which are products must be treated |
| * separately: ncovn=4- 2=2 (V1+V3). */ | * separately: ncovn=4- 2=2 (V1+V3). */ |
| cptcovprod=j1; /**< Number of products V1*V2 +v3*age = 2 */ | cptcovprod=j1; /**< Number of products V1*V2 +v3*age = 2 */ |
| cptcovprodnoage=0; /**< Number of covariate products without age: V3*V4 =1 */ | cptcovprodnoage=0; /**< Number of covariate products without age: V3*V4 =1 */ |
| /* Design | /* Design |
| * V1 V2 V3 V4 V5 V6 V7 V8 V9 Weight | * V1 V2 V3 V4 V5 V6 V7 V8 V9 Weight |
| * < ncovcol=8 > | * < ncovcol=8 > |
| Line 7029 int decodemodel ( char model[], int last | Line 7847 int decodemodel ( char model[], int last |
| * k= 1 2 3 4 5 6 7 8 | * k= 1 2 3 4 5 6 7 8 |
| * cptcovn number of covariates (not including constant and age ) = # of + plus 1 = 7+1=8 | * cptcovn number of covariates (not including constant and age ) = # of + plus 1 = 7+1=8 |
| * covar[k,i], value of kth covariate if not including age for individual i: | * covar[k,i], value of kth covariate if not including age for individual i: |
| * covar[1][i]= (V2), covar[4][i]=(V3), covar[8][i]=(V8) | * covar[1][i]= (V1), covar[4][i]=(V4), covar[8][i]=(V8) |
| * Tvar[k] # of the kth covariate: Tvar[1]=2 Tvar[4]=3 Tvar[8]=8 | * Tvar[k] # of the kth covariate: Tvar[1]=2 Tvar[2]=1 Tvar[4]=3 Tvar[8]=8 |
| * if multiplied by age: V3*age Tvar[3=V3*age]=3 (V3) Tvar[7]=8 and | * if multiplied by age: V3*age Tvar[3=V3*age]=3 (V3) Tvar[7]=8 and |
| * Tage[++cptcovage]=k | * Tage[++cptcovage]=k |
| * if products, new covar are created after ncovcol with k1 | * if products, new covar are created after ncovcol with k1 |
| Line 7055 int decodemodel ( char model[], int last | Line 7873 int decodemodel ( char model[], int last |
| * {2, 1, 4, 8, 5, 6, 3, 7} | * {2, 1, 4, 8, 5, 6, 3, 7} |
| * Struct [] | * Struct [] |
| */ | */ |
| /* This loop fills the array Tvar from the string 'model'.*/ | /* This loop fills the array Tvar from the string 'model'.*/ |
| /* j is the number of + signs in the model V1+V2+V3 j=2 i=3 to 1 */ | /* j is the number of + signs in the model V1+V2+V3 j=2 i=3 to 1 */ |
| /* modelsav=V2+V1+V4+age*V3 strb=age*V3 stra=V2+V1+V4 */ | /* modelsav=V2+V1+V4+age*V3 strb=age*V3 stra=V2+V1+V4 */ |
| Line 7070 int decodemodel ( char model[], int last | Line 7888 int decodemodel ( char model[], int last |
| /* for (k=1; k<=cptcovage;k++) cov[2+Tage[k]]=nbcode[Tvar[Tage[k]]][codtabm(ij,Tvar[Tage[k])]]*cov[2]; */ | /* for (k=1; k<=cptcovage;k++) cov[2+Tage[k]]=nbcode[Tvar[Tage[k]]][codtabm(ij,Tvar[Tage[k])]]*cov[2]; */ |
| /* | /* |
| * Treating invertedly V2+V1+V3*age+V2*V4 is as if written V2*V4 +V3*age + V1 + V2 */ | * Treating invertedly V2+V1+V3*age+V2*V4 is as if written V2*V4 +V3*age + V1 + V2 */ |
| for(k=cptcovt; k>=1;k--) /**< Number of covariates */ | for(k=cptcovt; k>=1;k--){ /**< Number of covariates not including constant and age, neither age*age*/ |
| Tvar[k]=0; | Tvar[k]=0; Tprod[k]=0; Tposprod[k]=0; |
| } | |
| cptcovage=0; | cptcovage=0; |
| for(k=1; k<=cptcovt;k++){ /* Loop on total covariates of the model */ | for(k=1; k<=cptcovt;k++){ /* Loop on total covariates of the model */ |
| cutl(stra,strb,modelsav,'+'); /* keeps in strb after the first '+' | cutl(stra,strb,modelsav,'+'); /* keeps in strb after the first '+' |
| Line 7086 int decodemodel ( char model[], int last | Line 7905 int decodemodel ( char model[], int last |
| cptcovprod--; | cptcovprod--; |
| cutl(stre,strb,strd,'V'); /* strd=V3(input): stre="3" */ | cutl(stre,strb,strd,'V'); /* strd=V3(input): stre="3" */ |
| Tvar[k]=atoi(stre); /* V2+V1+V4+V3*age Tvar[4]=3 ; V1+V2*age Tvar[2]=2; V1+V1*age Tvar[2]=1 */ | Tvar[k]=atoi(stre); /* V2+V1+V4+V3*age Tvar[4]=3 ; V1+V2*age Tvar[2]=2; V1+V1*age Tvar[2]=1 */ |
| Typevar[k]=1; /* 1 for age product */ | |
| cptcovage++; /* Sums the number of covariates which include age as a product */ | cptcovage++; /* Sums the number of covariates which include age as a product */ |
| Tage[cptcovage]=k; /* Tvar[4]=3, Tage[1] = 4 or V1+V1*age Tvar[2]=1, Tage[1]=2 */ | Tage[cptcovage]=k; /* Tvar[4]=3, Tage[1] = 4 or V1+V1*age Tvar[2]=1, Tage[1]=2 */ |
| /*printf("stre=%s ", stre);*/ | /*printf("stre=%s ", stre);*/ |
| Line 7093 int decodemodel ( char model[], int last | Line 7913 int decodemodel ( char model[], int last |
| cptcovprod--; | cptcovprod--; |
| cutl(stre,strb,strc,'V'); | cutl(stre,strb,strc,'V'); |
| Tvar[k]=atoi(stre); | Tvar[k]=atoi(stre); |
| Typevar[k]=1; /* 1 for age product */ | |
| cptcovage++; | cptcovage++; |
| Tage[cptcovage]=k; | Tage[cptcovage]=k; |
| } else { /* Age is not in the model product V2+V1+V1*V4+V3*age+V3*V2 strb=V3*V2*/ | } else { /* Age is not in the model product V2+V1+V1*V4+V3*age+V3*V2 strb=V3*V2*/ |
| Line 7100 int decodemodel ( char model[], int last | Line 7921 int decodemodel ( char model[], int last |
| cptcovn++; | cptcovn++; |
| cptcovprodnoage++;k1++; | cptcovprodnoage++;k1++; |
| cutl(stre,strb,strc,'V'); /* strc= Vn, stre is n; strb=V3*V2 stre=3 strc=*/ | cutl(stre,strb,strc,'V'); /* strc= Vn, stre is n; strb=V3*V2 stre=3 strc=*/ |
| Tvar[k]=ncovcol+k1; /* For model-covariate k tells which data-covariate to use but | Tvar[k]=ncovcol+nqv+ntv+nqtv+k1; /* For model-covariate k tells which data-covariate to use but |
| because this model-covariate is a construction we invent a new column | because this model-covariate is a construction we invent a new column |
| ncovcol + k1 | which is after existing variables ncovcol+nqv+ntv+nqtv + k1 |
| If already ncovcol=4 and model=V2+V1+V1*V4+age*V3+V3*V2 | If already ncovcol=4 and model=V2+V1+V1*V4+age*V3+V3*V2 |
| Tvar[3=V1*V4]=4+1 Tvar[5=V3*V2]=4 + 2= 6, etc */ | Tvar[3=V1*V4]=4+1 Tvar[5=V3*V2]=4 + 2= 6, etc */ |
| Typevar[k]=2; /* 2 for double fixed dummy covariates */ | |
| cutl(strc,strb,strd,'V'); /* strd was Vm, strc is m */ | cutl(strc,strb,strd,'V'); /* strd was Vm, strc is m */ |
| Tprod[k1]=k; /* Tprod[1]=3(=V1*V4) for V2+V1+V1*V4+age*V3+V3*V2 */ | Tprod[k1]=k; /* Tprod[1]=3(=V1*V4) for V2+V1+V1*V4+age*V3+V3*V2 */ |
| Tposprod[k]=k1; /* Tpsprod[3]=1, Tposprod[2]=5 */ | |
| Tvard[k1][1] =atoi(strc); /* m 1 for V1*/ | Tvard[k1][1] =atoi(strc); /* m 1 for V1*/ |
| Tvard[k1][2] =atoi(stre); /* n 4 for V4*/ | Tvard[k1][2] =atoi(stre); /* n 4 for V4*/ |
| k2=k2+2; | k2=k2+2; /* k2 is initialize to -1, We want to store the n and m in Vn*Vm at the end of Tvar */ |
| Tvar[cptcovt+k2]=Tvard[k1][1]; /* Tvar[(cptcovt=4+k2=1)=5]= 1 (V1) */ | /* Tvar[cptcovt+k2]=Tvard[k1][1]; /\* Tvar[(cptcovt=4+k2=1)=5]= 1 (V1) *\/ */ |
| Tvar[cptcovt+k2+1]=Tvard[k1][2]; /* Tvar[(cptcovt=4+(k2=1)+1)=6]= 4 (V4) */ | /* Tvar[cptcovt+k2+1]=Tvard[k1][2]; /\* Tvar[(cptcovt=4+(k2=1)+1)=6]= 4 (V4) *\/ */ |
| /*ncovcol=4 and model=V2+V1+V1*V4+age*V3+V3*V2, Tvar[3]=5, Tvar[4]=6, cptcovt=5 */ | |
| /* 1 2 3 4 5 | Tvar[5+1)=1, Tvar[7]=2 */ | |
| for (i=1; i<=lastobs;i++){ | for (i=1; i<=lastobs;i++){ |
| /* Computes the new covariate which is a product of | /* Computes the new covariate which is a product of |
| covar[n][i]* covar[m][i] and stores it at ncovol+k1 May not be defined */ | covar[n][i]* covar[m][i] and stores it at ncovol+k1 May not be defined */ |
| Line 7123 int decodemodel ( char model[], int last | Line 7948 int decodemodel ( char model[], int last |
| /*printf("d=%s c=%s b=%s\n", strd,strc,strb);*/ | /*printf("d=%s c=%s b=%s\n", strd,strc,strb);*/ |
| /* scanf("%d",i);*/ | /* scanf("%d",i);*/ |
| cutl(strd,strc,strb,'V'); | cutl(strd,strc,strb,'V'); |
| ks++; /**< Number of simple covariates */ | ks++; /**< Number of simple covariates dummy or quantitative, fixe or varying */ |
| cptcovn++; | cptcovn++; /** V4+V3+V5: V4 and V3 timevarying dummy covariates, V5 timevarying quantitative */ |
| Tvar[k]=atoi(strd); | Tvar[k]=atoi(strd); |
| Typevar[k]=0; /* 0 for simple covariates */ | |
| } | } |
| strcpy(modelsav,stra); /* modelsav=V2+V1+V4 stra=V2+V1+V4 */ | strcpy(modelsav,stra); /* modelsav=V2+V1+V4 stra=V2+V1+V4 */ |
| /*printf("a=%s b=%s sav=%s\n", stra,strb,modelsav); | /*printf("a=%s b=%s sav=%s\n", stra,strb,modelsav); |
| scanf("%d",i);*/ | scanf("%d",i);*/ |
| } /* end of loop + on total covariates */ | } /* end of loop + on total covariates */ |
| } /* end if strlen(modelsave == 0) age*age might exist */ | } /* end if strlen(modelsave == 0) age*age might exist */ |
| } /* end if strlen(model == 0) */ | } /* end if strlen(model == 0) */ |
| /*The number n of Vn is stored in Tvar. cptcovage =number of age covariate. Tage gives the position of age. cptcovprod= number of products. | /*The number n of Vn is stored in Tvar. cptcovage =number of age covariate. Tage gives the position of age. cptcovprod= number of products. |
| If model=V1+V1*age then Tvar[1]=1 Tvar[2]=1 cptcovage=1 Tage[1]=2 cptcovprod=0*/ | If model=V1+V1*age then Tvar[1]=1 Tvar[2]=1 cptcovage=1 Tage[1]=2 cptcovprod=0*/ |
| /* printf("tvar1=%d tvar2=%d tvar3=%d cptcovage=%d Tage=%d",Tvar[1],Tvar[2],Tvar[3],cptcovage,Tage[1]); | /* printf("tvar1=%d tvar2=%d tvar3=%d cptcovage=%d Tage=%d",Tvar[1],Tvar[2],Tvar[3],cptcovage,Tage[1]); |
| printf("cptcovprod=%d ", cptcovprod); | printf("cptcovprod=%d ", cptcovprod); |
| fprintf(ficlog,"cptcovprod=%d ", cptcovprod); | fprintf(ficlog,"cptcovprod=%d ", cptcovprod); |
| scanf("%d ",i);*/ | |
| scanf("%d ",i);*/ | |
| /* Decodemodel knows only the grammar (simple, product, age*) of the model but not what kind | |
| of variable (dummy vs quantitative, fixed vs time varying) is behind */ | |
| /* ncovcol= 1, nqv=1 | ntv=2, nqtv= 1 = 5 possible variables data: 2 fixed 3, varying | |
| model= V5 + V4 +V3 + V4*V3 + V5*age + V2 + V1*V2 + V1*age + V5*age, V1 is not used saving its place | |
| k = 1 2 3 4 5 6 7 8 9 | |
| Tvar[k]= 5 4 3 1+1+2+1+1=6 5 2 7 1 5 | |
| Typevar[k]= 0 0 0 2 1 0 2 1 1 | |
| Fixed[k] 1 1 1 1 3 0 0 or 2 2 3 | |
| Dummy[k] 1 0 0 0 3 1 1 2 3 | |
| Tmodelind[combination of covar]=k; | |
| */ | |
| /* Dispatching between quantitative and time varying covariates */ | |
| /* If Tvar[k] >ncovcol it is a product */ | |
| /* Tvar[k] is the value n of Vn with n varying for 1 to nvcol, or p Vp=Vn*Vm for product */ | |
| /* Computing effective variables, ie used by the model, that is from the cptcovt variables */ | |
| printf("Model=%s\n\ | |
| Typevar: 0 for simple covariate (dummy, quantitative, fixed or varying), 1 for age product, 2 for product \n\ | |
| Fixed[k] 0=fixed (product or simple), 1 varying, 2 fixed with age product, 3 varying with age product \n\ | |
| Dummy[k] 0=dummy (0 1), 1 quantitative (single or product without age), 2 dummy with age product, 3 quant with age product\n",model); | |
| fprintf(ficlog,"Model=%s\n\ | |
| Typevar: 0 for simple covariate (dummy, quantitative, fixed or varying), 1 for age product, 2 for product \n\ | |
| Fixed[k] 0=fixed (product or simple), 1 varying, 2 fixed with age product, 3 varying with age product \n\ | |
| Dummy[k] 0=dummy (0 1), 1 quantitative (single or product without age), 2 dummy with age product, 3 quant with age product\n",model); | |
| for(k=1, ncoveff=0, nqfveff=0, ntveff=0, nqtveff=0;k<=cptcovt; k++){ /* or cptocvt */ | |
| if (Tvar[k] <=ncovcol && (Typevar[k]==0 || Typevar[k]==2)){ /* Simple or product fixed dummy covariatee */ | |
| Fixed[k]= 0; | |
| Dummy[k]= 0; | |
| ncoveff++; | |
| }else if( Tvar[k] <=ncovcol+nqv && Typevar[k]==0){ /* Remind that product Vn*Vm are added in k*/ | |
| Fixed[k]= 0; | |
| Dummy[k]= 1; | |
| nqfveff++; /* Only simple fixed quantitative variable */ | |
| }else if( Tvar[k] <=ncovcol+nqv+ntv && Typevar[k]==0){ | |
| Fixed[k]= 1; | |
| Dummy[k]= 0; | |
| ntveff++; /* Only simple time varying dummy variable */ | |
| }else if( Tvar[k] <=ncovcol+nqv+ntv+nqtv && Typevar[k]==0){ | |
| Fixed[k]= 1; | |
| Dummy[k]= 1; | |
| nqtveff++;/* Only simple time varying quantitative variable */ | |
| }else if (Typevar[k] == 1) { /* product with age */ | |
| if (Tvar[k] <=ncovcol ){ /* Simple or product fixed dummy covariatee */ | |
| Fixed[k]= 2; | |
| Dummy[k]= 2; | |
| /* ncoveff++; */ | |
| }else if( Tvar[k] <=ncovcol+nqv) { /* Remind that product Vn*Vm are added in k*/ | |
| Fixed[k]= 2; | |
| Dummy[k]= 3; | |
| /* nqfveff++; /\* Only simple fixed quantitative variable *\/ */ | |
| }else if( Tvar[k] <=ncovcol+nqv+ntv ){ | |
| Fixed[k]= 3; | |
| Dummy[k]= 2; | |
| /* ntveff++; /\* Only simple time varying dummy variable *\/ */ | |
| }else if( Tvar[k] <=ncovcol+nqv+ntv+nqtv){ | |
| Fixed[k]= 3; | |
| Dummy[k]= 3; | |
| /* nqtveff++;/\* Only simple time varying quantitative variable *\/ */ | |
| } | |
| }else if (Typevar[k] == 2) { /* product without age */ | |
| k1=Tposprod[k]; | |
| if(Tvard[k1][1] <=ncovcol){ | |
| if(Tvard[k1][2] <=ncovcol){ | |
| Fixed[k]= 1; | |
| Dummy[k]= 0; | |
| }else if(Tvard[k1][2] <=ncovcol+nqv){ | |
| Fixed[k]= 0; /* or 2 ?*/ | |
| Dummy[k]= 1; | |
| }else if(Tvard[k1][2] <=ncovcol+nqv+ntv){ | |
| Fixed[k]= 1; | |
| Dummy[k]= 0; | |
| }else if(Tvard[k1][2] <=ncovcol+nqv+ntv+nqtv){ | |
| Fixed[k]= 1; | |
| Dummy[k]= 1; | |
| } | |
| }else if(Tvard[k1][1] <=ncovcol+nqv){ | |
| if(Tvard[k1][2] <=ncovcol){ | |
| Fixed[k]= 0; /* or 2 ?*/ | |
| Dummy[k]= 1; | |
| }else if(Tvard[k1][2] <=ncovcol+nqv){ | |
| Fixed[k]= 0; /* or 2 ?*/ | |
| Dummy[k]= 1; | |
| }else if(Tvard[k1][2] <=ncovcol+nqv+ntv){ | |
| Fixed[k]= 1; | |
| Dummy[k]= 1; | |
| }else if(Tvard[k1][2] <=ncovcol+nqv+ntv+nqtv){ | |
| Fixed[k]= 1; | |
| Dummy[k]= 1; | |
| } | |
| }else if(Tvard[k1][1] <=ncovcol+nqv+ntv){ | |
| if(Tvard[k1][2] <=ncovcol){ | |
| Fixed[k]= 1; | |
| Dummy[k]= 1; | |
| }else if(Tvard[k1][2] <=ncovcol+nqv){ | |
| Fixed[k]= 1; | |
| Dummy[k]= 1; | |
| }else if(Tvard[k1][2] <=ncovcol+nqv+ntv){ | |
| Fixed[k]= 1; | |
| Dummy[k]= 0; | |
| }else if(Tvard[k1][2] <=ncovcol+nqv+ntv+nqtv){ | |
| Fixed[k]= 1; | |
| Dummy[k]= 1; | |
| } | |
| }else if(Tvard[k1][1] <=ncovcol+nqv+ntv+nqtv){ | |
| if(Tvard[k1][2] <=ncovcol){ | |
| Fixed[k]= 1; | |
| Dummy[k]= 1; | |
| }else if(Tvard[k1][2] <=ncovcol+nqv){ | |
| Fixed[k]= 1; | |
| Dummy[k]= 1; | |
| }else if(Tvard[k1][2] <=ncovcol+nqv+ntv){ | |
| Fixed[k]= 1; | |
| Dummy[k]= 1; | |
| }else if(Tvard[k1][2] <=ncovcol+nqv+ntv+nqtv){ | |
| Fixed[k]= 1; | |
| Dummy[k]= 1; | |
| } | |
| }else{ | |
| printf("Error unknown type of covariate: Tvard[%d][1]=%d,Tvard[%d][2]=%d\n",k1,Tvard[k1][1],k1,Tvard[k1][2]); | |
| fprintf(ficlog,"Error unknown type of covariate: Tvard[%d][1]=%d,Tvard[%d][2]=%d\n",k1,Tvard[k1][1],k1,Tvard[k1][2]); | |
| } /* end k1 */ | |
| }else{ | |
| printf("Error, current version can't treat for performance reasons, Tvar[%d]=%d, Typevar[%d]=%d\n", k, Tvar[k], k, Typevar[k]); | |
| fprintf(ficlog,"Error, current version can't treat for performance reasons, Tvar[%d]=%d, Typevar[%d]=%d\n", k, Tvar[k], k, Typevar[k]); | |
| } | |
| printf("Decodemodel, k=%d, Tvar[%d]=V%d,Typevar=%d, Fixed=%d, Dummy=%d\n",k, k,Tvar[k],Typevar[k],Fixed[k],Dummy[k]); | |
| fprintf(ficlog,"Decodemodel, k=%d, Tvar[%d]=V%d,Typevar=%d, Fixed=%d, Dummy=%d\n",k, k,Tvar[k],Typevar[k],Fixed[k],Dummy[k]); | |
| } | |
| /* Searching for doublons in the model */ | |
| for(k1=1; k1<= cptcovt;k1++){ | |
| for(k2=1; k2 <k1;k2++){ | |
| if((Typevar[k1]==Typevar[k2]) && (Fixed[Tvar[k1]]==Fixed[Tvar[k2]]) && (Dummy[Tvar[k1]]==Dummy[Tvar[k2]] )){ | |
| if((Typevar[k1] == 0 || Typevar[k1] == 1)){ /* Simple or age product */ | |
| if(Tvar[k1]==Tvar[k2]){ | |
| printf("Error duplication in the model=%s at positions (+) %d and %d, Tvar[%d]=V%d, Tvar[%d]=V%d, Typevar=%d, Fixed=%d, Dummy=%d\n", model, k1,k2, k1, Tvar[k1], k2, Tvar[k2],Typevar[k1],Fixed[Tvar[k1]],Dummy[Tvar[k1]]); | |
| fprintf(ficlog,"Error duplication in the model=%s at positions (+) %d and %d, Tvar[%d]=V%d, Tvar[%d]=V%d, Typevar=%d, Fixed=%d, Dummy=%d\n", model, k1,k2, k1, Tvar[k1], k2, Tvar[k2],Typevar[k1],Fixed[Tvar[k1]],Dummy[Tvar[k1]]); fflush(ficlog); | |
| return(1); | |
| } | |
| }else if (Typevar[k1] ==2){ | |
| k3=Tposprod[k1]; | |
| k4=Tposprod[k2]; | |
| if( ((Tvard[k3][1]== Tvard[k4][1])&&(Tvard[k3][2]== Tvard[k4][2])) || ((Tvard[k3][1]== Tvard[k4][2])&&(Tvard[k3][2]== Tvard[k4][1])) ){ | |
| printf("Error duplication in the model=%s at positions (+) %d and %d, V%d*V%d, Typevar=%d, Fixed=%d, Dummy=%d\n",model, k1,k2, Tvard[k3][1], Tvard[k3][2],Typevar[k1],Fixed[Tvar[k1]],Dummy[Tvar[k1]]); | |
| fprintf(ficlog,"Error duplication in the model=%s at positions (+) %d and %d, V%d*V%d, Typevar=%d, Fixed=%d, Dummy=%d\n",model, k1,k2, Tvard[k3][1], Tvard[k3][2],Typevar[k1],Fixed[Tvar[k1]],Dummy[Tvar[k1]]); fflush(ficlog); | |
| return(1); | |
| } | |
| } | |
| } | |
| } | |
| } | |
| printf("ncoveff=%d, nqfveff=%d, ntveff=%d, nqtveff=%d, cptcovn=%d\n",ncoveff,nqfveff,ntveff,nqtveff,cptcovn); | |
| fprintf(ficlog,"ncoveff=%d, nqfveff=%d, ntveff=%d, nqtveff=%d, cptcovn=%d\n",ncoveff,nqfveff,ntveff,nqtveff,cptcovn); | |
| return (0); /* with covar[new additional covariate if product] and Tage if age */ | return (0); /* with covar[new additional covariate if product] and Tage if age */ |
| /*endread:*/ | /*endread:*/ |
| printf("Exiting decodemodel: "); | printf("Exiting decodemodel: "); |
| return (1); | return (1); |
| } | } |
| int calandcheckages(int imx, int maxwav, double *agemin, double *agemax, int *nberr, int *nbwarn ) | int calandcheckages(int imx, int maxwav, double *agemin, double *agemax, int *nberr, int *nbwarn ) |
| { | { |
| int i, m; | int i, m; |
| int firstone=0; | |
| for (i=1; i<=imx; i++) { | for (i=1; i<=imx; i++) { |
| for(m=2; (m<= maxwav); m++) { | for(m=2; (m<= maxwav); m++) { |
| if (((int)mint[m][i]== 99) && (s[m][i] <= nlstate)){ | if (((int)mint[m][i]== 99) && (s[m][i] <= nlstate)){ |
| Line 7163 int calandcheckages(int imx, int maxwav, | Line 8141 int calandcheckages(int imx, int maxwav, |
| } | } |
| if((int)moisdc[i]==99 && (int)andc[i]==9999 && s[m][i]>nlstate){ | if((int)moisdc[i]==99 && (int)andc[i]==9999 && s[m][i]>nlstate){ |
| *nberr = *nberr + 1; | *nberr = *nberr + 1; |
| printf("Error! Date of death (month %2d and year %4d) of individual %ld on line %d was unknown, you must set an arbitrary year of death or he/she is skipped and results are biased (%d)\n",(int)moisdc[i],(int)andc[i],num[i],i, *nberr); | if(firstone == 0){ |
| fprintf(ficlog,"Error! Date of death (month %2d and year %4d) of individual %ld on line %d was unknown, you must set an arbitrary year of death or he/she is skipped and results are biased (%d)\n",(int)moisdc[i],(int)andc[i],num[i],i, *nberr); | firstone=1; |
| printf("Error! Date of death (month %2d and year %4d) of individual %ld on line %d was unknown, you must set an arbitrary year of death or he/she is skipped and results can be biased (%d) because status is a death state %d at wave %d. Wave dropped.\nOther similar cases in log file\n",(int)moisdc[i],(int)andc[i],num[i],i, *nberr,s[m][i],m); | |
| } | |
| fprintf(ficlog,"Error! Date of death (month %2d and year %4d) of individual %ld on line %d was unknown, you must set an arbitrary year of death or he/she is skipped and results can be biased (%d) because status is a death state %d at wave %d. Wave dropped.\n",(int)moisdc[i],(int)andc[i],num[i],i, *nberr,s[m][i],m); | |
| s[m][i]=-1; | s[m][i]=-1; |
| } | } |
| if((int)moisdc[i]==99 && (int)andc[i]!=9999 && s[m][i]>nlstate){ | if((int)moisdc[i]==99 && (int)andc[i]!=9999 && s[m][i]>nlstate){ |
| Line 7450 void syscompilerinfo(int logged) | Line 8431 void syscompilerinfo(int logged) |
| #endif | #endif |
| } | } |
| int prevalence_limit(double *p, double **prlim, double ageminpar, double agemaxpar, double ftolpl, int *ncvyearp){ | int prevalence_limit(double *p, double **prlim, double ageminpar, double agemaxpar, double ftolpl, int *ncvyearp){ |
| /*--------------- Prevalence limit (period or stable prevalence) --------------*/ | /*--------------- Prevalence limit (period or stable prevalence) --------------*/ |
| int i, j, k, i1 ; | int i, j, k, i1 ; |
| /* double ftolpl = 1.e-10; */ | /* double ftolpl = 1.e-10; */ |
| Line 7465 void syscompilerinfo(int logged) | Line 8446 void syscompilerinfo(int logged) |
| printf("Problem with period (stable) prevalence resultfile: %s\n", filerespl);return 1; | printf("Problem with period (stable) prevalence resultfile: %s\n", filerespl);return 1; |
| fprintf(ficlog,"Problem with period (stable) prevalence resultfile: %s\n", filerespl);return 1; | fprintf(ficlog,"Problem with period (stable) prevalence resultfile: %s\n", filerespl);return 1; |
| } | } |
| printf("Computing period (stable) prevalence: result on file '%s' \n", filerespl); | printf("\nComputing period (stable) prevalence: result on file '%s' \n", filerespl); |
| fprintf(ficlog,"Computing period (stable) prevalence: result on file '%s' \n", filerespl); | fprintf(ficlog,"\nComputing period (stable) prevalence: result on file '%s' \n", filerespl); |
| pstamp(ficrespl); | pstamp(ficrespl); |
| fprintf(ficrespl,"# Period (stable) prevalence. Precision given by ftolpl=%g \n", ftolpl); | fprintf(ficrespl,"# Period (stable) prevalence. Precision given by ftolpl=%g \n", ftolpl); |
| fprintf(ficrespl,"#Age "); | fprintf(ficrespl,"#Age "); |
| for(i=1; i<=nlstate;i++) fprintf(ficrespl,"%d-%d ",i,i); | for(i=1; i<=nlstate;i++) fprintf(ficrespl,"%d-%d ",i,i); |
| fprintf(ficrespl,"\n"); | fprintf(ficrespl,"\n"); |
| /* prlim=matrix(1,nlstate,1,nlstate);*/ /* back in main */ | /* prlim=matrix(1,nlstate,1,nlstate);*/ /* back in main */ |
| agebase=ageminpar; | agebase=ageminpar; |
| agelim=agemaxpar; | agelim=agemaxpar; |
| i1=pow(2,cptcoveff); | /* i1=pow(2,ncoveff); */ |
| if (cptcovn < 1){i1=1;} | i1=pow(2,cptcoveff); /* Number of dummy covariates */ |
| if (cptcovn < 1){i1=1;} | |
| for(cptcov=1,k=0;cptcov<=i1;cptcov++){ | for(k=1; k<=i1;k++){ |
| /* for(cptcov=1,k=0;cptcov<=i1;cptcov++){ */ | |
| /* for(cptcov=1,k=0;cptcov<=1;cptcov++){ */ | /* for(cptcov=1,k=0;cptcov<=1;cptcov++){ */ |
| //for(cptcod=1;cptcod<=ncodemax[cptcov];cptcod++){ | //for(cptcod=1;cptcod<=ncodemax[cptcov];cptcod++){ |
| k=k+1; | /* k=k+1; */ |
| /* to clean */ | /* to clean */ |
| //printf("cptcov=%d cptcod=%d codtab=%d\n",cptcov, cptcod,codtabm(cptcod,cptcov)); | //printf("cptcov=%d cptcod=%d codtab=%d\n",cptcov, cptcod,codtabm(cptcod,cptcov)); |
| fprintf(ficrespl,"#******"); | fprintf(ficrespl,"#******"); |
| printf("#******"); | printf("#******"); |
| fprintf(ficlog,"#******"); | fprintf(ficlog,"#******"); |
| for(j=1;j<=cptcoveff;j++) { | for(j=1;j<=cptcoveff ;j++) {/* all covariates */ |
| fprintf(ficrespl," V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); | fprintf(ficrespl," V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); /* Here problem for varying dummy*/ |
| printf(" V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); | printf(" V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); |
| fprintf(ficlog," V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); | fprintf(ficlog," V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); |
| } | } |
| fprintf(ficrespl,"******\n"); | fprintf(ficrespl,"******\n"); |
| printf("******\n"); | printf("******\n"); |
| fprintf(ficlog,"******\n"); | fprintf(ficlog,"******\n"); |
| if(invalidvarcomb[k]){ | |
| fprintf(ficrespl,"#Age "); | printf("\nCombination (%d) ignored because no case \n",k); |
| for(j=1;j<=cptcoveff;j++) { | fprintf(ficrespl,"#Combination (%d) ignored because no case \n",k); |
| fprintf(ficrespl,"V%d %d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); | fprintf(ficlog,"\nCombination (%d) ignored because no case \n",k); |
| } | continue; |
| for(i=1; i<=nlstate;i++) fprintf(ficrespl," %d-%d ",i,i); | } |
| fprintf(ficrespl,"Total Years_to_converge\n"); | |
| fprintf(ficrespl,"#Age "); | |
| for (age=agebase; age<=agelim; age++){ | for(j=1;j<=cptcoveff;j++) { |
| /* for (age=agebase; age<=agebase; age++){ */ | fprintf(ficrespl,"V%d %d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); |
| prevalim(prlim, nlstate, p, age, oldm, savm, ftolpl, ncvyearp, k); | } |
| fprintf(ficrespl,"%.0f ",age ); | for(i=1; i<=nlstate;i++) fprintf(ficrespl," %d-%d ",i,i); |
| for(j=1;j<=cptcoveff;j++) | fprintf(ficrespl,"Total Years_to_converge\n"); |
| fprintf(ficrespl,"%d %d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); | |
| tot=0.; | for (age=agebase; age<=agelim; age++){ |
| for(i=1; i<=nlstate;i++){ | /* for (age=agebase; age<=agebase; age++){ */ |
| tot += prlim[i][i]; | prevalim(prlim, nlstate, p, age, oldm, savm, ftolpl, ncvyearp, k); |
| fprintf(ficrespl," %.5f", prlim[i][i]); | fprintf(ficrespl,"%.0f ",age ); |
| } | for(j=1;j<=cptcoveff;j++) |
| fprintf(ficrespl," %.3f %d\n", tot, *ncvyearp); | fprintf(ficrespl,"%d %d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); |
| } /* Age */ | tot=0.; |
| /* was end of cptcod */ | for(i=1; i<=nlstate;i++){ |
| } /* cptcov */ | tot += prlim[i][i]; |
| return 0; | fprintf(ficrespl," %.5f", prlim[i][i]); |
| } | |
| fprintf(ficrespl," %.3f %d\n", tot, *ncvyearp); | |
| } /* Age */ | |
| /* was end of cptcod */ | |
| } /* cptcov */ | |
| return 0; | |
| } | } |
| int back_prevalence_limit(double *p, double **bprlim, double ageminpar, double agemaxpar, double ftolpl, int *ncvyearp){ | int back_prevalence_limit(double *p, double **bprlim, double ageminpar, double agemaxpar, double ftolpl, int *ncvyearp, double dateprev1,double dateprev2, int firstpass, int lastpass, int mobilavproj){ |
| /*--------------- Back Prevalence limit (period or stable prevalence) --------------*/ | /*--------------- Back Prevalence limit (period or stable prevalence) --------------*/ |
| /* Computes the back prevalence limit for any combination of covariate values | |
| * at any age between ageminpar and agemaxpar | |
| */ | |
| int i, j, k, i1 ; | int i, j, k, i1 ; |
| /* double ftolpl = 1.e-10; */ | /* double ftolpl = 1.e-10; */ |
| double age, agebase, agelim; | double age, agebase, agelim; |
| double tot; | double tot; |
| /* double ***mobaverage; */ | |
| /* double **dnewm, **doldm, **dsavm; /\* for use *\/ */ | |
| strcpy(fileresplb,"PLB_"); | strcpy(fileresplb,"PLB_"); |
| strcat(fileresplb,fileresu); | strcat(fileresplb,fileresu); |
| Line 7545 void syscompilerinfo(int logged) | Line 8540 void syscompilerinfo(int logged) |
| for(i=1; i<=nlstate;i++) fprintf(ficresplb,"%d-%d ",i,i); | for(i=1; i<=nlstate;i++) fprintf(ficresplb,"%d-%d ",i,i); |
| fprintf(ficresplb,"\n"); | fprintf(ficresplb,"\n"); |
| /* prlim=matrix(1,nlstate,1,nlstate);*/ /* back in main */ | |
| /* prlim=matrix(1,nlstate,1,nlstate);*/ /* back in main */ | |
| agebase=ageminpar; | |
| agelim=agemaxpar; | agebase=ageminpar; |
| agelim=agemaxpar; | |
| i1=pow(2,cptcoveff); | |
| if (cptcovn < 1){i1=1;} | |
| i1=pow(2,cptcoveff); | |
| for(cptcov=1,k=0;cptcov<=i1;cptcov++){ | if (cptcovn < 1){i1=1;} |
| /* for(cptcov=1,k=0;cptcov<=1;cptcov++){ */ | |
| //for(cptcod=1;cptcod<=ncodemax[cptcov];cptcod++){ | for(k=1; k<=i1;k++){ |
| k=k+1; | //printf("cptcov=%d cptcod=%d codtab=%d\n",cptcov, cptcod,codtabm(cptcod,cptcov)); |
| /* to clean */ | fprintf(ficresplb,"#******"); |
| //printf("cptcov=%d cptcod=%d codtab=%d\n",cptcov, cptcod,codtabm(cptcod,cptcov)); | printf("#******"); |
| fprintf(ficresplb,"#******"); | fprintf(ficlog,"#******"); |
| printf("#******"); | for(j=1;j<=cptcoveff ;j++) {/* all covariates */ |
| fprintf(ficlog,"#******"); | fprintf(ficresplb," V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); |
| for(j=1;j<=cptcoveff;j++) { | printf(" V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); |
| fprintf(ficresplb," V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); | fprintf(ficlog," V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); |
| printf(" V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); | } |
| fprintf(ficlog," V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); | fprintf(ficresplb,"******\n"); |
| } | printf("******\n"); |
| fprintf(ficresplb,"******\n"); | fprintf(ficlog,"******\n"); |
| printf("******\n"); | if(invalidvarcomb[k]){ |
| fprintf(ficlog,"******\n"); | printf("\nCombination (%d) ignored because no cases \n",k); |
| fprintf(ficresplb,"#Combination (%d) ignored because no cases \n",k); | |
| fprintf(ficresplb,"#Age "); | fprintf(ficlog,"\nCombination (%d) ignored because no cases \n",k); |
| for(j=1;j<=cptcoveff;j++) { | continue; |
| fprintf(ficresplb,"V%d %d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); | } |
| } | |
| for(i=1; i<=nlstate;i++) fprintf(ficresplb," %d-%d ",i,i); | fprintf(ficresplb,"#Age "); |
| fprintf(ficresplb,"Total Years_to_converge\n"); | for(j=1;j<=cptcoveff;j++) { |
| fprintf(ficresplb,"V%d %d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); | |
| for (age=agebase; age<=agelim; age++){ | } |
| /* for (age=agebase; age<=agebase; age++){ */ | for(i=1; i<=nlstate;i++) fprintf(ficresplb," %d-%d ",i,i); |
| bprevalim(bprlim, nlstate, p, age, oldm, savm, ftolpl, ncvyearp, k); | fprintf(ficresplb,"Total Years_to_converge\n"); |
| fprintf(ficresplb,"%.0f ",age ); | |
| for(j=1;j<=cptcoveff;j++) | |
| fprintf(ficresplb,"%d %d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); | for (age=agebase; age<=agelim; age++){ |
| tot=0.; | /* for (age=agebase; age<=agebase; age++){ */ |
| for(i=1; i<=nlstate;i++){ | if(mobilavproj > 0){ |
| tot += bprlim[i][i]; | /* bprevalim(bprlim, mobaverage, nlstate, p, age, ageminpar, agemaxpar, oldm, savm, doldm, dsavm, ftolpl, ncvyearp, k); */ |
| fprintf(ficresplb," %.5f", bprlim[i][i]); | /* bprevalim(bprlim, mobaverage, nlstate, p, age, oldm, savm, dnewm, doldm, dsavm, ftolpl, ncvyearp, k); */ |
| } | bprevalim(bprlim, mobaverage, nlstate, p, age, ftolpl, ncvyearp, k); |
| fprintf(ficresplb," %.3f %d\n", tot, *ncvyearp); | }else if (mobilavproj == 0){ |
| } /* Age */ | printf("There is no chance to get back prevalence limit if data aren't non zero and summing to 1, please try a non null mobil_average(=%d) parameter or mobil_average=-1 if you want to try at your own risk.\n",mobilavproj); |
| /* was end of cptcod */ | fprintf(ficlog,"There is no chance to get back prevalence limit if data aren't non zero and summing to 1, please try a non null mobil_average(=%d) parameter or mobil_average=-1 if you want to try at your own risk.\n",mobilavproj); |
| } /* cptcov */ | exit(1); |
| return 0; | }else{ |
| /* bprevalim(bprlim, probs, nlstate, p, age, oldm, savm, dnewm, doldm, dsavm, ftolpl, ncvyearp, k); */ | |
| bprevalim(bprlim, probs, nlstate, p, age, ftolpl, ncvyearp, k); | |
| } | |
| fprintf(ficresplb,"%.0f ",age ); | |
| for(j=1;j<=cptcoveff;j++) | |
| fprintf(ficresplb,"%d %d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); | |
| tot=0.; | |
| for(i=1; i<=nlstate;i++){ | |
| tot += bprlim[i][i]; | |
| fprintf(ficresplb," %.5f", bprlim[i][i]); | |
| } | |
| fprintf(ficresplb," %.3f %d\n", tot, *ncvyearp); | |
| } /* Age */ | |
| /* was end of cptcod */ | |
| } /* cptcov */ | |
| /* hBijx(p, bage, fage); */ | |
| /* fclose(ficrespijb); */ | |
| return 0; | |
| } | } |
| int hPijx(double *p, int bage, int fage){ | int hPijx(double *p, int bage, int fage){ |
| /*------------- h Pij x at various ages ------------*/ | /*------------- h Pij x at various ages ------------*/ |
| Line 7622 int hPijx(double *p, int bage, int fage) | Line 8637 int hPijx(double *p, int bage, int fage) |
| agelim=AGESUP; | agelim=AGESUP; |
| hstepm=stepsize*YEARM; /* Every year of age */ | hstepm=stepsize*YEARM; /* Every year of age */ |
| hstepm=hstepm/stepm; /* Typically 2 years, = 2/6 months = 4 */ | hstepm=hstepm/stepm; /* Typically 2 years, = 2/6 months = 4 */ |
| /* hstepm=1; aff par mois*/ | /* hstepm=1; aff par mois*/ |
| pstamp(ficrespij); | pstamp(ficrespij); |
| fprintf(ficrespij,"#****** h Pij x Probability to be in state j at age x+h being in i at x "); | fprintf(ficrespij,"#****** h Pij x Probability to be in state j at age x+h being in i at x "); |
| i1= pow(2,cptcoveff); | i1= pow(2,cptcoveff); |
| /* for(cptcov=1,k=0;cptcov<=i1;cptcov++){ */ | /* for(cptcov=1,k=0;cptcov<=i1;cptcov++){ */ |
| /* /\*for(cptcod=1;cptcod<=ncodemax[cptcov];cptcod++){*\/ */ | /* /\*for(cptcod=1;cptcod<=ncodemax[cptcov];cptcod++){*\/ */ |
| /* k=k+1; */ | /* k=k+1; */ |
| for (k=1; k <= (int) pow(2,cptcoveff); k++){ | for (k=1; k <= (int) pow(2,cptcoveff); k++){ |
| fprintf(ficrespij,"\n#****** "); | fprintf(ficrespij,"\n#****** "); |
| for(j=1;j<=cptcoveff;j++) | for(j=1;j<=cptcoveff;j++) |
| Line 7663 int hPijx(double *p, int bage, int fage) | Line 8678 int hPijx(double *p, int bage, int fage) |
| } | } |
| /*}*/ | /*}*/ |
| } | } |
| return 0; | return 0; |
| } | } |
| int hBijx(double *p, int bage, int fage){ | int hBijx(double *p, int bage, int fage, double ***prevacurrent){ |
| /*------------- h Bij x at various ages ------------*/ | /*------------- h Bij x at various ages ------------*/ |
| int stepsize; | int stepsize; |
| int agelim; | /* int agelim; */ |
| int ageminl; | |
| int hstepm; | int hstepm; |
| int nhstepm; | int nhstepm; |
| int h, i, i1, j, k; | int h, i, i1, j, k; |
| double agedeb; | double agedeb; |
| double ***p3mat; | double ***p3mat; |
| strcpy(filerespijb,"PIJB_"); strcat(filerespijb,fileresu); | |
| if((ficrespijb=fopen(filerespijb,"w"))==NULL) { | |
| printf("Problem with Pij back resultfile: %s\n", filerespijb); return 1; | |
| fprintf(ficlog,"Problem with Pij back resultfile: %s\n", filerespijb); return 1; | |
| } | |
| printf("Computing pij back: result on file '%s' \n", filerespijb); | |
| fprintf(ficlog,"Computing pij back: result on file '%s' \n", filerespijb); | |
| stepsize=(int) (stepm+YEARM-1)/YEARM; | |
| /*if (stepm<=24) stepsize=2;*/ | |
| agelim=AGESUP; | |
| hstepm=stepsize*YEARM; /* Every year of age */ | |
| hstepm=hstepm/stepm; /* Typically 2 years, = 2/6 months = 4 */ | |
| /* hstepm=1; aff par mois*/ | |
| pstamp(ficrespijb); | |
| fprintf(ficrespijb,"#****** h Pij x Back Probability to be in state i at age x-h being in j at x "); | |
| i1= pow(2,cptcoveff); | |
| /* for(cptcov=1,k=0;cptcov<=i1;cptcov++){ */ | |
| /* /\*for(cptcod=1;cptcod<=ncodemax[cptcov];cptcod++){*\/ */ | |
| /* k=k+1; */ | |
| for (k=1; k <= (int) pow(2,cptcoveff); k++){ | |
| fprintf(ficrespijb,"\n#****** "); | |
| for(j=1;j<=cptcoveff;j++) | |
| fprintf(ficrespijb,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); | |
| fprintf(ficrespijb,"******\n"); | |
| /* for (agedeb=fage; agedeb>=bage; agedeb--){ /\* If stepm=6 months *\/ */ | |
| for (agedeb=bage; agedeb<=fage; agedeb++){ /* If stepm=6 months */ | |
| nhstepm=(int) rint((agelim-agedeb)*YEARM/stepm); /* Typically 20 years = 20*12/6=40 */ | |
| nhstepm = nhstepm/hstepm; /* Typically 40/4=10 */ | |
| /* nhstepm=nhstepm*YEARM; aff par mois*/ | strcpy(filerespijb,"PIJB_"); strcat(filerespijb,fileresu); |
| if((ficrespijb=fopen(filerespijb,"w"))==NULL) { | |
| p3mat=ma3x(1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); | printf("Problem with Pij back resultfile: %s\n", filerespijb); return 1; |
| oldm=oldms;savm=savms; | fprintf(ficlog,"Problem with Pij back resultfile: %s\n", filerespijb); return 1; |
| hbxij(p3mat,nhstepm,agedeb,hstepm,p,nlstate,stepm,oldm,savm, k); | } |
| fprintf(ficrespijb,"# Cov Agex agex-h hpijx with i,j="); | printf("Computing pij back: result on file '%s' \n", filerespijb); |
| fprintf(ficlog,"Computing pij back: result on file '%s' \n", filerespijb); | |
| stepsize=(int) (stepm+YEARM-1)/YEARM; | |
| /*if (stepm<=24) stepsize=2;*/ | |
| /* agelim=AGESUP; */ | |
| ageminl=30; | |
| hstepm=stepsize*YEARM; /* Every year of age */ | |
| hstepm=hstepm/stepm; /* Typically 2 years, = 2/6 months = 4 */ | |
| /* hstepm=1; aff par mois*/ | |
| pstamp(ficrespijb); | |
| fprintf(ficrespijb,"#****** h Pij x Back Probability to be in state i at age x-h being in j at x "); | |
| i1= pow(2,cptcoveff); | |
| /* for(cptcov=1,k=0;cptcov<=i1;cptcov++){ */ | |
| /* /\*for(cptcod=1;cptcod<=ncodemax[cptcov];cptcod++){*\/ */ | |
| /* k=k+1; */ | |
| for (k=1; k <= (int) pow(2,cptcoveff); k++){ | |
| fprintf(ficrespijb,"\n#****** "); | |
| for(j=1;j<=cptcoveff;j++) | |
| fprintf(ficrespijb,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); | |
| fprintf(ficrespijb,"******\n"); | |
| if(invalidvarcomb[k]){ | |
| fprintf(ficrespijb,"\n#Combination (%d) ignored because no cases \n",k); | |
| continue; | |
| } | |
| /* for (agedeb=fage; agedeb>=bage; agedeb--){ /\* If stepm=6 months *\/ */ | |
| for (agedeb=bage; agedeb<=fage; agedeb++){ /* If stepm=6 months and estepm=24 (2 years) */ | |
| /* nhstepm=(int) rint((agelim-agedeb)*YEARM/stepm); /\* Typically 20 years = 20*12/6=40 *\/ */ | |
| nhstepm=(int) rint((agedeb-ageminl)*YEARM/stepm); /* Typically 20 years = 20*12/6=40 */ | |
| nhstepm = nhstepm/hstepm; /* Typically 40/4=10, because estepm=24 stepm=6 => hstepm=24/6=4 */ | |
| /* nhstepm=nhstepm*YEARM; aff par mois*/ | |
| 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,prevacurrent,nlstate,stepm, k); | |
| /* hbxij(p3mat,nhstepm,agedeb,hstepm,p,prevacurrent,nlstate,stepm,oldm,savm, dnewm, doldm, dsavm, k); */ | |
| fprintf(ficrespijb,"# Cov Agex agex-h hpijx with i,j="); | |
| for(i=1; i<=nlstate;i++) | |
| for(j=1; j<=nlstate+ndeath;j++) | |
| fprintf(ficrespijb," %1d-%1d",i,j); | |
| fprintf(ficrespijb,"\n"); | |
| for (h=0; h<=nhstepm; h++){ | |
| /*agedebphstep = agedeb + h*hstepm/YEARM*stepm;*/ | |
| fprintf(ficrespijb,"%d %3.f %3.f",k, agedeb, agedeb - h*hstepm/YEARM*stepm ); | |
| /* fprintf(ficrespijb,"%d %3.f %3.f",k, agedeb, agedeb + h*hstepm/YEARM*stepm ); */ | |
| for(i=1; i<=nlstate;i++) | for(i=1; i<=nlstate;i++) |
| for(j=1; j<=nlstate+ndeath;j++) | for(j=1; j<=nlstate+ndeath;j++) |
| fprintf(ficrespijb," %1d-%1d",i,j); | fprintf(ficrespijb," %.5f", p3mat[i][j][h]); |
| fprintf(ficrespijb,"\n"); | |
| for (h=0; h<=nhstepm; h++){ | |
| /*agedebphstep = agedeb + h*hstepm/YEARM*stepm;*/ | |
| fprintf(ficrespijb,"%d %3.f %3.f",k, agedeb, agedeb - h*hstepm/YEARM*stepm ); | |
| /* fprintf(ficrespijb,"%d %3.f %3.f",k, agedeb, agedeb + h*hstepm/YEARM*stepm ); */ | |
| for(i=1; i<=nlstate;i++) | |
| for(j=1; j<=nlstate+ndeath;j++) | |
| fprintf(ficrespijb," %.5f", p3mat[i][j][h]); | |
| fprintf(ficrespijb,"\n"); | |
| } | |
| free_ma3x(p3mat,1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); | |
| fprintf(ficrespijb,"\n"); | fprintf(ficrespijb,"\n"); |
| } | } |
| /*}*/ | free_ma3x(p3mat,1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); |
| fprintf(ficrespijb,"\n"); | |
| } | } |
| return 0; | /*}*/ |
| } | } |
| return 0; | |
| } /* hBijx */ | |
| /***********************************************/ | /***********************************************/ |
| Line 7769 int main(int argc, char *argv[]) | Line 8793 int main(int argc, char *argv[]) |
| double agedeb=0.; | double agedeb=0.; |
| double ageminpar=AGEOVERFLOW,agemin=AGEOVERFLOW, agemaxpar=-AGEOVERFLOW, agemax=-AGEOVERFLOW; | double ageminpar=AGEOVERFLOW,agemin=AGEOVERFLOW, agemaxpar=-AGEOVERFLOW, agemax=-AGEOVERFLOW; |
| double ageminout=-AGEOVERFLOW,agemaxout=AGEOVERFLOW; /* Smaller Age range redefined after movingaverage */ | |
| double fret; | double fret; |
| double dum=0.; /* Dummy variable */ | double dum=0.; /* Dummy variable */ |
| double ***p3mat; | double ***p3mat; |
| double ***mobaverage; | /* double ***mobaverage; */ |
| char line[MAXLINE]; | char line[MAXLINE]; |
| char path[MAXLINE],pathc[MAXLINE],pathcd[MAXLINE],pathtot[MAXLINE]; | char path[MAXLINE],pathc[MAXLINE],pathcd[MAXLINE],pathtot[MAXLINE]; |
| Line 8015 int main(int argc, char *argv[]) | Line 9040 int main(int argc, char *argv[]) |
| }else | }else |
| break; | break; |
| } | } |
| if((num_filled=sscanf(line,"ftol=%lf stepm=%d ncovcol=%d nlstate=%d ndeath=%d maxwav=%d mle=%d weight=%d\n", \ | if((num_filled=sscanf(line,"ftol=%lf stepm=%d ncovcol=%d nqv=%d ntv=%d nqtv=%d nlstate=%d ndeath=%d maxwav=%d mle=%d weight=%d\n", \ |
| &ftol, &stepm, &ncovcol, &nlstate, &ndeath, &maxwav, &mle, &weightopt)) !=EOF){ | &ftol, &stepm, &ncovcol, &nqv, &ntv, &nqtv, &nlstate, &ndeath, &maxwav, &mle, &weightopt)) !=EOF){ |
| if (num_filled != 8) { | if (num_filled != 11) { |
| printf("Not 8 parameters, for example:ftol=1.e-8 stepm=12 ncovcol=2 nlstate=2 ndeath=1 maxwav=3 mle=1 weight=1\n"); | printf("Not 11 parameters, for example:ftol=1.e-8 stepm=12 ncovcol=2 nqv=1 ntv=2 nqtv=1 nlstate=2 ndeath=1 maxwav=3 mle=1 weight=1\n"); |
| printf("but line=%s\n",line); | printf("but line=%s\n",line); |
| } | } |
| printf("ftol=%e stepm=%d ncovcol=%d nlstate=%d ndeath=%d maxwav=%d mle=%d weight=%d\n",ftol, stepm, ncovcol, nlstate,ndeath, maxwav, mle, weightopt); | printf("ftol=%e stepm=%d ncovcol=%d nqv=%d ntv=%d nqtv=%d nlstate=%d ndeath=%d maxwav=%d mle=%d weight=%d\n",ftol, stepm, ncovcol, nqv, ntv, nqtv, nlstate, ndeath, maxwav, mle, weightopt); |
| } | } |
| /* ftolpl=6*ftol*1.e5; /\* 6.e-3 make convergences in less than 80 loops for the prevalence limit *\/ */ | /* ftolpl=6*ftol*1.e5; /\* 6.e-3 make convergences in less than 80 loops for the prevalence limit *\/ */ |
| /*ftolpl=6.e-4; *//* 6.e-3 make convergences in less than 80 loops for the prevalence limit */ | /*ftolpl=6.e-4; *//* 6.e-3 make convergences in less than 80 loops for the prevalence limit */ |
| Line 8059 int main(int argc, char *argv[]) | Line 9084 int main(int argc, char *argv[]) |
| /* fscanf(ficpar,"title=%s datafile=%s lastobs=%d firstpass=%d lastpass=%d\nftol=%lf stepm=%d ncovcol=%d nlstate=%d ndeath=%d maxwav=%d mle=%d weight=%d model=1+age+%s\n",title, datafile, &lastobs, &firstpass,&lastpass,&ftol, &stepm, &ncovcol, &nlstate,&ndeath, &maxwav, &mle, &weightopt,model); */ | /* fscanf(ficpar,"title=%s datafile=%s lastobs=%d firstpass=%d lastpass=%d\nftol=%lf stepm=%d ncovcol=%d nlstate=%d ndeath=%d maxwav=%d mle=%d weight=%d model=1+age+%s\n",title, datafile, &lastobs, &firstpass,&lastpass,&ftol, &stepm, &ncovcol, &nlstate,&ndeath, &maxwav, &mle, &weightopt,model); */ |
| /* numlinepar=numlinepar+3; /\* In general *\/ */ | /* numlinepar=numlinepar+3; /\* In general *\/ */ |
| /* printf("title=%s datafile=%s lastobs=%d firstpass=%d lastpass=%d\nftol=%e stepm=%d ncovcol=%d nlstate=%d ndeath=%d maxwav=%d mle=%d weight=%d\nmodel=1+age+%s\n", title, datafile, lastobs, firstpass,lastpass,ftol, stepm, ncovcol, nlstate,ndeath, maxwav, mle, weightopt,model); */ | /* printf("title=%s datafile=%s lastobs=%d firstpass=%d lastpass=%d\nftol=%e stepm=%d ncovcol=%d nlstate=%d ndeath=%d maxwav=%d mle=%d weight=%d\nmodel=1+age+%s\n", title, datafile, lastobs, firstpass,lastpass,ftol, stepm, ncovcol, nlstate,ndeath, maxwav, mle, weightopt,model); */ |
| fprintf(ficparo,"title=%s datafile=%s lastobs=%d firstpass=%d lastpass=%d\nftol=%e stepm=%d ncovcol=%d nlstate=%d ndeath=%d maxwav=%d mle=%d weight=%d\nmodel=1+age+%s.\n", title, datafile, lastobs, firstpass,lastpass,ftol,stepm,ncovcol,nlstate,ndeath,maxwav, mle, weightopt,model); | fprintf(ficparo,"title=%s datafile=%s lastobs=%d firstpass=%d lastpass=%d\nftol=%e stepm=%d ncovcol=%d nqv=%d ntv=%d nqtv=%d nlstate=%d ndeath=%d maxwav=%d mle=%d weight=%d\nmodel=1+age+%s.\n", title, datafile, lastobs, firstpass,lastpass,ftol,stepm,ncovcol, nqv, ntv, nqtv, nlstate,ndeath,maxwav, mle, weightopt,model); |
| fprintf(ficlog,"title=%s datafile=%s lastobs=%d firstpass=%d lastpass=%d\nftol=%e stepm=%d ncovcol=%d nlstate=%d ndeath=%d maxwav=%d mle=%d weight=%d\nmodel=1+age+%s.\n", title, datafile, lastobs, firstpass,lastpass,ftol,stepm,ncovcol,nlstate,ndeath,maxwav, mle, weightopt,model); | fprintf(ficlog,"title=%s datafile=%s lastobs=%d firstpass=%d lastpass=%d\nftol=%e stepm=%d ncovcol=%d nqv=%d ntv=%d nqtv=%d nlstate=%d ndeath=%d maxwav=%d mle=%d weight=%d\nmodel=1+age+%s.\n", title, datafile, lastobs, firstpass,lastpass,ftol,stepm,ncovcol, nqv, ntv, nqtv, nlstate,ndeath,maxwav, mle, weightopt,model); |
| fflush(ficlog); | fflush(ficlog); |
| /* if(model[0]=='#'|| model[0]== '\0'){ */ | /* if(model[0]=='#'|| model[0]== '\0'){ */ |
| if(model[0]=='#'){ | if(model[0]=='#'){ |
| Line 8089 int main(int argc, char *argv[]) | Line 9114 int main(int argc, char *argv[]) |
| covar=matrix(0,NCOVMAX,1,n); /**< used in readdata */ | covar=matrix(0,NCOVMAX,1,n); /**< used in readdata */ |
| coqvar=matrix(1,nqv,1,n); /**< Fixed quantitative covariate */ | |
| cotvar=ma3x(1,maxwav,1,ntv,1,n); /**< Time varying covariate */ | |
| cotqvar=ma3x(1,maxwav,1,nqtv,1,n); /**< Time varying quantitative covariate */ | |
| cptcovn=0; /*Number of covariates, i.e. number of '+' in model statement plus one, indepently of n in Vn*/ | cptcovn=0; /*Number of covariates, i.e. number of '+' in model statement plus one, indepently of n in Vn*/ |
| /* v1+v2+v3+v2*v4+v5*age makes cptcovn = 5 | /* v1+v2+v3+v2*v4+v5*age makes cptcovn = 5 |
| v1+v2*age+v2*v3 makes cptcovn = 3 | v1+v2*age+v2*v3 makes cptcovn = 3 |
| Line 8118 int main(int argc, char *argv[]) | Line 9146 int main(int argc, char *argv[]) |
| fclose (ficlog); | fclose (ficlog); |
| goto end; | goto end; |
| exit(0); | exit(0); |
| } | } else if(mle==-5) { /* Main Wizard */ |
| else if(mle==-3) { /* Main Wizard */ | |
| prwizard(ncovmodel, nlstate, ndeath, model, ficparo); | prwizard(ncovmodel, nlstate, ndeath, model, ficparo); |
| printf(" You chose mle=-3, look at file %s for a template of covariance matrix \n",filereso); | printf(" You chose mle=-3, look at file %s for a template of covariance matrix \n",filereso); |
| fprintf(ficlog," You chose mle=-3, look at file %s for a template of covariance matrix \n",filereso); | fprintf(ficlog," You chose mle=-3, look at file %s for a template of covariance matrix \n",filereso); |
| param= ma3x(1,nlstate,1,nlstate+ndeath-1,1,ncovmodel); | param= ma3x(1,nlstate,1,nlstate+ndeath-1,1,ncovmodel); |
| matcov=matrix(1,npar,1,npar); | matcov=matrix(1,npar,1,npar); |
| hess=matrix(1,npar,1,npar); | hess=matrix(1,npar,1,npar); |
| } | } else{ /* Begin of mle != -1 or -5 */ |
| else{ | |
| /* Read guessed parameters */ | /* Read guessed parameters */ |
| /* Reads comments: lines beginning with '#' */ | /* Reads comments: lines beginning with '#' */ |
| while((c=getc(ficpar))=='#' && c!= EOF){ | while((c=getc(ficpar))=='#' && c!= EOF){ |
| Line 8142 int main(int argc, char *argv[]) | Line 9168 int main(int argc, char *argv[]) |
| param= ma3x(1,nlstate,1,nlstate+ndeath-1,1,ncovmodel); | param= ma3x(1,nlstate,1,nlstate+ndeath-1,1,ncovmodel); |
| for(i=1; i <=nlstate; i++){ | for(i=1; i <=nlstate; i++){ |
| j=0; | j=0; |
| for(jj=1; jj <=nlstate+ndeath; jj++){ | for(jj=1; jj <=nlstate+ndeath; jj++){ |
| if(jj==i) continue; | if(jj==i) continue; |
| j++; | j++; |
| fscanf(ficpar,"%1d%1d",&i1,&j1); | fscanf(ficpar,"%1d%1d",&i1,&j1); |
| if ((i1 != i) || (j1 != jj)){ | if ((i1 != i) || (j1 != jj)){ |
| printf("Error in line parameters number %d, %1d%1d instead of %1d%1d \n \ | printf("Error in line parameters number %d, %1d%1d instead of %1d%1d \n \ |
| It might be a problem of design; if ncovcol and the model are correct\n \ | It might be a problem of design; if ncovcol and the model are correct\n \ |
| run imach with mle=-1 to get a correct template of the parameter file.\n",numlinepar, i,j, i1, j1); | run imach with mle=-1 to get a correct template of the parameter file.\n",numlinepar, i,j, i1, j1); |
| exit(1); | exit(1); |
| } | } |
| fprintf(ficparo,"%1d%1d",i1,j1); | fprintf(ficparo,"%1d%1d",i1,j1); |
| if(mle==1) | if(mle==1) |
| printf("%1d%1d",i,jj); | printf("%1d%1d",i,jj); |
| fprintf(ficlog,"%1d%1d",i,jj); | fprintf(ficlog,"%1d%1d",i,jj); |
| for(k=1; k<=ncovmodel;k++){ | for(k=1; k<=ncovmodel;k++){ |
| fscanf(ficpar," %lf",¶m[i][j][k]); | fscanf(ficpar," %lf",¶m[i][j][k]); |
| if(mle==1){ | if(mle==1){ |
| printf(" %lf",param[i][j][k]); | printf(" %lf",param[i][j][k]); |
| fprintf(ficlog," %lf",param[i][j][k]); | fprintf(ficlog," %lf",param[i][j][k]); |
| } | } |
| else | else |
| fprintf(ficlog," %lf",param[i][j][k]); | fprintf(ficlog," %lf",param[i][j][k]); |
| fprintf(ficparo," %lf",param[i][j][k]); | fprintf(ficparo," %lf",param[i][j][k]); |
| } | } |
| fscanf(ficpar,"\n"); | fscanf(ficpar,"\n"); |
| numlinepar++; | numlinepar++; |
| if(mle==1) | if(mle==1) |
| printf("\n"); | printf("\n"); |
| fprintf(ficlog,"\n"); | fprintf(ficlog,"\n"); |
| fprintf(ficparo,"\n"); | fprintf(ficparo,"\n"); |
| } | } |
| } | } |
| fflush(ficlog); | fflush(ficlog); |
| Line 8193 run imach with mle=-1 to get a correct t | Line 9219 run imach with mle=-1 to get a correct t |
| for(i=1; i <=nlstate; i++){ | for(i=1; i <=nlstate; i++){ |
| for(j=1; j <=nlstate+ndeath-1; j++){ | for(j=1; j <=nlstate+ndeath-1; j++){ |
| fscanf(ficpar,"%1d%1d",&i1,&j1); | fscanf(ficpar,"%1d%1d",&i1,&j1); |
| if ( (i1-i) * (j1-j) != 0){ | if ( (i1-i) * (j1-j) != 0){ |
| printf("Error in line parameters number %d, %1d%1d instead of %1d%1d \n",numlinepar, i,j, i1, j1); | printf("Error in line parameters number %d, %1d%1d instead of %1d%1d \n",numlinepar, i,j, i1, j1); |
| exit(1); | exit(1); |
| } | } |
| printf("%1d%1d",i,j); | printf("%1d%1d",i,j); |
| fprintf(ficparo,"%1d%1d",i1,j1); | fprintf(ficparo,"%1d%1d",i1,j1); |
| fprintf(ficlog,"%1d%1d",i1,j1); | fprintf(ficlog,"%1d%1d",i1,j1); |
| for(k=1; k<=ncovmodel;k++){ | for(k=1; k<=ncovmodel;k++){ |
| fscanf(ficpar,"%le",&delti3[i][j][k]); | fscanf(ficpar,"%le",&delti3[i][j][k]); |
| printf(" %le",delti3[i][j][k]); | printf(" %le",delti3[i][j][k]); |
| fprintf(ficparo," %le",delti3[i][j][k]); | fprintf(ficparo," %le",delti3[i][j][k]); |
| fprintf(ficlog," %le",delti3[i][j][k]); | fprintf(ficlog," %le",delti3[i][j][k]); |
| } | } |
| fscanf(ficpar,"\n"); | fscanf(ficpar,"\n"); |
| numlinepar++; | numlinepar++; |
| printf("\n"); | printf("\n"); |
| fprintf(ficparo,"\n"); | fprintf(ficparo,"\n"); |
| fprintf(ficlog,"\n"); | fprintf(ficlog,"\n"); |
| } | } |
| } | } |
| fflush(ficlog); | fflush(ficlog); |
| /* Reads covariance matrix */ | /* Reads covariance matrix */ |
| delti=delti3[1][1]; | delti=delti3[1][1]; |
| /* free_ma3x(delti3,1,nlstate,1,nlstate+ndeath-1,1,ncovmodel); */ /* Hasn't to to freed here otherwise delti is no more allocated */ | /* free_ma3x(delti3,1,nlstate,1,nlstate+ndeath-1,1,ncovmodel); */ /* Hasn't to to freed here otherwise delti is no more allocated */ |
| /* Reads comments: lines beginning with '#' */ | /* Reads comments: lines beginning with '#' */ |
| while((c=getc(ficpar))=='#' && c!= EOF){ | while((c=getc(ficpar))=='#' && c!= EOF){ |
| ungetc(c,ficpar); | ungetc(c,ficpar); |
| Line 8232 run imach with mle=-1 to get a correct t | Line 9258 run imach with mle=-1 to get a correct t |
| fputs(line,ficlog); | fputs(line,ficlog); |
| } | } |
| ungetc(c,ficpar); | ungetc(c,ficpar); |
| matcov=matrix(1,npar,1,npar); | matcov=matrix(1,npar,1,npar); |
| hess=matrix(1,npar,1,npar); | hess=matrix(1,npar,1,npar); |
| for(i=1; i <=npar; i++) | for(i=1; i <=npar; i++) |
| for(j=1; j <=npar; j++) matcov[i][j]=0.; | for(j=1; j <=npar; j++) matcov[i][j]=0.; |
| /* Scans npar lines */ | /* Scans npar lines */ |
| for(i=1; i <=npar; i++){ | for(i=1; i <=npar; i++){ |
| count=fscanf(ficpar,"%1d%1d%1d",&i1,&j1,&jk); | count=fscanf(ficpar,"%1d%1d%d",&i1,&j1,&jk); |
| if(count != 3){ | if(count != 3){ |
| printf("Error! Error in parameter file %s at line %d after line starting with %1d%1d%1d\n\ | printf("Error! Error in parameter file %s at line %d after line starting with %1d%1d%1d\n\ |
| This is probably because your covariance matrix doesn't \n contain exactly %d lines corresponding to your model line '1+age+%s'.\n\ | This is probably because your covariance matrix doesn't \n contain exactly %d lines corresponding to your model line '1+age+%s'.\n\ |
| Line 8249 Please run with mle=-1 to get a correct | Line 9275 Please run with mle=-1 to get a correct |
| This is probably because your covariance matrix doesn't \n contain exactly %d lines corresponding to your model line '1+age+%s'.\n\ | This is probably because your covariance matrix doesn't \n contain exactly %d lines corresponding to your model line '1+age+%s'.\n\ |
| Please run with mle=-1 to get a correct covariance matrix.\n",optionfile,numlinepar, i1,j1,jk, npar, model); | Please run with mle=-1 to get a correct covariance matrix.\n",optionfile,numlinepar, i1,j1,jk, npar, model); |
| exit(1); | exit(1); |
| }else | }else{ |
| if(mle==1) | if(mle==1) |
| printf("%1d%1d%1d",i1,j1,jk); | printf("%1d%1d%d",i1,j1,jk); |
| fprintf(ficlog,"%1d%1d%1d",i1,j1,jk); | } |
| fprintf(ficparo,"%1d%1d%1d",i1,j1,jk); | fprintf(ficlog,"%1d%1d%d",i1,j1,jk); |
| fprintf(ficparo,"%1d%1d%d",i1,j1,jk); | |
| for(j=1; j <=i; j++){ | for(j=1; j <=i; j++){ |
| fscanf(ficpar," %le",&matcov[i][j]); | fscanf(ficpar," %le",&matcov[i][j]); |
| if(mle==1){ | if(mle==1){ |
| Line 8265 Please run with mle=-1 to get a correct | Line 9292 Please run with mle=-1 to get a correct |
| fscanf(ficpar,"\n"); | fscanf(ficpar,"\n"); |
| numlinepar++; | numlinepar++; |
| if(mle==1) | if(mle==1) |
| printf("\n"); | printf("\n"); |
| fprintf(ficlog,"\n"); | fprintf(ficlog,"\n"); |
| fprintf(ficparo,"\n"); | fprintf(ficparo,"\n"); |
| } | } |
| Line 8291 Please run with mle=-1 to get a correct | Line 9318 Please run with mle=-1 to get a correct |
| } | } |
| fprintf(ficres,"#%s\n",version); | fprintf(ficres,"#%s\n",version); |
| } /* End of mle != -3 */ | } /* End of mle != -3 */ |
| /* Main data | /* Main data |
| */ | */ |
| n= lastobs; | n= lastobs; |
| Line 8300 Please run with mle=-1 to get a correct | Line 9327 Please run with mle=-1 to get a correct |
| annais=vector(1,n); | annais=vector(1,n); |
| moisdc=vector(1,n); | moisdc=vector(1,n); |
| andc=vector(1,n); | andc=vector(1,n); |
| weight=vector(1,n); | |
| agedc=vector(1,n); | agedc=vector(1,n); |
| cod=ivector(1,n); | cod=ivector(1,n); |
| weight=vector(1,n); | for(i=1;i<=n;i++){ |
| for(i=1;i<=n;i++) weight[i]=1.0; /* Equal weights, 1 by default */ | num[i]=0; |
| moisnais[i]=0; | |
| annais[i]=0; | |
| moisdc[i]=0; | |
| andc[i]=0; | |
| agedc[i]=0; | |
| cod[i]=0; | |
| weight[i]=1.0; /* Equal weights, 1 by default */ | |
| } | |
| mint=matrix(1,maxwav,1,n); | mint=matrix(1,maxwav,1,n); |
| anint=matrix(1,maxwav,1,n); | anint=matrix(1,maxwav,1,n); |
| s=imatrix(1,maxwav+1,1,n); /* s[i][j] health state for wave i and individual j */ | s=imatrix(1,maxwav+1,1,n); /* s[i][j] health state for wave i and individual j */ |
| Line 8323 Please run with mle=-1 to get a correct | Line 9359 Please run with mle=-1 to get a correct |
| k=1 Tvar[1]=2 (from V2) | k=1 Tvar[1]=2 (from V2) |
| */ | */ |
| Tvar=ivector(1,NCOVMAX); /* Was 15 changed to NCOVMAX. */ | Tvar=ivector(1,NCOVMAX); /* Was 15 changed to NCOVMAX. */ |
| Typevar=ivector(-1,NCOVMAX); /* -1 to 2 */ | |
| Fixed=ivector(-1,NCOVMAX); /* -1 to 3 */ | |
| Dummy=ivector(-1,NCOVMAX); /* -1 to 3 */ | |
| /* V2+V1+V4+age*V3 is a model with 4 covariates (3 plus signs). | /* V2+V1+V4+age*V3 is a model with 4 covariates (3 plus signs). |
| For each model-covariate stores the data-covariate id. Tvar[1]=2, Tvar[2]=1, Tvar[3]=4, | For each model-covariate stores the data-covariate id. Tvar[1]=2, Tvar[2]=1, Tvar[3]=4, |
| Tvar[4=age*V3] is 3 and 'age' is recorded in Tage. | Tvar[4=age*V3] is 3 and 'age' is recorded in Tage. |
| Line 8332 Please run with mle=-1 to get a correct | Line 9371 Please run with mle=-1 to get a correct |
| ncovcol + k1 | ncovcol + k1 |
| If already ncovcol=4 and model=V2+V1+V1*V4+age*V3 | If already ncovcol=4 and model=V2+V1+V1*V4+age*V3 |
| Tvar[3=V1*V4]=4+1 etc */ | Tvar[3=V1*V4]=4+1 etc */ |
| Tprod=ivector(1,NCOVMAX); /* Gives the position of a product */ | Tprod=ivector(1,NCOVMAX); /* Gives the k position of the k1 product */ |
| Tposprod=ivector(1,NCOVMAX); /* Gives the k1 product from the k position */ | |
| /* Tprod[k1=1]=3(=V1*V4) for V2+V1+V1*V4+age*V3 | /* Tprod[k1=1]=3(=V1*V4) for V2+V1+V1*V4+age*V3 |
| if V2+V1+V1*V4+age*V3+V3*V2 TProd[k1=2]=5 (V3*V2) | if V2+V1+V1*V4+age*V3+V3*V2 TProd[k1=2]=5 (V3*V2) |
| Tposprod[k]=k1 , Tposprod[3]=1, Tposprod[5]=2 | |
| */ | */ |
| Tvaraff=ivector(1,NCOVMAX); /* Unclear */ | Tvaraff=ivector(1,NCOVMAX); /* Unclear */ |
| Tvard=imatrix(1,NCOVMAX,1,2); /* n=Tvard[k1][1] and m=Tvard[k1][2] gives the couple n,m of the k1 th product Vn*Vm | Tvard=imatrix(1,NCOVMAX,1,2); /* n=Tvard[k1][1] and m=Tvard[k1][2] gives the couple n,m of the k1 th product Vn*Vm |
| Line 8344 Please run with mle=-1 to get a correct | Line 9385 Please run with mle=-1 to get a correct |
| 4 covariates (3 plus signs) | 4 covariates (3 plus signs) |
| Tage[1=V3*age]= 4; Tage[2=age*V4] = 3 | Tage[1=V3*age]= 4; Tage[2=age*V4] = 3 |
| */ | */ |
| Tmodelind=ivector(1,NCOVMAX);/** five the k model position of an | |
| * individual dummy, fixed or varying: | |
| * Tmodelind[Tvaraff[3]]=9,Tvaraff[1]@9={4, | |
| * 3, 1, 0, 0, 0, 0, 0, 0}, | |
| * model=V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1*/ | |
| /* Main decodemodel */ | /* Main decodemodel */ |
| if(decodemodel(model, lastobs) == 1) | if(decodemodel(model, lastobs) == 1) /* In order to get Tvar[k] V4+V3+V5 p Tvar[1]@3 = {4, 3, 5}*/ |
| goto end; | goto end; |
| if((double)(lastobs-imx)/(double)imx > 1.10){ | if((double)(lastobs-imx)/(double)imx > 1.10){ |
| Line 8400 Please run with mle=-1 to get a correct | Line 9445 Please run with mle=-1 to get a correct |
| free_vector(andc,1,n); | free_vector(andc,1,n); |
| /* Routine tricode is to calculate cptcoveff (real number of unique covariates) and to associate covariable number and modality */ | /* Routine tricode is to calculate cptcoveff (real number of unique covariates) and to associate covariable number and modality */ |
| nbcode=imatrix(0,NCOVMAX,0,NCOVMAX); | nbcode=imatrix(0,NCOVMAX,0,NCOVMAX); |
| ncodemax[1]=1; | ncodemax[1]=1; |
| Ndum =ivector(-1,NCOVMAX); | Ndum =ivector(-1,NCOVMAX); |
| if (ncovmodel-nagesqr > 2 ) /* That is if covariate other than cst, age and age*age */ | cptcoveff=0; |
| tricode(Tvar,nbcode,imx, Ndum); /**< Fills nbcode[Tvar[j]][l]; */ | if (ncovmodel-nagesqr > 2 ){ /* That is if covariate other than cst, age and age*age */ |
| tricode(&cptcoveff,Tvar,nbcode,imx, Ndum); /**< Fills nbcode[Tvar[j]][l]; */ | |
| } | |
| ncovcombmax=pow(2,cptcoveff); | |
| invalidvarcomb=ivector(1, ncovcombmax); | |
| for(i=1;i<ncovcombmax;i++) | |
| invalidvarcomb[i]=0; | |
| /* Nbcode gives the value of the lth modality (currently 1 to 2) of jth covariate, in | /* Nbcode gives the value of the lth modality (currently 1 to 2) of jth covariate, in |
| V2+V1*age, there are 3 covariates Tvar[2]=1 (V1).*/ | V2+V1*age, there are 3 covariates Tvar[2]=1 (V1).*/ |
| /* 1 to ncodemax[j] which is the maximum value of this jth covariate */ | /* 1 to ncodemax[j] which is the maximum value of this jth covariate */ |
| /* codtab=imatrix(1,100,1,10);*/ /* codtab[h,k]=( (h-1) - mod(k-1,2**(k-1) )/2**(k-1) */ | /* codtab=imatrix(1,100,1,10);*/ /* codtab[h,k]=( (h-1) - mod(k-1,2**(k-1) )/2**(k-1) */ |
| /*printf(" codtab[1,1],codtab[100,10]=%d,%d\n", codtab[1][1],codtabm(100,10));*/ | /*printf(" codtab[1,1],codtab[100,10]=%d,%d\n", codtab[1][1],codtabm(100,10));*/ |
| /* codtab gives the value 1 or 2 of the hth combination of k covariates (1 or 2).*/ | /* codtab gives the value 1 or 2 of the hth combination of k covariates (1 or 2).*/ |
| Line 8421 Please run with mle=-1 to get a correct | Line 9473 Please run with mle=-1 to get a correct |
| */ | */ |
| h=0; | h=0; |
| /*if (cptcovn > 0) */ | /*if (cptcovn > 0) */ |
| m=pow(2,cptcoveff); | m=pow(2,cptcoveff); |
| /**< codtab(h,k) k = codtab[h,k]=( (h-1) - mod(k-1,2**(k-1) )/2**(k-1) + 1 | /**< codtab(h,k) k = codtab[h,k]=( (h-1) - mod(k-1,2**(k-1) )/2**(k-1) + 1 |
| Line 8466 Please run with mle=-1 to get a correct | Line 9514 Please run with mle=-1 to get a correct |
| * bbbbbbbb | * bbbbbbbb |
| * 76543210 | * 76543210 |
| * h-1 00000101 (6-1=5) | * h-1 00000101 (6-1=5) |
| *(h-1)>>(k-1)= 00000001 >> (2-1) = 1 right shift | *(h-1)>>(k-1)= 00000010 >> (2-1) = 1 right shift |
| * & | * & |
| * 1 00000001 (1) | * 1 00000001 (1) |
| * 00000001 = 1 & ((h-1) >> (k-1)) | * 00000000 = 1 & ((h-1) >> (k-1)) |
| * +1= 00000010 =2 | * +1= 00000001 =1 |
| * | * |
| * h=14, k=3 => h'=h-1=13, k'=k-1=2 | * h=14, k=3 => h'=h-1=13, k'=k-1=2 |
| * h' 1101 =2^3+2^2+0x2^1+2^0 | * h' 1101 =2^3+2^2+0x2^1+2^0 |
| Line 8492 Please run with mle=-1 to get a correct | Line 9540 Please run with mle=-1 to get a correct |
| * 2211 | * 2211 |
| * V1=1+1, V2=0+1, V3=1+1, V4=1+1 | * V1=1+1, V2=0+1, V3=1+1, V4=1+1 |
| * V3=2 | * V3=2 |
| * codtabm and decodtabm are identical | |
| */ | */ |
| /* /\* for(h=1; h <=100 ;h++){ *\/ */ | |
| /* /\* printf("h=%2d ", h); *\/ */ | |
| /* /\* for(k=1; k <=10; k++){ *\/ */ | |
| /* /\* printf("k=%d %d ",k,codtabm(h,k)); *\/ */ | |
| /* /\* codtab[h][k]=codtabm(h,k); *\/ */ | |
| /* /\* } *\/ */ | |
| /* /\* printf("\n"); *\/ */ | |
| /* } */ | |
| /* for(k=1;k<=cptcoveff; k++){ /\* scans any effective covariate *\/ */ | |
| /* for(i=1; i <=pow(2,cptcoveff-k);i++){ /\* i=1 to 8/1=8; i=1 to 8/2=4; i=1 to 8/8=1 *\/ */ | |
| /* for(j=1; j <= ncodemax[k]; j++){ /\* For each modality of this covariate ncodemax=2*\/ */ | |
| /* for(cpt=1; cpt <=pow(2,k-1); cpt++){ /\* cpt=1 to 8/2**(3+1-1 or 3+1-3) =1 or 4 *\/ */ | |
| /* h++; */ | |
| /* if (h>m) */ | |
| /* h=1; */ | |
| /* codtab[h][k]=j; */ | |
| /* /\* codtab[12][3]=1; *\/ */ | |
| /* /\*codtab[h][Tvar[k]]=j;*\/ */ | |
| /* /\* printf("h=%d k=%d j=%d codtab[h][k]=%d Tvar[k]=%d codtab[h][Tvar[k]]=%d \n",h, k,j,codtab[h][k],Tvar[k],codtab[h][Tvar[k]]); *\/ */ | |
| /* } */ | |
| /* } */ | |
| /* } */ | |
| /* } */ | |
| /* printf("codtab[1][2]=%d codtab[2][2]=%d",codtab[1][2],codtab[2][2]); | |
| codtab[1][2]=1;codtab[2][2]=2; */ | |
| /* for(i=1; i <=m ;i++){ */ | |
| /* for(k=1; k <=cptcovn; k++){ */ | |
| /* printf("i=%d k=%d %d %d ",i,k,codtab[i][k], cptcoveff); */ | |
| /* } */ | |
| /* printf("\n"); */ | |
| /* } */ | |
| /* scanf("%d",i);*/ | |
| free_ivector(Ndum,-1,NCOVMAX); | free_ivector(Ndum,-1,NCOVMAX); |
| Line 8600 Title=%s <br>Datafile=%s Firstpass=%d La | Line 9617 Title=%s <br>Datafile=%s Firstpass=%d La |
| #endif | #endif |
| /* Calculates basic frequencies. Computes observed prevalence at single age | /* Calculates basic frequencies. Computes observed prevalence at single age |
| and for any valid combination of covariates | |
| and prints on file fileres'p'. */ | and prints on file fileres'p'. */ |
| freqsummary(fileres, agemin, agemax, s, agev, nlstate, imx,Tvaraff,nbcode, ncodemax,mint,anint,strstart,\ | freqsummary(fileres, agemin, agemax, s, agev, nlstate, imx, Tvaraff, invalidvarcomb, nbcode, ncodemax,mint,anint,strstart, \ |
| firstpass, lastpass, stepm, weightopt, model); | firstpass, lastpass, stepm, weightopt, model); |
| fprintf(fichtm,"\n"); | fprintf(fichtm,"\n"); |
| Line 8611 Youngest age at first (selected) pass %. | Line 9629 Youngest age at first (selected) pass %. |
| Interval (in months) between two waves: Min=%d Max=%d Mean=%.2lf<br>\n",\ | Interval (in months) between two waves: Min=%d Max=%d Mean=%.2lf<br>\n",\ |
| imx,agemin,agemax,jmin,jmax,jmean); | imx,agemin,agemax,jmin,jmax,jmean); |
| pmmij= matrix(1,nlstate+ndeath,1,nlstate+ndeath); /* creation */ | pmmij= matrix(1,nlstate+ndeath,1,nlstate+ndeath); /* creation */ |
| oldms= 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 */ | newms= matrix(1,nlstate+ndeath,1,nlstate+ndeath); /* creation */ |
| savms= 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 */ | oldm=oldms; newm=newms; savm=savms; /* Keeps fixed addresses to free */ |
| /* For Powell, parameters are in a vector p[] starting at p[1] | /* 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] */ | 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) */ | p=param[1][1]; /* *(*(*(param +1)+1)+0) */ |
| Line 8625 Interval (in months) between two waves: | Line 9642 Interval (in months) between two waves: |
| /* For mortality only */ | /* For mortality only */ |
| if (mle==-3){ | if (mle==-3){ |
| ximort=matrix(1,NDIM,1,NDIM); | ximort=matrix(1,NDIM,1,NDIM); |
| for(i=1;i<=NDIM;i++) | |
| for(j=1;j<=NDIM;j++) | |
| ximort[i][j]=0.; | |
| /* ximort=gsl_matrix_alloc(1,NDIM,1,NDIM); */ | /* ximort=gsl_matrix_alloc(1,NDIM,1,NDIM); */ |
| cens=ivector(1,n); | cens=ivector(1,n); |
| ageexmed=vector(1,n); | ageexmed=vector(1,n); |
| agecens=vector(1,n); | agecens=vector(1,n); |
| dcwave=ivector(1,n); | dcwave=ivector(1,n); |
| for (i=1; i<=imx; i++){ | for (i=1; i<=imx; i++){ |
| dcwave[i]=-1; | dcwave[i]=-1; |
| for (m=firstpass; m<=lastpass; m++) | for (m=firstpass; m<=lastpass; m++) |
| Line 8640 Interval (in months) between two waves: | Line 9660 Interval (in months) between two waves: |
| break; | break; |
| } | } |
| } | } |
| for (i=1; i<=imx; i++) { | for (i=1; i<=imx; i++) { |
| if (wav[i]>0){ | if (wav[i]>0){ |
| ageexmed[i]=agev[mw[1][i]][i]; | ageexmed[i]=agev[mw[1][i]][i]; |
| j=wav[i]; | j=wav[i]; |
| agecens[i]=1.; | agecens[i]=1.; |
| if (ageexmed[i]> 1 && wav[i] > 0){ | if (ageexmed[i]> 1 && wav[i] > 0){ |
| agecens[i]=agev[mw[j][i]][i]; | agecens[i]=agev[mw[j][i]][i]; |
| cens[i]= 1; | cens[i]= 1; |
| Line 8773 Interval (in months) between two waves: | Line 9793 Interval (in months) between two waves: |
| for(i=1; i <=NDIM; i++) | for(i=1; i <=NDIM; i++) |
| for(j=i+1;j<=NDIM;j++) | for(j=i+1;j<=NDIM;j++) |
| matcov[i][j]=matcov[j][i]; | matcov[i][j]=matcov[j][i]; |
| printf("\nCovariance matrix\n "); | printf("\nCovariance matrix\n "); |
| fprintf(ficlog,"\nCovariance matrix\n "); | fprintf(ficlog,"\nCovariance matrix\n "); |
| for(i=1; i <=NDIM; i++) { | for(i=1; i <=NDIM; i++) { |
| for(j=1;j<=NDIM;j++){ | for(j=1;j<=NDIM;j++){ |
| printf("%f ",matcov[i][j]); | printf("%f ",matcov[i][j]); |
| fprintf(ficlog,"%f ",matcov[i][j]); | fprintf(ficlog,"%f ",matcov[i][j]); |
| } | } |
| printf("\n "); fprintf(ficlog,"\n "); | printf("\n "); fprintf(ficlog,"\n "); |
| } | } |
| Line 8821 Interval (in months) between two waves: | Line 9841 Interval (in months) between two waves: |
| replace_back_to_slash(pathc,pathcd); /* Even gnuplot wants a / */ | replace_back_to_slash(pathc,pathcd); /* Even gnuplot wants a / */ |
| ageminpar=50; | |
| agemaxpar=100; | |
| if(ageminpar == AGEOVERFLOW ||agemaxpar == AGEOVERFLOW){ | if(ageminpar == AGEOVERFLOW ||agemaxpar == AGEOVERFLOW){ |
| printf("Warning! Error in gnuplot file with ageminpar %f or agemaxpar %f overflow\n\ | printf("Warning! Error in gnuplot file with ageminpar %f or agemaxpar %f overflow\n\ |
| This is probably because your parameter file doesn't \n contain the exact number of lines (or columns) corresponding to your model line.\n\ | This is probably because your parameter file doesn't \n contain the exact number of lines (or columns) corresponding to your model line.\n\ |
| Line 8828 Please run with mle=-1 to get a correct | Line 9850 Please run with mle=-1 to get a correct |
| fprintf(ficlog,"Warning! Error in gnuplot file with ageminpar %f or agemaxpar %f overflow\n\ | fprintf(ficlog,"Warning! Error in gnuplot file with ageminpar %f or agemaxpar %f overflow\n\ |
| This is probably because your parameter file doesn't \n contain the exact number of lines (or columns) corresponding to your model line.\n\ | This is probably because your parameter file doesn't \n contain the exact number of lines (or columns) corresponding to your model line.\n\ |
| Please run with mle=-1 to get a correct covariance matrix.\n",ageminpar,agemaxpar); | Please run with mle=-1 to get a correct covariance matrix.\n",ageminpar,agemaxpar); |
| }else | }else{ |
| printf("Warning! ageminpar %f and agemaxpar %f have been fixed because for simplification until it is fixed...\n\n",ageminpar,agemaxpar); | |
| fprintf(ficlog,"Warning! ageminpar %f and agemaxpar %f have been fixed because for simplification until it is fixed...\n\n",ageminpar,agemaxpar); | |
| printinggnuplotmort(fileresu, optionfilefiname,ageminpar,agemaxpar,fage, pathc,p); | printinggnuplotmort(fileresu, optionfilefiname,ageminpar,agemaxpar,fage, pathc,p); |
| } | |
| printinghtmlmort(fileresu,title,datafile, firstpass, lastpass, \ | printinghtmlmort(fileresu,title,datafile, firstpass, lastpass, \ |
| stepm, weightopt,\ | stepm, weightopt,\ |
| model,imx,p,matcov,agemortsup); | model,imx,p,matcov,agemortsup); |
| Line 8837 Please run with mle=-1 to get a correct | Line 9862 Please run with mle=-1 to get a correct |
| free_vector(lsurv,1,AGESUP); | free_vector(lsurv,1,AGESUP); |
| free_vector(lpop,1,AGESUP); | free_vector(lpop,1,AGESUP); |
| free_vector(tpop,1,AGESUP); | free_vector(tpop,1,AGESUP); |
| #ifdef GSL | free_matrix(ximort,1,NDIM,1,NDIM); |
| free_ivector(cens,1,n); | free_ivector(cens,1,n); |
| free_vector(agecens,1,n); | free_vector(agecens,1,n); |
| free_ivector(dcwave,1,n); | free_ivector(dcwave,1,n); |
| free_matrix(ximort,1,NDIM,1,NDIM); | #ifdef GSL |
| #endif | #endif |
| } /* Endof if mle==-3 mortality only */ | } /* Endof if mle==-3 mortality only */ |
| /* Standard */ | /* Standard */ |
| Line 8870 Please run with mle=-1 to get a correct | Line 9895 Please run with mle=-1 to get a correct |
| printf("\n"); | printf("\n"); |
| /*--------- results files --------------*/ | /*--------- results files --------------*/ |
| fprintf(ficres,"title=%s datafile=%s lastobs=%d firstpass=%d lastpass=%d\nftol=%e stepm=%d ncovcol=%d nlstate=%d ndeath=%d maxwav=%d mle= 0 weight=%d\nmodel=1+age+%s.\n", title, datafile, lastobs, firstpass,lastpass,ftol, stepm, ncovcol, nlstate, ndeath, maxwav, weightopt,model); | fprintf(ficres,"title=%s datafile=%s lastobs=%d firstpass=%d lastpass=%d\nftol=%e stepm=%d ncovcol=%d nqv=%d ntv=%d nqtv=%d nlstate=%d ndeath=%d maxwav=%d mle= 0 weight=%d\nmodel=1+age+%s.\n", title, datafile, lastobs, firstpass,lastpass,ftol, stepm, ncovcol, nqv, ntv, nqtv, nlstate, ndeath, maxwav, weightopt,model); |
| fprintf(ficres,"# Parameters nlstate*nlstate*ncov a12*1 + b12 * age + ...\n"); | fprintf(ficres,"# Parameters nlstate*nlstate*ncov a12*1 + b12 * age + ...\n"); |
| Line 8916 Please run with mle=-1 to get a correct | Line 9941 Please run with mle=-1 to get a correct |
| } | } |
| } | } |
| } /* end of hesscov and Wald tests */ | } /* end of hesscov and Wald tests */ |
| /* */ | /* */ |
| fprintf(ficres,"# Scales (for hessian or gradient estimation)\n"); | fprintf(ficres,"# Scales (for hessian or gradient estimation)\n"); |
| printf("# Scales (for hessian or gradient estimation)\n"); | printf("# Scales (for hessian or gradient estimation)\n"); |
| Line 9025 Please run with mle=-1 to get a correct | Line 10050 Please run with mle=-1 to get a correct |
| fflush(ficlog); | fflush(ficlog); |
| fflush(ficres); | fflush(ficres); |
| while(fgets(line, MAXLINE, ficpar)) { | while(fgets(line, MAXLINE, ficpar)) { |
| /* If line starts with a # it is a comment */ | /* If line starts with a # it is a comment */ |
| if (line[0] == '#') { | if (line[0] == '#') { |
| numlinepar++; | numlinepar++; |
| fputs(line,stdout); | fputs(line,stdout); |
| fputs(line,ficparo); | fputs(line,ficparo); |
| fputs(line,ficlog); | fputs(line,ficlog); |
| continue; | continue; |
| }else | }else |
| break; | break; |
| } | } |
| /* while((c=getc(ficpar))=='#' && c!= EOF){ */ | /* while((c=getc(ficpar))=='#' && c!= EOF){ */ |
| /* ungetc(c,ficpar); */ | /* ungetc(c,ficpar); */ |
| /* fgets(line, MAXLINE, ficpar); */ | /* fgets(line, MAXLINE, ficpar); */ |
| Line 9047 Please run with mle=-1 to get a correct | Line 10072 Please run with mle=-1 to get a correct |
| estepm=0; | estepm=0; |
| if((num_filled=sscanf(line,"agemin=%lf agemax=%lf bage=%lf fage=%lf estepm=%d ftolpl=%lf\n",&ageminpar,&agemaxpar, &bage, &fage, &estepm, &ftolpl)) !=EOF){ | if((num_filled=sscanf(line,"agemin=%lf agemax=%lf bage=%lf fage=%lf estepm=%d ftolpl=%lf\n",&ageminpar,&agemaxpar, &bage, &fage, &estepm, &ftolpl)) !=EOF){ |
| if (num_filled != 6) { | if (num_filled != 6) { |
| printf("Not 6 parameters in line, for example:agemin=60 agemax=95 bage=55 fage=95 estepm=24 ftolpl=6e-4\n"); | printf("Error: Not 6 parameters in line, for example:agemin=60 agemax=95 bage=55 fage=95 estepm=24 ftolpl=6e-4\n, your line=%s . Probably you are running an older format.\n",line); |
| printf("but line=%s\n",line); | fprintf(ficlog,"Error: Not 6 parameters in line, for example:agemin=60 agemax=95 bage=55 fage=95 estepm=24 ftolpl=6e-4\n, your line=%s . Probably you are running an older format.\n",line); |
| goto end; | goto end; |
| } | |
| printf("agemin=%lf agemax=%lf bage=%lf fage=%lf estepm=%d ftolpl=%lf\n",ageminpar,agemaxpar, bage, fage, estepm, ftolpl); | |
| } | } |
| printf("agemin=%lf agemax=%lf bage=%lf fage=%lf estepm=%d ftolpl=%lf\n",ageminpar,agemaxpar, bage, fage, estepm, ftolpl); | /* ftolpl=6*ftol*1.e5; /\* 6.e-3 make convergences in less than 80 loops for the prevalence limit *\/ */ |
| } | /*ftolpl=6.e-4;*/ /* 6.e-3 make convergences in less than 80 loops for the prevalence limit */ |
| /* ftolpl=6*ftol*1.e5; /\* 6.e-3 make convergences in less than 80 loops for the prevalence limit *\/ */ | |
| /*ftolpl=6.e-4;*/ /* 6.e-3 make convergences in less than 80 loops for the prevalence limit */ | |
| /* fscanf(ficpar,"agemin=%lf agemax=%lf bage=%lf fage=%lf estepm=%d ftolpl=%\n",&ageminpar,&agemaxpar, &bage, &fage, &estepm); */ | /* fscanf(ficpar,"agemin=%lf agemax=%lf bage=%lf fage=%lf estepm=%d ftolpl=%\n",&ageminpar,&agemaxpar, &bage, &fage, &estepm); */ |
| if (estepm==0 || estepm < stepm) estepm=stepm; | if (estepm==0 || estepm < stepm) estepm=stepm; |
| if (fage <= 2) { | if (fage <= 2) { |
| Line 9068 Please run with mle=-1 to get a correct | Line 10093 Please run with mle=-1 to get a correct |
| fprintf(ficres,"# agemin agemax for life expectancy, bage fage (if mle==0 ie no data nor Max likelihood).\n"); | fprintf(ficres,"# agemin agemax for life expectancy, bage fage (if mle==0 ie no data nor Max likelihood).\n"); |
| fprintf(ficres,"agemin=%.0f agemax=%.0f bage=%.0f fage=%.0f estepm=%d ftolpl=%e\n",ageminpar,agemaxpar,bage,fage, estepm, ftolpl); | fprintf(ficres,"agemin=%.0f agemax=%.0f bage=%.0f fage=%.0f estepm=%d ftolpl=%e\n",ageminpar,agemaxpar,bage,fage, estepm, ftolpl); |
| fprintf(ficparo,"agemin=%.0f agemax=%.0f bage=%.0f fage=%.0f estepm=%d, ftolpl=%e\n",ageminpar,agemaxpar,bage,fage, estepm, ftolpl); | fprintf(ficparo,"agemin=%.0f agemax=%.0f bage=%.0f fage=%.0f estepm=%d, ftolpl=%e\n",ageminpar,agemaxpar,bage,fage, estepm, ftolpl); |
| /* Other stuffs, more or less useful */ | /* Other stuffs, more or less useful */ |
| while((c=getc(ficpar))=='#' && c!= EOF){ | while((c=getc(ficpar))=='#' && c!= EOF){ |
| ungetc(c,ficpar); | ungetc(c,ficpar); |
| Line 9125 Please run with mle=-1 to get a correct | Line 10150 Please run with mle=-1 to get a correct |
| ungetc(c,ficpar); | ungetc(c,ficpar); |
| fscanf(ficpar,"backcast=%d starting-back-date=%lf/%lf/%lf final-back-date=%lf/%lf/%lf mobil_average=%d\n",&backcast,&jback1,&mback1,&anback1,&jback2,&mback2,&anback2,&mobilavproj); | fscanf(ficpar,"backcast=%d starting-back-date=%lf/%lf/%lf final-back-date=%lf/%lf/%lf mobil_average=%d\n",&backcast,&jback1,&mback1,&anback1,&jback2,&mback2,&anback2,&mobilavproj); |
| fscanf(ficparo,"backcast=%d starting-back-date=%lf/%lf/%lf final-back-date=%lf/%lf/%lf mobil_average=%d\n",&backcast,&jback1,&mback1,&anback1,&jback2,&mback2,&anback2,&mobilavproj); | fprintf(ficparo,"backcast=%d starting-back-date=%.lf/%.lf/%.lf final-back-date=%.lf/%.lf/%.lf mobil_average=%d\n",backcast,jback1,mback1,anback1,jback2,mback2,anback2,mobilavproj); |
| fscanf(ficlog,"backcast=%d starting-back-date=%lf/%lf/%lf final-back-date=%lf/%lf/%lf mobil_average=%d\n",&backcast,&jback1,&mback1,&anback1,&jback2,&mback2,&anback2,&mobilavproj); | fprintf(ficlog,"backcast=%d starting-back-date=%.lf/%.lf/%.lf final-back-date=%.lf/%.lf/%.lf mobil_average=%d\n",backcast,jback1,mback1,anback1,jback2,mback2,anback2,mobilavproj); |
| fscanf(ficres,"backcast=%d starting-back-date=%lf/%lf/%lf final-back-date=%lf/%lf/%lf mobil_average=%d\n",&backcast,&jback1,&mback1,&anback1,&jback2,&mback2,&anback2,&mobilavproj); | fprintf(ficres,"backcast=%d starting-back-date=%.lf/%.lf/%.lf final-back-date=%.lf/%.lf/%.lf mobil_average=%d\n",backcast,jback1,mback1,anback1,jback2,mback2,anback2,mobilavproj); |
| /* day and month of proj2 are not used but only year anproj2.*/ | /* day and month of proj2 are not used but only year anproj2.*/ |
| /* freqsummary(fileres, agemin, agemax, s, agev, nlstate, imx,Tvaraff,nbcode, ncodemax,mint,anint); */ | /* freqsummary(fileres, agemin, agemax, s, agev, nlstate, imx,Tvaraff,nbcode, ncodemax,mint,anint); */ |
| /* ,dateprev1,dateprev2,jprev1, mprev1,anprev1,jprev2, mprev2,anprev2); */ | /* ,dateprev1,dateprev2,jprev1, mprev1,anprev1,jprev2, mprev2,anprev2); */ |
| replace_back_to_slash(pathc,pathcd); /* Even gnuplot wants a / */ | replace_back_to_slash(pathc,pathcd); /* Even gnuplot wants a / */ |
| if(ageminpar == AGEOVERFLOW ||agemaxpar == -AGEOVERFLOW){ | if(ageminpar == AGEOVERFLOW ||agemaxpar == -AGEOVERFLOW){ |
| printf("Warning! Error in gnuplot file with ageminpar %f or agemaxpar %f overflow\n\ | printf("Warning! Error in gnuplot file with ageminpar %f or agemaxpar %f overflow\n\ |
| This is probably because your parameter file doesn't \n contain the exact number of lines (or columns) corresponding to your model line.\n\ | This is probably because your parameter file doesn't \n contain the exact number of lines (or columns) corresponding to your model line.\n\ |
| Please run with mle=-1 to get a correct covariance matrix.\n",ageminpar,agemaxpar); | Please run with mle=-1 to get a correct covariance matrix.\n",ageminpar,agemaxpar); |
| fprintf(ficlog,"Warning! Error in gnuplot file with ageminpar %f or agemaxpar %f overflow\n\ | fprintf(ficlog,"Warning! Error in gnuplot file with ageminpar %f or agemaxpar %f overflow\n\ |
| This is probably because your parameter file doesn't \n contain the exact number of lines (or columns) corresponding to your model line.\n\ | This is probably because your parameter file doesn't \n contain the exact number of lines (or columns) corresponding to your model line.\n\ |
| Please run with mle=-1 to get a correct covariance matrix.\n",ageminpar,agemaxpar); | Please run with mle=-1 to get a correct covariance matrix.\n",ageminpar,agemaxpar); |
| }else | }else{ |
| printinggnuplot(fileresu, optionfilefiname,ageminpar,agemaxpar,fage, prevfcast, pathc,p); | printinggnuplot(fileresu, optionfilefiname,ageminpar,agemaxpar,fage, prevfcast, backcast, pathc,p); |
| } | |
| printinghtml(fileresu,title,datafile, firstpass, lastpass, stepm, weightopt,\ | printinghtml(fileresu,title,datafile, firstpass, lastpass, stepm, weightopt, \ |
| model,imx,jmin,jmax,jmean,rfileres,popforecast,prevfcast,backcast, estepm, \ | model,imx,jmin,jmax,jmean,rfileres,popforecast,prevfcast,backcast, estepm, \ |
| jprev1,mprev1,anprev1,dateprev1,jprev2,mprev2,anprev2,dateprev2); | jprev1,mprev1,anprev1,dateprev1,jprev2,mprev2,anprev2,dateprev2); |
| /*------------ free_vector -------------*/ | /*------------ free_vector -------------*/ |
| /* chdir(path); */ | /* chdir(path); */ |
| /* free_ivector(wav,1,imx); */ /* Moved after last prevalence call */ | /* free_ivector(wav,1,imx); */ /* Moved after last prevalence call */ |
| /* free_imatrix(dh,1,lastpass-firstpass+2,1,imx); */ | /* free_imatrix(dh,1,lastpass-firstpass+2,1,imx); */ |
| /* free_imatrix(bh,1,lastpass-firstpass+2,1,imx); */ | /* free_imatrix(bh,1,lastpass-firstpass+2,1,imx); */ |
| Line 9162 Please run with mle=-1 to get a correct | Line 10187 Please run with mle=-1 to get a correct |
| /*free_matrix(covar,1,NCOVMAX,1,n);*/ | /*free_matrix(covar,1,NCOVMAX,1,n);*/ |
| fclose(ficparo); | fclose(ficparo); |
| fclose(ficres); | fclose(ficres); |
| /* Other results (useful)*/ | /* Other results (useful)*/ |
| /*--------------- Prevalence limit (period or stable prevalence) --------------*/ | /*--------------- Prevalence limit (period or stable prevalence) --------------*/ |
| /*#include "prevlim.h"*/ /* Use ficrespl, ficlog */ | /*#include "prevlim.h"*/ /* Use ficrespl, ficlog */ |
| prlim=matrix(1,nlstate,1,nlstate); | prlim=matrix(1,nlstate,1,nlstate); |
| prevalence_limit(p, prlim, ageminpar, agemaxpar, ftolpl, &ncvyear); | prevalence_limit(p, prlim, ageminpar, agemaxpar, ftolpl, &ncvyear); |
| fclose(ficrespl); | fclose(ficrespl); |
| /*--------------- Back Prevalence limit (period or stable prevalence) --------------*/ | |
| /*#include "prevlim.h"*/ /* Use ficresplb, ficlog */ | |
| bprlim=matrix(1,nlstate,1,nlstate); | |
| back_prevalence_limit(p, bprlim, ageminpar, agemaxpar, ftolpl, &ncvyear); | |
| fclose(ficresplb); | |
| #ifdef FREEEXIT2 | |
| #include "freeexit2.h" | |
| #endif | |
| /*------------- h Pij x at various ages ------------*/ | /*------------- h Pij x at various ages ------------*/ |
| /*#include "hpijx.h"*/ | /*#include "hpijx.h"*/ |
| hPijx(p, bage, fage); | hPijx(p, bage, fage); |
| fclose(ficrespij); | fclose(ficrespij); |
| hBijx(p, bage, fage); | /* ncovcombmax= pow(2,cptcoveff); */ |
| fclose(ficrespijb); | /*-------------- Variance of one-step probabilities---*/ |
| /*-------------- Variance of one-step probabilities---*/ | |
| k=1; | k=1; |
| varprob(optionfilefiname, matcov, p, delti, nlstate, bage, fage,k,Tvar,nbcode, ncodemax,strstart); | varprob(optionfilefiname, matcov, p, delti, nlstate, bage, fage,k,Tvar,nbcode, ncodemax,strstart); |
| /* Prevalence for each covariates in probs[age][status][cov] */ | |
| probs= ma3x(1,AGESUP,1,NCOVMAX, 1,NCOVMAX); | probs= ma3x(1,AGESUP,1,nlstate+ndeath, 1,ncovcombmax); |
| for(i=1;i<=AGESUP;i++) | for(i=1;i<=AGESUP;i++) |
| for(j=1;j<=NCOVMAX;j++) | for(j=1;j<=nlstate+ndeath;j++) /* ndeath is useless but a necessity to be compared with mobaverages */ |
| for(k=1;k<=NCOVMAX;k++) | for(k=1;k<=ncovcombmax;k++) |
| probs[i][j][k]=0.; | probs[i][j][k]=0.; |
| prevalence(probs, ageminpar, agemaxpar, s, agev, nlstate, imx, Tvar, nbcode, ncodemax, mint, anint, dateprev1, dateprev2, firstpass, lastpass); | |
| if (mobilav!=0 ||mobilavproj !=0 ) { | |
| mobaverages= ma3x(1, AGESUP,1,nlstate+ndeath, 1,ncovcombmax); | |
| for(i=1;i<=AGESUP;i++) | |
| for(j=1;j<=nlstate;j++) | |
| for(k=1;k<=ncovcombmax;k++) | |
| mobaverages[i][j][k]=0.; | |
| mobaverage=mobaverages; | |
| if (mobilav!=0) { | |
| if (movingaverage(probs, ageminpar, agemaxpar, mobaverage, mobilav)!=0){ | |
| fprintf(ficlog," Error in movingaverage mobilav=%d\n",mobilav); | |
| printf(" Error in movingaverage mobilav=%d\n",mobilav); | |
| } | |
| } | |
| /* /\* Prevalence for each covariates in probs[age][status][cov] *\/ */ | |
| /* prevalence(probs, ageminpar, agemaxpar, s, agev, nlstate, imx, Tvar, nbcode, ncodemax, mint, anint, dateprev1, dateprev2, firstpass, lastpass); */ | |
| else if (mobilavproj !=0) { | |
| if (movingaverage(probs, ageminpar, agemaxpar, mobaverage, mobilavproj)!=0){ | |
| fprintf(ficlog," Error in movingaverage mobilavproj=%d\n",mobilavproj); | |
| printf(" Error in movingaverage mobilavproj=%d\n",mobilavproj); | |
| } | |
| } | |
| }/* end if moving average */ | |
| /*---------- Forecasting ------------------*/ | /*---------- Forecasting ------------------*/ |
| /*if((stepm == 1) && (strcmp(model,".")==0)){*/ | /*if((stepm == 1) && (strcmp(model,".")==0)){*/ |
| if(prevfcast==1){ | if(prevfcast==1){ |
| Line 9210 Please run with mle=-1 to get a correct | Line 10245 Please run with mle=-1 to get a correct |
| prevforecast(fileresu, anproj1, mproj1, jproj1, agemin, agemax, dateprev1, dateprev2, mobilavproj, bage, fage, firstpass, lastpass, anproj2, p, cptcoveff); | prevforecast(fileresu, anproj1, mproj1, jproj1, agemin, agemax, dateprev1, dateprev2, mobilavproj, bage, fage, firstpass, lastpass, anproj2, p, cptcoveff); |
| } | } |
| if(backcast==1){ | if(backcast==1){ |
| prevbackforecast(fileresu, anback1, mback1, jback1, agemin, agemax, dateprev1, dateprev2, mobilavproj, bage, fage, firstpass, lastpass, anback2, p, cptcoveff); | ddnewms=matrix(1,nlstate+ndeath,1,nlstate+ndeath); |
| ddoldms=matrix(1,nlstate+ndeath,1,nlstate+ndeath); | |
| ddsavms=matrix(1,nlstate+ndeath,1,nlstate+ndeath); | |
| /*--------------- Back Prevalence limit (period or stable prevalence) --------------*/ | |
| bprlim=matrix(1,nlstate,1,nlstate); | |
| back_prevalence_limit(p, bprlim, ageminpar, agemaxpar, ftolpl, &ncvyear, dateprev1, dateprev2, firstpass, lastpass, mobilavproj); | |
| fclose(ficresplb); | |
| hBijx(p, bage, fage, mobaverage); | |
| fclose(ficrespijb); | |
| free_matrix(bprlim,1,nlstate,1,nlstate); /*here or after loop ? */ | |
| /* prevbackforecast(fileresu, anback1, mback1, jback1, agemin, agemax, dateprev1, dateprev2, mobilavproj, | |
| bage, fage, firstpass, lastpass, anback2, p, cptcoveff); */ | |
| free_matrix(ddnewms, 1, nlstate+ndeath, 1, nlstate+ndeath); | |
| free_matrix(ddsavms, 1, nlstate+ndeath, 1, nlstate+ndeath); | |
| free_matrix(ddoldms, 1, nlstate+ndeath, 1, nlstate+ndeath); | |
| } | } |
| /* (popforecast==1) populforecast(fileres, anpyram,mpyram,jpyram, agemin,agemax, dateprev1, dateprev2,mobilav, agedeb, fage, popforecast, popfile, anpyram1,p, i1);*/ | |
| /* } */ | |
| /* else{ */ | |
| /* erreur=108; */ | |
| /* printf("Warning %d!! You can only forecast the prevalences if the optimization\n has been performed with stepm = 1 (month) instead of %d or model=. instead of '%s'\n", erreur, stepm, model); */ | |
| /* fprintf(ficlog,"Warning %d!! You can only forecast the prevalences if the optimization\n has been performed with stepm = 1 (month) instead of %d or model=. instead of '%s'\n", erreur, stepm, model); */ | |
| /* } */ | |
| /* ------ Other prevalence ratios------------ */ | /* ------ Other prevalence ratios------------ */ |
| /* Computes prevalence between agemin (i.e minimal age computed) and no more ageminpar */ | |
| prevalence(probs, agemin, agemax, s, agev, nlstate, imx, Tvar, nbcode, ncodemax, mint, anint, dateprev1, dateprev2, firstpass, lastpass); | |
| /* printf("ageminpar=%f, agemax=%f, s[lastpass][imx]=%d, agev[lastpass][imx]=%f, nlstate=%d, imx=%d, mint[lastpass][imx]=%f, anint[lastpass][imx]=%f,dateprev1=%f, dateprev2=%f, firstpass=%d, lastpass=%d\n",\ | |
| ageminpar, agemax, s[lastpass][imx], agev[lastpass][imx], nlstate, imx, mint[lastpass][imx],anint[lastpass][imx], dateprev1, dateprev2, firstpass, lastpass); | |
| */ | |
| free_ivector(wav,1,imx); | free_ivector(wav,1,imx); |
| free_imatrix(dh,1,lastpass-firstpass+2,1,imx); | free_imatrix(dh,1,lastpass-firstpass+2,1,imx); |
| free_imatrix(bh,1,lastpass-firstpass+2,1,imx); | free_imatrix(bh,1,lastpass-firstpass+2,1,imx); |
| free_imatrix(mw,1,lastpass-firstpass+2,1,imx); | free_imatrix(mw,1,lastpass-firstpass+2,1,imx); |
| if (mobilav!=0) { | |
| mobaverage= ma3x(1, AGESUP,1,NCOVMAX, 1,NCOVMAX); | |
| if (movingaverage(probs, bage, fage, mobaverage,mobilav)!=0){ | |
| fprintf(ficlog," Error in movingaverage mobilav=%d\n",mobilav); | |
| printf(" Error in movingaverage mobilav=%d\n",mobilav); | |
| } | |
| } | |
| /*---------- Health expectancies, no variances ------------*/ | /*---------- Health expectancies, no variances ------------*/ |
| strcpy(filerese,"E_"); | strcpy(filerese,"E_"); |
| strcat(filerese,fileresu); | strcat(filerese,fileresu); |
| if((ficreseij=fopen(filerese,"w"))==NULL) { | if((ficreseij=fopen(filerese,"w"))==NULL) { |
| Line 9254 Please run with mle=-1 to get a correct | Line 10285 Please run with mle=-1 to get a correct |
| } | } |
| printf("Computing Health Expectancies: result on file '%s' ...", filerese);fflush(stdout); | printf("Computing Health Expectancies: result on file '%s' ...", filerese);fflush(stdout); |
| fprintf(ficlog,"Computing Health Expectancies: result on file '%s' ...", filerese);fflush(ficlog); | fprintf(ficlog,"Computing Health Expectancies: result on file '%s' ...", filerese);fflush(ficlog); |
| /*for(cptcov=1,k=0;cptcov<=i1;cptcov++){ | |
| for(cptcod=1;cptcod<=ncodemax[cptcov];cptcod++){*/ | for (k=1; k <= (int) pow(2,cptcoveff); k++){ /* For any combination of dummy covariates, fixed and varying */ |
| fprintf(ficreseij,"\n#****** "); | |
| for (k=1; k <= (int) pow(2,cptcoveff); k++){ | for(j=1;j<=cptcoveff;j++) { |
| fprintf(ficreseij,"\n#****** "); | fprintf(ficreseij,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); |
| for(j=1;j<=cptcoveff;j++) { | } |
| fprintf(ficreseij,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); | fprintf(ficreseij,"******\n"); |
| } | |
| fprintf(ficreseij,"******\n"); | |
| eij=ma3x(1,nlstate,1,nlstate,(int) bage, (int) fage); | |
| oldm=oldms;savm=savms; | |
| evsij(eij, p, nlstate, stepm, (int) bage, (int)fage, oldm, savm, k, estepm, strstart); | |
| free_ma3x(eij,1,nlstate,1,nlstate,(int) bage, (int)fage); | eij=ma3x(1,nlstate,1,nlstate,(int) bage, (int) fage); |
| /*}*/ | oldm=oldms;savm=savms; |
| evsij(eij, p, nlstate, stepm, (int) bage, (int)fage, oldm, savm, k, estepm, strstart); | |
| free_ma3x(eij,1,nlstate,1,nlstate,(int) bage, (int)fage); | |
| } | } |
| fclose(ficreseij); | fclose(ficreseij); |
| printf("done evsij\n");fflush(stdout); | printf("done evsij\n");fflush(stdout); |
| fprintf(ficlog,"done evsij\n");fflush(ficlog); | fprintf(ficlog,"done evsij\n");fflush(ficlog); |
| /*---------- Health expectancies and variances ------------*/ | /*---------- State-specific expectancies and variances ------------*/ |
| strcpy(filerest,"T_"); | strcpy(filerest,"T_"); |
| strcat(filerest,fileresu); | strcat(filerest,fileresu); |
| if((ficrest=fopen(filerest,"w"))==NULL) { | if((ficrest=fopen(filerest,"w"))==NULL) { |
| Line 9286 Please run with mle=-1 to get a correct | Line 10314 Please run with mle=-1 to get a correct |
| } | } |
| printf("Computing Total Life expectancies with their standard errors: file '%s' ...\n", filerest); fflush(stdout); | printf("Computing Total Life expectancies with their standard errors: file '%s' ...\n", filerest); fflush(stdout); |
| fprintf(ficlog,"Computing Total Life expectancies with their standard errors: file '%s' ...\n", filerest); fflush(ficlog); | fprintf(ficlog,"Computing Total Life expectancies with their standard errors: file '%s' ...\n", filerest); fflush(ficlog); |
| strcpy(fileresstde,"STDE_"); | strcpy(fileresstde,"STDE_"); |
| strcat(fileresstde,fileresu); | strcat(fileresstde,fileresu); |
| if((ficresstdeij=fopen(fileresstde,"w"))==NULL) { | if((ficresstdeij=fopen(fileresstde,"w"))==NULL) { |
| printf("Problem with Health Exp. and std errors resultfile: %s\n", fileresstde); exit(0); | printf("Problem with State specific Exp. and std errors resultfile: %s\n", fileresstde); exit(0); |
| fprintf(ficlog,"Problem with Health Exp. and std errors resultfile: %s\n", fileresstde); exit(0); | fprintf(ficlog,"Problem with State specific Exp. and std errors resultfile: %s\n", fileresstde); exit(0); |
| } | } |
| printf(" Computing Health Expectancies and standard errors: result on file '%s' \n", fileresstde); | printf(" Computing State-specific Expectancies and standard errors: result on file '%s' \n", fileresstde); |
| fprintf(ficlog," Computing Health Expectancies and standard errors: result on file '%s' \n", fileresstde); | fprintf(ficlog," Computing State-specific Expectancies and standard errors: result on file '%s' \n", fileresstde); |
| strcpy(filerescve,"CVE_"); | strcpy(filerescve,"CVE_"); |
| strcat(filerescve,fileresu); | strcat(filerescve,fileresu); |
| if((ficrescveij=fopen(filerescve,"w"))==NULL) { | if((ficrescveij=fopen(filerescve,"w"))==NULL) { |
| printf("Problem with Covar. Health Exp. resultfile: %s\n", filerescve); exit(0); | printf("Problem with Covar. State-specific Exp. resultfile: %s\n", filerescve); exit(0); |
| fprintf(ficlog,"Problem with Covar. Health Exp. resultfile: %s\n", filerescve); exit(0); | fprintf(ficlog,"Problem with Covar. State-specific Exp. resultfile: %s\n", filerescve); exit(0); |
| } | } |
| printf(" Computing Covar. of Health Expectancies: result on file '%s' \n", filerescve); | printf(" Computing Covar. of State-specific Expectancies: result on file '%s' \n", filerescve); |
| fprintf(ficlog," Computing Covar. of Health Expectancies: result on file '%s' \n", filerescve); | fprintf(ficlog," Computing Covar. of State-specific Expectancies: result on file '%s' \n", filerescve); |
| strcpy(fileresv,"V_"); | strcpy(fileresv,"V_"); |
| strcat(fileresv,fileresu); | strcat(fileresv,fileresu); |
| Line 9312 Please run with mle=-1 to get a correct | Line 10340 Please run with mle=-1 to get a correct |
| printf("Problem with variance resultfile: %s\n", fileresv);exit(0); | printf("Problem with variance resultfile: %s\n", fileresv);exit(0); |
| fprintf(ficlog,"Problem with variance resultfile: %s\n", fileresv);exit(0); | fprintf(ficlog,"Problem with variance resultfile: %s\n", fileresv);exit(0); |
| } | } |
| printf(" Computing Variance-covariance of DFLEs: file '%s' ... ", fileresv);fflush(stdout); | printf(" Computing Variance-covariance of State-specific Expectancies: file '%s' ... ", fileresv);fflush(stdout); |
| fprintf(ficlog," Computing Variance-covariance of DFLEs: file '%s' ... ", fileresv);fflush(ficlog); | fprintf(ficlog," Computing Variance-covariance of State-specific Expectancies: file '%s' ... ", fileresv);fflush(ficlog); |
| /*for(cptcov=1,k=0;cptcov<=i1;cptcov++){ | /*for(cptcov=1,k=0;cptcov<=i1;cptcov++){ |
| for(cptcod=1;cptcod<=ncodemax[cptcov];cptcod++){*/ | for(cptcod=1;cptcod<=ncodemax[cptcov];cptcod++){*/ |
| for (k=1; k <= (int) pow(2,cptcoveff); k++){ | for (k=1; k <= (int) pow(2,cptcoveff); k++){ |
| printf("\n#****** "); | |
| fprintf(ficrest,"\n#****** "); | fprintf(ficrest,"\n#****** "); |
| for(j=1;j<=cptcoveff;j++) | fprintf(ficlog,"\n#****** "); |
| for(j=1;j<=cptcoveff;j++){ | |
| printf("V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); | |
| fprintf(ficrest,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); | fprintf(ficrest,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); |
| fprintf(ficlog,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); | |
| } | |
| fprintf(ficrest,"******\n"); | fprintf(ficrest,"******\n"); |
| fprintf(ficlog,"******\n"); | |
| printf("******\n"); | |
| fprintf(ficresstdeij,"\n#****** "); | fprintf(ficresstdeij,"\n#****** "); |
| fprintf(ficrescveij,"\n#****** "); | fprintf(ficrescveij,"\n#****** "); |
| Line 9340 Please run with mle=-1 to get a correct | Line 10375 Please run with mle=-1 to get a correct |
| eij=ma3x(1,nlstate,1,nlstate,(int) bage, (int) fage); | eij=ma3x(1,nlstate,1,nlstate,(int) bage, (int) fage); |
| oldm=oldms;savm=savms; | oldm=oldms;savm=savms; |
| printf(" cvevsij %d, ",k); | printf(" cvevsij combination#=%d, ",k); |
| fprintf(ficlog, " cvevsij %d, ",k); | fprintf(ficlog, " cvevsij combination#=%d, ",k); |
| cvevsij(eij, p, nlstate, stepm, (int) bage, (int)fage, oldm, savm, k, estepm, delti, matcov, strstart); | cvevsij(eij, p, nlstate, stepm, (int) bage, (int)fage, oldm, savm, k, estepm, delti, matcov, strstart); |
| printf(" end cvevsij \n "); | printf(" end cvevsij \n "); |
| fprintf(ficlog, " end cvevsij \n "); | fprintf(ficlog, " end cvevsij \n "); |
| Line 9357 Please run with mle=-1 to get a correct | Line 10392 Please run with mle=-1 to get a correct |
| for(vpopbased=0; vpopbased <= popbased; vpopbased++){ /* Done for vpopbased=0 and vpopbased=1 if popbased==1*/ | for(vpopbased=0; vpopbased <= popbased; vpopbased++){ /* Done for vpopbased=0 and vpopbased=1 if popbased==1*/ |
| oldm=oldms;savm=savms; /* ZZ Segmentation fault */ | oldm=oldms;savm=savms; /* ZZ Segmentation fault */ |
| cptcod= 0; /* To be deleted */ | cptcod= 0; /* To be deleted */ |
| printf("varevsij %d \n",vpopbased); | printf("varevsij vpopbased=%d \n",vpopbased); |
| fprintf(ficlog, "varevsij %d \n",vpopbased); | fprintf(ficlog, "varevsij vpopbased=%d \n",vpopbased); |
| varevsij(optionfilefiname, vareij, matcov, p, delti, nlstate, stepm, (int) bage, (int) fage, oldm, savm, prlim, ftolpl, &ncvyear, k, estepm, cptcov,cptcod,vpopbased,mobilav, strstart); /* cptcod not initialized Intel */ | varevsij(optionfilefiname, vareij, matcov, p, delti, nlstate, stepm, (int) bage, (int) fage, oldm, savm, prlim, ftolpl, &ncvyear, k, estepm, cptcov,cptcod,vpopbased,mobilav, strstart); /* cptcod not initialized Intel */ |
| fprintf(ficrest,"# Total life expectancy with std error and decomposition into time to be expected in each health state\n# (weighted average of eij where weights are "); | fprintf(ficrest,"# Total life expectancy with std error and decomposition into time to be expected in each health state\n# (weighted average of eij where weights are "); |
| if(vpopbased==1) | if(vpopbased==1) |
| Line 9415 Please run with mle=-1 to get a correct | Line 10450 Please run with mle=-1 to get a correct |
| /*}*/ | /*}*/ |
| } /* End k */ | } /* End k */ |
| free_vector(weight,1,n); | |
| free_imatrix(Tvard,1,NCOVMAX,1,2); | |
| free_imatrix(s,1,maxwav+1,1,n); | |
| free_matrix(anint,1,maxwav,1,n); | |
| free_matrix(mint,1,maxwav,1,n); | |
| free_ivector(cod,1,n); | |
| free_ivector(tab,1,NCOVMAX); | |
| fclose(ficresstdeij); | |
| fclose(ficrescveij); | |
| fclose(ficresvij); | |
| fclose(ficrest); | |
| printf("done Health expectancies\n");fflush(stdout); | |
| fprintf(ficlog,"done Health expectancies\n");fflush(ficlog); | |
| fclose(ficpar); | |
| /*------- Variance of period (stable) prevalence------*/ | |
| printf("done State-specific expectancies\n");fflush(stdout); | |
| fprintf(ficlog,"done State-specific expectancies\n");fflush(ficlog); | |
| /*------- Variance of period (stable) prevalence------*/ | |
| strcpy(fileresvpl,"VPL_"); | strcpy(fileresvpl,"VPL_"); |
| strcat(fileresvpl,fileresu); | strcat(fileresvpl,fileresu); |
| if((ficresvpl=fopen(fileresvpl,"w"))==NULL) { | if((ficresvpl=fopen(fileresvpl,"w"))==NULL) { |
| Line 9440 Please run with mle=-1 to get a correct | Line 10464 Please run with mle=-1 to get a correct |
| } | } |
| printf("Computing Variance-covariance of period (stable) prevalence: file '%s' ...", fileresvpl);fflush(stdout); | printf("Computing Variance-covariance of period (stable) prevalence: file '%s' ...", fileresvpl);fflush(stdout); |
| fprintf(ficlog, "Computing Variance-covariance of period (stable) prevalence: file '%s' ...", fileresvpl);fflush(ficlog); | fprintf(ficlog, "Computing Variance-covariance of period (stable) prevalence: file '%s' ...", fileresvpl);fflush(ficlog); |
| /*for(cptcov=1,k=0;cptcov<=i1;cptcov++){ | /*for(cptcov=1,k=0;cptcov<=i1;cptcov++){ |
| for(cptcod=1;cptcod<=ncodemax[cptcov];cptcod++){*/ | for(cptcod=1;cptcod<=ncodemax[cptcov];cptcod++){*/ |
| for (k=1; k <= (int) pow(2,cptcoveff); k++){ | for (k=1; k <= (int) pow(2,cptcoveff); k++){ |
| fprintf(ficresvpl,"\n#****** "); | fprintf(ficresvpl,"\n#****** "); |
| for(j=1;j<=cptcoveff;j++) | printf("\n#****** "); |
| fprintf(ficresvpl,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); | fprintf(ficlog,"\n#****** "); |
| fprintf(ficresvpl,"******\n"); | for(j=1;j<=cptcoveff;j++) { |
| fprintf(ficresvpl,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); | |
| fprintf(ficlog,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); | |
| printf("V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); | |
| } | |
| fprintf(ficresvpl,"******\n"); | |
| printf("******\n"); | |
| fprintf(ficlog,"******\n"); | |
| varpl=matrix(1,nlstate,(int) bage, (int) fage); | varpl=matrix(1,nlstate,(int) bage, (int) fage); |
| oldm=oldms;savm=savms; | oldm=oldms;savm=savms; |
| varprevlim(fileres, varpl, matcov, p, delti, nlstate, stepm, (int) bage, (int) fage, oldm, savm, prlim, ftolpl, &ncvyear, k, strstart); | varprevlim(fileres, varpl, matcov, p, delti, nlstate, stepm, (int) bage, (int) fage, oldm, savm, prlim, ftolpl, &ncvyear, k, strstart); |
| free_matrix(varpl,1,nlstate,(int) bage, (int)fage); | free_matrix(varpl,1,nlstate,(int) bage, (int)fage); |
| /*}*/ | /*}*/ |
| } | } |
| fclose(ficresvpl); | fclose(ficresvpl); |
| printf("done variance-covariance of period prevalence\n");fflush(stdout); | printf("done variance-covariance of period prevalence\n");fflush(stdout); |
| fprintf(ficlog,"done variance-covariance of period prevalence\n");fflush(ficlog); | fprintf(ficlog,"done variance-covariance of period prevalence\n");fflush(ficlog); |
| free_vector(weight,1,n); | |
| free_imatrix(Tvard,1,NCOVMAX,1,2); | |
| free_imatrix(s,1,maxwav+1,1,n); | |
| free_matrix(anint,1,maxwav,1,n); | |
| free_matrix(mint,1,maxwav,1,n); | |
| free_ivector(cod,1,n); | |
| free_ivector(tab,1,NCOVMAX); | |
| fclose(ficresstdeij); | |
| fclose(ficrescveij); | |
| fclose(ficresvij); | |
| fclose(ficrest); | |
| fclose(ficpar); | |
| /*---------- End : free ----------------*/ | /*---------- End : free ----------------*/ |
| if (mobilav!=0) free_ma3x(mobaverage,1, AGESUP,1,NCOVMAX, 1,NCOVMAX); | if (mobilav!=0 ||mobilavproj !=0) |
| free_ma3x(probs,1,AGESUP,1,NCOVMAX, 1,NCOVMAX); | free_ma3x(mobaverages,1, AGESUP,1,nlstate+ndeath, 1,ncovcombmax); /* We need to have a squared matrix with prevalence of the dead! */ |
| } /* mle==-3 arrives here for freeing */ | free_ma3x(probs,1,AGESUP,1,nlstate+ndeath, 1,ncovcombmax); |
| /* endfree:*/ | |
| free_matrix(prlim,1,nlstate,1,nlstate); /*here or after loop ? */ | free_matrix(prlim,1,nlstate,1,nlstate); /*here or after loop ? */ |
| free_matrix(pmmij,1,nlstate+ndeath,1,nlstate+ndeath); | free_matrix(pmmij,1,nlstate+ndeath,1,nlstate+ndeath); |
| free_matrix(oldms, 1,nlstate+ndeath,1,nlstate+ndeath); | } /* mle==-3 arrives here for freeing */ |
| free_matrix(newms, 1,nlstate+ndeath,1,nlstate+ndeath); | /* endfree:*/ |
| free_matrix(savms, 1,nlstate+ndeath,1,nlstate+ndeath); | free_matrix(oldms, 1,nlstate+ndeath,1,nlstate+ndeath); |
| free_matrix(covar,0,NCOVMAX,1,n); | free_matrix(newms, 1,nlstate+ndeath,1,nlstate+ndeath); |
| free_matrix(matcov,1,npar,1,npar); | free_matrix(savms, 1,nlstate+ndeath,1,nlstate+ndeath); |
| free_matrix(hess,1,npar,1,npar); | free_ma3x(cotqvar,1,maxwav,1,nqtv,1,n); |
| /*free_vector(delti,1,npar);*/ | free_ma3x(cotvar,1,maxwav,1,ntv,1,n); |
| free_ma3x(delti3,1,nlstate,1, nlstate+ndeath-1,1,ncovmodel); | free_matrix(coqvar,1,maxwav,1,n); |
| free_matrix(agev,1,maxwav,1,imx); | free_matrix(covar,0,NCOVMAX,1,n); |
| free_ma3x(param,1,nlstate,1, nlstate+ndeath-1,1,ncovmodel); | free_matrix(matcov,1,npar,1,npar); |
| free_matrix(hess,1,npar,1,npar); | |
| free_ivector(ncodemax,1,NCOVMAX); | /*free_vector(delti,1,npar);*/ |
| free_ivector(ncodemaxwundef,1,NCOVMAX); | free_ma3x(delti3,1,nlstate,1, nlstate+ndeath-1,1,ncovmodel); |
| free_ivector(Tvar,1,NCOVMAX); | free_matrix(agev,1,maxwav,1,imx); |
| free_ivector(Tprod,1,NCOVMAX); | free_ma3x(param,1,nlstate,1, nlstate+ndeath-1,1,ncovmodel); |
| free_ivector(Tvaraff,1,NCOVMAX); | |
| free_ivector(Tage,1,NCOVMAX); | free_ivector(ncodemax,1,NCOVMAX); |
| free_ivector(ncodemaxwundef,1,NCOVMAX); | |
| free_imatrix(nbcode,0,NCOVMAX,0,NCOVMAX); | free_ivector(Dummy,-1,NCOVMAX); |
| /* free_imatrix(codtab,1,100,1,10); */ | free_ivector(Fixed,-1,NCOVMAX); |
| free_ivector(Typevar,-1,NCOVMAX); | |
| free_ivector(Tvar,1,NCOVMAX); | |
| free_ivector(Tposprod,1,NCOVMAX); | |
| free_ivector(Tprod,1,NCOVMAX); | |
| free_ivector(Tvaraff,1,NCOVMAX); | |
| free_ivector(invalidvarcomb,1,ncovcombmax); | |
| free_ivector(Tage,1,NCOVMAX); | |
| free_ivector(Tmodelind,1,NCOVMAX); | |
| free_imatrix(nbcode,0,NCOVMAX,0,NCOVMAX); | |
| /* free_imatrix(codtab,1,100,1,10); */ | |
| fflush(fichtm); | fflush(fichtm); |
| fflush(ficgp); | fflush(ficgp); |
| if((nberr >0) || (nbwarn>0)){ | if((nberr >0) || (nbwarn>0)){ |
| printf("End of Imach with %d errors and/or %d warnings. Please look at the log file for details.\n",nberr,nbwarn); | printf("End of Imach with %d errors and/or %d warnings. Please look at the log file for details.\n",nberr,nbwarn); |
| fprintf(ficlog,"End of Imach with %d errors and/or warnings %d. Please look at the log file for details.\n",nberr,nbwarn); | fprintf(ficlog,"End of Imach with %d errors and/or warnings %d. Please look at the log file for details.\n",nberr,nbwarn); |
| Line 9509 Please run with mle=-1 to get a correct | Line 10564 Please run with mle=-1 to get a correct |
| printf("Local time at start %s\nLocal time at end %s",strstart, strtend); | printf("Local time at start %s\nLocal time at end %s",strstart, strtend); |
| fprintf(ficlog,"Local time at start %s\nLocal time at end %s\n",strstart, strtend); | fprintf(ficlog,"Local time at start %s\nLocal time at end %s\n",strstart, strtend); |
| printf("Total time used %s\n", asc_diff_time(rend_time -rstart_time,tmpout)); | printf("Total time used %s\n", asc_diff_time(rend_time -rstart_time,tmpout)); |
| printf("Total time was %.0lf Sec.\n", difftime(rend_time,rstart_time)); | printf("Total time was %.0lf Sec.\n", difftime(rend_time,rstart_time)); |
| fprintf(ficlog,"Total time used %s\n", asc_diff_time(rend_time -rstart_time,tmpout)); | fprintf(ficlog,"Total time used %s\n", asc_diff_time(rend_time -rstart_time,tmpout)); |
| fprintf(ficlog,"Total time was %.0lf Sec.\n", difftime(rend_time,rstart_time)); | fprintf(ficlog,"Total time was %.0lf Sec.\n", difftime(rend_time,rstart_time)); |
| Line 9522 Please run with mle=-1 to get a correct | Line 10577 Please run with mle=-1 to get a correct |
| fclose(ficgp); | fclose(ficgp); |
| fclose(ficlog); | fclose(ficlog); |
| /*------ End -----------*/ | /*------ End -----------*/ |
| printf("Before Current directory %s!\n",pathcd); | printf("Before Current directory %s!\n",pathcd); |
| #ifdef WIN32 | #ifdef WIN32 |
| if (_chdir(pathcd) != 0) | if (_chdir(pathcd) != 0) |
| printf("Can't move to directory %s!\n",path); | printf("Can't move to directory %s!\n",path); |
| if(_getcwd(pathcd,MAXLINE) > 0) | if(_getcwd(pathcd,MAXLINE) > 0) |
| #else | #else |
| if(chdir(pathcd) != 0) | if(chdir(pathcd) != 0) |
| printf("Can't move to directory %s!\n", path); | printf("Can't move to directory %s!\n", path); |
| if (getcwd(pathcd, MAXLINE) > 0) | if (getcwd(pathcd, MAXLINE) > 0) |
| #endif | #endif |
| printf("Current directory %s!\n",pathcd); | printf("Current directory %s!\n",pathcd); |
| /*strcat(plotcmd,CHARSEPARATOR);*/ | /*strcat(plotcmd,CHARSEPARATOR);*/ |
| Line 9558 Please run with mle=-1 to get a correct | Line 10613 Please run with mle=-1 to get a correct |
| sprintf(plotcmd,"%s %s",pplotcmd, optionfilegnuplot); | sprintf(plotcmd,"%s %s",pplotcmd, optionfilegnuplot); |
| printf("Starting graphs with: '%s'\n",plotcmd);fflush(stdout); | printf("Starting graphs with: '%s'\n",plotcmd);fflush(stdout); |
| if((outcmd=system(plotcmd)) != 0){ | if((outcmd=system(plotcmd)) != 0){ |
| printf("gnuplot command might not be in your path: '%s', err=%d\n", plotcmd, outcmd); | printf("gnuplot command might not be in your path: '%s', err=%d\n", plotcmd, outcmd); |
| printf("\n Trying if gnuplot resides on the same directory that IMaCh\n"); | printf("\n Trying if gnuplot resides on the same directory that IMaCh\n"); |
| Line 9586 Please run with mle=-1 to get a correct | Line 10641 Please run with mle=-1 to get a correct |
| else if (z[0] == 'g') system(plotcmd); | else if (z[0] == 'g') system(plotcmd); |
| else if (z[0] == 'q') exit(0); | else if (z[0] == 'q') exit(0); |
| } | } |
| end: | end: |
| while (z[0] != 'q') { | while (z[0] != 'q') { |
| printf("\nType q for exiting: "); fflush(stdout); | printf("\nType q for exiting: "); fflush(stdout); |
| scanf("%s",z); | scanf("%s",z); |