--- imach/src/imach.c 2015/10/24 07:14:11 1.206 +++ imach/src/imach.c 2021/03/31 13:11:57 1.308 @@ -1,6 +1,344 @@ -/* $Id: imach.c,v 1.206 2015/10/24 07:14:11 brouard Exp $ +/* $Id: imach.c,v 1.308 2021/03/31 13:11:57 brouard Exp $ $State: Exp $ $Log: imach.c,v $ + Revision 1.308 2021/03/31 13:11:57 brouard + Summary: Version 0.99r23 + + + * imach.c (Module): Still bugs in the result loop. Thank to Holly Benett + + Revision 1.307 2021/03/08 18:11:32 brouard + Summary: 0.99r22 fixed bug on result: + + Revision 1.306 2021/02/20 15:44:02 brouard + Summary: Version 0.99r21 + + * imach.c (Module): Fix bug on quitting after result lines! + (Module): Version 0.99r21 + + Revision 1.305 2021/02/20 15:28:30 brouard + * imach.c (Module): Fix bug on quitting after result lines! + + Revision 1.304 2021/02/12 11:34:20 brouard + * imach.c (Module): The use of a Windows BOM (huge) file is now an error + + Revision 1.303 2021/02/11 19:50:15 brouard + * (Module): imach.c Someone entered 'results:' instead of 'result:'. Now it is an error which is printed. + + Revision 1.302 2020/02/22 21:00:05 brouard + * (Module): imach.c Update mle=-3 (for computing Life expectancy + and life table from the data without any state) + + Revision 1.301 2019/06/04 13:51:20 brouard + Summary: Error in 'r'parameter file backcast yearsbproj instead of yearsfproj + + Revision 1.300 2019/05/22 19:09:45 brouard + Summary: version 0.99r19 of May 2019 + + Revision 1.299 2019/05/22 18:37:08 brouard + Summary: Cleaned 0.99r19 + + Revision 1.298 2019/05/22 18:19:56 brouard + *** empty log message *** + + Revision 1.297 2019/05/22 17:56:10 brouard + Summary: Fix bug by moving date2dmy and nhstepm which gaefin=-1 + + Revision 1.296 2019/05/20 13:03:18 brouard + Summary: Projection syntax simplified + + + We can now start projections, forward or backward, from the mean date + of inteviews up to or down to a number of years of projection: + prevforecast=1 yearsfproj=15.3 mobil_average=0 + or + prevforecast=1 starting-proj-date=1/1/2007 final-proj-date=12/31/2017 mobil_average=0 + or + prevbackcast=1 yearsbproj=12.3 mobil_average=1 + or + prevbackcast=1 starting-back-date=1/10/1999 final-back-date=1/1/1985 mobil_average=1 + + Revision 1.295 2019/05/18 09:52:50 brouard + Summary: doxygen tex bug + + Revision 1.294 2019/05/16 14:54:33 brouard + Summary: There was some wrong lines added + + Revision 1.293 2019/05/09 15:17:34 brouard + *** empty log message *** + + Revision 1.292 2019/05/09 14:17:20 brouard + Summary: Some updates + + Revision 1.291 2019/05/09 13:44:18 brouard + Summary: Before ncovmax + + Revision 1.290 2019/05/09 13:39:37 brouard + Summary: 0.99r18 unlimited number of individuals + + The number n which was limited to 20,000 cases is now unlimited, from firstobs to lastobs. If the number is too for the virtual memory, probably an error will occur. + + Revision 1.289 2018/12/13 09:16:26 brouard + Summary: Bug for young ages (<-30) will be in r17 + + Revision 1.288 2018/05/02 20:58:27 brouard + Summary: Some bugs fixed + + Revision 1.287 2018/05/01 17:57:25 brouard + Summary: Bug fixed by providing frequencies only for non missing covariates + + Revision 1.286 2018/04/27 14:27:04 brouard + Summary: some minor bugs + + Revision 1.285 2018/04/21 21:02:16 brouard + Summary: Some bugs fixed, valgrind tested + + Revision 1.284 2018/04/20 05:22:13 brouard + Summary: Computing mean and stdeviation of fixed quantitative variables + + Revision 1.283 2018/04/19 14:49:16 brouard + Summary: Some minor bugs fixed + + Revision 1.282 2018/02/27 22:50:02 brouard + *** empty log message *** + + Revision 1.281 2018/02/27 19:25:23 brouard + Summary: Adding second argument for quitting + + Revision 1.280 2018/02/21 07:58:13 brouard + Summary: 0.99r15 + + New Makefile with recent VirtualBox 5.26. Bug in sqrt negatve in imach.c + + Revision 1.279 2017/07/20 13:35:01 brouard + Summary: temporary working + + Revision 1.278 2017/07/19 14:09:02 brouard + Summary: Bug for mobil_average=0 and prevforecast fixed(?) + + Revision 1.277 2017/07/17 08:53:49 brouard + Summary: BOM files can be read now + + Revision 1.276 2017/06/30 15:48:31 brouard + Summary: Graphs improvements + + Revision 1.275 2017/06/30 13:39:33 brouard + Summary: Saito's color + + Revision 1.274 2017/06/29 09:47:08 brouard + Summary: Version 0.99r14 + + Revision 1.273 2017/06/27 11:06:02 brouard + Summary: More documentation on projections + + Revision 1.272 2017/06/27 10:22:40 brouard + Summary: Color of backprojection changed from 6 to 5(yellow) + + Revision 1.271 2017/06/27 10:17:50 brouard + Summary: Some bug with rint + + Revision 1.270 2017/05/24 05:45:29 brouard + *** empty log message *** + + Revision 1.269 2017/05/23 08:39:25 brouard + Summary: Code into subroutine, cleanings + + Revision 1.268 2017/05/18 20:09:32 brouard + Summary: backprojection and confidence intervals of backprevalence + + Revision 1.267 2017/05/13 10:25:05 brouard + Summary: temporary save for backprojection + + Revision 1.266 2017/05/13 07:26:12 brouard + Summary: Version 0.99r13 (improvements and bugs fixed) + + Revision 1.265 2017/04/26 16:22:11 brouard + Summary: imach 0.99r13 Some bugs fixed + + Revision 1.264 2017/04/26 06:01:29 brouard + Summary: Labels in graphs + + Revision 1.263 2017/04/24 15:23:15 brouard + Summary: to save + + Revision 1.262 2017/04/18 16:48:12 brouard + *** empty log message *** + + Revision 1.261 2017/04/05 10:14:09 brouard + Summary: Bug in E_ as well as in T_ fixed nres-1 vs k1-1 + + Revision 1.260 2017/04/04 17:46:59 brouard + Summary: Gnuplot indexations fixed (humm) + + Revision 1.259 2017/04/04 13:01:16 brouard + Summary: Some errors to warnings only if date of death is unknown but status is death we could set to pi3 + + Revision 1.258 2017/04/03 10:17:47 brouard + Summary: Version 0.99r12 + + Some cleanings, conformed with updated documentation. + + Revision 1.257 2017/03/29 16:53:30 brouard + Summary: Temp + + Revision 1.256 2017/03/27 05:50:23 brouard + Summary: Temporary + + Revision 1.255 2017/03/08 16:02:28 brouard + Summary: IMaCh version 0.99r10 bugs in gnuplot fixed + + Revision 1.254 2017/03/08 07:13:00 brouard + Summary: Fixing data parameter line + + Revision 1.253 2016/12/15 11:59:41 brouard + Summary: 0.99 in progress + + Revision 1.252 2016/09/15 21:15:37 brouard + *** empty log message *** + + Revision 1.251 2016/09/15 15:01:13 brouard + Summary: not working + + Revision 1.250 2016/09/08 16:07:27 brouard + Summary: continue + + Revision 1.249 2016/09/07 17:14:18 brouard + Summary: Starting values from frequencies + + Revision 1.248 2016/09/07 14:10:18 brouard + *** empty log message *** + + Revision 1.247 2016/09/02 11:11:21 brouard + *** empty log message *** + + Revision 1.246 2016/09/02 08:49:22 brouard + *** empty log message *** + + Revision 1.245 2016/09/02 07:25:01 brouard + *** empty log message *** + + Revision 1.244 2016/09/02 07:17:34 brouard + *** empty log message *** + + Revision 1.243 2016/09/02 06:45:35 brouard + *** empty log message *** + + Revision 1.242 2016/08/30 15:01:20 brouard + Summary: Fixing a lots + + Revision 1.241 2016/08/29 17:17:25 brouard + Summary: gnuplot problem in Back projection to fix + + Revision 1.240 2016/08/29 07:53:18 brouard + Summary: Better + + Revision 1.239 2016/08/26 15:51:03 brouard + Summary: Improvement in Powell output in order to copy and paste + + Author: + + Revision 1.238 2016/08/26 14:23:35 brouard + Summary: Starting tests of 0.99 + + Revision 1.237 2016/08/26 09:20:19 brouard + Summary: to valgrind + + Revision 1.236 2016/08/25 10:50:18 brouard + *** empty log message *** + + Revision 1.235 2016/08/25 06:59:23 brouard + *** empty log message *** + + Revision 1.234 2016/08/23 16:51:20 brouard + *** empty log message *** + + Revision 1.233 2016/08/23 07:40:50 brouard + Summary: not working + + Revision 1.232 2016/08/22 14:20:21 brouard + Summary: not working + + Revision 1.231 2016/08/22 07:17:15 brouard + Summary: not working + + Revision 1.230 2016/08/22 06:55:53 brouard + Summary: Not working + + Revision 1.229 2016/07/23 09:45:53 brouard + Summary: Completing for func too + + Revision 1.228 2016/07/22 17:45:30 brouard + Summary: Fixing some arrays, still debugging + + 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 + Summary: Experimental backcast + + Revision 1.216 2015/12/18 17:32:11 brouard + Summary: 0.98r4 Warning and status=-2 + + Version 0.98r4 is now: + - displaying an error when status is -1, date of interview unknown and date of death known; + - permitting a status -2 when the vital status is unknown at a known date of right truncation. + Older changes concerning s=-2, dating from 2005 have been supersed. + + Revision 1.215 2015/12/16 08:52:24 brouard + Summary: 0.98r4 working + + Revision 1.214 2015/12/16 06:57:54 brouard + Summary: temporary not working + + Revision 1.213 2015/12/11 18:22:17 brouard + Summary: 0.98r4 + + Revision 1.212 2015/11/21 12:47:24 brouard + Summary: minor typo + + Revision 1.211 2015/11/21 12:41:11 brouard + Summary: 0.98r3 with some graph of projected cross-sectional + + Author: Nicolas Brouard + + Revision 1.210 2015/11/18 17:41:20 brouard + Summary: Start working on projected prevalences Revision 1.209 2015/11/17 22:12:03 brouard + Summary: Adding ftolpl parameter + Author: N Brouard + + We had difficulties to get smoothed confidence intervals. It was due + to the period prevalence which wasn't computed accurately. The inner + parameter ftolpl is now an outer parameter of the .imach parameter + file after estepm. If ftolpl is small 1.e-4 and estepm too, + computation are long. + + Revision 1.208 2015/11/17 14:31:57 brouard + Summary: temporary + + Revision 1.207 2015/10/27 17:36:57 brouard + *** empty log message *** + Revision 1.206 2015/10/24 07:14:11 brouard *** empty log message *** @@ -568,24 +906,27 @@ Short summary of the programme: - This program computes Healthy Life Expectancies from - cross-longitudinal data. Cross-longitudinal data consist in: -1- a - first survey ("cross") where individuals from different ages are - interviewed on their health status or degree of disability (in the - case of a health survey which is our main interest) -2- at least a - second wave of interviews ("longitudinal") which measure each change - (if any) in individual health status. Health expectancies are - computed from the time spent in each health state according to a - model. More health states you consider, more time is necessary to reach the - Maximum Likelihood of the parameters involved in the model. The - simplest model is the multinomial logistic model where pij is the - probability to be observed in state j at the second wave - conditional to be observed in state i at the first wave. Therefore - the model is: log(pij/pii)= aij + bij*age+ cij*sex + etc , where - 'age' is age and 'sex' is a covariate. If you want to have a more - complex model than "constant and age", you should modify the program - where the markup *Covariates have to be included here again* invites - you to do it. More covariates you add, slower the + This program computes Healthy Life Expectancies or State-specific + (if states aren't health statuses) Expectancies from + cross-longitudinal data. Cross-longitudinal data consist in: + + -1- a first survey ("cross") where individuals from different ages + are interviewed on their health status or degree of disability (in + the case of a health survey which is our main interest) + + -2- at least a second wave of interviews ("longitudinal") which + measure each change (if any) in individual health status. Health + expectancies are computed from the time spent in each health state + according to a model. More health states you consider, more time is + necessary to reach the Maximum Likelihood of the parameters involved + in the model. The simplest model is the multinomial logistic model + where pij is the probability to be observed in state j at the second + wave conditional to be observed in state i at the first + wave. Therefore the model is: log(pij/pii)= aij + bij*age+ cij*sex + + etc , where 'age' is age and 'sex' is a covariate. If you want to + have a more complex model than "constant and age", you should modify + the program where the markup *Covariates have to be included here + again* invites you to do it. More covariates you add, slower the convergence. The advantage of this computer programme, compared to a simple @@ -604,7 +945,55 @@ hPijx. 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, nres); + Computes the transition matrix starting at age 'age' over + 'nhstepm*hstepm*stepm' months (i.e. until + age (in years) age+nhstepm*hstepm*stepm/12) by multiplying + 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). Institut national d'études démographiques, Paris. @@ -666,9 +1055,9 @@ /* #define DEBUGLINMIN */ /* #define DEBUGHESS */ #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 POWELLF1F3 /* Skip test */ +#define POWELLNOF3INFF1TEST /* Skip test */ /* #define POWELLORIGINAL /\* Don't use Directest to decide new direction but original Powell test *\/ */ /* #define MNBRAKORIGINAL /\* Don't use mnbrak fix *\/ */ @@ -676,6 +1065,7 @@ #include #include #include +#include #ifdef _WIN32 #include @@ -721,7 +1111,7 @@ typedef struct { /* #include */ /* #define _(String) gettext (String) */ -#define MAXLINE 1024 /* Was 256. Overflow with 312 with 2 states and 4 covariates. Should be ok */ +#define MAXLINE 2048 /* Was 256 and 1024. Overflow with 312 with 2 states and 4 covariates. Should be ok */ #define GNUPLOTPROGRAM "gnuplot" /*#define GNUPLOTPROGRAM "..\\gp37mgw\\wgnuplot"*/ @@ -736,11 +1126,17 @@ typedef struct { #define NINTERVMAX 8 #define NLSTATEMAX 8 /**< Maximum number of live states (for func) */ #define NDEATHMAX 8 /**< Maximum number of dead states (for func) */ -#define NCOVMAX 20 /**< Maximum number of covariates, including generated covariates V1*V2 */ +#define NCOVMAX 20 /**< Maximum number of covariates, including generated covariates V1*V2 */ #define codtabm(h,k) (1 & (h-1) >> (k-1))+1 -#define MAXN 20000 +/*#define decodtabm(h,k,cptcoveff)= (h <= (1<> (k-1)) & 1) +1 : -1)*/ +#define decodtabm(h,k,cptcoveff) (((h-1) >> (k-1)) & 1) +1 +/*#define MAXN 20000 */ /* Should by replaced by nobs, real number of observations and unlimited */ #define YEARM 12. /**< Number of months per year */ -#define AGESUP 130 +/* #define AGESUP 130 */ +/* #define AGESUP 150 */ +#define AGESUP 200 +#define AGEINF 0 +#define AGEMARGE 25 /* Marge for agemin and agemax for(iage=agemin-AGEMARGE; iage <= agemax+3+AGEMARGE; iage++) */ #define AGEBASE 40 #define AGEOVERFLOW 1.e20 #define AGEGOMP 10 /**< Minimal age for Gompertz adjustment */ @@ -754,12 +1150,12 @@ typedef struct { #define ODIRSEPARATOR '\\' #endif -/* $Id: imach.c,v 1.206 2015/10/24 07:14:11 brouard Exp $ */ +/* $Id: imach.c,v 1.308 2021/03/31 13:11:57 brouard Exp $ */ /* $State: Exp $ */ #include "version.h" 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 fullversion[]="$Revision: 1.206 $ $Date: 2015/10/24 07:14:11 $"; +char copyright[]="March 2021,INED-EUROREVES-Institut de longevite-Japan Society for the Promotion of Science (Grant-in-Aid for Scientific Research 25293121), Intel Software 2015-2020, Nihon University 2021, INED 2000-2021"; +char fullversion[]="$Revision: 1.308 $ $Date: 2021/03/31 13:11:57 $"; char strstart[80]; char optionfilext[10], optionfilefiname[FILENAMELENGTH]; int erreur=0, nberr=0, nbwarn=0; /* Error number, number of errors number of warnings */ @@ -767,15 +1163,28 @@ int nagesqr=0, nforce=0; /* nagesqr=1 if /* 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 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 cptcovprodnoage=0; /**< Number of covariate products without age */ int cptcoveff=0; /* Total number of covariates to vary for printing results */ +int ncovf=0; /* Total number of effective fixed covariates (dummy or quantitative) in the model */ +int ncovv=0; /* Total number of effective (wave) varying covariates (dummy or quantitative) in the model */ +int ncova=0; /* Total number of effective (wave and stepm) varying with age covariates (dummy of quantitative) in the model */ +int nsd=0; /**< Total number of single dummy variables (output) */ +int nsq=0; /**< Total number of single quantitative variables (output) */ +int ncoveff=0; /* Total number of effective fixed dummy 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 npar=NPARMAX; +int nobs=10; /* Number of observations in the data lastobs-firstobs */ +int ncovcombmax=NCOVMAX; /* Maximum calculated number of covariate combination = pow(2, cptcoveff) */ +int npar=NPARMAX; /* Number of parameters (nlstate+ndeath-1)*nlstate*ncovmodel; */ int nlstate=2; /* Number of live 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 nqv=0, ntv=0, nqtv=0; /* Total number of quantitative variables, time variable (dummy), quantitative and time variable */ int popbased=0; int *wav; /* Number of waves for this individuual 0 is possible */ @@ -790,12 +1199,16 @@ int **dh; /* dh[mi][i] is number of step int **bh; /* bh[mi][i] is the bias (+ or -) for this individual if the delay between * wave mi and wave mi+1 is not an exact multiple of stepm. */ int countcallfunc=0; /* Count the number of calls to func */ +int selected(int kvar); /* Is covariate kvar selected for printing results */ + double jmean=1; /* Mean space between 2 waves */ double **matprod2(); /* test */ double **oldm, **newm, **savm; /* 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 *ficpar, *ficparo,*ficres, *ficresp, *ficrespl, *ficrespij, *ficrest,*ficresf,*ficrespop; +FILE *ficpar, *ficparo,*ficres, *ficresp, *ficresphtm, *ficresphtmfr, *ficrespl, *ficresplb,*ficrespij, *ficrespijb, *ficrest,*ficresf, *ficresfb,*ficrespop; FILE *ficlog, *ficrespow; int globpr=0; /* Global variable for printing or not */ double fretone; /* Only one call to likelihood */ @@ -815,16 +1228,16 @@ FILE *ficrescveij; char filerescve[FILENAMELENGTH]; FILE *ficresvij; char fileresv[FILENAMELENGTH]; -FILE *ficresvpl; -char fileresvpl[FILENAMELENGTH]; + char title[MAXLINE]; -char optionfile[FILENAMELENGTH], datafile[FILENAMELENGTH], filerespl[FILENAMELENGTH]; +char model[MAXLINE]; /**< The model line */ +char optionfile[FILENAMELENGTH], datafile[FILENAMELENGTH], filerespl[FILENAMELENGTH], fileresplb[FILENAMELENGTH]; char plotcmd[FILENAMELENGTH], pplotcmd[FILENAMELENGTH]; char tmpout[FILENAMELENGTH], tmpout2[FILENAMELENGTH]; char command[FILENAMELENGTH]; int outcmd=0; -char fileres[FILENAMELENGTH], filerespij[FILENAMELENGTH], filereso[FILENAMELENGTH], rfileres[FILENAMELENGTH]; +char fileres[FILENAMELENGTH], filerespij[FILENAMELENGTH], filerespijb[FILENAMELENGTH], filereso[FILENAMELENGTH], rfileres[FILENAMELENGTH]; char fileresu[FILENAMELENGTH]; /* fileres without r in front */ char filelog[FILENAMELENGTH]; /* Log file */ char filerest[FILENAMELENGTH]; @@ -855,7 +1268,8 @@ double dval; #define FTOL 1.0e-10 #define NRANSI -#define ITMAX 200 +#define ITMAX 200 +#define ITPOWMAX 20 /* This is now multiplied by the number of parameters */ #define TOL 2.0e-4 @@ -901,24 +1315,127 @@ int *ncodemaxwundef; /* ncodemax[j]= Nu covariate for which somebody answered including undefined. Usually 3: -1, 0 and 1. */ double **agev,*moisnais, *annais, *moisdc, *andc,**mint, **anint; -double **pmmij, ***probs; +double **pmmij, ***probs; /* Global pointer */ +double ***mobaverage, ***mobaverages; /* New global variable */ double *ageexmed,*agecens; double dateintmean=0; + double anprojd, mprojd, jprojd; /* For eventual projections */ + double anprojf, mprojf, jprojf; + double anbackd, mbackd, jbackd; /* For eventual backprojections */ + double anbackf, mbackf, jbackf; + double jintmean,mintmean,aintmean; double *weight; int **s; /* Status */ double *agedc; double **covar; /**< covar[j,i], value of jth covariate for individual i, * covar=matrix(0,NCOVMAX,1,n); * cov[Tage[kk]+2]=covar[Tvar[Tage[kk]]][i]*age; */ +double **coqvar; /* Fixed quantitative covariate nqv */ +double ***cotvar; /* Time varying covariate ntv */ +double ***cotqvar; /* Time varying quantitative covariate itqv */ double idx; int **nbcode, *Tvar; /**< model=V2 => Tvar[1]= 2 */ +/* V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ +/*k 1 2 3 4 5 6 7 8 9 */ +/*Tvar[k]= 5 4 3 6 5 2 7 1 1 */ +/* Tndvar[k] 1 2 3 4 5 */ +/*TDvar 4 3 6 7 1 */ /* For outputs only; combination of dummies fixed or varying */ +/* Tns[k] 1 2 2 4 5 */ /* Number of single cova */ +/* TvarsD[k] 1 2 3 */ /* Number of single dummy cova */ +/* TvarsDind 2 3 9 */ /* position K of single dummy cova */ +/* TvarsQ[k] 1 2 */ /* Number of single quantitative cova */ +/* TvarsQind 1 6 */ /* position K of single quantitative cova */ +/* Tprod[i]=k 4 7 */ +/* Tage[i]=k 5 8 */ +/* */ +/* Type */ +/* V 1 2 3 4 5 */ +/* F F V V V */ +/* D Q D D Q */ +/* */ +int *TvarsD; +int *TvarsDind; +int *TvarsQ; +int *TvarsQind; + +#define MAXRESULTLINES 10 +int nresult=0; +int parameterline=0; /* # of the parameter (type) line */ +int TKresult[MAXRESULTLINES]; +int Tresult[MAXRESULTLINES][NCOVMAX];/* For dummy variable , value (output) */ +int Tinvresult[MAXRESULTLINES][NCOVMAX];/* For dummy variable , value (output) */ +int Tvresult[MAXRESULTLINES][NCOVMAX]; /* For dummy variable , variable # (output) */ +double Tqresult[MAXRESULTLINES][NCOVMAX]; /* For quantitative variable , value (output) */ +double Tqinvresult[MAXRESULTLINES][NCOVMAX]; /* For quantitative variable , value (output) */ +int Tvqresult[MAXRESULTLINES][NCOVMAX]; /* For quantitative variable , variable # (output) */ + +/* int *TDvar; /\**< TDvar[1]=4, TDvarF[2]=3, TDvar[3]=6 in V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 *\/ */ +int *TvarF; /**< TvarF[1]=Tvar[6]=2, TvarF[2]=Tvar[7]=7, TvarF[3]=Tvar[9]=1 in V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ +int *TvarFind; /**< TvarFind[1]=6, TvarFind[2]=7, Tvarind[3]=9 in V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ +int *TvarV; /**< TvarV[1]=Tvar[1]=5, TvarV[2]=Tvar[2]=4 in V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ +int *TvarVind; /**< TvarVind[1]=1, TvarVind[2]=2 in V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ +int *TvarA; /**< TvarA[1]=Tvar[5]=5, TvarA[2]=Tvar[8]=1 in V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ +int *TvarAind; /**< TvarindA[1]=5, TvarAind[2]=8 in V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ +int *TvarFD; /**< TvarFD[1]=V1 in V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ +int *TvarFDind; /* TvarFDind[1]=9 in V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ +int *TvarFQ; /* TvarFQ[1]=V2 in V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ /* Only simple fixed quantitative variable */ +int *TvarFQind; /* TvarFQind[1]=6 in V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ /* Only simple fixed quantitative variable */ +int *TvarVD; /* TvarVD[1]=V5 in V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ /* Only simple fixed quantitative variable */ +int *TvarVDind; /* TvarVDind[1]=1 in V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ /* Only simple fixed quantitative variable */ +int *TvarVQ; /* TvarVQ[1]=V5 in V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ /* Only simple time varying quantitative variable */ +int *TvarVQind; /* TvarVQind[1]=1 in V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ /* Only simple time varying quantitative variable */ + +int *Tvarsel; /**< Selected covariates for output */ +double *Tvalsel; /**< Selected modality value of covariate for output */ +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 *DummyV; /** Dummy[v] 0=dummy (0 1), 1 quantitative */ +int *FixedV; /** FixedV[v] 0 fixed, 1 varying */ 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 for V1 position,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 *TmodelInvind; /** Tmodelind[Tvaraff[3]]=9 for V1 position,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 *TmodelInvQind; /** Tmodelqind[1]=1 for V5(quantitative varying) position,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 **codtab;*/ /**< codtab=imatrix(1,100,1,10); */ -int **Tvard, *Tprod, cptcovprod, *Tvaraff; +int **Tvard; +int *Tprod;/**< Gives the k position of the k1 product */ +/* Tprod[k1=1]=3(=V1*V4) for V2+V1+V1*V4+age*V3 */ +int *Tposprod; /**< Gives the k1 product from the k position */ + /* if V2+V1+V1*V4+age*V3+V3*V2 TProd[k1=2]=5 (V3*V2) */ + /* Tposprod[k]=k1 , Tposprod[3]=1, Tposprod[5(V3*V2)]=2 (2nd product without age) */ +int cptcovprod, *Tvaraff, *invalidvarcomb; double *lsurv, *lpop, *tpop; +#define FD 1; /* Fixed dummy covariate */ +#define FQ 2; /* Fixed quantitative covariate */ +#define FP 3; /* Fixed product covariate */ +#define FPDD 7; /* Fixed product dummy*dummy covariate */ +#define FPDQ 8; /* Fixed product dummy*quantitative covariate */ +#define FPQQ 9; /* Fixed product quantitative*quantitative covariate */ +#define VD 10; /* Varying dummy covariate */ +#define VQ 11; /* Varying quantitative covariate */ +#define VP 12; /* Varying product covariate */ +#define VPDD 13; /* Varying product dummy*dummy covariate */ +#define VPDQ 14; /* Varying product dummy*quantitative covariate */ +#define VPQQ 15; /* Varying product quantitative*quantitative covariate */ +#define APFD 16; /* Age product * fixed dummy covariate */ +#define APFQ 17; /* Age product * fixed quantitative covariate */ +#define APVD 18; /* Age product * varying dummy covariate */ +#define APVQ 19; /* Age product * varying quantitative covariate */ + +#define FTYPE 1; /* Fixed covariate */ +#define VTYPE 2; /* Varying covariate (loop in wave) */ +#define ATYPE 2; /* Age product covariate (loop in dh within wave)*/ + +struct kmodel{ + int maintype; /* main type */ + int subtype; /* subtype */ +}; +struct kmodel modell[NCOVMAX]; + double ftol=FTOL; /**< Tolerance for computing Max Likelihood */ double ftolhess; /**< Tolerance for computing hessian */ @@ -1114,7 +1631,7 @@ int nbocc(char *s, char occ) i=0; lg=strlen(s); for(i=0; i<= lg; i++) { - if (s[i] == occ ) j++; + if (s[i] == occ ) j++; } return j; } @@ -1357,7 +1874,30 @@ char *subdirf3(char fileres[], char *pre strcat(tmpout,fileres); return tmpout; } + +/*************** function subdirfext ***********/ +char *subdirfext(char fileres[], char *preop, char *postop) +{ + + strcpy(tmpout,preop); + strcat(tmpout,fileres); + strcat(tmpout,postop); + return tmpout; +} +/*************** function subdirfext3 ***********/ +char *subdirfext3(char fileres[], char *preop, char *postop) +{ + + /* Caution optionfilefiname is hidden */ + strcpy(tmpout,optionfilefiname); + strcat(tmpout,"/"); + strcat(tmpout,preop); + strcat(tmpout,fileres); + strcat(tmpout,postop); + return tmpout; +} + char *asc_diff_time(long time_sec, char ascdiff[]) { long sec_left, days, hours, minutes; @@ -1435,12 +1975,12 @@ double brent(double ax, double bx, doubl etemp=e; e=d; 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 { - d=p/q; - u=x+d; - if (u-a < tol2 || b-u < tol2) - d=SIGN(tol1,xm-x); + d=p/q; + u=x+d; + if (u-a < tol2 || b-u < tol2) + d=SIGN(tol1,xm-x); } } else { d=CGOLD*(e=(x >= xm ? a-x : b-x)); @@ -1454,13 +1994,13 @@ double brent(double ax, double bx, doubl } else { if (u < x) a=u; else b=u; if (fu <= fw || w == x) { - v=w; - w=u; - fv=fw; - fw=fu; + v=w; + w=u; + fv=fw; + fw=fu; } else if (fu <= fv || v == x || v == w) { - v=u; - fv=fu; + v=u; + fv=fu; } } } @@ -1501,12 +2041,12 @@ values at the three points, fa, fb , and *cx=(*bx)+GOLD*(*bx-*ax); *fc=(*func)(*cx); #ifdef DEBUG - printf("mnbrak0 *fb=%.12e *fc=%.12e\n",*fb,*fc); - fprintf(ficlog,"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 a=%lf *fa=%lf, b=%lf *fb=%lf, c=%lf *fc=%lf\n",*ax,*fa,*bx,*fb,*cx, *fc); #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); - q=(*bx-*cx)*(*fb-*fa); + q=(*bx-*cx)*(*fb-*fa); /* What if fa=inf */ 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). */ ulim=(*bx)+GLIMIT*(*cx-*bx); /* Maximum abscissa where function should be evaluated */ @@ -1517,8 +2057,8 @@ values at the three points, fa, fb , and double A, fparabu; A= (*fb - *fa)/(*bx-*ax)/(*bx+*ax-2*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); - 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); + 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,"\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 */ /* 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) */ @@ -1551,9 +2091,12 @@ values at the three points, fa, fb , and /* fu = *fc; */ /* *fc =dum; */ /* } */ -#ifdef DEBUG - printf("mnbrak34 fu < or >= fc \n"); - fprintf(ficlog, "mnbrak34 fu < fc\n"); +#ifdef DEBUGMNBRAK + double A, fparabu; + 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 dum=u; /* Shifting c and u */ u = *cx; @@ -1564,38 +2107,45 @@ values at the three points, fa, fb , and #endif } else if ((*cx-u)*(u-ulim) > 0.0) { /* u is after c but before ulim */ #ifdef DEBUG - printf("mnbrak2 u after c but before ulim\n"); - fprintf(ficlog, "mnbrak2 u after c but before ulim\n"); + printf("\nmnbrak2 u=%lf after c=%lf but before ulim\n",u,*cx); + fprintf(ficlog,"\nmnbrak2 u=%lf after c=%lf but before ulim\n",u,*cx); #endif fu=(*func)(u); if (fu < *fc) { #ifdef DEBUG - printf("mnbrak2 u after c but before ulim AND fu < fc\n"); - fprintf(ficlog, "mnbrak2 u after c but before ulim AND fu = 0.0) { /* u outside ulim (verifying that ulim is beyond c) */ #ifdef DEBUG - printf("mnbrak2 u outside ulim (verifying that ulim is beyond c)\n"); - fprintf(ficlog, "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,"\nmnbrak2 u=%lf outside ulim=%lf (verifying that ulim is beyond c=%lf)\n",u,ulim,*cx); #endif u=ulim; fu=(*func)(u); } else { /* u could be left to b (if r > q parabola has a maximum) */ #ifdef DEBUG - printf("mnbrak2 u could be left to b (if r > q parabola has a maximum)\n"); - fprintf(ficlog, "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,"\nmnbrak2 u=%lf could be left to b=%lf (if r=%lf > q=%lf parabola has a maximum)\n",u,*bx,r,q); #endif u=(*cx)+GOLD*(*cx-*bx); 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 */ SHFT(*ax,*bx,*cx,u) SHFT(*fa,*fb,*fc,fu) #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); - 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); + printf("\nmnbrak2 shift (*ax=%.12f, *fa=%.12lf), (*bx=%.12f, *fb=%.12lf), (*cx=%.12f, *fc=%.12lf)\n",*ax,*fa,*bx,*fb,*cx,*fc); + fprintf(ficlog, "\nmnbrak2 shift (*ax=%.12f, *fa=%.12lf), (*bx=%.12f, *fb=%.12lf), (*cx=%.12f, *fc=%.12lf)\n",*ax,*fa,*bx,*fb,*cx,*fc); #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) */ } @@ -1610,7 +2160,11 @@ int ncom; double *pcom,*xicom; double (*nrfunc)(double []); +#ifdef LINMINORIGINAL 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 (*f)(double), double tol, double *xmin); @@ -1654,28 +2208,41 @@ void linmin(double p[], double xi[], int #ifdef LINMINORIGINAL #else if (fx != fx){ - xxs=xxs/scale; /* Trying a smaller xx, closer to initial ax=0 */ - printf("|"); - fprintf(ficlog,"|"); + xxs=xxs/scale; /* Trying a smaller xx, closer to initial ax=0 */ + printf("|"); + fprintf(ficlog,"|"); #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 } - }while(fx != fx); + }while(fx != fx && xxs > 1.e-5); #endif #ifdef DEBUGLINMIN printf("\nLinmin after mnbrak: ax=%12.7f xx=%12.7f bx=%12.7f fa=%12.2f fx=%12.2f fb=%12.2f\n", ax,xx,bx,fa,fx,fb); fprintf(ficlog,"\nLinmin after mnbrak: ax=%12.7f xx=%12.7f bx=%12.7f fa=%12.2f fx=%12.2f fb=%12.2f\n", ax,xx,bx,fa,fx,fb); #endif +#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),*/ /* 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]) */ /* 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]; */ #ifdef DEBUG - printf("retour brent fret=%.12e xmin=%.12e\n",*fret,xmin); - fprintf(ficlog,"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 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 #ifdef DEBUGLINMIN printf("linmin end "); @@ -1725,17 +2292,33 @@ 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 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, 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 [])); - int i,ibig,j; +#else + void linmin(double p[], double xi[], int n, double *fret, + double (*func)(double []),int *flat); +#endif + int i,ibig,j,jk,k; double del,t,*pt,*ptt,*xit; double directest; double fp,fptt; double *xits; int niterf, itmp; +#ifdef LINMINORIGINAL +#else + + flatdir=ivector(1,n); + for (j=1;j<=n;j++) flatdir[j]=0; +#endif pt=vector(1,n); ptt=vector(1,n); @@ -1756,14 +2339,47 @@ void powell(double p[], double **xi, int fprintf(ficlog,"\nPowell iter=%d -2*LL=%.12f %ld sec. %ld sec.",*iter,*fret,rcurr_time-rlast_time, rcurr_time-rstart_time); fflush(ficlog); /* fprintf(ficrespow,"%d %.12f %ld",*iter,*fret,curr_time.tm_sec-start_time.tm_sec); */ for (i=1;i<=n;i++) { - printf(" %d %.12f",i, p[i]); - fprintf(ficlog," %d %.12lf",i, p[i]); fprintf(ficrespow," %.12lf", p[i]); } + fprintf(ficrespow,"\n");fflush(ficrespow); + printf("\n#model= 1 + age "); + fprintf(ficlog,"\n#model= 1 + age "); + if(nagesqr==1){ + printf(" + age*age "); + fprintf(ficlog," + age*age "); + } + for(j=1;j <=ncovmodel-2;j++){ + if(Typevar[j]==0) { + printf(" + V%d ",Tvar[j]); + fprintf(ficlog," + V%d ",Tvar[j]); + }else if(Typevar[j]==1) { + printf(" + V%d*age ",Tvar[j]); + fprintf(ficlog," + V%d*age ",Tvar[j]); + }else if(Typevar[j]==2) { + printf(" + V%d*V%d ",Tvard[Tposprod[j]][1],Tvard[Tposprod[j]][2]); + fprintf(ficlog," + V%d*V%d ",Tvard[Tposprod[j]][1],Tvard[Tposprod[j]][2]); + } + } printf("\n"); +/* printf("12 47.0114589 0.0154322 33.2424412 0.3279905 2.3731903 */ +/* 13 -21.5392400 0.1118147 1.2680506 1.2973408 -1.0663662 */ fprintf(ficlog,"\n"); - fprintf(ficrespow,"\n");fflush(ficrespow); - if(*iter <=3){ + for(i=1,jk=1; i <=nlstate; i++){ + for(k=1; k <=(nlstate+ndeath); k++){ + if (k != i) { + printf("%d%d ",i,k); + fprintf(ficlog,"%d%d ",i,k); + for(j=1; j <=ncovmodel; j++){ + printf("%12.7f ",p[jk]); + fprintf(ficlog,"%12.7f ",p[jk]); + jk++; + } + printf("\n"); + fprintf(ficlog,"\n"); + } + } + } + if(*iter <=3 && *iter >1){ tml = *localtime(&rcurr_time); strcpy(strcurr,asctime(&tml)); rforecast_time=rcurr_time; @@ -1778,7 +2394,7 @@ void powell(double p[], double **xi, int strcpy(strfor,asctime(&forecast_time)); itmp = strlen(strfor); 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); 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); } @@ -1792,27 +2408,32 @@ void powell(double p[], double **xi, int #endif printf("%d",i);fflush(stdout); /* print direction (parameter) i */ 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.*/ - /* 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 */ - /* 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. */ - /* Unless the n directions are conjugate some gain in the determinant may be obtained */ - /* with the new direction. */ - del=fabs(fptt-(*fret)); - ibig=i; + /* 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. */ + /* Unless the n directions are conjugate some gain in the determinant may be obtained */ + /* with the new direction. */ + del=fabs(fptt-(*fret)); + ibig=i; } #ifdef DEBUG printf("%d %.12e",i,(*fret)); fprintf(ficlog,"%d %.12e",i,(*fret)); for (j=1;j<=n;j++) { - xits[j]=FMAX(fabs(p[j]-pt[j]),1.e-5); - printf(" x(%d)=%.12e",j,xit[j]); - fprintf(ficlog," x(%d)=%.12e",j,xit[j]); + xits[j]=FMAX(fabs(p[j]-pt[j]),1.e-5); + printf(" x(%d)=%.12e",j,xit[j]); + fprintf(ficlog," x(%d)=%.12e",j,xit[j]); } for(j=1;j<=n;j++) { - printf(" p(%d)=%.12e",j,p[j]); - fprintf(ficlog," p(%d)=%.12e",j,p[j]); + printf(" p(%d)=%.12e",j,p[j]); + fprintf(ficlog," p(%d)=%.12e",j,p[j]); } printf("\n"); fprintf(ficlog,"\n"); @@ -1821,7 +2442,16 @@ void powell(double p[], double **xi, int /* 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 */ /* New value of last point Pn is not computed, P(n-1) */ - if (2.0*fabs(fp-(*fret)) <= ftol*(fabs(fp)+fabs(*fret))) { /* Did we reach enough precision? */ + 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) { /* Did we reach enough precision? */ /* 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 */ /* a chisquare statistics with 1 degree. To be significant at the 95% level, it should have */ @@ -1829,7 +2459,7 @@ 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 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 */ - + /* 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 */ /* Thus the first calls to linmin will give new points and better maximizations until fp-(*fret) is */ @@ -1857,21 +2487,28 @@ void powell(double p[], double **xi, int } #endif - +#ifdef LINMINORIGINAL +#else + free_ivector(flatdir,1,n); +#endif free_vector(xit,1,n); free_vector(xits,1,n); free_vector(ptt,1,n); free_vector(pt,1,n); return; } /* enough precision */ - if (*iter == ITMAX) nrerror("powell exceeding maximum iterations."); + if (*iter == ITMAX*n) nrerror("powell exceeding maximum iterations."); for (j=1;j<=n;j++) { /* Computes the extrapolated point P_0 + 2 (P_n-P_0) */ ptt[j]=2.0*p[j]-pt[j]; xit[j]=p[j]-pt[j]; pt[j]=p[j]; } 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 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 t=2.0*(fp-2.0*(*fret)+fptt)*SQR(fp-(*fret)-del)- del*SQR(fp-fptt); /* Original Numerical Recipes in C*/ #else @@ -1903,16 +2548,16 @@ void powell(double p[], double **xi, int if (t < 0.0) { /* Then we use it for new direction */ #else if (directest*t < 0.0) { /* Contradiction between both tests */ - printf("directest= %.12lf (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); - 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); } if (directest < 0.0) { /* Then we use it for new direction */ #endif #ifdef DEBUGLINMIN printf("Before linmin in direction P%d-P0\n",n); - for (j=1;j<=n;j++) { + for (j=1;j<=n;j++) { printf(" Before xit[%d]= %12.7f p[%d]= %12.7f",j,xit[j],j,p[j]); fprintf(ficlog," Before xit[%d]= %12.7f p[%d]= %12.7f",j,xit[j],j,p[j]); if(j % ncovmodel == 0){ @@ -1921,7 +2566,13 @@ void powell(double p[], double **xi, int } } #endif +#ifdef LINMINORIGINAL linmin(p,xit,n,fret,func); /* computes minimum on the extrapolated direction: changes p and rescales xit.*/ +#else + linmin(p,xit,n,fret,func,&flat); /* computes minimum on the extrapolated direction: changes p and rescales xit.*/ + flatdir[i]=flat; /* Function is vanishing in that direction i */ +#endif + #ifdef DEBUGLINMIN for (j=1;j<=n;j++) { printf("After xit[%d]= %12.7f p[%d]= %12.7f",j,xit[j],j,p[j]); @@ -1936,38 +2587,66 @@ void powell(double p[], double **xi, int 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: ",flatd); + fprintf(ficlog,"%d flat directions :",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 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); for(j=1;j<=n;j++){ - printf(" %.12e",xit[j]); - fprintf(ficlog," %.12e",xit[j]); + printf(" %lf",xit[j]); + fprintf(ficlog," %lf",xit[j]); } printf("\n"); fprintf(ficlog,"\n"); #endif } /* end of t or directest negative */ -#ifdef POWELLF1F3 +#ifdef POWELLNOF3INFF1TEST #else - } /* end if (fptt < fp) */ + } /* end if (fptt < fp) */ #endif - } /* loop iteration */ +#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 */ } - + /**** Prevalence limit (stable or period prevalence) ****************/ - -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 - matrix by transitions matrix until convergence is reached with precision ftolpl */ - /* Wx= Wx-1 Px-1= Wx-2 Px-2 Px-1 = Wx-n Px-n ... Px-2 Px-1 I */ - /* Wx is row vector: population in state 1, population in state 2, population dead */ - /* or prevalence in state 1, prevalence in state 2, 0 */ - /* newm is the matrix after multiplications, its rows are identical at a factor */ - /* Initial matrix pimij */ + + double **prevalim(double **prlim, int nlstate, double x[], double age, double **oldm, double **savm, double ftolpl, int *ncvyear, int ij, int nres) + { + /**< Computes the prevalence limit in each live state at age x and for covariate combination ij + * (and selected quantitative values in nres) + * by left multiplying the unit + * matrix by transitions matrix until convergence is reached with precision ftolpl + * Wx= Wx-1 Px-1= Wx-2 Px-2 Px-1 = Wx-n Px-n ... Px-2 Px-1 I + * Wx is row vector: population in state 1, population in state 2, population dead + * or prevalence in state 1, prevalence in state 2, 0 + * newm is the matrix after multiplications, its rows are identical at a factor. + * Inputs are the parameter, age, a tolerance for the prevalence limit ftolpl. + * Output is prlim. + * Initial matrix pimij + */ /* {0.85204250825084937, 0.13044499163996345, 0.017512500109187184, */ /* 0.090851990222114765, 0.88271245433047185, 0.026435555447413338, */ /* 0, 0 , 1} */ @@ -1980,15 +2659,21 @@ double **prevalim(double **prlim, int nl /* {0.51571254859325999, 0.4842874514067399, */ /* 0.51326036147820708, 0.48673963852179264} */ /* If we start from prlim again, prlim tends to a constant matrix */ - + int i, ii,j,k; - double min, max, maxmin, maxmax,sumnew=0.; + double *min, *max, *meandiff, maxmax,sumnew=0.; /* 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 agefin, delaymax=100 ; /* Max number of years to converge */ + double agefin, delaymax=200. ; /* 100 Max number of years to converge */ int ncvloop=0; + int first=0; + min=vector(1,nlstate); + max=vector(1,nlstate); + meandiff=vector(1,nlstate); + + /* 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); @@ -2005,61 +2690,291 @@ double **prevalim(double **prlim, int nl cov[2]=agefin; if(nagesqr==1) cov[3]= agefin*agefin;; - 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,k)]; - /* printf("prevalim ij=%d k=%d Tvar[%d]=%d nbcode=%d cov=%lf codtabm(%d,Tvar[%d])=%d \n",ij,k, k, Tvar[k],nbcode[Tvar[k]][codtabm(ij,Tvar[k])],cov[2+k], ij, k, codtabm(ij,Tvar[k])]); */ - } - /*wrong? for (k=1; k<=cptcovage;k++) cov[2+Tage[k]]=cov[2+Tage[k]]*cov[2]; */ - /* for (k=1; k<=cptcovage;k++) cov[2+nagesqr+Tage[k]]=nbcode[Tvar[k]][codtabm(ij,Tvar[k])]*cov[2]; */ - for (k=1; k<=cptcovage;k++) cov[2+nagesqr+Tage[k]]=nbcode[Tvar[k]][codtabm(ij,k)]*cov[2]; - for (k=1; k<=cptcovprod;k++) /* Useless */ - /* cov[2+nagesqr+Tprod[k]]=nbcode[Tvard[k][1]][codtabm(ij,Tvard[k][1])] * nbcode[Tvard[k][2]][codtabm(ij,Tvard[k][2])]; */ - cov[2+nagesqr+Tprod[k]]=nbcode[Tvard[k][1]][codtabm(ij,k)] * nbcode[Tvard[k][2]][codtabm(ij,k)]; - - /*printf("ij=%d cptcovprod=%d tvar=%d ", ij, cptcovprod, Tvar[1]);*/ - /*printf("ij=%d cov[3]=%lf cov[4]=%lf \n",ij, cov[3],cov[4]);*/ - /*printf("ij=%d cov[3]=%lf \n",ij, cov[3]);*/ - /* 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 *\/ */ + for (k=1; k<=nsd;k++) { /* For single dummy covariates only */ + /* Here comes the value of the covariate 'ij' after renumbering k with single dummy covariates */ + cov[2+nagesqr+TvarsDind[k]]=nbcode[TvarsD[k]][codtabm(ij,k)]; + /* printf("prevalim Dummy combi=%d k=%d TvarsD[%d]=V%d TvarsDind[%d]=%d nbcode=%d cov=%lf codtabm(%d,Tvar[%d])=%d \n",ij,k, k, TvarsD[k],k,TvarsDind[k],nbcode[TvarsD[k]][codtabm(ij,k)],cov[2+nagesqr+TvarsDind[k]], ij, k, codtabm(ij,k)); */ + } + for (k=1; k<=nsq;k++) { /* For single varying covariates only */ + /* Here comes the value of quantitative after renumbering k with single quantitative covariates */ + cov[2+nagesqr+TvarsQind[k]]=Tqresult[nres][k]; + /* printf("prevalim Quantitative k=%d TvarsQind[%d]=%d, TvarsQ[%d]=V%d,Tqresult[%d][%d]=%f\n",k,k,TvarsQind[k],k,TvarsQ[k],nres,k,Tqresult[nres][k]); */ + } + for (k=1; k<=cptcovage;k++){ /* For product with age */ + if(Dummy[Tvar[Tage[k]]]){ + cov[2+nagesqr+Tage[k]]=nbcode[Tvar[Tage[k]]][codtabm(ij,k)]*cov[2]; + } else{ + cov[2+nagesqr+Tage[k]]=Tqresult[nres][k]; + } + /* printf("prevalim Age combi=%d k=%d Tage[%d]=V%d Tqresult[%d][%d]=%f\n",ij,k,k,Tage[k],nres,k,Tqresult[nres][k]); */ + } + for (k=1; k<=cptcovprod;k++){ /* For product without age */ + /* printf("prevalim Prod ij=%d k=%d Tprod[%d]=%d Tvard[%d][1]=V%d, Tvard[%d][2]=V%d\n",ij,k,k,Tprod[k], k,Tvard[k][1], k,Tvard[k][2]); */ + if(Dummy[Tvard[k][1]==0]){ + if(Dummy[Tvard[k][2]==0]){ + cov[2+nagesqr+Tprod[k]]=nbcode[Tvard[k][1]][codtabm(ij,k)] * nbcode[Tvard[k][2]][codtabm(ij,k)]; + }else{ + cov[2+nagesqr+Tprod[k]]=nbcode[Tvard[k][1]][codtabm(ij,k)] * Tqresult[nres][k]; + } + }else{ + if(Dummy[Tvard[k][2]==0]){ + cov[2+nagesqr+Tprod[k]]=nbcode[Tvard[k][2]][codtabm(ij,k)] * Tqinvresult[nres][Tvard[k][1]]; + }else{ + cov[2+nagesqr+Tprod[k]]=Tqinvresult[nres][Tvard[k][1]]* Tqinvresult[nres][Tvard[k][2]]; + } + } + } + /*printf("ij=%d cptcovprod=%d tvar=%d ", ij, cptcovprod, Tvar[1]);*/ + /*printf("ij=%d cov[3]=%lf cov[4]=%lf \n",ij, cov[3],cov[4]);*/ + /*printf("ij=%d cov[3]=%lf \n",ij, cov[3]);*/ + /* 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 *\/ */ + /* 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 */ savm=oldm; oldm=newm; - maxmax=0.; - for(j=1;j<=nlstate;j++){ - min=1.; - max=0.; - for(i=1; i<=nlstate; i++) { - sumnew=0; - for(k=1; k<=ndeath; k++) sumnew+=newm[i][nlstate+k]; + + for(j=1; j<=nlstate; j++){ + max[j]=0.; + min[j]=1.; + } + for(i=1;i<=nlstate;i++){ + sumnew=0; + for(k=1; k<=ndeath; k++) sumnew+=newm[i][nlstate+k]; + for(j=1; j<=nlstate; j++){ prlim[i][j]= newm[i][j]/(1-sumnew); - max=FMAX(max,prlim[i][j]); - min=FMIN(min,prlim[i][j]); - printf(" age= %d prevalim i=%d, j=%d, prmlim[%d][%d]=%f, agefin=%d max=%f min=%f\n", (int)age, i, j, i, j, prlim[i][j],(int)agefin, max, min); + max[j]=FMAX(max[j],prlim[i][j]); + min[j]=FMIN(min[j],prlim[i][j]); } - maxmin=(max-min)/(max+min)*2; - maxmax=FMAX(maxmax,maxmin); + } + + maxmax=0.; + for(j=1; j<=nlstate; j++){ + meandiff[j]=(max[j]-min[j])/(max[j]+min[j])*2.; /* mean difference for each column */ + maxmax=FMAX(maxmax,meandiff[j]); + /* printf(" age= %d meandiff[%d]=%f, agefin=%d max[%d]=%f min[%d]=%f maxmax=%f\n", (int)age, j, meandiff[j],(int)agefin, j, max[j], j, min[j],maxmax); */ } /* j loop */ *ncvyear= (int)age- (int)agefin; - printf("maxmax=%lf maxmin=%lf ncvloop=%ld, age=%d, agefin=%d ncvyear=%d \n", maxmax, maxmin, ncvloop, (int)age, (int)agefin, *ncvyear); + /* printf("maxmax=%lf maxmin=%lf ncvloop=%d, age=%d, agefin=%d ncvyear=%d \n", maxmax, maxmin, ncvloop, (int)age, (int)agefin, *ncvyear); */ if(maxmax < ftolpl){ - /* printf("maxmax=%lf maxmin=%lf ncvloop=%ld, age=%d, agefin=%d ncvyear=%d \n", maxmax, maxmin, ncvloop, (int)age, (int)agefin, *ncvyear); */ + /* printf("maxmax=%lf ncvloop=%ld, age=%d, agefin=%d ncvyear=%d \n", maxmax, ncvloop, (int)age, (int)agefin, *ncvyear); */ + free_vector(min,1,nlstate); + free_vector(max,1,nlstate); + free_vector(meandiff,1,nlstate); return prlim; } - } /* age loop */ - printf("Warning: the stable prevalence at age %d did not converge with the required precision %g > ftolpl=%g. \n\ -Earliest age to start was %d-%d=%d, ncvloop=%d, ncvyear=%d\n", (int)age, maxmax, ftolpl, (int)age, (int)delaymax, (int)agefin, ncvloop, *ncvyear); -/* Try to lower 'ftol', for example from 1.e-8 to 6.e-9.\n", ftolpl, (int)age, (int)delaymax, (int)agefin, ncvloop, (int)age-(int)agefin); */ + } /* agefin loop */ + /* After some age loop it doesn't converge */ + if(!first){ + first=1; + printf("Warning: the stable prevalence at age %d did not converge with the required precision (%g > ftolpl=%g) within %.d years and %d loops. Try to lower 'ftolpl'. Youngest age to start was %d=(%d-%d). Others in log file only...\n", (int)age, maxmax, ftolpl, *ncvyear, ncvloop, (int)(agefin+stepm/YEARM), (int)(age-stepm/YEARM), (int)delaymax); + } + fprintf(ficlog, "Warning: the stable prevalence at age %d did not converge with the required precision (%g > ftolpl=%g) within %.d years and %d loops. Try to lower 'ftolpl'. Youngest age to start was %d=(%d-%d).\n", (int)age, maxmax, ftolpl, *ncvyear, ncvloop, (int)(agefin+stepm/YEARM), (int)(age-stepm/YEARM), (int)delaymax); + + /* Try to lower 'ftol', for example from 1.e-8 to 6.e-9.\n", ftolpl, (int)age, (int)delaymax, (int)agefin, ncvloop, (int)age-(int)agefin); */ + free_vector(min,1,nlstate); + free_vector(max,1,nlstate); + free_vector(meandiff,1,nlstate); + return prlim; /* should not reach here */ } + + /**** Back Prevalence limit (stable or period prevalence) ****************/ + + /* 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, int nres) +{ + /* Computes the prevalence limit in each live state at age x and for covariate combination ij (<=2**cptcoveff) by left multiplying the unit + matrix by transitions matrix until convergence is reached with precision ftolpl */ + /* Wx= Wx-1 Px-1= Wx-2 Px-2 Px-1 = Wx-n Px-n ... Px-2 Px-1 I */ + /* Wx is row vector: population in state 1, population in state 2, population dead */ + /* or prevalence in state 1, prevalence in state 2, 0 */ + /* newm is the matrix after multiplications, its rows are identical at a factor */ + /* Initial matrix pimij */ + /* {0.85204250825084937, 0.13044499163996345, 0.017512500109187184, */ + /* 0.090851990222114765, 0.88271245433047185, 0.026435555447413338, */ + /* 0, 0 , 1} */ + /* + * and after some iteration: */ + /* {0.45504275246439968, 0.42731458730878791, 0.11764266022681241, */ + /* 0.45201005341706885, 0.42865420071559901, 0.11933574586733192, */ + /* 0, 0 , 1} */ + /* And prevalence by suppressing the deaths are close to identical rows in prlim: */ + /* {0.51571254859325999, 0.4842874514067399, */ + /* 0.51326036147820708, 0.48673963852179264} */ + /* If we start from prlim again, prlim tends to a constant matrix */ + + int i, ii,j,k; + int first=0; + double *min, *max, *meandiff, maxmax,sumnew=0.; + /* double **matprod2(); */ /* test */ + double **out, cov[NCOVMAX+1], **bmij(); + double **newm; + double **dnewm, **doldm, **dsavm; /* for use */ + double **oldm, **savm; /* for use */ + + double agefin, delaymax=200. ; /* 100 Max number of years to converge */ + int ncvloop=0; + + min=vector(1,nlstate); + max=vector(1,nlstate); + meandiff=vector(1,nlstate); + + dnewm=ddnewms; doldm=ddoldms; dsavm=ddsavms; + oldm=oldms; savm=savms; + + /* Starting with matrix unity */ + for (ii=1;ii<=nlstate+ndeath;ii++) + for (j=1;j<=nlstate+ndeath;j++){ + oldm[ii][j]=(ii==j ? 1.0 : 0.0); + } + + cov[1]=1.; + + /* Even if hstepm = 1, at least one multiplication by the unit matrix */ + /* Start at agefin= age, computes the matrix of passage and loops decreasing agefin until convergence is reached */ + /* for(agefin=age+stepm/YEARM; agefin<=age+delaymax; agefin=agefin+stepm/YEARM){ /\* A changer en age *\/ */ + /* for(agefin=age; agefin ftolpl=%g) within %.0f years. Try to lower 'ftolpl'. Others in log file only...\n\ +Oldest age to start was %d-%d=%d, ncvloop=%d, ncvyear=%d\n", (int)age, maxmax, ftolpl, delaymax, (int)age, (int)delaymax, (int)agefin, ncvloop, *ncvyear); + } + fprintf(ficlog,"Warning: the back stable prevalence at age %d did not converge with the required precision (%g > ftolpl=%g) within %.0f years. Try to lower 'ftolpl'. \n\ +Oldest age to start was %d-%d=%d, ncvloop=%d, ncvyear=%d\n", (int)age, maxmax, ftolpl, delaymax, (int)age, (int)delaymax, (int)agefin, ncvloop, *ncvyear); + /* Try to lower 'ftol', for example from 1.e-8 to 6.e-9.\n", ftolpl, (int)age, (int)delaymax, (int)agefin, ncvloop, (int)age-(int)agefin); */ + free_vector(min,1,nlstate); + free_vector(max,1,nlstate); + free_vector(meandiff,1,nlstate); + + return bprlim; /* should not reach here */ +} + /*************** transition probabilities ***************/ double **pmij(double **ps, double *cov, int ncovmodel, double *x, int nlstate ) { /* According to parameters values stored in x and the covariate's values stored in cov, - computes the probability to be observed in state j being in state i by appying the + computes the probability to be observed in state j (after stepm years) being in state i by appying the model to the ncovmodel covariates (including constant and age). lnpijopii=ln(pij/pii)= aij+bij*age+cij*v1+dij*v2+... = sum_nc=1^ncovmodel xij(nc)*cov[nc] and, according on how parameters are entered, the position of the coefficient xij(nc) of the @@ -2068,74 +2983,260 @@ double **pmij(double **ps, double *cov, j>=i nc + ((i-1)*(nlstate+ndeath-1)+(j-2))*ncovmodel Computes ln(pij/pii) (lnpijopii), deduces pij/pii by exponentiation, sums on j different of i to get 1-pii/pii, deduces pii, and then all pij. - Outputs ps[i][j] the probability to be observed in j being in j according to + Outputs ps[i][j] or probability to be observed in j being in i according to the values of the covariates cov[nc] and corresponding parameter values x[nc+shiftij] + Sum on j ps[i][j] should equal to 1. */ double s1, lnpijopii; /*double t34;*/ int i,j, nc, ii, jj; - for(i=1; i<= nlstate; i++){ - for(j=1; ji s1=%.17e, lnpijopii=%.17e %lx %lx\n",s1,lnpijopii,s1,lnpijopii); */ - } - ps[i][j]=lnpijopii; /* In fact ln(pij/pii) */ + for(i=1; i<= nlstate; i++){ + for(j=1; ji} pij/pii=(1-pii)/pii and thus pii is known from s1 */ - ps[i][i]=1./(s1+1.); - /* Computing other pijs */ - for(j=1; ji s1=%.17e, lnpijopii=%.17e %lx %lx\n",s1,lnpijopii,s1,lnpijopii); */ } + ps[i][j]=lnpijopii; /* In fact ln(pij/pii) */ } - - - /* 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 "); */ + } + + for(i=1; i<= nlstate; i++){ + s1=0; + for(j=1; ji} pij/pii=(1-pii)/pii and thus pii is known from s1 */ + ps[i][i]=1./(s1+1.); + /* Computing other pijs */ + for(j=1; j0.01){ /* At least some value in the prevalence */ + for (ii=1;ii<=nlstate+ndeath;ii++){ + for (j=1;j<=nlstate+ndeath;j++) + doldm[ii][j]=(ii==j ? prevacurrent[(int)agefin][ii][ij]/sumnew : 0.0); + } + }else{ + for (ii=1;ii<=nlstate+ndeath;ii++){ + for (j=1;j<=nlstate+ndeath;j++) + doldm[ii][j]=(ii==j ? 1./nlstate : 0.0); + } + /* if(sumnew <0.9){ */ + /* printf("Problem internal bmij B: sum on i wi <0.9: j=%d, sum_i wi=%lf,agefin=%d\n",j,sumnew, (int)agefin); */ /* } */ - /* printf("\n ");printf("%lf ",cov[2]);*/ - /* - for(i=1; i<= npar; i++) printf("%f ",x[i]); - goto end;*/ - return ps; + } + k3=0.0; /* We put the last diagonal to 0 */ + for (ii=nlstate+1;ii<=nlstate+ndeath;ii++){ + doldm[ii][ii]= k3; + } + /* End doldm, At the end doldm is diag[(w_i)] */ + + /* Left product of this diag matrix by pmmij=Px (dnewm=dsavm*doldm): diag[(w_i)*Px */ + bbmij=matprod2(dnewm, doldm,1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, pmmij); /* was a Bug Valgrind */ + + /* Diag(Sum_i w^i_x p^ij_x, should be the prevalence at age x+stepm */ + /* w1 p11 + w2 p21 only on live states N1./N..*N11/N1. + N2./N..*N21/N2.=(N11+N21)/N..=N.1/N.. */ + for (j=1;j<=nlstate+ndeath;j++){ + sumnew=0.; + for (ii=1;ii<=nlstate;ii++){ + /* sumnew+=dsavm[ii][j]*prevacurrent[(int)agefin][ii][ij]; */ + sumnew+=pmmij[ii][j]*doldm[ii][ii]; /* Yes prevalence at beginning of transition */ + } /* sumnew is (N11+N21)/N..= N.1/N.. = sum on i of w_i pij */ + for (ii=1;ii<=nlstate+ndeath;ii++){ + /* if(agefin >= agemaxpar && agefin <= agemaxpar+stepm/YEARM){ */ + /* dsavm[ii][j]=(ii==j ? 1./sumnew : 0.0); */ + /* }else if(agefin >= agemaxpar+stepm/YEARM){ */ + /* dsavm[ii][j]=(ii==j ? 1./sumnew : 0.0); */ + /* }else */ + dsavm[ii][j]=(ii==j ? 1./sumnew : 0.0); + } /*End ii */ + } /* End j, At the end dsavm is diag[1/(w_1p1i+w_2 p2i)] for ALL states even if the sum is only for live states */ + + ps=matprod2(ps, dnewm,1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, dsavm); /* was a Bug Valgrind */ + /* ps is now diag[w_i] * Px * diag [1/(w_1p1i+w_2 p2i)] */ + /* end bmij */ + return ps; /*pointer is unchanged */ +} +/*************** transition probabilities ***************/ + +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, + computes the probability to be observed in state j being in state i by appying the + model to the ncovmodel covariates (including constant and age). + lnpijopii=ln(pij/pii)= aij+bij*age+cij*v1+dij*v2+... = sum_nc=1^ncovmodel xij(nc)*cov[nc] + and, according on how parameters are entered, the position of the coefficient xij(nc) of the + ncth covariate in the global vector x is given by the formula: + j=i nc + ((i-1)*(nlstate+ndeath-1)+(j-2))*ncovmodel + Computes ln(pij/pii) (lnpijopii), deduces pij/pii by exponentiation, + sums on j different of i to get 1-pii/pii, deduces pii, and then all pij. + Outputs ps[i][j] the probability to be observed in j being in j according to + the values of the covariates cov[nc] and corresponding parameter values x[nc+shiftij] + */ + double s1, lnpijopii; + /*double t34;*/ + int i,j, nc, ii, jj; + + for(i=1; i<= nlstate; i++){ + for(j=1; ji s1=%.17e, lnpijopii=%.17e %lx %lx\n",s1,lnpijopii,s1,lnpijopii); */ + } + ps[i][j]=lnpijopii; /* In fact ln(pij/pii) */ + } + } + + for(i=1; i<= nlstate; i++){ + s1=0; + for(j=1; ji} 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 1 the results are less biased than in previous versions. - */ + * from savm to out if bh is negative or even beyond if bh is positive. bh varies + * -stepm/2 to stepm/2 . + * For stepm=1 the results are the same as for previous versions of Imach. + * For stepm > 1 the results are less biased than in previous versions. + */ s1=s[mw[mi][i]][i]; s2=s[mw[mi+1][i]][i]; bbh=(double)bh[mi][i]/(double)stepm; @@ -2329,35 +3586,35 @@ double func( double *x) which is also equal to probability to die before dh minus probability to die before dh-stepm . In version up to 0.92 likelihood was computed - as if date of death was unknown. Death was treated as any other - 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 - to consider that at each interview the state was recorded - (healthy, disable or death) and IMaCh was corrected; but when we - introduced the exact date of death then we should have modified - the contribution of an exact death to the likelihood. This new - contribution is smaller and very dependent of the step unit - stepm. It is no more the probability to die between last interview - and month of death but the probability to survive from last - interview up to one month before death multiplied by the - probability to die within a month. Thanks to Chris - Jackson for correcting this bug. Former versions increased - mortality artificially. The bad side is that we add another loop - which slows down the processing. The difference can be up to 10% - lower mortality. + as if date of death was unknown. Death was treated as any other + 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 + to consider that at each interview the state was recorded + (healthy, disable or death) and IMaCh was corrected; but when we + introduced the exact date of death then we should have modified + the contribution of an exact death to the likelihood. This new + contribution is smaller and very dependent of the step unit + stepm. It is no more the probability to die between last interview + and month of death but the probability to survive from last + interview up to one month before death multiplied by the + probability to die within a month. Thanks to Chris + Jackson for correcting this bug. Former versions increased + mortality artificially. The bad side is that we add another loop + which slows down the processing. The difference can be up to 10% + 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 */ /* lli=log(out[s1][s2] - savm[s1][s2]); */ /* #else */ @@ -2366,27 +3623,24 @@ double func( double *x) /* else */ /* lli=log(out[s1][s2] - savm[s1][s2]); */ /* #endif */ - lli=log(out[s1][s2] - savm[s1][s2]); - - } else if (s2==-2) { + lli=log(out[s1][s2] - savm[s1][s2]); + + } else if ( s2==-1 ) { /* alive */ for (j=1,survp=0. ; j<=nlstate; j++) survp += (1.+bbh)*out[s1][j]- bbh*savm[s1][j]; /*survp += out[s1][j]; */ lli= log(survp); } - - else if (s2==-4) { + else if (s2==-4) { for (j=3,survp=0. ; j<=nlstate; j++) survp += (1.+bbh)*out[s1][j]- bbh*savm[s1][j]; - lli= log(survp); - } - - else if (s2==-5) { - for (j=1,survp=0. ; j<=2; j++) + lli= log(survp); + } + else if (s2==-5) { + for (j=1,survp=0. ; j<=2; j++) survp += (1.+bbh)*out[s1][j]- bbh*savm[s1][j]; - lli= log(survp); - } - + lli= log(survp); + } else{ 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 */ @@ -2394,7 +3648,7 @@ double func( double *x) /*lli=(1.+bbh)*log(out[s1][s2])- bbh*log(savm[s1][s2]);*/ /*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); */ - ipmx +=1; + ipmx +=1; sw += weight[i]; ll[s[mw[mi][i]][i]] += 2*weight[i]*lli; /* if (lli < log(mytinydouble)){ */ @@ -2498,6 +3752,10 @@ double func( double *x) s2=s[mw[mi+1][i]][i]; if( s2 > nlstate){ lli=log(out[s1][s2] - savm[s1][s2]); + } else if ( s2==-1 ) { /* alive */ + for (j=1,survp=0. ; j<=nlstate; j++) + survp += out[s1][j]; + lli= log(survp); }else{ lli=log(out[s[mw[mi][i]][i]][s[mw[mi+1][i]][i]]); /* Original formula */ } @@ -2551,15 +3809,19 @@ double func( double *x) /*************** log-likelihood *************/ double funcone( double *x) { - /* Same as likeli but slower because of a lot of printf and if */ + /* Same as func but slower because of a lot of printf and if */ int i, ii, j, k, mi, d, kk; + int ioffset=0; double l, ll[NLSTATEMAX+1], cov[NCOVMAX+1]; double **out; double lli; /* Individual log likelihood */ double llt; int s1, s2; + int iv=0, iqv=0, itv=0, iqtv=0 ; /* Index of varying covariate, fixed quantitative cov, time varying covariate, quantitative time varying covariate */ + double bbh, survp; double agexact; + double agebegin, ageend; /*extern weight */ /* We are differentiating ll according to initial status */ /* for (i=1;i<=npar;i++) printf("%f ", x[i]);*/ @@ -2569,25 +3831,74 @@ double funcone( double *x) cov[1]=1.; for(k=1; k<=nlstate; k++) ll[k]=0.; - + ioffset=0; for (i=1,ipmx=0, sw=0.; i<=imx; i++){ - for (k=1; k<=cptcovn;k++) cov[2+nagesqr+k]=covar[Tvar[k]][i]; - for(mi=1; mi<= wav[i]-1; mi++){ + /* ioffset=2+nagesqr+cptcovage; */ + ioffset=2+nagesqr; + /* Fixed */ + /* for (k=1; k<=cptcovn;k++) cov[2+nagesqr+k]=covar[Tvar[k]][i]; */ + /* for (k=1; k<=ncoveff;k++){ /\* Simple and product fixed Dummy covariates without age* products *\/ */ + for (k=1; k<=ncovf;k++){ /* Simple and product fixed covariates without age* products */ + cov[ioffset+TvarFind[k]]=covar[Tvar[TvarFind[k]]][i];/* V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1, only V1 is fixed (k=6)*/ +/* cov[ioffset+TvarFind[1]]=covar[Tvar[TvarFind[1]]][i]; */ +/* cov[2+6]=covar[Tvar[6]][i]; */ +/* cov[2+6]=covar[2][i]; V2 */ +/* cov[TvarFind[2]]=covar[Tvar[TvarFind[2]]][i]; */ +/* cov[2+7]=covar[Tvar[7]][i]; */ +/* cov[2+7]=covar[7][i]; V7=V1*V2 */ +/* cov[TvarFind[3]]=covar[Tvar[TvarFind[3]]][i]; */ +/* cov[2+9]=covar[Tvar[9]][i]; */ +/* cov[2+9]=covar[1][i]; V1 */ + } + /* for (k=1; k<=nqfveff;k++){ /\* Simple and product fixed Quantitative covariates without age* products *\/ */ + /* cov[++ioffset]=coqvar[TvarFQ[k]][i];/\* V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1, only V2 and V1*V2 is fixed (k=6 and 7?)*\/ */ + /* } */ + /* for(iqv=1; iqv <= nqfveff; iqv++){ /\* Quantitative fixed covariates *\/ */ + /* cov[++ioffset]=coqvar[Tvar[iqv]][i]; /\* Only V2 k=6 and V1*V2 7 *\/ */ + /* } */ + + + for(mi=1; mi<= wav[i]-1; mi++){ /* Varying with waves */ + /* Wave varying (but not age varying) */ + for(k=1; k <= ncovv ; k++){ /* Varying covariates (single and product but no age )*/ + /* cov[ioffset+TvarVind[k]]=cotvar[mw[mi][i]][Tvar[TvarVind[k]]][i]; */ + cov[ioffset+TvarVind[k]]=cotvar[mw[mi][i]][Tvar[TvarVind[k]]-ncovcol-nqv][i]; + } + /* for(itv=1; itv <= ntveff; itv++){ /\* Varying dummy covariates (single??)*\/ */ + /* iv= Tvar[Tmodelind[ioffset-2-nagesqr-cptcovage+itv]]-ncovcol-nqv; /\* Counting the # varying covariate from 1 to ntveff *\/ */ + /* cov[ioffset+iv]=cotvar[mw[mi][i]][iv][i]; */ + /* k=ioffset-2-nagesqr-cptcovage+itv; /\* position in simple model *\/ */ + /* cov[ioffset+itv]=cotvar[mw[mi][i]][TmodelInvind[itv]][i]; */ + /* printf(" i=%d,mi=%d,itv=%d,TmodelInvind[itv]=%d,cotvar[mw[mi][i]][TmodelInvind[itv]][i]=%f\n", i, mi, itv, TmodelInvind[itv],cotvar[mw[mi][i]][TmodelInvind[itv]][i]); */ + /* for(iqtv=1; iqtv <= nqtveff; iqtv++){ /\* Varying quantitatives covariates *\/ */ + /* iv=TmodelInvQind[iqtv]; /\* Counting the # varying covariate from 1 to ntveff *\/ */ + /* /\* printf(" i=%d,mi=%d,iqtv=%d,TmodelInvQind[iqtv]=%d,cotqvar[mw[mi][i]][TmodelInvQind[iqtv]][i]=%f\n", i, mi, iqtv, TmodelInvQind[iqtv],cotqvar[mw[mi][i]][TmodelInvQind[iqtv]][i]); *\/ */ + /* cov[ioffset+ntveff+iqtv]=cotqvar[mw[mi][i]][TmodelInvQind[iqtv]][i]; */ + /* } */ for (ii=1;ii<=nlstate+ndeath;ii++) for (j=1;j<=nlstate+ndeath;j++){ oldm[ii][j]=(ii==j ? 1.0 : 0.0); savm[ii][j]=(ii==j ? 1.0 : 0.0); } - for(d=0; d nlstate && (mle <5) ){ /* Jackson */ lli=log(out[s1][s2] - savm[s1][s2]); - } else if (s2==-2) { + } else if ( s2==-1 ) { /* alive */ for (j=1,survp=0. ; j<=nlstate; j++) survp += (1.+bbh)*out[s1][j]- bbh*savm[s1][j]; lli= log(survp); @@ -2626,31 +3941,31 @@ double funcone( double *x) ll[s[mw[mi][i]][i]] += 2*weight[i]*lli; /*printf("i=%6d s1=%1d s2=%1d mi=%1d mw=%1d dh=%3d prob=%10.6f w=%6.4f out=%10.6f sav=%10.6f\n",i,s1,s2,mi,mw[mi][i],dh[mi][i],exp(lli),weight[i],out[s1][s2],savm[s1][s2]); */ if(globpr){ - fprintf(ficresilk,"%9ld %6.1f %6d %2d %2d %2d %2d %3d %11.6f %8.4f %8.3f\ + fprintf(ficresilk,"%09ld %6.1f %6.1f %6d %2d %2d %2d %2d %3d %15.6f %8.4f %8.3f\ %11.6f %11.6f %11.6f ", \ - num[i], agexact, 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]); + 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,(s2==-1? -1: out[s1][s2]),(s2==-1? -1: savm[s1][s2])); for(k=1,llt=0.,l=0.; k<=nlstate; k++){ llt +=ll[k]*gipmx/gsw; fprintf(ficresilk," %10.6f",-ll[k]*gipmx/gsw); } fprintf(ficresilk," %10.6f\n", -llt); } - } /* end of wave */ - } /* end of individual */ - for(k=1,l=0.; k<=nlstate; k++) l += ll[k]; - /* printf("l1=%f l2=%f ",ll[1],ll[2]); */ - l= l*ipmx/sw; /* To get the same order of magnitude as if weight=1 for every body */ - if(globpr==0){ /* First time we count the contributions and weights */ - gipmx=ipmx; - gsw=sw; - } - return -l; + } /* end of wave */ +} /* end of individual */ +for(k=1,l=0.; k<=nlstate; k++) l += ll[k]; +/* printf("l1=%f l2=%f ",ll[1],ll[2]); */ +l= l*ipmx/sw; /* To get the same order of magnitude as if weight=1 for every body */ +if(globpr==0){ /* First time we count the contributions and weights */ + gipmx=ipmx; + gsw=sw; +} +return -l; } /*************** function likelione ***********/ -void likelione(FILE *ficres,double p[], int npar, int nlstate, int *globpri, long *ipmx, double *sw, double *fretone, double (*funcone)(double [])) +void likelione(FILE *ficres,double p[], int npar, int nlstate, int *globpri, long *ipmx, double *sw, double *fretone, double (*func)(double [])) { /* This routine should help understanding what is done with the selection of individuals/waves and @@ -2666,15 +3981,15 @@ void likelione(FILE *ficres,double p[], printf("Problem with resultfile: %s\n", fileresilk); fprintf(ficlog,"Problem with resultfile: %s\n", fileresilk); } - fprintf(ficresilk, "#individual(line's_record) count age s1 s2 wave# effective_wave# number_of_matrices_product pij weight weight/gpw -2ln(pij)*weight 0pij_x 0pij_(x-stepm) cumulating_loglikeli_by_health_state(reweighted=-2ll*weightXnumber_of_contribs/sum_of_weights) and_total\n"); - fprintf(ficresilk, "#num_i age i s1 s2 mi mw dh likeli weight %weight 2wlli out sav "); + fprintf(ficresilk, "#individual(line's_record) count ageb ageend s1 s2 wave# effective_wave# number_of_matrices_product pij weight weight/gpw -2ln(pij)*weight 0pij_x 0pij_(x-stepm) cumulating_loglikeli_by_health_state(reweighted=-2ll*weightXnumber_of_contribs/sum_of_weights) and_total\n"); + fprintf(ficresilk, "#num_i ageb agend i s1 s2 mi mw dh likeli weight %%weight 2wlli out sav "); /* i,s1,s2,mi,mw[mi][i],dh[mi][i],exp(lli),weight[i],2*weight[i]*lli,out[s1][s2],savm[s1][s2]); */ for(k=1; k<=nlstate; k++) fprintf(ficresilk," -2*gipw/gsw*weight*ll[%d]++",k); fprintf(ficresilk," -2*gipw/gsw*weight*ll(total)\n"); } - *fretone=(*funcone)(p); + *fretone=(*func)(p); if(*globpri !=0){ fclose(ficresilk); if (mle ==0) @@ -2682,17 +3997,17 @@ void likelione(FILE *ficres,double p[], else if(mle >=1) fprintf(fichtm,"\n
File of contributions to the likelihood computed with optimized parameters mle = %d.",mle); fprintf(fichtm," You should at least run with mle >= 1 to get starting values corresponding to the optimized parameters in order to visualize the real contribution of each individual/wave: %s
\n",subdirf(fileresilk),subdirf(fileresilk)); - - fprintf(fichtm,"
- The function drawn is -2Log(L) in Log scale: by state of origin %s-ori.png
\ -",subdirf2(optionfilefiname,"ILK_"),subdirf2(optionfilefiname,"ILK_"),subdirf2(optionfilefiname,"ILK_")); - fprintf(fichtm,"
- and by state of destination %s-dest.png
\ -",subdirf2(optionfilefiname,"ILK_"),subdirf2(optionfilefiname,"ILK_"),subdirf2(optionfilefiname,"ILK_")); - fflush(fichtm); + fprintf(fichtm,"\n
Equation of the model: model=1+age+%s
\n",model); - for (k=1; k<= nlstate ; k++) { - fprintf(fichtm,"
- Probability p%dj by origin %d and destination j %s-p%dj.png
\ + for (k=1; k<= nlstate ; k++) { + fprintf(fichtm,"
- Probability p%dj by origin %d and destination j. Dot's sizes are related to corresponding weight: %s-p%dj.png
\ ",k,k,subdirf2(optionfilefiname,"ILK_"),k,subdirf2(optionfilefiname,"ILK_"),k,subdirf2(optionfilefiname,"ILK_"),k); - } + } + fprintf(fichtm,"
- The function drawn is -2Log(L) in Log scale: by state of origin %s-ori.png
\ +",subdirf2(optionfilefiname,"ILK_"),subdirf2(optionfilefiname,"ILK_"),subdirf2(optionfilefiname,"ILK_")); + fprintf(fichtm,"
- and by state of destination %s-dest.png
\ +",subdirf2(optionfilefiname,"ILK_"),subdirf2(optionfilefiname,"ILK_"),subdirf2(optionfilefiname,"ILK_")); + fflush(fichtm); } return; } @@ -2957,6 +4272,8 @@ double hessij( double x[], double **hess double p2[MAXPARM+1]; int k, kmax=1; double v1, v2, cv12, lc1, lc2; + + int firstime=0; fx=func(x); for (k=1; k<=kmax; k=k+10) { @@ -2978,13 +4295,14 @@ double hessij( double x[], double **hess k4=func(p2)-fx; res=(k1-k2-k3+k4)/4.0/delti[thetai]/k/delti[thetaj]/k/2.; /* Because of L not 2*L */ if(k1*k2*k3*k4 <0.){ + firstime=1; kmax=kmax+10; - if(kmax >=10){ - printf("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; increase ftol=%.2e\n",thetai,thetaj, ftol); + } + if(kmax >=10 || firstime ==1){ + printf("Warning: directions %d-%d, you are not estimating the Hessian at the exact maximum likelihood; you could 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 could 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); 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); - } } #ifdef DEBUGHESSIJ v1=hess[thetai][thetai]; @@ -3071,10 +4389,19 @@ void ludcmp(double **a, int n, int *indx big=0.0; for (j=1;j<=n;j++) if ((temp=fabs(a[i][j])) > big) big=temp; - if (big == 0.0) nrerror("Singular matrix in routine ludcmp"); - vv[i]=1.0/big; - } - for (j=1;j<=n;j++) { + if (big == 0.0){ + printf(" Singular Hessian matrix at row %d:\n",i); + for (j=1;j<=n;j++) { + printf(" a[%d][%d]=%f,",i,j,a[i][j]); + fprintf(ficlog," a[%d][%d]=%f,",i,j,a[i][j]); + } + fflush(ficlog); + fclose(ficlog); + nrerror("Singular matrix in routine ludcmp"); + } + vv[i]=1.0/big; + } + for (j=1;j<=n;j++) { for (i=1;i\nIMaCh PHTM_ %s\n %s
%s \ +
\n \ +Title=%s
Datafile=%s Firstpass=%d Lastpass=%d Stepm=%d Weight=%d Model=1+age+%s
\n",\ + fileresphtm,version,fullversion,title,datafile,firstpass,lastpass,stepm, weightopt, model); + } + fprintf(ficresphtm,"Current page is file %s
\n\n

Frequencies and prevalence by age at begin of transition and dummy covariate value at beginning of transition

\n",fileresphtm, fileresphtm); + + strcpy(fileresphtmfr,subdirfext(optionfilefiname,"PHTMFR_",".htm")); + if((ficresphtmfr=fopen(fileresphtmfr,"w"))==NULL) { + printf("Problem with frequency table HTM resultfile '%s' with errno='%s'\n",fileresphtmfr,strerror(errno)); + fprintf(ficlog,"Problem with frequency table HTM resultfile '%s' with errno='%s'\n",fileresphtmfr,strerror(errno)); + fflush(ficlog); + exit(70); + } else{ + fprintf(ficresphtmfr,"\nIMaCh PHTM_Frequency table %s\n %s
%s \ +
\n \ +Title=%s
Datafile=%s Firstpass=%d Lastpass=%d Stepm=%d Weight=%d Model=1+age+%s
\n",\ + fileresphtmfr,version,fullversion,title,datafile,firstpass,lastpass,stepm, weightopt, model); + } + fprintf(ficresphtmfr,"Current page is file %s
\n\n

Frequencies of all effective transitions of the model, by age at begin of transition, and covariate value at the begin of transition (if the covariate is a varying covariate)

Unknown status is -1
\n",fileresphtmfr, fileresphtmfr); + + y= vector(iagemin-AGEMARGE,iagemax+4+AGEMARGE); + x= vector(iagemin-AGEMARGE,iagemax+4+AGEMARGE); + freq= ma3x(-5,nlstate+ndeath,-5,nlstate+ndeath,iagemin-AGEMARGE,iagemax+4+AGEMARGE); 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;} + + + /* Detects if a combination j1 is empty: for a multinomial variable like 3 education levels: + reference=low_education V1=0,V2=0 + med_educ V1=1 V2=0, + high_educ V1=0 V2=1 + Then V1=1 and V2=1 is a noisy combination that we want to exclude for the list 2**cptcoveff + */ + dateintsum=0; + k2cpt=0; - first=1; + if(cptcoveff == 0 ) + nl=1; /* Constant and age model only */ + else + nl=2; - /* for(k1=1; k1<=j ; k1++){ */ /* Loop on covariates */ - /* for(i1=1; i1<=ncodemax[k1];i1++){ */ /* Now it is 2 */ - /* j1++; */ - for (j1 = 1; j1 <= (int) pow(2,cptcoveff); j1++){ + /* if a constant only model, one pass to compute frequency tables and to write it on ficresp */ + /* Loop on nj=1 or 2 if dummy covariates j!=0 + * Loop on j1(1 to 2**cptcoveff) covariate combination + * freq[s1][s2][iage] =0. + * Loop on iind + * ++freq[s1][s2][iage] weighted + * end iind + * if covariate and j!0 + * headers Variable on one line + * endif cov j!=0 + * header of frequency table by age + * Loop on age + * pp[s1]+=freq[s1][s2][iage] weighted + * pos+=freq[s1][s2][iage] weighted + * Loop on s1 initial state + * fprintf(ficresp + * end s1 + * end age + * if j!=0 computes starting values + * end compute starting values + * end j1 + * end nl + */ + for (nj = 1; nj <= nl; nj++){ /* nj= 1 constant model, nl number of loops. */ + if(nj==1) + j=0; /* First pass for the constant */ + else{ + j=cptcoveff; /* Other passes for the covariate values */ + } + first=1; + for (j1 = 1; j1 <= (int) pow(2,j); j1++){ /* Loop on all covariates combination of the model, excluding quantitatives, V4=0, V3=0 for example, fixed or varying covariates */ + posproptt=0.; /*printf("cptcoveff=%d Tvaraff=%d", cptcoveff,Tvaraff[1]); scanf("%d", i);*/ for (i=-5; i<=nlstate+ndeath; i++) - for (jk=-5; jk<=nlstate+ndeath; jk++) + for (s2=-5; s2<=nlstate+ndeath; s2++) for(m=iagemin; m <= iagemax+3; m++) - freq[i][jk][m]=0; + freq[i][s2][m]=0; - for (i=1; i<=nlstate; i++) + for (i=1; i<=nlstate; i++) { for(m=iagemin; m <= iagemax+3; m++) prop[i][m]=0; + posprop[i]=0; + pospropt[i]=0; + } + for (z1=1; z1<= nqfveff; z1++) { /* zeroing for each combination j1 as well as for the total */ + idq[z1]=0.; + meanq[z1]=0.; + stdq[z1]=0.; + } + /* for (z1=1; z1<= nqtveff; z1++) { */ + /* for(m=1;m<=lastpass;m++){ */ + /* meanqt[m][z1]=0.; */ + /* } */ + /* } */ + /* dateintsum=0; */ + /* k2cpt=0; */ - dateintsum=0; - k2cpt=0; - for (i=1; i<=imx; i++) { + /* For that combination of covariates j1 (V4=1 V3=0 for example), we count and print the frequencies in one pass */ + for (iind=1; iind<=imx; iind++) { /* For each individual iind */ bool=1; - if (cptcovn>0) { /* Filter is here: Must be looked at for model=V1+V2+V3+V4 */ - for (z1=1; z1<=cptcoveff; z1++) - if (covar[Tvaraff[z1]][i]!= nbcode[Tvaraff[z1]][codtabm(j1,z1)]){ - /* Tests if the value of each of the covariates of i is equal to filter j1 */ - bool=0; - /* printf("bool=%d i=%d, z1=%d, Tvaraff[%d]=%d, covar[Tvarff][%d]=%2f, 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*/ - } - } - - if (bool==1){ - for(m=firstpass; m<=lastpass; m++){ - k2=anint[m][i]+(mint[m][i]/12.); - /*if ((k2>=dateprev1) && (k2<=dateprev2)) {*/ - if(agev[m][i]==0) agev[m][i]=iagemax+1; - if(agev[m][i]==1) agev[m][i]=iagemax+2; - if (s[m][i]>0 && s[m][i]<=nlstate) prop[s[m][i]][(int)agev[m][i]] += weight[i]; - if (m1) && (agev[m][i]< (iagemax+3))) { - dateintsum=dateintsum+k2; + if(j !=0){ + 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<=cptcoveff; z1++) { /* loops on covariates in the model */ + /* 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)]){ /* for combination j1 of covariates */ + /* Tests if the value of the covariate z1 for this individual iind responded to combination j1 (V4=1 V3=0) */ + bool=0; /* bool should be equal to 1 to be selected, one covariate value failed */ + /* printf("bool=%d i=%d, z1=%d, Tvaraff[%d]=%d, covar[Tvarff][%d]=%2f, codtabm(%d,%d)=%d, nbcode[Tvaraff][codtabm(%d,%d)=%d, j1=%d\n", + bool,i,z1, z1, Tvaraff[z1],i,covar[Tvaraff[z1]][i],j1,z1,codtabm(j1,z1), + 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 */ + } /* end any */ + }/* end j==0 */ + if (bool==1){ /* We selected an individual iind satisfying combination j1 (V4=1 V3=0) or all fixed covariates */ + /* for(m=firstpass; m<=lastpass; m++){ */ + for(mi=1; mi=firstpass && m <=lastpass){ + k2=anint[m][iind]+(mint[m][iind]/12.); + /*if ((k2>=dateprev1) && (k2<=dateprev2)) {*/ + if(agev[m][iind]==0) agev[m][iind]=iagemax+1; /* All ages equal to 0 are in iagemax+1 */ + if(agev[m][iind]==1) agev[m][iind]=iagemax+2; /* All ages equal to 1 are in iagemax+2 */ + if (s[m][iind]>0 && s[m][iind]<=nlstate) /* If status at wave m is known and a live state */ + prop[s[m][iind]][(int)agev[m][iind]] += weight[iind]; /* At age of beginning of transition, where status is known */ + if (m1) && (agev[m][iind]< (iagemax+3)) && (anint[m][iind]!=9999) && (mint[m][iind]!=99) && (j==0)) { + dateintsum=dateintsum+k2; /* on all covariates ?*/ k2cpt++; + /* printf("iind=%ld dateintmean = %lf dateintsum=%lf k2cpt=%lf k2=%lf\n",iind, dateintsum/k2cpt, dateintsum,k2cpt, k2); */ } - /*}*/ - } - } - } /* end i */ - + }else{ + bool=1; + }/* end bool 2 */ + } /* end m */ + /* for (z1=1; z1<= nqfveff; z1++) { /\* Quantitative variables, calculating mean *\/ */ + /* idq[z1]=idq[z1]+weight[iind]; */ + /* meanq[z1]+=covar[ncovcol+z1][iind]*weight[iind]; /\* Computes mean of quantitative with selected filter *\/ */ + /* stdq[z1]+=covar[ncovcol+z1][iind]*covar[ncovcol+z1][iind]*weight[iind]*weight[iind]; /\* *weight[iind];*\/ /\* Computes mean of quantitative with selected filter *\/ */ + /* } */ + } /* end bool */ + } /* end iind = 1 to imx */ + /* prop[s][age] is feeded for any initial and valid live state as well as + freq[s1][s2][age] at single age of beginning the transition, for a combination j1 */ + + /* fprintf(ficresp, "#Count between %.lf/%.lf/%.lf and %.lf/%.lf/%.lf\n",jprev1, mprev1,anprev1,jprev2, mprev2,anprev2);*/ - pstamp(ficresp); - if (cptcovn>0) { + if(cptcoveff==0 && nj==1) /* no covariate and first pass */ + pstamp(ficresp); + if (cptcoveff>0 && j!=0){ + pstamp(ficresp); + printf( "\n#********** Variable "); fprintf(ficresp, "\n#********** Variable "); - for (z1=1; z1<=cptcoveff; z1++) fprintf(ficresp, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); - fprintf(ficresp, "**********\n#"); + fprintf(ficresphtm, "\n

********** Variable "); + fprintf(ficresphtmfr, "\n

********** Variable "); fprintf(ficlog, "\n#********** Variable "); - for (z1=1; z1<=cptcoveff; z1++) fprintf(ficlog, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); - fprintf(ficlog, "**********\n#"); + for (z1=1; z1<=cptcoveff; z1++){ + if(!FixedV[Tvaraff[z1]]){ + printf( "V%d(fixed)=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); + fprintf(ficresp, "V%d(fixed)=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); + fprintf(ficresphtm, "V%d(fixed)=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); + fprintf(ficresphtmfr, "V%d(fixed)=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); + fprintf(ficlog, "V%d(fixed)=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); + }else{ + printf( "V%d(varying)=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); + fprintf(ficresp, "V%d(varying)=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); + fprintf(ficresphtm, "V%d(varying)=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); + fprintf(ficresphtmfr, "V%d(varying)=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); + fprintf(ficlog, "V%d(varying)=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); + } + } + printf( "**********\n#"); + fprintf(ficresp, "**********\n#"); + fprintf(ficresphtm, "**********

\n"); + fprintf(ficresphtmfr, "**********\n"); + fprintf(ficlog, "**********\n"); + } + /* + Printing means of quantitative variables if any + */ + for (z1=1; z1<= nqfveff; z1++) { + fprintf(ficlog,"Mean of fixed quantitative variable V%d on %.0f individuals sum=%f", ncovcol+z1, idq[z1], meanq[z1]); + fprintf(ficlog,", mean=%.3g\n",meanq[z1]/idq[z1]); + if(weightopt==1){ + printf(" Weighted mean and standard deviation of"); + fprintf(ficlog," Weighted mean and standard deviation of"); + fprintf(ficresphtmfr," Weighted mean and standard deviation of"); + } + printf(" fixed quantitative variable V%d on %.0f representatives of the population : %6.3g (%6.3g)\n", ncovcol+z1, idq[z1],meanq[z1]/idq[z1], sqrt((stdq[z1]-meanq[z1]*meanq[z1]/idq[z1])/idq[z1])); + fprintf(ficlog," fixed quantitative variable V%d on %.0f representatives of the population : %6.3g (%6.3g)\n", ncovcol+z1, idq[z1],meanq[z1]/idq[z1], sqrt((stdq[z1]-meanq[z1]*meanq[z1]/idq[z1])/idq[z1])); + fprintf(ficresphtmfr," fixed quantitative variable V%d on %.0f representatives of the population : %6.3g (%6.3g)

\n", ncovcol+z1, idq[z1],meanq[z1]/idq[z1], sqrt((stdq[z1]-meanq[z1]*meanq[z1]/idq[z1])/idq[z1])); + } + /* for (z1=1; z1<= nqtveff; z1++) { */ + /* for(m=1;m<=lastpass;m++){ */ + /* fprintf(ficresphtmfr,"V quantitative id %d, pass id=%d, mean=%f

\n", z1, m, meanqt[m][z1]); */ + /* } */ + /* } */ + + fprintf(ficresphtm,""); + if((cptcoveff==0 && nj==1)|| nj==2 ) /* no covariate and first pass */ + fprintf(ficresp, " Age"); + if(nj==2) for (z1=1; z1<=cptcoveff; z1++) fprintf(ficresp, " V%d=%d",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); + for(i=1; i<=nlstate;i++) { + if((cptcoveff==0 && nj==1)|| nj==2 ) fprintf(ficresp," Prev(%d) N(%d) N ",i,i); + fprintf(ficresphtm, "",i,i); } - for(i=1; i<=nlstate;i++) - fprintf(ficresp, " Age Prev(%d) N(%d) N",i,i); - fprintf(ficresp, "\n"); + if((cptcoveff==0 && nj==1)|| nj==2 ) fprintf(ficresp, "\n"); + fprintf(ficresphtm, "\n"); - for(i=iagemin; i <= iagemax+3; i++){ - if(i==iagemax+3){ + /* Header of frequency table by age */ + fprintf(ficresphtmfr,"
AgePrev(%d)N(%d)N
"); + fprintf(ficresphtmfr," "); + for(s2=-1; s2 <=nlstate+ndeath; s2++){ + for(m=-1; m <=nlstate+ndeath; m++){ + if(s2!=0 && m!=0) + fprintf(ficresphtmfr," ",s2,m); + } + } + fprintf(ficresphtmfr, "\n"); + + /* For each age */ + for(iage=iagemin; iage <= iagemax+3; iage++){ + fprintf(ficresphtm,""); + if(iage==iagemax+1){ + fprintf(ficlog,"1"); + fprintf(ficresphtmfr," "); + }else if(iage==iagemax+2){ + fprintf(ficlog,"0"); + fprintf(ficresphtmfr," "); + }else if(iage==iagemax+3){ fprintf(ficlog,"Total"); + fprintf(ficresphtmfr," "); }else{ if(first==1){ first=0; printf("See log file for details...\n"); } - fprintf(ficlog,"Age %d", i); + fprintf(ficresphtmfr," ",iage); + fprintf(ficlog,"Age %d", iage); } - for(jk=1; jk <=nlstate ; jk++){ - for(m=-1, pp[jk]=0; m <=nlstate+ndeath ; m++) - pp[jk] += freq[jk][m][i]; + for(s1=1; s1 <=nlstate ; s1++){ + for(m=-1, pp[s1]=0; m <=nlstate+ndeath ; m++) + pp[s1] += freq[s1][m][iage]; } - for(jk=1; jk <=nlstate ; jk++){ + for(s1=1; s1 <=nlstate ; s1++){ for(m=-1, pos=0; m <=0 ; m++) - pos += freq[jk][m][i]; - if(pp[jk]>=1.e-10){ + pos += freq[s1][m][iage]; + if(pp[s1]>=1.e-10){ if(first==1){ - printf(" %d.=%.0f loss[%d]=%.1f%%",jk,pp[jk],jk,100*pos/pp[jk]); + printf(" %d.=%.0f loss[%d]=%.1f%%",s1,pp[s1],s1,100*pos/pp[s1]); } - fprintf(ficlog," %d.=%.0f loss[%d]=%.1f%%",jk,pp[jk],jk,100*pos/pp[jk]); + fprintf(ficlog," %d.=%.0f loss[%d]=%.1f%%",s1,pp[s1],s1,100*pos/pp[s1]); }else{ if(first==1) - printf(" %d.=%.0f loss[%d]=NaNQ%%",jk,pp[jk],jk); - fprintf(ficlog," %d.=%.0f loss[%d]=NaNQ%%",jk,pp[jk],jk); + printf(" %d.=%.0f loss[%d]=NaNQ%%",s1,pp[s1],s1); + fprintf(ficlog," %d.=%.0f loss[%d]=NaNQ%%",s1,pp[s1],s1); } } - - for(jk=1; jk <=nlstate ; jk++){ - for(m=0, pp[jk]=0; m <=nlstate+ndeath; m++) - pp[jk] += freq[jk][m][i]; - } - for(jk=1,pos=0,posprop=0; jk <=nlstate ; jk++){ - pos += pp[jk]; - posprop += prop[jk][i]; + + for(s1=1; s1 <=nlstate ; s1++){ + /* posprop[s1]=0; */ + for(m=0, pp[s1]=0; m <=nlstate+ndeath; m++)/* Summing on all ages */ + pp[s1] += freq[s1][m][iage]; + } /* pp[s1] is the total number of transitions starting from state s1 and any ending status until this age */ + + for(s1=1,pos=0, pospropta=0.; s1 <=nlstate ; s1++){ + pos += pp[s1]; /* pos is the total number of transitions until this age */ + posprop[s1] += prop[s1][iage]; /* prop is the number of transitions from a live state + from s1 at age iage prop[s[m][iind]][(int)agev[m][iind]] += weight[iind] */ + pospropta += prop[s1][iage]; /* prop is the number of transitions from a live state + from s1 at age iage prop[s[m][iind]][(int)agev[m][iind]] += weight[iind] */ } - for(jk=1; jk <=nlstate ; jk++){ + + /* Writing ficresp */ + if(cptcoveff==0 && nj==1){ /* no covariate and first pass */ + if( iage <= iagemax){ + fprintf(ficresp," %d",iage); + } + }else if( nj==2){ + if( iage <= iagemax){ + fprintf(ficresp," %d",iage); + for (z1=1; z1<=cptcoveff; z1++) fprintf(ficresp, " %d %d",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); + } + } + for(s1=1; s1 <=nlstate ; s1++){ if(pos>=1.e-5){ if(first==1) - printf(" %d.=%.0f prev[%d]=%.1f%%",jk,pp[jk],jk,100*pp[jk]/pos); - fprintf(ficlog," %d.=%.0f prev[%d]=%.1f%%",jk,pp[jk],jk,100*pp[jk]/pos); + printf(" %d.=%.0f prev[%d]=%.1f%%",s1,pp[s1],s1,100*pp[s1]/pos); + fprintf(ficlog," %d.=%.0f prev[%d]=%.1f%%",s1,pp[s1],s1,100*pp[s1]/pos); }else{ if(first==1) - printf(" %d.=%.0f prev[%d]=NaNQ%%",jk,pp[jk],jk); - fprintf(ficlog," %d.=%.0f prev[%d]=NaNQ%%",jk,pp[jk],jk); + printf(" %d.=%.0f prev[%d]=NaNQ%%",s1,pp[s1],s1); + fprintf(ficlog," %d.=%.0f prev[%d]=NaNQ%%",s1,pp[s1],s1); } - if( i <= iagemax){ + if( iage <= iagemax){ if(pos>=1.e-5){ - fprintf(ficresp," %d %.5f %.0f %.0f",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]);*/ + if(cptcoveff==0 && nj==1){ /* no covariate and first pass */ + fprintf(ficresp," %.5f %.0f %.0f",prop[s1][iage]/pospropta, prop[s1][iage],pospropta); + }else if( nj==2){ + fprintf(ficresp," %.5f %.0f %.0f",prop[s1][iage]/pospropta, prop[s1][iage],pospropta); + } + fprintf(ficresphtm,"",iage,prop[s1][iage]/pospropta, prop[s1][iage],pospropta); + /*probs[iage][s1][j1]= pp[s1]/pos;*/ + /*printf("\niage=%d s1=%d j1=%d %.5f %.0f %.0f %f",iage,s1,j1,pp[s1]/pos, pp[s1],pos,probs[iage][s1][j1]);*/ + } else{ + if((cptcoveff==0 && nj==1)|| nj==2 ) fprintf(ficresp," NaNq %.0f %.0f",prop[s1][iage],pospropta); + fprintf(ficresphtm,"",iage, prop[s1][iage],pospropta); } - else - fprintf(ficresp," %d NaNq %.0f %.0f",i,prop[jk][i],posprop); } - } - - for(jk=-1; jk <=nlstate+ndeath; jk++) - for(m=-1; m <=nlstate+ndeath; m++) - if(freq[jk][m][i] !=0 ) { - if(first==1) - printf(" %d%d=%.0f",jk,m,freq[jk][m][i]); - fprintf(ficlog," %d%d=%.0f",jk,m,freq[jk][m][i]); + pospropt[s1] +=posprop[s1]; + } /* end loop s1 */ + /* pospropt=0.; */ + for(s1=-1; s1 <=nlstate+ndeath; s1++){ + for(m=-1; m <=nlstate+ndeath; m++){ + if(freq[s1][m][iage] !=0 ) { /* minimizing output */ + if(first==1){ + printf(" %d%d=%.0f",s1,m,freq[s1][m][iage]); + } + /* printf(" %d%d=%.0f",s1,m,freq[s1][m][iage]); */ + fprintf(ficlog," %d%d=%.0f",s1,m,freq[s1][m][iage]); } - if(i <= iagemax) - fprintf(ficresp,"\n"); + if(s1!=0 && m!=0) + fprintf(ficresphtmfr," ",freq[s1][m][iage]); + } + } /* end loop s1 */ + posproptt=0.; + for(s1=1; s1 <=nlstate; s1++){ + posproptt += pospropt[s1]; + } + fprintf(ficresphtmfr,"\n "); + fprintf(ficresphtm,"\n"); + if((cptcoveff==0 && nj==1)|| nj==2 ) { + if(iage <= iagemax) + fprintf(ficresp,"\n"); + } if(first==1) printf("Others in log...\n"); fprintf(ficlog,"\n"); + } /* end loop age iage */ + + fprintf(ficresphtm,""); + for(s1=1; s1 <=nlstate ; s1++){ + if(posproptt < 1.e-5){ + fprintf(ficresphtm,"",pospropt[s1],posproptt); + }else{ + fprintf(ficresphtm,"",pospropt[s1]/posproptt,pospropt[s1],posproptt); + } } - /*}*/ - } + fprintf(ficresphtm,"\n"); + fprintf(ficresphtm,"
Age%d%d
0
Unknown
Total
%d%d%.5f%.0f%.0f%dNaNq%.0f%.0f%.0f
TotNanq%.0f%.0f%.5f%.0f%.0f
\n"); + fprintf(ficresphtmfr,"\n"); + if(posproptt < 1.e-5){ + fprintf(ficresphtm,"\n

This combination (%d) is not valid and no result will be produced

",j1); + fprintf(ficresphtmfr,"\n

This combination (%d) is not valid and no result will be produced

",j1); + fprintf(ficlog,"# This combination (%d) is not valid and no result will be produced\n",j1); + printf("# This combination (%d) is not valid and no result will be produced\n",j1); + invalidvarcomb[j1]=1; + }else{ + fprintf(ficresphtm,"\n

This combination (%d) is valid and result will be produced.

",j1); + invalidvarcomb[j1]=0; + } + fprintf(ficresphtmfr,"\n"); + fprintf(ficlog,"\n"); + if(j!=0){ + printf("#Freqsummary: Starting values for combination j1=%d:\n", j1); + for(i=1,s1=1; i <=nlstate; i++){ + for(k=1; k <=(nlstate+ndeath); k++){ + if (k != i) { + for(jj=1; jj <=ncovmodel; jj++){ /* For counting s1 */ + if(jj==1){ /* Constant case (in fact cste + age) */ + if(j1==1){ /* All dummy covariates to zero */ + freq[i][k][iagemax+4]=freq[i][k][iagemax+3]; /* Stores case 0 0 0 */ + freq[i][i][iagemax+4]=freq[i][i][iagemax+3]; /* Stores case 0 0 0 */ + printf("%d%d ",i,k); + fprintf(ficlog,"%d%d ",i,k); + printf("%12.7f ln(%.0f/%.0f)= %f, OR=%f sd=%f \n",p[s1],freq[i][k][iagemax+3],freq[i][i][iagemax+3], log(freq[i][k][iagemax+3]/freq[i][i][iagemax+3]),freq[i][k][iagemax+3]/freq[i][i][iagemax+3], sqrt(1/freq[i][k][iagemax+3]+1/freq[i][i][iagemax+3])); + fprintf(ficlog,"%12.7f ln(%.0f/%.0f)= %12.7f \n",p[s1],freq[i][k][iagemax+3],freq[i][i][iagemax+3], log(freq[i][k][iagemax+3]/freq[i][i][iagemax+3])); + pstart[s1]= log(freq[i][k][iagemax+3]/freq[i][i][iagemax+3]); + } + }else if((j1==1) && (jj==2 || nagesqr==1)){ /* age or age*age parameter without covariate V4*age (to be done later) */ + for(iage=iagemin; iage <= iagemax+3; iage++){ + x[iage]= (double)iage; + y[iage]= log(freq[i][k][iage]/freq[i][i][iage]); + /* printf("i=%d, k=%d, s1=%d, j1=%d, jj=%d, y[%d]=%f\n",i,k,s1,j1,jj, iage, y[iage]); */ + } + /* Some are not finite, but linreg will ignore these ages */ + no=0; + linreg(iagemin,iagemax,&no,x,y,&a,&b,&r, &sa, &sb ); /* y= a+b*x with standard errors */ + pstart[s1]=b; + pstart[s1-1]=a; + }else if( j1!=1 && (j1==2 || (log(j1-1.)/log(2.)-(int)(log(j1-1.)/log(2.))) <0.010) && ( TvarsDind[(int)(log(j1-1.)/log(2.))+1]+2+nagesqr == jj) && Dummy[jj-2-nagesqr]==0){ /* We want only if the position, jj, in model corresponds to unique covariate equal to 1 in j1 combination */ + printf("j1=%d, jj=%d, (int)(log(j1-1.)/log(2.))+1=%d, TvarsDind[(int)(log(j1-1.)/log(2.))+1]=%d\n",j1, jj,(int)(log(j1-1.)/log(2.))+1,TvarsDind[(int)(log(j1-1.)/log(2.))+1]); + printf("j1=%d, jj=%d, (log(j1-1.)/log(2.))+1=%f, TvarsDind[(int)(log(j1-1.)/log(2.))+1]=%d\n",j1, jj,(log(j1-1.)/log(2.))+1,TvarsDind[(int)(log(j1-1.)/log(2.))+1]); + pstart[s1]= log((freq[i][k][iagemax+3]/freq[i][i][iagemax+3])/(freq[i][k][iagemax+4]/freq[i][i][iagemax+4])); + printf("%d%d ",i,k); + fprintf(ficlog,"%d%d ",i,k); + printf("s1=%d,i=%d,k=%d,p[%d]=%12.7f ln((%.0f/%.0f)/(%.0f/%.0f))= %f, OR=%f sd=%f \n",s1,i,k,s1,p[s1],freq[i][k][iagemax+3],freq[i][i][iagemax+3],freq[i][k][iagemax+4],freq[i][i][iagemax+4], log((freq[i][k][iagemax+3]/freq[i][i][iagemax+3])/(freq[i][k][iagemax+4]/freq[i][i][iagemax+4])),(freq[i][k][iagemax+3]/freq[i][i][iagemax+3])/(freq[i][k][iagemax+4]/freq[i][i][iagemax+4]), sqrt(1/freq[i][k][iagemax+3]+1/freq[i][i][iagemax+3]+1/freq[i][k][iagemax+4]+1/freq[i][i][iagemax+4])); + }else{ /* Other cases, like quantitative fixed or varying covariates */ + ; + } + /* printf("%12.7f )", param[i][jj][k]); */ + /* fprintf(ficlog,"%12.7f )", param[i][jj][k]); */ + s1++; + } /* end jj */ + } /* end k!= i */ + } /* end k */ + } /* end i, s1 */ + } /* end j !=0 */ + } /* end selected combination of covariate j1 */ + if(j==0){ /* We can estimate starting values from the occurences in each case */ + printf("#Freqsummary: Starting values for the constants:\n"); + fprintf(ficlog,"\n"); + for(i=1,s1=1; i <=nlstate; i++){ + for(k=1; k <=(nlstate+ndeath); k++){ + if (k != i) { + printf("%d%d ",i,k); + fprintf(ficlog,"%d%d ",i,k); + for(jj=1; jj <=ncovmodel; jj++){ + pstart[s1]=p[s1]; /* Setting pstart to p values by default */ + if(jj==1){ /* Age has to be done */ + pstart[s1]= log(freq[i][k][iagemax+3]/freq[i][i][iagemax+3]); + printf("%12.7f ln(%.0f/%.0f)= %12.7f ",p[s1],freq[i][k][iagemax+3],freq[i][i][iagemax+3], log(freq[i][k][iagemax+3]/freq[i][i][iagemax+3])); + fprintf(ficlog,"%12.7f ln(%.0f/%.0f)= %12.7f ",p[s1],freq[i][k][iagemax+3],freq[i][i][iagemax+3], log(freq[i][k][iagemax+3]/freq[i][i][iagemax+3])); + } + /* printf("%12.7f )", param[i][jj][k]); */ + /* fprintf(ficlog,"%12.7f )", param[i][jj][k]); */ + s1++; + } + printf("\n"); + fprintf(ficlog,"\n"); + } + } + } /* end of state i */ + printf("#Freqsummary\n"); + fprintf(ficlog,"\n"); + for(s1=-1; s1 <=nlstate+ndeath; s1++){ + for(s2=-1; s2 <=nlstate+ndeath; s2++){ + /* param[i]|j][k]= freq[s1][s2][iagemax+3] */ + printf(" %d%d=%.0f",s1,s2,freq[s1][s2][iagemax+3]); + fprintf(ficlog," %d%d=%.0f",s1,s2,freq[s1][s2][iagemax+3]); + /* if(freq[s1][s2][iage] !=0 ) { /\* minimizing output *\/ */ + /* printf(" %d%d=%.0f",s1,s2,freq[s1][s2][iagemax+3]); */ + /* fprintf(ficlog," %d%d=%.0f",s1,s2,freq[s1][s2][iagemax+3]); */ + /* } */ + } + } /* end loop s1 */ + + printf("\n"); + fprintf(ficlog,"\n"); + } /* end j=0 */ + } /* end j */ + + if(mle == -2){ /* We want to use these values as starting values */ + for(i=1, jk=1; i <=nlstate; i++){ + for(j=1; j <=nlstate+ndeath; j++){ + if(j!=i){ + /*ca[0]= k+'a'-1;ca[1]='\0';*/ + printf("%1d%1d",i,j); + fprintf(ficparo,"%1d%1d",i,j); + for(k=1; k<=ncovmodel;k++){ + /* printf(" %lf",param[i][j][k]); */ + /* fprintf(ficparo," %lf",param[i][j][k]); */ + p[jk]=pstart[jk]; + printf(" %f ",pstart[jk]); + fprintf(ficparo," %f ",pstart[jk]); + jk++; + } + printf("\n"); + fprintf(ficparo,"\n"); + } + } + } + } /* end mle=-2 */ dateintmean=dateintsum/k2cpt; - + date2dmy(dateintmean,&jintmean,&mintmean,&aintmean); + fclose(ficresp); - free_ma3x(freq,-5,nlstate+ndeath,-5,nlstate+ndeath, iagemin, iagemax+3); + fclose(ficresphtm); + fclose(ficresphtmfr); + free_vector(idq,1,nqfveff); + free_vector(meanq,1,nqfveff); + free_vector(stdq,1,nqfveff); + free_matrix(meanqt,1,lastpass,1,nqtveff); + free_vector(x, iagemin-AGEMARGE, iagemax+4+AGEMARGE); + free_vector(y, iagemin-AGEMARGE, iagemax+4+AGEMARGE); + free_ma3x(freq,-5,nlstate+ndeath,-5,nlstate+ndeath, iagemin-AGEMARGE, iagemax+4+AGEMARGE); + free_vector(pospropt,1,nlstate); + free_vector(posprop,1,nlstate); + free_matrix(prop,1,nlstate,iagemin-AGEMARGE, iagemax+4+AGEMARGE); free_vector(pp,1,nlstate); - free_matrix(prop,1,nlstate,iagemin, iagemax+3); - /* End of Freq */ + /* End of freqsummary */ +} + +/* Simple linear regression */ +int linreg(int ifi, int ila, int *no, const double x[], const double y[], double* a, double* b, double* r, double* sa, double * sb) { + + /* y=a+bx regression */ + double sumx = 0.0; /* sum of x */ + double sumx2 = 0.0; /* sum of x**2 */ + double sumxy = 0.0; /* sum of x * y */ + double sumy = 0.0; /* sum of y */ + double sumy2 = 0.0; /* sum of y**2 */ + double sume2 = 0.0; /* sum of square or residuals */ + double yhat; + + double denom=0; + int i; + int ne=*no; + + for ( i=ifi, ne=0;i<=ila;i++) { + if(!isfinite(x[i]) || !isfinite(y[i])){ + /* printf(" x[%d]=%f, y[%d]=%f\n",i,x[i],i,y[i]); */ + continue; + } + ne=ne+1; + sumx += x[i]; + sumx2 += x[i]*x[i]; + sumxy += x[i] * y[i]; + sumy += y[i]; + sumy2 += y[i]*y[i]; + denom = (ne * sumx2 - sumx*sumx); + /* printf("ne=%d, i=%d,x[%d]=%f, y[%d]=%f sumx=%f, sumx2=%f, sumxy=%f, sumy=%f, sumy2=%f, denom=%f\n",ne,i,i,x[i],i,y[i], sumx, sumx2,sumxy, sumy, sumy2,denom); */ + } + + denom = (ne * sumx2 - sumx*sumx); + if (denom == 0) { + // vertical, slope m is infinity + *b = INFINITY; + *a = 0; + if (r) *r = 0; + return 1; + } + + *b = (ne * sumxy - sumx * sumy) / denom; + *a = (sumy * sumx2 - sumx * sumxy) / denom; + if (r!=NULL) { + *r = (sumxy - sumx * sumy / ne) / /* compute correlation coeff */ + sqrt((sumx2 - sumx*sumx/ne) * + (sumy2 - sumy*sumy/ne)); + } + *no=ne; + for ( i=ifi, ne=0;i<=ila;i++) { + if(!isfinite(x[i]) || !isfinite(y[i])){ + /* printf(" x[%d]=%f, y[%d]=%f\n",i,x[i],i,y[i]); */ + continue; + } + ne=ne+1; + yhat = y[i] - *a -*b* x[i]; + sume2 += yhat * yhat ; + + denom = (ne * sumx2 - sumx*sumx); + /* printf("ne=%d, i=%d,x[%d]=%f, y[%d]=%f sumx=%f, sumx2=%f, sumxy=%f, sumy=%f, sumy2=%f, denom=%f\n",ne,i,i,x[i],i,y[i], sumx, sumx2,sumxy, sumy, sumy2,denom); */ + } + *sb = sqrt(sume2/(double)(ne-2)/(sumx2 - sumx * sumx /(double)ne)); + *sa= *sb * sqrt(sumx2/ne); + + return 0; } /************ Prevalence ********************/ @@ -3321,7 +5145,10 @@ void prevalence(double ***probs, double 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 iage; + double agebegin, ageend; double **prop; double posprop; @@ -3332,111 +5159,197 @@ void prevalence(double ***probs, double iagemin= (int) agemin; iagemax= (int) agemax; /*pp=vector(1,nlstate);*/ - prop=matrix(1,nlstate,iagemin,iagemax+3); + prop=matrix(1,nlstate,iagemin-AGEMARGE,iagemax+4+AGEMARGE); /* freq=ma3x(-1,nlstate+ndeath,-1,nlstate+ndeath,iagemin,iagemax+3);*/ j1=0; /*j=cptcoveff;*/ if (cptcovn<1) {j=1;ncodemax[1]=1;} - first=1; - for(j1=1; j1<= (int) pow(2,cptcoveff);j1++){ - /*for(i1=1; i1<=ncodemax[k1];i1++){ - j1++;*/ - - for (i=1; i<=nlstate; i++) - for(m=iagemin; m <= iagemax+3; m++) - prop[i][m]=0.0; - - for (i=1; i<=imx; i++) { /* Each individual */ - bool=1; - if (cptcovn>0) { - for (z1=1; z1<=cptcoveff; z1++) - if (covar[Tvaraff[z1]][i]!= nbcode[Tvaraff[z1]][codtabm(j1,z1)]) + first=0; + for(j1=1; j1<= (int) pow(2,cptcoveff);j1++){ /* For each combination of covariate */ + for (i=1; i<=nlstate; i++) + for(iage=iagemin-AGEMARGE; iage <= iagemax+4+AGEMARGE; iage++) + 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 */ + bool=1; + /* for(m=firstpass; m<=lastpass; m++){/\* Other selection (we can limit to certain interviews*\/ */ + for(mi=1; mi=firstpass && m <=lastpass){ y2=anint[m][i]+(mint[m][i]/12.); /* Fractional date in year */ 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]==1) agev[m][i]=iagemax+2; - if((int)agev[m][i] iagemax+3) printf("Error on individual =%d agev[m][i]=%f m=%d\n",i, agev[m][i],m); - if (s[m][i]>0 && s[m][i]<=nlstate) { + if((int)agev[m][i] iagemax+4+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(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]; - prop[s[m][i]][iagemax+3] += weight[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]][iagemax+3] += weight[i]; + } /* end valid statuses */ + } /* end selection of dates */ } /* end selection of waves */ - } - } - for(i=iagemin; i <= iagemax+3; i++){ - for(jk=1,posprop=0; jk <=nlstate ; jk++) { - posprop += prop[jk][i]; - } - - for(jk=1; jk <=nlstate ; jk++){ - if( i <= iagemax){ - if(posprop>=1.e-5){ - probs[i][jk][j1]= prop[jk][i]/posprop; - } else{ - if(first==1){ - 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]); - } + } /* end bool */ + } /* end wave */ + } /* end individual */ + for(i=iagemin; i <= iagemax+3; i++){ + for(jk=1,posprop=0; jk <=nlstate ; jk++) { + posprop += prop[jk][i]; + } + + for(jk=1; jk <=nlstate ; jk++){ + if( i <= iagemax){ + if(posprop>=1.e-5){ + probs[i][jk][j1]= prop[jk][i]/posprop; + } else{ + if(!first){ + first=1; + printf("Warning Observed prevalence doesn't sum to 1 for state %d: probs[%d][%d][%d]=%lf because of lack of cases\nSee others in log file...\n",jk,i,jk, j1,probs[i][jk][j1]); + }else{ + fprintf(ficlog,"Warning Observed prevalence doesn't sum to 1 for state %d: probs[%d][%d][%d]=%lf because of lack of cases.\n",jk,i,jk, j1,probs[i][jk][j1]); } - } - }/* end jk */ - }/* end i */ - /*} *//* end i1 */ + } + } + }/* end jk */ + }/* end i */ + /*} *//* end i1 */ } /* end j1 */ /* free_ma3x(freq,-1,nlstate+ndeath,-1,nlstate+ndeath, iagemin, iagemax+3);*/ /*free_vector(pp,1,nlstate);*/ - free_matrix(prop,1,nlstate, iagemin,iagemax+3); + free_matrix(prop,1,nlstate, iagemin-AGEMARGE,iagemax+4+AGEMARGE); } /* End of prevalence */ /************* Waves Concatenation ***************/ void concatwav(int wav[], int **dh, int **bh, int **mw, int **s, double *agedc, double **agev, int firstpass, int lastpass, int imx, int nlstate, int stepm) { - /* Concatenates waves: wav[i] is the number of effective (useful waves) of individual i. + /* Concatenates waves: wav[i] is the number of effective (useful waves in the sense that a non interview is useless) of individual i. Death is a valid wave (if date is known). 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] - and mw[mi+1][i]. dh depends on stepm. - */ + and mw[mi+1][i]. dh depends on stepm. s[m][i] exists for any wave from firstpass to lastpass + */ - 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; double sum=0., jmean=0.;*/ - int first; + int first=0, firstwo=0, firsthree=0, firstfour=0, firstfiv=0; int j, k=0,jk, ju, jl; double sum=0.; first=0; + firstwo=0; + firsthree=0; + firstfour=0; jmin=100000; jmax=-1; jmean=0.; - for(i=1; i<=imx; i++){ - mi=0; + +/* Treating live states */ + for(i=1; i<=imx; i++){ /* For simple cases and if state is death */ + mi=0; /* First valid wave */ + mli=0; /* Last valid wave */ m=firstpass; - while(s[m][i] <= nlstate){ - if(s[m][i]>=1 || s[m][i]==-2 || s[m][i]==-4 || s[m][i]==-5) + while(s[m][i] <= nlstate){ /* a live state */ + 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; - if(m >=lastpass) + 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 */ + } + else{ /* m >= lastpass, eventual special issue with warning */ +#ifdef UNKNOWNSTATUSNOTCONTRIBUTING break; - else - m++; +#else + if(s[m][i]==-1 && (int) andc[i] == 9999 && (int)anint[m][i] != 9999){ + if(firsthree == 0){ + 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 1-p_{%d%d} .\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, s[m][i], nlstate+ndeath); + firsthree=1; + } + 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 1-p_{%d%d} .\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, s[m][i], nlstate+ndeath); + mw[++mi][i]=m; + mli=m; + } + if(s[m][i]==-2){ /* Vital status is really unknown */ + nbwarn++; + 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); + 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; +#endif + }/* End m >= lastpass */ }/* end while */ - if (s[m][i] > nlstate){ + + /* 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 */ +/* Treating death states */ + 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 */ /* 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; - } - - wav[i]=mi; + } /* else not in a death state */ +#ifndef DISPATCHINGKNOWNDEATHAFTERLASTWAVE + else if ((int) andc[i] != 9999) { /* Date of death is known */ + if ((int)anint[m][i]!= 9999) { /* date of last interview is known */ + 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 */ + nbwarn++; + if(firstfiv==0){ + 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 ); + firstfiv=1; + }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. Please add a new fictive wave at the date of last vital status scan, with a dead status or alive but unknown state status (-1). See documentation\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. Please add a new fictive wave at the date of last vital status scan, with a dead status or alive but unknown state status (-1). See documentation\n\n",num[i],i,(int) moisdc[i], (int) andc[i], lastpass,(int)mint[m][i],(int)anint[m][i], i,m ); + } + }else{ /* if date of interview is unknown */ + /* 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 */ +#endif + wav[i]=mi; /* mi should be the last effective wave (or mli) */ + /* wav[i]=mw[mi][i]; */ if(mi==0){ nbwarn++; if(first==0){ @@ -3448,13 +5361,15 @@ void concatwav(int wav[], int **dh, int } } /* end mi==0 */ } /* End individuals */ - + /* wav and mw are no more changed */ + + for(i=1; i<=imx; i++){ for(mi=1; mi nlstate) { /* A death */ + if (s[mw[mi+1][i]][i] > nlstate) { /* A death, but what if date is unknown? */ if (agedc[i] < 2*AGESUP) { j= rint(agedc[i]*12-agev[mw[mi][i]][i]*12); if(j==0) j=1; /* Survives at least one month after exam */ @@ -3483,7 +5398,7 @@ void concatwav(int wav[], int **dh, int else{ 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]); */ - + k=k+1; if (j >= jmax) { jmax=j; @@ -3537,142 +5452,180 @@ void concatwav(int wav[], int **dh, int 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); 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 ****************************/ -void tricode(int *Tvar, int **nbcode, int imx, int *Ndum) -{ - /**< 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 - * Boring subroutine which should only output nbcode[Tvar[j]][k] - * Tvar[5] in V2+V1+V3*age+V2*V4 is 2 (V2) - * nbcode[Tvar[j]][1]= - */ + void tricode(int *cptcov, int *Tvar, int **nbcode, int imx, int *Ndum) + { + /**< 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 + * Boring subroutine which should only output nbcode[Tvar[j]][k] + * Tvar[5] in V2+V1+V3*age+V2*V4 is 4 (V4) even it is a time varying or quantitative variable + * 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 modmaxcovj=0; /* Modality max of covariates j */ - int cptcode=0; /* Modality max of covariates j */ - int modmincovj=0; /* Modality min of covariates j */ + int ij=1, k=0, j=0, i=0, maxncov=NCOVMAX; + int modmaxcovj=0; /* Modality max of covariates j */ + int cptcode=0; /* Modality max 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 */ - - /* Loop on covariates without age and products */ - for (j=1; j<=(cptcovs); j++) { /* From model V1 + V2*age+ V3 + V3*V4 keeps V1 + V3 = 2 only */ - for (k=-1; k < maxncov; k++) Ndum[k]=0; - for (i=1; i<=imx; i++) { /* Loop on individuals: reads the data file to get the maximum value of the - modality of this covariate Vj*/ - ij=(int)(covar[Tvar[j]][i]); /* ij=0 or 1 or -1. Value of the covariate Tvar[j] for individual i - * If product of Vn*Vm, still boolean *: - * If it was coded 1, 2, 3, 4 should be splitted into 3 boolean variables - * 1 => 0 0 0, 2 => 0 0 1, 3 => 0 1 1, 4=1 0 0 */ - /* Finds for covariate j, n=Tvar[j] of Vn . ij is the - modality of the nth covariate of individual i. */ - if (ij > modmaxcovj) - modmaxcovj=ij; - else if (ij < modmincovj) - modmincovj=ij; - if ((ij < -1) && (ij > NCOVMAX)){ - printf( "Error: minimal is less than -1 or maximal is bigger than %d. Exiting. \n", NCOVMAX ); - exit(1); - }else - Ndum[ij]++; /*counts and stores the occurence of this modality 0, 1, -1*/ - /* If coded 1, 2, 3 , counts the number of 1 Ndum[1], number of 2, Ndum[2], etc */ - /*printf("i=%d ij=%d Ndum[ij]=%d imx=%d",i,ij,Ndum[ij],imx);*/ - /* getting the maximum value of the modality of the covariate - (should be 0 or 1 now) Tvar[j]. If V=sex and male is coded 0 and - female is 1, then modmaxcovj=1.*/ - } /* end for loop on individuals i */ - printf(" Minimal and maximal values of %d th covariate V%d: min=%d max=%d \n", j, Tvar[j], modmincovj, modmaxcovj); - fprintf(ficlog," Minimal and maximal values of %d th covariate V%d: min=%d max=%d \n", j, Tvar[j], modmincovj, modmaxcovj); - cptcode=modmaxcovj; - /* Ndum[0] = frequency of 0 for model-covariate j, Ndum[1] frequency of 1 etc. */ - /*for (i=0; i<=cptcode; i++) {*/ - for (k=modmincovj; k<=modmaxcovj; k++) { /* k=-1 ? 0 and 1*//* For each value k of the modality of model-cov j */ - printf("Frequencies of covariates %d ie V%d with value %d: %d\n", j, Tvar[j], k, Ndum[k]); - fprintf(ficlog, "Frequencies of covariates %d ie V%d with value %d: %d\n", j, Tvar[j], k, Ndum[k]); - if( Ndum[k] != 0 ){ /* Counts if nobody answered modality k ie empty modality, we skip it and reorder */ - if( k != -1){ - ncodemax[j]++; /* ncodemax[j]= Number of modalities of the j th - covariate for which somebody answered excluding - undefined. Usually 2: 0 and 1. */ - } - ncodemaxwundef[j]++; /* ncodemax[j]= Number of modalities of the j th - covariate for which somebody answered including - undefined. Usually 3: -1, 0 and 1. */ - } - /* In fact ncodemax[j]=2 (dichotom. variables only) but it could be more for - historical reasons: 3 if coded 1, 2, 3 and 4 and Ndum[2]=0 */ - } /* Ndum[-1] number of undefined modalities */ - - /* j is a covariate, n=Tvar[j] of Vn; Fills nbcode */ - /* For covariate j, modalities could be 1, 2, 3, 4, 5, 6, 7. - If Ndum[1]=0, Ndum[2]=0, Ndum[3]= 635, Ndum[4]=0, Ndum[5]=0, Ndum[6]=27, Ndum[7]=125; - modmincovj=3; modmaxcovj = 7; - 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; - defining two dummy variables: variables V1_1 and V1_2. - nbcode[Tvar[j]][ij]=k; - nbcode[Tvar[j]][1]=0; - nbcode[Tvar[j]][2]=1; - nbcode[Tvar[j]][3]=2; - 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[j]][ij]=i; /* stores the original value of modality i in an array nbcode, ij modality from 1 to last non-nul modality.*/ - cptcode = ij; /* New max modality for covar j */ - } /* end of loop on modality i=-1 to 1 or more */ - - /* for (k=0; k<= cptcode; k++) { /\* k=-1 ? k=0 to 1 *\//\* Could be 1 to 4 *\//\* cptcode=modmaxcovj *\/ */ - /* /\*recode from 0 *\/ */ - /* k is a modality. If we have model=V1+V1*sex */ - /* then: nbcode[1][1]=0 ; nbcode[1][2]=1; nbcode[2][1]=0 ; nbcode[2][2]=1; */ - /* But if some modality were not used, it is recoded from 0 to a newer modmaxcovj=cptcode *\/ */ - /* } */ - /* /\* cptcode = ij; *\/ /\* New max modality for covar j *\/ */ - /* if (ij > ncodemax[j]) { */ - /* printf( " Error ij=%d > ncodemax[%d]=%d\n", ij, j, ncodemax[j]); */ - /* fprintf(ficlog, " Error ij=%d > ncodemax[%d]=%d\n", ij, j, ncodemax[j]); */ - /* break; */ - /* } */ - /* } /\* end of loop on modality k *\/ */ - } /* end of loop on model-covariate j. nbcode[Tvarj][1]=0 and nbcode[Tvarj][2]=1 sets the value of covariate j*/ - - for (k=-1; k< maxncov; k++) Ndum[k]=0; - - 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.*/ - ij=Tvar[i]; /* Tvar might be -1 if status was unknown */ - Ndum[ij]++; /* Might be supersed V1 + V1*age */ - } - - ij=0; - for (i=0; i<= maxncov-1; i++) { /* modmaxcovj is unknown here. Only Ndum[2(V2),3(age*V3), 5(V3*V2) 6(V1*V4) */ - /*printf("Ndum[%d]=%d\n",i, Ndum[i]);*/ - if((Ndum[i]!=0) && (i<=ncovcol)){ - ij++; - /*printf("diff Ndum[%d]=%d\n",i, Ndum[i]);*/ - Tvaraff[ij]=i; /*For printing (unclear) */ - }else{ - /* Tvaraff[ij]=0; */ + for (k=1; k <= maxncov; k++) ncodemax[k]=0; /* Horrible constant again replaced by NCOVMAX */ + for (k=1; k <= maxncov; k++) + for(j=1; j<=2; j++) + nbcode[k][j]=0; /* Valgrind */ + + /* Loop on covariates without age and products and no quantitative variable */ + for (k=1; k<=cptcovt; k++) { /* From model V1 + V2*age + V3 + V3*V4 keeps V1 + V3 = 2 only */ + for (j=-1; (j < maxncov); j++) Ndum[j]=0; + if(Dummy[k]==0 && Typevar[k] !=1){ /* Dummy covariate and not age product */ + switch(Fixed[k]) { + case 0: /* Testing on fixed dummy covariate, simple or product of fixed */ + for (i=1; i<=imx; i++) { /* Loop on individuals: reads the data file to get the maximum value of the modality of this covariate Vj*/ + ij=(int)(covar[Tvar[k]][i]); + /* ij=0 or 1 or -1. Value of the covariate Tvar[j] for individual i + * If product of Vn*Vm, still boolean *: + * If it was coded 1, 2, 3, 4 should be splitted into 3 boolean variables + * 1 => 0 0 0, 2 => 0 0 1, 3 => 0 1 1, 4=1 0 0 */ + /* Finds for covariate j, n=Tvar[j] of Vn . ij is the + modality of the nth covariate of individual i. */ + if (ij > modmaxcovj) + modmaxcovj=ij; + else if (ij < modmincovj) + modmincovj=ij; + if (ij <0 || ij >1 ){ + printf("Information, IMaCh doesn't treat covariate with missing values (-1), individual %d will be skipped.\n",i); + fprintf(ficlog,"Information, currently IMaCh doesn't treat covariate with missing values (-1), individual %d will be skipped.\n",i); + } + if ((ij < -1) || (ij > NCOVMAX)){ + printf( "Error: minimal is less than -1 or maximal is bigger than %d. Exiting. \n", NCOVMAX ); + exit(1); + }else + Ndum[ij]++; /*counts and stores the occurence of this modality 0, 1, -1*/ + /* If coded 1, 2, 3 , counts the number of 1 Ndum[1], number of 2, Ndum[2], etc */ + /*printf("i=%d ij=%d Ndum[ij]=%d imx=%d",i,ij,Ndum[ij],imx);*/ + /* getting the maximum value of the modality of the covariate + (should be 0 or 1 now) Tvar[j]. If V=sex and male is coded 0 and + female ies 1, then modmaxcovj=1. + */ + } /* end for loop on individuals i */ + printf(" Minimal and maximal values of %d th (fixed) covariate V%d: min=%d max=%d \n", k, Tvar[k], modmincovj, modmaxcovj); + fprintf(ficlog," Minimal and maximal values of %d th (fixed) covariate V%d: min=%d max=%d \n", k, Tvar[k], modmincovj, modmaxcovj); + cptcode=modmaxcovj; + /* Ndum[0] = frequency of 0 for model-covariate j, Ndum[1] frequency of 1 etc. */ + /*for (i=0; i<=cptcode; i++) {*/ + for (j=modmincovj; j<=modmaxcovj; j++) { /* j=-1 ? 0 and 1*//* For each value j of the modality of model-cov k */ + printf("Frequencies of (fixed) covariate %d ie V%d with value %d: %d\n", k, Tvar[k], j, Ndum[j]); + fprintf(ficlog, "Frequencies of (fixed) covariate %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 */ + if( j != -1){ + ncodemax[k]++; /* ncodemax[k]= Number of modalities of the k th + covariate for which somebody answered excluding + undefined. Usually 2: 0 and 1. */ + } + ncodemaxwundef[k]++; /* ncodemax[j]= Number of modalities of the k th + covariate for which somebody answered including + undefined. Usually 3: -1, 0 and 1. */ + } /* In fact ncodemax[k]=2 (dichotom. variables only) but it could be more for + * historical reasons: 3 if coded 1, 2, 3 and 4 and Ndum[2]=0 */ + } /* Ndum[-1] number of undefined modalities */ + + /* j is a covariate, n=Tvar[j] of Vn; Fills nbcode */ + /* For covariate j, modalities could be 1, 2, 3, 4, 5, 6, 7. */ + /* If Ndum[1]=0, Ndum[2]=0, Ndum[3]= 635, Ndum[4]=0, Ndum[5]=0, Ndum[6]=27, Ndum[7]=125; */ + /* modmincovj=3; modmaxcovj = 7; */ + /* 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; */ + /* defining two dummy variables: variables V1_1 and V1_2.*/ + /* nbcode[Tvar[j]][ij]=k; */ + /* nbcode[Tvar[j]][1]=0; */ + /* nbcode[Tvar[j]][2]=1; */ + /* nbcode[Tvar[j]][3]=2; */ + /* 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*/ + /* Skipping the case of missing values by reducing nbcode to 0 and 1 and not -1, 0, 1 */ + /* model=V1+V2+V3, if V2=-1, 0 or 1, then nbcode[2][1]=0 and nbcode[2][2]=1 instead of + * nbcode[2][1]=-1, nbcode[2][2]=0 and nbcode[2][3]=1 */ + /*, could be restored in the future */ + for (i=0; i<=1; 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 . Could be -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; + } + break; + default: + break; + } /* end switch */ + } /* end dummy test */ + } /* end of loop on model-covariate k. nbcode[Tvark][1]=-1, nbcode[Tvark][1]=0 and nbcode[Tvark][2]=1 sets the value of covariate k*/ + + 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 */ + /* 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 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]++; /* 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) *\/ */ + for (k=1; k<= cptcovt; k++) { /* modmaxcovj is unknown here. Only Ndum[2(V2),3(age*V3), 5(V3*V2) 6(V1*V4) */ + /*printf("Ndum[%d]=%d\n",i, Ndum[i]);*/ + /* if((Ndum[i]!=0) && (i<=ncovcol)){ /\* Tvar[i] <= ncovmodel ? *\/ */ + if(Ndum[Tvar[k]]!=0 && Dummy[k] == 0 && Typevar[k]==0){ /* Only Dummy and non empty in the model */ + /* If product not in single variable we don't print results */ + /*printf("diff Ndum[%d]=%d\n",i, Ndum[i]);*/ + ++ij;/* V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1, */ + Tvaraff[ij]=Tvar[k]; /* For printing combination *//* V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1, Tvar {5, 4, 3, 6, 5, 2, 7, 1, 1} Tvaraff={4, 3, 1} V4, V3, V1*/ + Tmodelind[ij]=k; /* Tmodelind: index in model of dummies Tmodelind[1]=2 V4: pos=2; V3: pos=3, V1=9 {2, 3, 9, ?, ?,} */ + TmodelInvind[ij]=Tvar[k]- ncovcol-nqv; /* Inverse TmodelInvind[2=V4]=2 second dummy varying cov (V4)4-1-1 {0, 2, 1, } TmodelInvind[3]=1 */ + 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; + } + for(j=ntveff+1; j<= cptcovt; j++){ + TmodelInvind[j]=0; } + /* To be sorted */ + ; } - /* ij--; */ - cptcoveff=ij; /*Number of total covariates*/ - -} /*********** Health Expectancies ****************/ -void evsij(double ***eij, double x[], int nlstate, int stepm, int bage, int fage, double **oldm, double **savm, int cij, int estepm,char strstart[] ) + void evsij(double ***eij, double x[], int nlstate, int stepm, int bage, int fage, double **oldm, double **savm, int cij, int estepm,char strstart[], int nres ) { /* Health expectancies, no variances */ @@ -3682,7 +5635,7 @@ void evsij(double ***eij, double x[], in double ***p3mat; double eip; - pstamp(ficreseij); + /* pstamp(ficreseij); */ fprintf(ficreseij,"# (a) Life expectancies by health status at initial age and (b) health expectancies by health status at initial age\n"); fprintf(ficreseij,"# Age"); for(i=1; i<=nlstate;i++){ @@ -3713,7 +5666,7 @@ void evsij(double ***eij, double x[], in /* hstepm beeing the number of stepms, if hstepm=1 the length of hstepm is stepm. nhstepm is the number of hstepm from age to agelim nstepm is the number of stepm from age to agelin. - Look at hpijx to understand the reason of that which relies in memory size + Look at hpijx to understand the reason which relies in memory size consideration and note for a fixed period like estepm months */ /* We decided (b) to get a life expectancy respecting the most precise curvature of the survival function given by stepm (the optimization length). Unfortunately it @@ -3745,7 +5698,7 @@ void evsij(double ***eij, double x[], in /* Computed by stepm unit matrices, product of hstepma matrices, stored in an array of nhstepma length: nhstepma=10, hstepm=4, stepm=6 months */ - hpxij(p3mat,nhstepma,age,hstepm,x,nlstate,stepm,oldm, savm, cij); + hpxij(p3mat,nhstepma,age,hstepm,x,nlstate,stepm,oldm, savm, cij, nres); hf=hstepm*stepm/YEARM; /* Duration of hstepm expressed in year unit. */ @@ -3780,11 +5733,11 @@ void evsij(double ***eij, double x[], in } -void cvevsij(double ***eij, double x[], int nlstate, int stepm, int bage, int fage, double **oldm, double **savm, int cij, int estepm,double delti[],double **matcov,char strstart[] ) + void cvevsij(double ***eij, double x[], int nlstate, int stepm, int bage, int fage, double **oldm, double **savm, int cij, int estepm,double delti[],double **matcov,char strstart[], int nres ) { /* 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 nhstepma, nstepma; /* Decreasing with age */ @@ -3878,13 +5831,13 @@ void cvevsij(double ***eij, double x[], /* Typically if 20 years nstepm = 20*12/6=40 stepm */ /* if (stepm >= YEARM) hstepm=1;*/ nhstepma = nstepma/hstepm;/* Expressed in hstepm, typically nhstepma=40/4=10 */ - + /* If stepm=6 months */ /* Computed by stepm unit matrices, product of hstepma matrices, stored in an array of nhstepma length: nhstepma=10, hstepm=4, stepm=6 months */ hf=hstepm*stepm/YEARM; /* Duration of hstepm expressed in year unit. */ - + /* Computing Variances of health expectancies */ /* Gradient is computed with plus gp and minus gm. Code is duplicated in order to decrease memory allocation */ @@ -3893,9 +5846,9 @@ void cvevsij(double ***eij, double x[], xp[i] = x[i] + (i==theta ?delti[theta]:0); xm[i] = x[i] - (i==theta ?delti[theta]:0); } - hpxij(p3matp,nhstepm,age,hstepm,xp,nlstate,stepm,oldm,savm, cij); - hpxij(p3matm,nhstepm,age,hstepm,xm,nlstate,stepm,oldm,savm, cij); - + hpxij(p3matp,nhstepm,age,hstepm,xp,nlstate,stepm,oldm,savm, cij, nres); + hpxij(p3matm,nhstepm,age,hstepm,xm,nlstate,stepm,oldm,savm, cij, nres); + for(j=1; j<= nlstate; j++){ for(i=1; i<=nlstate; i++){ for(h=0; h<=nhstepm-1; h++){ @@ -3904,7 +5857,7 @@ void cvevsij(double ***eij, double x[], } } } - + for(ij=1; ij<= nlstate*nlstate; ij++) for(h=0; h<=nhstepm-1; h++){ gradg[h][theta][ij]= (gp[h][ij]-gm[h][ij])/2./delti[theta]; @@ -3917,14 +5870,14 @@ void cvevsij(double ***eij, double x[], for(theta=1; theta <=npar; theta++) 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++) varhe[ij][ji][(int)age] =0.; - - printf("%d|",(int)age);fflush(stdout); - fprintf(ficlog,"%d|",(int)age);fflush(ficlog); - for(h=0;h<=nhstepm-1;h++){ + + printf("%d|",(int)age);fflush(stdout); + fprintf(ficlog,"%d|",(int)age);fflush(ficlog); + for(h=0;h<=nhstepm-1;h++){ for(k=0;k<=nhstepm-1;k++){ 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]); @@ -3933,18 +5886,19 @@ void cvevsij(double ***eij, double x[], varhe[ij][ji][(int)age] += doldm[ij][ji]*hf*hf; } } - + /* Computing expectancies */ - hpxij(p3matm,nhstepm,age,hstepm,x,nlstate,stepm,oldm, savm, cij); + hpxij(p3matm,nhstepm,age,hstepm,x,nlstate,stepm,oldm, savm, cij,nres); for(i=1; i<=nlstate;i++) for(j=1; j<=nlstate;j++) 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; - + /* if((int)age==70)printf("i=%2d,j=%2d,h=%2d,age=%3d,%9.4f,%9.4f,%9.4f\n",i,j,h,(int)age,p3mat[i][j][h],hf,eij[i][j][(int)age]);*/ - + } + /* Standard deviation of expectancies ij */ fprintf(ficresstdeij,"%3.0f",age ); for(i=1; i<=nlstate;i++){ eip=0.; @@ -3958,7 +5912,8 @@ void cvevsij(double ***eij, double x[], fprintf(ficresstdeij," %9.4f (%.4f)", eip, sqrt(vip)); } fprintf(ficresstdeij,"\n"); - + + /* Variance of expectancies ij */ fprintf(ficrescveij,"%3.0f",age ); for(i=1; i<=nlstate;i++) for(j=1; j<=nlstate;j++){ @@ -3971,7 +5926,7 @@ void cvevsij(double ***eij, double x[], } } fprintf(ficrescveij,"\n"); - + } free_matrix(gm,0,nhstepm,1,nlstate*nlstate); free_matrix(gp,0,nhstepm,1,nlstate*nlstate); @@ -3981,347 +5936,386 @@ void cvevsij(double ***eij, double x[], free_ma3x(p3matp,1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); printf("\n"); fprintf(ficlog,"\n"); - + free_vector(xm,1,npar); free_vector(xp,1,npar); free_matrix(dnewm,1,nlstate*nlstate,1,npar); free_matrix(doldm,1,nlstate*nlstate,1,nlstate*nlstate); free_ma3x(varhe,1,nlstate*nlstate,1,nlstate*nlstate,(int) bage, (int)fage); } - + /************ 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 *ncvyear, int ij, int estepm, int cptcov, int cptcod, int popbased, int mobilav, char strstart[]) -{ - /* Variance of health expectancies */ - /* double **prevalim(double **prlim, int nlstate, double *xp, double age, double **oldm, double ** savm,double ftolpl);*/ - /* double **newm;*/ - /* int movingaverage(double ***probs, double bage,double fage, double ***mobaverage, int mobilav)*/ + void varevsij(char optionfilefiname[], double ***vareij, double **matcov, double x[], double delti[], int nlstate, int stepm, double bage, double fage, double **oldm, double **savm, double **prlim, double ftolpl, int *ncvyearp, int ij, int estepm, int cptcov, int cptcod, int popbased, int mobilav, char strstart[], int nres) + { + /** Variance of health expectancies + * double **prevalim(double **prlim, int nlstate, double *xp, double age, double **oldm, double ** savm,double ftolpl); + * double **newm; + * int movingaverage(double ***probs, double bage,double fage, double ***mobaverage, int mobilav) + */ - int movingaverage(); - double **dnewm,**doldm; - double **dnewmp,**doldmp; - int i, j, nhstepm, hstepm, h, nstepm ; - int k; - double *xp; - double **gp, **gm; /* for var eij */ - double ***gradg, ***trgradg; /*for var eij */ - double **gradgp, **trgradgp; /* for var p point j */ - double *gpp, *gmp; /* for var p point j */ - double **varppt; /* for var p point j nlstate to nlstate+ndeath */ - double ***p3mat; - double age,agelim, hf; - double ***mobaverage; - int theta; - char digit[4]; - char digitp[25]; - - char fileresprobmorprev[FILENAMELENGTH]; + /* int movingaverage(); */ + double **dnewm,**doldm; + double **dnewmp,**doldmp; + int i, j, nhstepm, hstepm, h, nstepm ; + int first=0; + int k; + double *xp; + double **gp, **gm; /**< for var eij */ + double ***gradg, ***trgradg; /**< for var eij */ + double **gradgp, **trgradgp; /**< for var p point j */ + double *gpp, *gmp; /**< for var p point j */ + double **varppt; /**< for var p point j nlstate to nlstate+ndeath */ + double ***p3mat; + double age,agelim, hf; + /* double ***mobaverage; */ + int theta; + char digit[4]; + char digitp[25]; + + char fileresprobmorprev[FILENAMELENGTH]; + + if(popbased==1){ + if(mobilav!=0) + strcpy(digitp,"-POPULBASED-MOBILAV_"); + else strcpy(digitp,"-POPULBASED-NOMOBIL_"); + } + else + strcpy(digitp,"-STABLBASED_"); - if(popbased==1){ - if(mobilav!=0) - strcpy(digitp,"-POPULBASED-MOBILAV_"); - else strcpy(digitp,"-POPULBASED-NOMOBIL_"); - } - else - 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); - } - } + /* 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,"# Selected quantitative variables and dummies"); + for (j=1; j<= nsq; j++){ /* For each selected (single) quantitative value */ + fprintf(ficresprobmorprev," V%d=%f ",Tvqresult[nres][j],Tqresult[nres][j]); + } + for(j=1;j<=cptcoveff;j++) + fprintf(ficresprobmorprev,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(ij,j)]); + fprintf(ficresprobmorprev,"\n"); + + 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

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

    • \n"); + fprintf(fichtm,"\n
    %s
    \n",digitp); + + varppt = matrix(nlstate+1,nlstate+ndeath,nlstate+1,nlstate+ndeath); + pstamp(ficresvij); + fprintf(ficresvij,"# Variance and covariance of health expectancies e.j \n# (weighted average of eij where weights are "); + 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); + } + /**< Computes the prevalence limit with parameter theta shifted of delta up to ftolpl precision and + * returns into prlim . + */ + prevalim(prlim,nlstate,xp,age,oldm,savm,ftolpl,ncvyearp,ij, nres); - 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

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

    • \n"); - fprintf(fichtm,"\n
    %s
    \n",digitp); -/* } */ - varppt = matrix(nlstate+1,nlstate+ndeath,nlstate+1,nlstate+ndeath); - pstamp(ficresvij); - fprintf(ficresvij,"# Variance and covariance of health expectancies e.j \n# (weighted average of eij where weights are "); - 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 agelin. - Look at function hpijx to understand why (it is linked to memory size questions) */ - /* 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); - } - hpxij(p3mat,nhstepm,age,hstepm,xp,nlstate,stepm,oldm,savm, ij); - prevalim(prlim,nlstate,xp,age,oldm,savm,ftolpl,ncvyear,ij); + /* If popbased = 1 we use crossection prevalences. Previous step is useless but prlim is created */ + if (popbased==1) { + if(mobilav ==0){ + for(i=1; i<=nlstate;i++) + prlim[i][i]=probs[(int)age][i][ij]; + }else{ /* mobilav */ + for(i=1; i<=nlstate;i++) + prlim[i][i]=mobaverage[(int)age][i][ij]; + } + } + /**< Computes the shifted transition matrix \f$ {}{h}_p^{ij}x\f$ at horizon h. + */ + hpxij(p3mat,nhstepm,age,hstepm,xp,nlstate,stepm,oldm,savm, ij,nres); /* Returns p3mat[i][j][h] for h=0 to nhstepm */ + /**< And for each alive state j, sums over i \f$ w^i_x {}{h}_p^{ij}x\f$, which are the probability + * at horizon h in state j including mortality. + */ + for(j=1; j<= nlstate; j++){ + for(h=0; h<=nhstepm; h++){ + for(i=1, gp[h][j]=0.;i<=nlstate;i++) + gp[h][j] += prlim[i][i]*p3mat[i][j][h]; + } + } + /* Next for computing shifted+ probability of death (h=1 means + computed over hstepm matrices product = hstepm*stepm months) + as a weighted average of prlim(i) * p(i,j) p.3=w1*p13 + w2*p23 . + */ + for(j=nlstate+1;j<=nlstate+ndeath;j++){ + for(i=1,gpp[j]=0.; i<= nlstate; i++) + gpp[j] += prlim[i][i]*p3mat[i][j][1]; + } + + /* Again with minus shift */ + + 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, nres); + + 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,nres); + + 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 shifting computations */ - 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]; - } - } - - 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]; - } - } - /* This for computing probability of death (h=1 means - computed over hstepm matrices product = hstepm*stepm months) - as a weighted average of prlim. + /**< Computing gradient matrix at horizon h + */ + for(j=1; j<= nlstate; j++) /* vareij */ + for(h=0; h<=nhstepm; h++){ + gradg[h][theta][j]= (gp[h][j]-gm[h][j])/2./delti[theta]; + } + /**< Gradient of overall mortality p.3 (or p.j) + */ + for(j=nlstate+1; j<= nlstate+ndeath; j++){ /* var mu mortality from j */ + gradgp[theta][j]= (gpp[j]-gmp[j])/2./delti[theta]; + } + + } /* End theta */ + + /* We got the gradient matrix for each theta and state j */ + trgradg =ma3x(0,nhstepm,1,nlstate,1,npar); /* veij */ + + for(h=0; h<=nhstepm; h++) /* veij */ + 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]; + /**< as well as its transposed matrix + */ + + hf=hstepm*stepm/YEARM; /* Duration of hstepm expressed in year unit. */ + for(i=1;i<=nlstate;i++) + for(j=1;j<=nlstate;j++) + vareij[i][j][(int)age] =0.; + + /* Computing trgradg by matcov by gradg at age and summing over h + * and k (nhstepm) formula 15 of article + * Lievre-Brouard-Heathcote */ - for(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); - hpxij(p3mat,nhstepm,age,hstepm,xp,nlstate,stepm,oldm,savm, ij); - prevalim(prlim,nlstate,xp,age,oldm,savm,ftolpl,ncvyear, 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]; - } - } - - 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(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 is p.3 or p.j = trgradgp by cov by gradgp, variance of + * p.j overall mortality formula 49 but computed directly because + * we compute the grad (wix pijx) instead of grad (pijx),even if + * wix is independent of theta. */ - 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 */ - hpxij(p3mat,nhstepm,age,hstepm,x,nlstate,stepm,oldm,savm, ij); - prevalim(prlim,nlstate,x,age,oldm,savm,ftolpl,ncvyear,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. + 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, nres); + + 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, nres); + 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
    File (multiple files are possible if covariates are present): %s\n",subdirf(fileresprobmorprev),subdirf(fileresprobmorprev)); + fprintf(fichtm,"\n
    Probability is computed over estepm=%d months.

    \n", estepm,subdirf3(optionfilefiname,"VARMUPTJGR-",digitp),digit); + /* fprintf(fichtm,"\n
    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

    \n", stepm,YEARM,digitp,digit); */ - 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(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); - 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
    File (multiple files are possible if covariates are present): %s\n",subdirf(fileresprobmorprev),subdirf(fileresprobmorprev)); - fprintf(fichtm,"\n
    Probability is computed over estepm=%d months.

    \n", estepm,subdirf3(optionfilefiname,"VARMUPTJGR-",digitp),digit); - /* fprintf(fichtm,"\n
    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

    \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_matrix(doldm,1,nlstate,1,nlstate); - free_matrix(dnewm,1,nlstate,1,npar); - free_matrix(doldmp,nlstate+1,nlstate+ndeath,nlstate+1,nlstate+ndeath); - free_matrix(dnewmp,nlstate+1,nlstate+ndeath,1,npar); - free_matrix(varppt,nlstate+1,nlstate+ndeath,nlstate+1,nlstate+ndeath); - if (mobilav!=0) free_ma3x(mobaverage,1, AGESUP,1,NCOVMAX, 1,NCOVMAX); - fclose(ficresprobmorprev); - fflush(ficgp); - fflush(fichtm); -} /* end varevsij */ + free_vector(xp,1,npar); + free_matrix(doldm,1,nlstate,1,nlstate); + free_matrix(dnewm,1,nlstate,1,npar); + free_matrix(doldmp,nlstate+1,nlstate+ndeath,nlstate+1,nlstate+ndeath); + free_matrix(dnewmp,nlstate+1,nlstate+ndeath,1,npar); + free_matrix(varppt,nlstate+1,nlstate+ndeath,nlstate+1,nlstate+ndeath); + /* if (mobilav!=0) free_ma3x(mobaverage,1, AGESUP,1,NCOVMAX, 1,NCOVMAX); */ + fclose(ficresprobmorprev); + fflush(ficgp); + fflush(fichtm); + } /* end varevsij */ /************ Variance of prevlim ******************/ - void varprevlim(char fileres[], double **varpl, double **matcov, double x[], double delti[], int nlstate, int stepm, double bage, double fage, double **oldm, double **savm, double **prlim, double ftolpl, int *ncvyear, int ij, char strstart[]) + void varprevlim(char fileresvpl[], FILE *ficresvpl, double **varpl, double **matcov, double x[], double delti[], int nlstate, int stepm, double bage, double fage, double **oldm, double **savm, double **prlim, double ftolpl, int *ncvyearp, int ij, char strstart[], int nres) { /* Variance of prevalence limit for each state ij using current parameters x[] and estimates of neighbourhood give by delti*/ /* double **prevalim(double **prlim, int nlstate, double *xp, double age, double **oldm, double **savm,double ftolpl);*/ - double **dnewm,**doldm; + double **dnewmpar,**doldm; int i, j, nhstepm, hstepm; double *xp; double *gp, *gm; double **gradg, **trgradg; + double **mgm, **mgp; double age,agelim; int theta; pstamp(ficresvpl); - fprintf(ficresvpl,"# Standard deviation of period (stable) prevalences \n"); - fprintf(ficresvpl,"# Age"); + fprintf(ficresvpl,"# Standard deviation of period (forward stable) prevalences \n"); + fprintf(ficresvpl,"# Age "); + if(nresult >=1) + fprintf(ficresvpl," Result# "); for(i=1; i<=nlstate;i++) fprintf(ficresvpl," %1d-%1d",i,i); fprintf(ficresvpl,"\n"); xp=vector(1,npar); - dnewm=matrix(1,nlstate,1,npar); + dnewmpar=matrix(1,nlstate,1,npar); doldm=matrix(1,nlstate,1,nlstate); hstepm=1*YEARM; /* Every year of age */ @@ -4332,6 +6326,8 @@ void cvevsij(double ***eij, double x[], if (stepm >= YEARM) hstepm=1; nhstepm = nhstepm/hstepm; /* Typically 40/4=10 */ gradg=matrix(1,npar,1,nlstate); + mgp=matrix(1,npar,1,nlstate); + mgm=matrix(1,npar,1,nlstate); gp=vector(1,nlstate); gm=vector(1,nlstate); @@ -4339,18 +6335,27 @@ void cvevsij(double ***eij, double x[], for(i=1; i<=npar; i++){ /* Computes gradient */ xp[i] = x[i] + (i==theta ?delti[theta]:0); } - prevalim(prlim,nlstate,xp,age,oldm,savm,ftolpl,ncvyear,ij); - for(i=1;i<=nlstate;i++) + /* if((int)age==79 ||(int)age== 80 ||(int)age== 81 ) */ + /* prevalim(prlim,nlstate,xp,age,oldm,savm,ftolpl,ncvyearp,ij,nres); */ + /* else */ + prevalim(prlim,nlstate,xp,age,oldm,savm,ftolpl,ncvyearp,ij,nres); + for(i=1;i<=nlstate;i++){ gp[i] = prlim[i][i]; - + mgp[theta][i] = prlim[i][i]; + } for(i=1; i<=npar; i++) /* Computes gradient */ xp[i] = x[i] - (i==theta ?delti[theta]:0); - prevalim(prlim,nlstate,xp,age,oldm,savm,ftolpl,ncvyear,ij); - for(i=1;i<=nlstate;i++) + /* if((int)age==79 ||(int)age== 80 ||(int)age== 81 ) */ + /* prevalim(prlim,nlstate,xp,age,oldm,savm,ftolpl,ncvyearp,ij,nres); */ + /* else */ + prevalim(prlim,nlstate,xp,age,oldm,savm,ftolpl,ncvyearp,ij,nres); + for(i=1;i<=nlstate;i++){ gm[i] = prlim[i][i]; - + mgm[theta][i] = prlim[i][i]; + } for(i=1;i<=nlstate;i++) gradg[theta][i]= (gp[i]-gm[i])/2./delti[theta]; + /* gradg[theta][2]= -gradg[theta][1]; */ /* For testing if nlstate=2 */ } /* End theta */ trgradg =matrix(1,nlstate,1,npar); @@ -4358,117 +6363,267 @@ void cvevsij(double ***eij, double x[], for(j=1; j<=nlstate;j++) for(theta=1; theta <=npar; theta++) trgradg[j][theta]=gradg[theta][j]; + /* if((int)age==79 ||(int)age== 80 ||(int)age== 81 ){ */ + /* printf("\nmgm mgp %d ",(int)age); */ + /* for(j=1; j<=nlstate;j++){ */ + /* printf(" %d ",j); */ + /* for(theta=1; theta <=npar; theta++) */ + /* printf(" %d %lf %lf",theta,mgm[theta][j],mgp[theta][j]); */ + /* printf("\n "); */ + /* } */ + /* } */ + /* if((int)age==79 ||(int)age== 80 ||(int)age== 81 ){ */ + /* printf("\n gradg %d ",(int)age); */ + /* for(j=1; j<=nlstate;j++){ */ + /* printf("%d ",j); */ + /* for(theta=1; theta <=npar; theta++) */ + /* printf("%d %lf ",theta,gradg[theta][j]); */ + /* printf("\n "); */ + /* } */ + /* } */ for(i=1;i<=nlstate;i++) varpl[i][(int)age] =0.; - if((int)age==67 ||(int)age== 66 ){ - matprod2(dnewm,trgradg,1,nlstate,1,npar,1,npar,matcov); - matprod2(doldm,dnewm,1,nlstate,1,npar,1,nlstate,gradg); + if((int)age==79 ||(int)age== 80 ||(int)age== 81){ + matprod2(dnewmpar,trgradg,1,nlstate,1,npar,1,npar,matcov); + matprod2(doldm,dnewmpar,1,nlstate,1,npar,1,nlstate,gradg); }else{ - matprod2(dnewm,trgradg,1,nlstate,1,npar,1,npar,matcov); - matprod2(doldm,dnewm,1,nlstate,1,npar,1,nlstate,gradg); + matprod2(dnewmpar,trgradg,1,nlstate,1,npar,1,npar,matcov); + matprod2(doldm,dnewmpar,1,nlstate,1,npar,1,nlstate,gradg); } for(i=1;i<=nlstate;i++) varpl[i][(int)age] = doldm[i][i]; /* Covariances are useless */ fprintf(ficresvpl,"%.0f ",age ); - for(i=1; i<=nlstate;i++) + if(nresult >=1) + fprintf(ficresvpl,"%d ",nres ); + for(i=1; i<=nlstate;i++){ fprintf(ficresvpl," %.5f (%.5f)",prlim[i][i],sqrt(varpl[i][(int)age])); + /* for(j=1;j<=nlstate;j++) */ + /* fprintf(ficresvpl," %d %.5f ",j,prlim[j][i]); */ + } fprintf(ficresvpl,"\n"); free_vector(gp,1,nlstate); free_vector(gm,1,nlstate); + free_matrix(mgm,1,npar,1,nlstate); + free_matrix(mgp,1,npar,1,nlstate); free_matrix(gradg,1,npar,1,nlstate); free_matrix(trgradg,1,nlstate,1,npar); } /* End age */ free_vector(xp,1,npar); free_matrix(doldm,1,nlstate,1,npar); - free_matrix(dnewm,1,nlstate,1,nlstate); + free_matrix(dnewmpar,1,nlstate,1,nlstate); } -/************ Variance of one-step probabilities ******************/ -void varprob(char optionfilefiname[], double **matcov, double x[], double delti[], int nlstate, double bage, double fage, int ij, int *Tvar, int **nbcode, int *ncodemax, char strstart[]) + +/************ Variance of backprevalence limit ******************/ + void varbrevlim(char fileresvbl[], FILE *ficresvbl, double **varbpl, double **matcov, double x[], double delti[], int nlstate, int stepm, double bage, double fage, double **oldm, double **savm, double **bprlim, double ftolpl, int mobilavproj, int *ncvyearp, int ij, char strstart[], int nres) { - int i, j=0, k1, l1, tj; - int k2, l2, j1, z1; - int k=0, l; - int first=1, first1, first2; - double cv12, mu1, mu2, lc1, lc2, v12, v21, v11, v22,v1,v2, c12, tnalp; - double **dnewm,**doldm; + /* Variance of backward prevalence limit for each state ij using current parameters x[] and estimates of neighbourhood give by delti*/ + /* double **prevalim(double **prlim, int nlstate, double *xp, double age, double **oldm, double **savm,double ftolpl);*/ + + double **dnewmpar,**doldm; + int i, j, nhstepm, hstepm; double *xp; double *gp, *gm; double **gradg, **trgradg; - double **mu; - double age, cov[NCOVMAX+1]; - double std=2.0; /* Number of standard deviation wide of confidence ellipsoids */ + double **mgm, **mgp; + double age,agelim; int theta; - char fileresprob[FILENAMELENGTH]; - char fileresprobcov[FILENAMELENGTH]; - char fileresprobcor[FILENAMELENGTH]; - double ***varpij; - - strcpy(fileresprob,"PROB_"); - strcat(fileresprob,fileres); - if((ficresprob=fopen(fileresprob,"w"))==NULL) { - printf("Problem with resultfile: %s\n", fileresprob); - fprintf(ficlog,"Problem with resultfile: %s\n", fileresprob); - } - strcpy(fileresprobcov,"PROBCOV_"); - strcat(fileresprobcov,fileresu); - if((ficresprobcov=fopen(fileresprobcov,"w"))==NULL) { - printf("Problem with resultfile: %s\n", fileresprobcov); - fprintf(ficlog,"Problem with resultfile: %s\n", fileresprobcov); - } - strcpy(fileresprobcor,"PROBCOR_"); - strcat(fileresprobcor,fileresu); - if((ficresprobcor=fopen(fileresprobcor,"w"))==NULL) { - printf("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); - 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); - 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); - fprintf(ficlog,"and correlation matrix of one-step probabilities: result on file '%s' \n",fileresprobcor); - pstamp(ficresprob); - fprintf(ficresprob,"#One-step probabilities and stand. devi in ()\n"); - fprintf(ficresprob,"# Age"); - pstamp(ficresprobcov); - fprintf(ficresprobcov,"#One-step probabilities and covariance matrix\n"); - fprintf(ficresprobcov,"# Age"); - pstamp(ficresprobcor); - fprintf(ficresprobcor,"#One-step probabilities and correlation matrix\n"); - fprintf(ficresprobcor,"# Age"); - - + + pstamp(ficresvbl); + fprintf(ficresvbl,"# Standard deviation of back (stable) prevalences \n"); + fprintf(ficresvbl,"# Age "); + if(nresult >=1) + fprintf(ficresvbl," Result# "); for(i=1; i<=nlstate;i++) - for(j=1; j<=(nlstate+ndeath);j++){ - fprintf(ficresprob," p%1d-%1d (SE)",i,j); - fprintf(ficresprobcov," p%1d-%1d ",i,j); - fprintf(ficresprobcor," p%1d-%1d ",i,j); - } - /* fprintf(ficresprob,"\n"); - fprintf(ficresprobcov,"\n"); - fprintf(ficresprobcor,"\n"); - */ + fprintf(ficresvbl," %1d-%1d",i,i); + fprintf(ficresvbl,"\n"); + xp=vector(1,npar); - dnewm=matrix(1,(nlstate)*(nlstate+ndeath),1,npar); - doldm=matrix(1,(nlstate)*(nlstate+ndeath),1,(nlstate)*(nlstate+ndeath)); - mu=matrix(1,(nlstate)*(nlstate+ndeath), (int) bage, (int)fage); - varpij=ma3x(1,nlstate*(nlstate+ndeath),1,nlstate*(nlstate+ndeath),(int) bage, (int) fage); - first=1; - fprintf(ficgp,"\n# Routine varprob"); - fprintf(fichtm,"\n

  • Computing and drawing one step probabilities with their confidence intervals

    • \n"); - fprintf(fichtm,"\n"); + dnewmpar=matrix(1,nlstate,1,npar); + doldm=matrix(1,nlstate,1,nlstate); + + hstepm=1*YEARM; /* Every year of age */ + hstepm=hstepm/stepm; /* Typically in stepm units, if j= 2 years, = 2/6 months = 4 */ + agelim = AGEINF; + for (age=fage; age>=bage; age --){ /* If stepm=6 months */ + nhstepm=(int) rint((age-agelim)*YEARM/stepm); /* Typically 20 years = 20*12/6=40 */ + if (stepm >= YEARM) hstepm=1; + nhstepm = nhstepm/hstepm; /* Typically 40/4=10 */ + gradg=matrix(1,npar,1,nlstate); + mgp=matrix(1,npar,1,nlstate); + mgm=matrix(1,npar,1,nlstate); + gp=vector(1,nlstate); + gm=vector(1,nlstate); + + for(theta=1; theta <=npar; theta++){ + for(i=1; i<=npar; i++){ /* Computes gradient */ + xp[i] = x[i] + (i==theta ?delti[theta]:0); + } + if(mobilavproj > 0 ) + bprevalim(bprlim, mobaverage,nlstate,xp,age,ftolpl,ncvyearp,ij,nres); + else + bprevalim(bprlim, mobaverage,nlstate,xp,age,ftolpl,ncvyearp,ij,nres); + for(i=1;i<=nlstate;i++){ + gp[i] = bprlim[i][i]; + mgp[theta][i] = bprlim[i][i]; + } + for(i=1; i<=npar; i++) /* Computes gradient */ + xp[i] = x[i] - (i==theta ?delti[theta]:0); + if(mobilavproj > 0 ) + bprevalim(bprlim, mobaverage,nlstate,xp,age,ftolpl,ncvyearp,ij,nres); + else + bprevalim(bprlim, mobaverage,nlstate,xp,age,ftolpl,ncvyearp,ij,nres); + for(i=1;i<=nlstate;i++){ + gm[i] = bprlim[i][i]; + mgm[theta][i] = bprlim[i][i]; + } + for(i=1;i<=nlstate;i++) + gradg[theta][i]= (gp[i]-gm[i])/2./delti[theta]; + /* gradg[theta][2]= -gradg[theta][1]; */ /* For testing if nlstate=2 */ + } /* End theta */ + + trgradg =matrix(1,nlstate,1,npar); - fprintf(fichtm,"\n

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

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

    Matrix of variance-covariance of pairs of step probabilities

    \n",optionfilehtmcov, optionfilehtmcov); - fprintf(fichtmcov,"\nEllipsoids of confidence centered on point (pij, pkl) are estimated \ + for(j=1; j<=nlstate;j++) + for(theta=1; theta <=npar; theta++) + trgradg[j][theta]=gradg[theta][j]; + /* if((int)age==79 ||(int)age== 80 ||(int)age== 81 ){ */ + /* printf("\nmgm mgp %d ",(int)age); */ + /* for(j=1; j<=nlstate;j++){ */ + /* printf(" %d ",j); */ + /* for(theta=1; theta <=npar; theta++) */ + /* printf(" %d %lf %lf",theta,mgm[theta][j],mgp[theta][j]); */ + /* printf("\n "); */ + /* } */ + /* } */ + /* if((int)age==79 ||(int)age== 80 ||(int)age== 81 ){ */ + /* printf("\n gradg %d ",(int)age); */ + /* for(j=1; j<=nlstate;j++){ */ + /* printf("%d ",j); */ + /* for(theta=1; theta <=npar; theta++) */ + /* printf("%d %lf ",theta,gradg[theta][j]); */ + /* printf("\n "); */ + /* } */ + /* } */ + + for(i=1;i<=nlstate;i++) + varbpl[i][(int)age] =0.; + if((int)age==79 ||(int)age== 80 ||(int)age== 81){ + matprod2(dnewmpar,trgradg,1,nlstate,1,npar,1,npar,matcov); + matprod2(doldm,dnewmpar,1,nlstate,1,npar,1,nlstate,gradg); + }else{ + matprod2(dnewmpar,trgradg,1,nlstate,1,npar,1,npar,matcov); + matprod2(doldm,dnewmpar,1,nlstate,1,npar,1,nlstate,gradg); + } + for(i=1;i<=nlstate;i++) + varbpl[i][(int)age] = doldm[i][i]; /* Covariances are useless */ + + fprintf(ficresvbl,"%.0f ",age ); + if(nresult >=1) + fprintf(ficresvbl,"%d ",nres ); + for(i=1; i<=nlstate;i++) + fprintf(ficresvbl," %.5f (%.5f)",bprlim[i][i],sqrt(varbpl[i][(int)age])); + fprintf(ficresvbl,"\n"); + free_vector(gp,1,nlstate); + free_vector(gm,1,nlstate); + free_matrix(mgm,1,npar,1,nlstate); + free_matrix(mgp,1,npar,1,nlstate); + free_matrix(gradg,1,npar,1,nlstate); + free_matrix(trgradg,1,nlstate,1,npar); + } /* End age */ + + free_vector(xp,1,npar); + free_matrix(doldm,1,nlstate,1,npar); + free_matrix(dnewmpar,1,nlstate,1,nlstate); + +} + +/************ Variance of one-step probabilities ******************/ +void varprob(char optionfilefiname[], double **matcov, double x[], double delti[], int nlstate, double bage, double fage, int ij, int *Tvar, int **nbcode, int *ncodemax, char strstart[]) + { + int i, j=0, k1, l1, tj; + int k2, l2, j1, z1; + int k=0, l; + int first=1, first1, first2; + double cv12, mu1, mu2, lc1, lc2, v12, v21, v11, v22,v1,v2, c12, tnalp; + double **dnewm,**doldm; + double *xp; + double *gp, *gm; + double **gradg, **trgradg; + double **mu; + double age, cov[NCOVMAX+1]; + double std=2.0; /* Number of standard deviation wide of confidence ellipsoids */ + int theta; + char fileresprob[FILENAMELENGTH]; + char fileresprobcov[FILENAMELENGTH]; + char fileresprobcor[FILENAMELENGTH]; + double ***varpij; + + strcpy(fileresprob,"PROB_"); + strcat(fileresprob,fileres); + if((ficresprob=fopen(fileresprob,"w"))==NULL) { + printf("Problem with resultfile: %s\n", fileresprob); + fprintf(ficlog,"Problem with resultfile: %s\n", fileresprob); + } + strcpy(fileresprobcov,"PROBCOV_"); + strcat(fileresprobcov,fileresu); + if((ficresprobcov=fopen(fileresprobcov,"w"))==NULL) { + printf("Problem with resultfile: %s\n", fileresprobcov); + fprintf(ficlog,"Problem with resultfile: %s\n", fileresprobcov); + } + strcpy(fileresprobcor,"PROBCOR_"); + strcat(fileresprobcor,fileresu); + if((ficresprobcor=fopen(fileresprobcor,"w"))==NULL) { + printf("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); + 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); + 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); + fprintf(ficlog,"and correlation matrix of one-step probabilities: result on file '%s' \n",fileresprobcor); + pstamp(ficresprob); + fprintf(ficresprob,"#One-step probabilities and stand. devi in ()\n"); + fprintf(ficresprob,"# Age"); + pstamp(ficresprobcov); + fprintf(ficresprobcov,"#One-step probabilities and covariance matrix\n"); + fprintf(ficresprobcov,"# Age"); + pstamp(ficresprobcor); + fprintf(ficresprobcor,"#One-step probabilities and correlation matrix\n"); + fprintf(ficresprobcor,"# Age"); + + + for(i=1; i<=nlstate;i++) + for(j=1; j<=(nlstate+ndeath);j++){ + fprintf(ficresprob," p%1d-%1d (SE)",i,j); + fprintf(ficresprobcov," p%1d-%1d ",i,j); + fprintf(ficresprobcor," p%1d-%1d ",i,j); + } + /* fprintf(ficresprob,"\n"); + fprintf(ficresprobcov,"\n"); + fprintf(ficresprobcor,"\n"); + */ + xp=vector(1,npar); + dnewm=matrix(1,(nlstate)*(nlstate+ndeath),1,npar); + doldm=matrix(1,(nlstate)*(nlstate+ndeath),1,(nlstate)*(nlstate+ndeath)); + mu=matrix(1,(nlstate)*(nlstate+ndeath), (int) bage, (int)fage); + varpij=ma3x(1,nlstate*(nlstate+ndeath),1,nlstate*(nlstate+ndeath),(int) bage, (int) fage); + first=1; + fprintf(ficgp,"\n# Routine varprob"); + fprintf(fichtm,"\n

  • Computing and drawing one step probabilities with their confidence intervals

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

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

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

    Matrix of variance-covariance of pairs of step probabilities

    \n",optionfilehtmcov, optionfilehtmcov); + fprintf(fichtmcov,"\nEllipsoids of confidence centered on point (pij, pkl) are estimated \ and drawn. It helps understanding how is the covariance between two incidences.\ They are expressed in year-1 in order to be less dependent of stepm.
    \n"); - fprintf(fichtmcov,"\n
    Contour plot corresponding to x'cov-1x = 4 (where x is the column vector (pij,pkl)) are drawn. \ + fprintf(fichtmcov,"\n
    Contour plot corresponding to x'cov-1x = 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 \ would have been (1/(var pij), 0 , 0, 1/(var pkl)), and the confidence interval would be 2 \ standard deviations wide on each axis.
    \ @@ -4476,336 +6631,443 @@ standard deviations wide on each axis. < and made the appropriate rotation to look at the uncorrelated principal directions.
    \ To be simple, these graphs help to understand the significativity of each parameter in relation to a second other one.
    \n"); - cov[1]=1; - /* tj=cptcoveff; */ - tj = (int) pow(2,cptcoveff); - if (cptcovn<1) {tj=1;ncodemax[1]=1;} - j1=0; - for(j1=1; j1<=tj;j1++){ - /*for(i1=1; i1<=ncodemax[t];i1++){ */ - /*j1++;*/ - if (cptcovn>0) { - fprintf(ficresprob, "\n#********** Variable "); - for (z1=1; z1<=cptcoveff; z1++) fprintf(ficresprob, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); - fprintf(ficresprob, "**********\n#\n"); - fprintf(ficresprobcov, "\n#********** Variable "); - 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#\n"); - - - fprintf(fichtmcov, "\n
    ********** Variable "); - for (z1=1; z1<=cptcoveff; z1++) fprintf(fichtm, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); - fprintf(fichtmcov, "**********\n
    "); - - 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#"); - } - - gradg=matrix(1,npar,1,(nlstate)*(nlstate+ndeath)); - trgradg=matrix(1,(nlstate)*(nlstate+ndeath),1,npar); - gp=vector(1,(nlstate)*(nlstate+ndeath)); - gm=vector(1,(nlstate)*(nlstate+ndeath)); - for (age=bage; age<=fage; age ++){ - cov[2]=age; - if(nagesqr==1) - cov[3]= age*age; - for (k=1; k<=cptcovn;k++) { - cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(j1,k)]; - /*cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(j1,Tvar[k])];*//* j1 1 2 3 4 - * 1 1 1 1 1 - * 2 2 1 1 1 - * 3 1 2 1 1 - */ - /* nbcode[1][1]=0 nbcode[1][2]=1;*/ - } - /* for (k=1; k<=cptcovage;k++) cov[2+Tage[k]]=cov[2+Tage[k]]*cov[2]; */ - 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); - - pmij(pmmij,cov,ncovmodel,xp,nlstate); - - k=0; - for(i=1; i<= (nlstate); i++){ - for(j=1; j<=(nlstate+ndeath);j++){ - k=k+1; - gp[k]=pmmij[i][j]; - } - } - - for(i=1; i<=npar; i++) - xp[i] = x[i] - (i==theta ?delti[theta]:(double)0); - - pmij(pmmij,cov,ncovmodel,xp,nlstate); - k=0; - for(i=1; i<=(nlstate); i++){ - 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(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
    Probability with confidence intervals expressed in year-1 :pijgr%s.png, ",optionfilefiname,optionfilefiname); - fprintf(fichtm,"\n
    ",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); */ - } + cov[1]=1; + /* tj=cptcoveff; */ + tj = (int) pow(2,cptcoveff); + if (cptcovn<1) {tj=1;ncodemax[1]=1;} + j1=0; + for(j1=1; j1<=tj;j1++){ /* For each valid combination of covariates or only once*/ + if (cptcovn>0) { + fprintf(ficresprob, "\n#********** Variable "); + for (z1=1; z1<=cptcoveff; z1++) fprintf(ficresprob, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); + fprintf(ficresprob, "**********\n#\n"); + fprintf(ficresprobcov, "\n#********** Variable "); + 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#\n"); + + + fprintf(fichtmcov, "\n
    ********** Variable "); + for (z1=1; z1<=cptcoveff; z1++) fprintf(fichtm, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); + fprintf(fichtmcov, "**********\n
    "); + + 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#"); + if(invalidvarcomb[j1]){ + fprintf(ficgp,"\n#Combination (%d) ignored because no cases \n",j1); + fprintf(fichtmcov,"\n

    Combination (%d) ignored because no cases

    \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)); + gm=vector(1,(nlstate)*(nlstate+ndeath)); + for (age=bage; age<=fage; age ++){ + cov[2]=age; + if(nagesqr==1) + cov[3]= age*age; + for (k=1; k<=cptcovn;k++) { + cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(j1,k)]; + /*cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(j1,Tvar[k])];*//* j1 1 2 3 4 + * 1 1 1 1 1 + * 2 2 1 1 1 + * 3 1 2 1 1 + */ + /* nbcode[1][1]=0 nbcode[1][2]=1;*/ + } + /* for (k=1; k<=cptcovage;k++) cov[2+Tage[k]]=cov[2+Tage[k]]*cov[2]; */ + 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); + + pmij(pmmij,cov,ncovmodel,xp,nlstate); + + k=0; + for(i=1; i<= (nlstate); i++){ + for(j=1; j<=(nlstate+ndeath);j++){ + k=k+1; + gp[k]=pmmij[i][j]; + } + } + + for(i=1; i<=npar; i++) + xp[i] = x[i] - (i==theta ?delti[theta]:(double)0); + + pmij(pmmij,cov,ncovmodel,xp,nlstate); + k=0; + for(i=1; i<=(nlstate); i++){ + 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]; + } - /* 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
    Ellipsoids of confidence cov(p%1d%1d,p%1d%1d) expressed in year-1\ - :\ + 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
    Probability with confidence intervals expressed in year-1 :    pijgr%s.png, ",optionfilefiname,optionfilefiname); + fprintf(fichtm,"\n
    ",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 */ + if(1+(v1-lc1)*(v1-lc1)/cv12/cv12 <1.e-5){ + printf(" Error sqrt of a negative number: %lf\n",1+(v1-lc1)*(v1-lc1)/cv12/cv12); + fprintf(ficlog," Error sqrt of a negative number: %lf\n",1+(v1-lc1)*(v1-lc1)/cv12/cv12); + v11=(1./sqrt(fabs(1+(v1-lc1)*(v1-lc1)/cv12/cv12))); + }else + v11=(1./sqrt(1+(v1-lc1)*(v1-lc1)/cv12/cv12)); + /*v21=sqrt(1.-v11*v11); *//* error */ + v21=(lc1-v1)/cv12*v11; + v12=-v21; + 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


    Ellipsoids of confidence cov(p%1d%1d,p%1d%1d) expressed in year-1\ + : \ %s_%d%1d%1d-%1d%1d.svg, ",k1,l1,k2,l2,\ - subdirf2(optionfilefiname,"VARPIJGR_"), j1,k1,l1,k2,l2,\ - subdirf2(optionfilefiname,"VARPIJGR_"), j1,k1,l1,k2,l2); - fprintf(fichtmcov,"\n
    ",subdirf2(optionfilefiname,"VARPIJGR_"), j1,k1,l1,k2,l2); - fprintf(fichtmcov,"\n
    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 label \"%d\" at %11.3e,%11.3e center",(int) age, mu1,mu2); - fprintf(ficgp,"\n# Age %d, p%1d%1d - p%1d%1d",(int) age, k1,l1,k2,l2); - fprintf(ficgp,"\nplot [-pi:pi] %11.3e+ %.3f*(%11.3e*%11.3e*cos(t)+%11.3e*%11.3e*sin(t)), %11.3e +%.3f*(%11.3e*%11.3e*cos(t)+%11.3e*%11.3e*sin(t)) not",\ - mu1,std,v11,sqrt(lc1),v12,sqrt(lc2),\ - mu2,std,v21,sqrt(lc1),v22,sqrt(lc2)); - }else{ - first=0; - fprintf(fichtmcov," %d (%.3f),",(int) age, c12); - fprintf(ficgp,"\n# Age %d, p%1d%1d - p%1d%1d",(int) age, k1,l1,k2,l2); - fprintf(ficgp,"\nset label \"%d\" at %11.3e,%11.3e center",(int) age, mu1,mu2); - fprintf(ficgp,"\nreplot %11.3e+ %.3f*(%11.3e*%11.3e*cos(t)+%11.3e*%11.3e*sin(t)), %11.3e +%.3f*(%11.3e*%11.3e*cos(t)+%11.3e*%11.3e*sin(t)) not",\ - mu1,std,v11,sqrt(lc1),v12,sqrt(lc2),\ - mu2,std,v21,sqrt(lc1),v22,sqrt(lc2)); - }/* if first */ - } /* age mod 5 */ - } /* 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); - first=1; - } /*l12 */ - } /* k12 */ - } /*l1 */ - }/* k1 */ - /* } */ /* loop covariates */ - } - 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(doldm,1,(nlstate)*(nlstate+ndeath),1,(nlstate)*(nlstate+ndeath)); - free_matrix(dnewm,1,(nlstate)*(nlstate+ndeath),1,npar); - free_vector(xp,1,npar); - fclose(ficresprob); - fclose(ficresprobcov); - fclose(ficresprobcor); - fflush(ficgp); - fflush(fichtmcov); -} + subdirf2(optionfilefiname,"VARPIJGR_"), j1,k1,l1,k2,l2, \ + subdirf2(optionfilefiname,"VARPIJGR_"), j1,k1,l1,k2,l2); + fprintf(fichtmcov,"\n
    ",subdirf2(optionfilefiname,"VARPIJGR_"), j1,k1,l1,k2,l2); + fprintf(fichtmcov,"\n
    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 label \"%d\" at %11.3e,%11.3e center",(int) age, mu1,mu2); + fprintf(ficgp,"\n# Age %d, p%1d%1d - p%1d%1d",(int) age, k1,l1,k2,l2); + fprintf(ficgp,"\nplot [-pi:pi] %11.3e+ %.3f*(%11.3e*%11.3e*cos(t)+%11.3e*%11.3e*sin(t)), %11.3e +%.3f*(%11.3e*%11.3e*cos(t)+%11.3e*%11.3e*sin(t)) not", \ + mu1,std,v11,sqrt(fabs(lc1)),v12,sqrt(fabs(lc2)), \ + mu2,std,v21,sqrt(fabs(lc1)),v22,sqrt(fabs(lc2))); /* For gnuplot only */ + }else{ + first=0; + fprintf(fichtmcov," %d (%.3f),",(int) age, c12); + fprintf(ficgp,"\n# Age %d, p%1d%1d - p%1d%1d",(int) age, k1,l1,k2,l2); + fprintf(ficgp,"\nset label \"%d\" at %11.3e,%11.3e center",(int) age, mu1,mu2); + fprintf(ficgp,"\nreplot %11.3e+ %.3f*(%11.3e*%11.3e*cos(t)+%11.3e*%11.3e*sin(t)), %11.3e +%.3f*(%11.3e*%11.3e*cos(t)+%11.3e*%11.3e*sin(t)) not", \ + mu1,std,v11,sqrt(lc1),v12,sqrt(fabs(lc2)), \ + mu2,std,v21,sqrt(lc1),v22,sqrt(fabs(lc2))); + }/* if first */ + } /* age mod 5 */ + } /* 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); + first=1; + } /*l12 */ + } /* k12 */ + } /*l1 */ + }/* k1 */ + } /* loop on combination of covariates j1 */ + 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(doldm,1,(nlstate)*(nlstate+ndeath),1,(nlstate)*(nlstate+ndeath)); + free_matrix(dnewm,1,(nlstate)*(nlstate+ndeath),1,npar); + free_vector(xp,1,npar); + fclose(ficresprob); + fclose(ficresprobcov); + fclose(ficresprobcor); + fflush(ficgp); + fflush(fichtmcov); + } /******************* Printing html file ***********/ void printinghtml(char fileresu[], char title[], char datafile[], int firstpass, \ int lastpass, int stepm, int weightopt, char model[],\ int imx,int jmin, int jmax, double jmeanint,char rfileres[],\ - int popforecast, int estepm ,\ - double jprev1, double mprev1,double anprev1, \ - double jprev2, double mprev2,double anprev2){ - int jj1, k1, i1, cpt; + int popforecast, int mobilav, int prevfcast, int mobilavproj, int prevbcast, int estepm , \ + double jprev1, double mprev1,double anprev1, double dateprev1, double dateprojd, double dateback1, \ + double jprev2, double mprev2,double anprev2, double dateprev2, double dateprojf, double dateback2){ + int jj1, k1, i1, cpt, k4, nres; fprintf(fichtm,"

    "); - fprintf(fichtm,"

    • Result files (first order: no variance)

      \n \ - - Observed prevalence in each state (during the period defined between %.lf/%.lf/%.lf and %.lf/%.lf/%.lf): %s
      \n ", - jprev1, mprev1,anprev1,jprev2, mprev2,anprev2,subdirf2(fileresu,"P_"),subdirf2(fileresu,"P_")); + fprintf(fichtm,"
      • model=1+age+%s\n \ +
      ", model); + fprintf(fichtm,"

      • Result files (first order: no variance)

        \n"); + fprintf(fichtm,"
      • - Observed frequency between two states (during the period defined between %.lf/%.lf/%.lf and %.lf/%.lf/%.lf): %s (html file)
        \n", + jprev1, mprev1,anprev1,jprev2, mprev2,anprev2,subdirfext3(optionfilefiname,"PHTMFR_",".htm"),subdirfext3(optionfilefiname,"PHTMFR_",".htm")); + fprintf(fichtm,"
      • - Observed prevalence in each state (during the period defined between %.lf/%.lf/%.lf and %.lf/%.lf/%.lf): %s (html file) ", + jprev1, mprev1,anprev1,jprev2, mprev2,anprev2,subdirfext3(optionfilefiname,"PHTM_",".htm"),subdirfext3(optionfilefiname,"PHTM_",".htm")); + fprintf(fichtm,", %s (text file)
        \n",subdirf2(fileresu,"P_"),subdirf2(fileresu,"P_")); fprintf(fichtm,"\ - Estimated transition probabilities over %d (stepm) months: %s
        \n ", stepm,subdirf2(fileresu,"PIJ_"),subdirf2(fileresu,"PIJ_")); fprintf(fichtm,"\ - - Period (stable) prevalence in each health state: %s
        \n", + - Estimated back transition probabilities over %d (stepm) months: %s
        \n ", + stepm,subdirf2(fileresu,"PIJB_"),subdirf2(fileresu,"PIJB_")); + fprintf(fichtm,"\ + - Period (forward) prevalence in each health state: %s
        \n", subdirf2(fileresu,"PL_"),subdirf2(fileresu,"PL_")); fprintf(fichtm,"\ - - (a) Life expectancies by health status at initial age, ei. (b) health expectancies by health status at initial age, eij . If one or more covariates are included, specific tables for each value of the covariate are output in sequences within the same file (estepm=%2d months): \ + - Backward prevalence in each health state: %s
        \n", + subdirf2(fileresu,"PLB_"),subdirf2(fileresu,"PLB_")); + fprintf(fichtm,"\ + - (a) Life expectancies by health status at initial age, ei. (b) health expectancies by health status at initial age, eij . If one or more covariates are included, specific tables for each value of the covariate are output in sequences within the same file (estepm=%2d months): \ %s
        \n", estepm,subdirf2(fileresu,"E_"),subdirf2(fileresu,"E_")); - fprintf(fichtm,"\ - - Population projections by age and states: \ + if(prevfcast==1){ + fprintf(fichtm,"\ + - Prevalence projections by age and states: \ %s
        \n
        • ", subdirf2(fileresu,"F_"),subdirf2(fileresu,"F_")); + } + + + m=pow(2,cptcoveff); + if (cptcovn < 1) {m=1;ncodemax[1]=1;} -fprintf(fichtm," \n"); - fprintf(fichtm,"\ + fprintf(fichtm,"\ \n

      • Result files (second order: variances)

        \n\ - Parameter file with estimated parameters and covariance matrix: %s
        \ - 95%% confidence intervals and Wald tests of the estimated parameters are in the log file if optimization has been done (mle != 0).
        \ @@ -4817,32 +7079,32 @@ variances but at the covariance matrix. covariance matrix of the one-step probabilities. \ See page 'Matrix of variance-covariance of one-step probabilities' below. \n", rfileres,rfileres); - fprintf(fichtm," - Standard deviation of one-step probabilities: %s
        \n", - subdirf2(fileresu,"PROB_"),subdirf2(fileresu,"PROB_")); - fprintf(fichtm,"\ + fprintf(fichtm," - Standard deviation of one-step probabilities: %s
        \n", + subdirf2(fileresu,"PROB_"),subdirf2(fileresu,"PROB_")); + fprintf(fichtm,"\ - Variance-covariance of one-step probabilities: %s
        \n", - subdirf2(fileresu,"PROBCOV_"),subdirf2(fileresu,"PROBCOV_")); + subdirf2(fileresu,"PROBCOV_"),subdirf2(fileresu,"PROBCOV_")); - fprintf(fichtm,"\ + fprintf(fichtm,"\ - Correlation matrix of one-step probabilities: %s
        \n", - subdirf2(fileresu,"PROBCOR_"),subdirf2(fileresu,"PROBCOR_")); - fprintf(fichtm,"\ + subdirf2(fileresu,"PROBCOR_"),subdirf2(fileresu,"PROBCOR_")); + fprintf(fichtm,"\ - Variances and covariances of health expectancies by age and initial health status (cov(eij,ekl)(estepm=%2d months): \ %s
        \n
        • ", estepm,subdirf2(fileresu,"CVE_"),subdirf2(fileresu,"CVE_")); - fprintf(fichtm,"\ + fprintf(fichtm,"\ - (a) Health expectancies by health status at initial age (eij) and standard errors (in parentheses) (b) life expectancies and standard errors (ei.=ei1+ei2+...)(estepm=%2d months): \ %s
        \n", estepm,subdirf2(fileresu,"STDE_"),subdirf2(fileresu,"STDE_")); - fprintf(fichtm,"\ - - Variances and covariances of health expectancies by age. Status (i) based health expectancies (in state j), eij 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): %s
        \n", - estepm, subdirf2(fileresu,"V_"),subdirf2(fileresu,"V_")); - fprintf(fichtm,"\ + fprintf(fichtm,"\ + - Variances and covariances of health expectancies by age. Status (i) based health expectancies (in state j), eij are weighted by the forward (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): %s
        \n", + estepm, subdirf2(fileresu,"V_"),subdirf2(fileresu,"V_")); + fprintf(fichtm,"\ - Total life expectancy and total health expectancies to be spent in each health state e.j with their standard errors (if popbased=1, an additional computation is done using the cross-sectional prevalences, i.e population based) (estepm=%d months): %s
        \n", - estepm, subdirf2(fileresu,"T_"),subdirf2(fileresu,"T_")); - fprintf(fichtm,"\ - - Standard deviation of period (stable) prevalences: %s
        \n",\ - subdirf2(fileresu,"VPL_"),subdirf2(fileresu,"VPL_")); + estepm, subdirf2(fileresu,"T_"),subdirf2(fileresu,"T_")); + fprintf(fichtm,"\ + - Standard deviation of forward (period) prevalences: %s
        \n",\ + subdirf2(fileresu,"VPL_"),subdirf2(fileresu,"VPL_")); /* if(popforecast==1) fprintf(fichtm,"\n */ /* - Prevalences forecasting: f%s
        \n */ @@ -4850,46 +7112,69 @@ See page 'Matrix of variance-covariance /*
        ",fileres,fileres,fileres,fileres); */ /* else */ /* fprintf(fichtm,"\n No population forecast: popforecast = %d (instead of 1) or stepm = %d (instead of 1) or model=%s (instead of .)

        \n",popforecast, stepm, model); */ - fflush(fichtm); - fprintf(fichtm," "); + fflush(fichtm); } /******************* Gnuplot file **************/ -void printinggnuplot(char fileresu[], char optionfilefiname[], double ageminpar, double agemaxpar, double fage , char pathc[], double p[]){ +void printinggnuplot(char fileresu[], char optionfilefiname[], double ageminpar, double agemaxpar, double bage, double fage , int prevfcast, int prevbcast, char pathc[], double p[], int offyear, int offbyear){ char dirfileres[132],optfileres[132]; - int cpt=0,k1=0,i=0,k=0,j=0,jk=0,k2=0,k3=0,ij=0,l=0; + char gplotcondition[132], gplotlabel[132]; + int cpt=0,k1=0,i=0,k=0,j=0,jk=0,k2=0,k3=0,k4=0,ij=0, ijp=0, l=0; + int lv=0, vlv=0, kl=0; int ng=0; int vpopbased; + int ioffset; /* variable offset for columns */ + int iyearc=1; /* variable column for year of projection */ + int iagec=1; /* variable column for age of projection */ + int nres=0; /* Index of resultline */ + int istart=1; /* For starting graphs in projections */ + /* if((ficgp=fopen(optionfilegnuplot,"a"))==NULL) { */ /* printf("Problem with file %s",optionfilegnuplot); */ /* fprintf(ficlog,"Problem with file %s",optionfilegnuplot); */ @@ -4897,216 +7182,759 @@ void printinggnuplot(char fileresu[], ch /*#ifdef windows */ fprintf(ficgp,"cd \"%s\" \n",pathc); - /*#endif */ + /*#endif */ m=pow(2,cptcoveff); + /* diagram of the model */ + fprintf(ficgp,"\n#Diagram of the model \n"); + fprintf(ficgp,"\ndelta=0.03;delta2=0.07;unset arrow;\n"); + fprintf(ficgp,"yoff=(%d > 2? 0:1);\n",nlstate); + fprintf(ficgp,"\n#Peripheral arrows\nset for [i=1:%d] for [j=1:%d] arrow i*10+j from cos(pi*((1-(%d/2)*2./%d)/2+(i-1)*2./%d))-(i!=j?(i-j)/abs(i-j)*delta:0), yoff +sin(pi*((1-(%d/2)*2./%d)/2+(i-1)*2./%d)) + (i!=j?(i-j)/abs(i-j)*delta:0) rto -0.95*(cos(pi*((1-(%d/2)*2./%d)/2+(i-1)*2./%d))+(i!=j?(i-j)/abs(i-j)*delta:0) - cos(pi*((1-(%d/2)*2./%d)/2+(j-1)*2./%d)) + (i!=j?(i-j)/abs(i-j)*delta2:0)), -0.95*(sin(pi*((1-(%d/2)*2./%d)/2+(i-1)*2./%d)) + (i!=j?(i-j)/abs(i-j)*delta:0) - sin(pi*((1-(%d/2)*2./%d)/2+(j-1)*2./%d))+( i!=j?(i-j)/abs(i-j)*delta2:0)) ls (i < j? 1:2)\n",nlstate,nlstate,nlstate,nlstate,nlstate,nlstate,nlstate,nlstate,nlstate,nlstate,nlstate,nlstate,nlstate,nlstate,nlstate,nlstate,nlstate,nlstate,nlstate,nlstate); + + fprintf(ficgp,"\n#Centripete arrows (turning in other direction (1-i) instead of (i-1)) \nset for [i=1:%d] arrow (%d+1)*10+i from cos(pi*((1-(%d/2)*2./%d)/2+(1-i)*2./%d))-(i!=j?(i-j)/abs(i-j)*delta:0), yoff +sin(pi*((1-(%d/2)*2./%d)/2+(1-i)*2./%d)) + (i!=j?(i-j)/abs(i-j)*delta:0) rto -0.80*(cos(pi*((1-(%d/2)*2./%d)/2+(1-i)*2./%d))+(i!=j?(i-j)/abs(i-j)*delta:0) ), -0.80*(sin(pi*((1-(%d/2)*2./%d)/2+(1-i)*2./%d)) + (i!=j?(i-j)/abs(i-j)*delta:0) + yoff ) ls 4\n",nlstate,nlstate,nlstate,nlstate,nlstate,nlstate,nlstate,nlstate,nlstate,nlstate,nlstate,nlstate,nlstate,nlstate); + fprintf(ficgp,"\n#show arrow\nunset label\n"); + fprintf(ficgp,"\n#States labels, starting from 2 (2-i) instead of (1-i), was (i-1)\nset for [i=1:%d] label i sprintf(\"State %%d\",i) center at cos(pi*((1-(%d/2)*2./%d)/2+(2-i)*2./%d)), yoff+sin(pi*((1-(%d/2)*2./%d)/2+(2-i)*2./%d)) font \"helvetica, 16\" tc rgbcolor \"blue\"\n",nlstate,nlstate,nlstate,nlstate,nlstate,nlstate,nlstate); + fprintf(ficgp,"\nset label %d+1 sprintf(\"State %%d\",%d+1) center at 0.,0. font \"helvetica, 16\" tc rgbcolor \"red\"\n",nlstate,nlstate); + fprintf(ficgp,"\n#show label\nunset border;unset xtics; unset ytics;\n"); + fprintf(ficgp,"\n\nset ter svg size 640, 480;set out \"%s_.svg\" \n",subdirf2(optionfilefiname,"D_")); + fprintf(ficgp,"unset log y; plot [-1.2:1.2][yoff-1.2:1.2] 1/0 not; set out;reset;\n"); + /* Contribution to 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 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 pngcairo size 640, 480"); + 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,"\nset ter svg size 640, 480"); */ /* Too big for svg */ + fprintf(ficgp,"\nset ter pngcairo size 640, 480"); /* 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 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-dest.png\";",subdirf2(optionfilefiname,"ILK_")); - fprintf(ficgp,"\nset log y;plot \"%s\" u 2:(-$12):5 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 log y;plot \"%s\" u 2:(-$12):4 t \"All sample, transitions colored by origin\" with dots lc variable; set out;\n\n",subdirf(fileresilk)); - 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,"unset log;\n# plot weighted, mean weight should have point size of 0.5\n plot \"%s\"",subdirf(fileresilk)); - fprintf(ficgp," u 2:($4 == %d && $5==%d ? $9 : 1/0):($11/4.):5 t \"p%d%d\" with points pointtype 7 ps variable lc variable \\\n",i,1,i,1); - for (j=2; j<= nlstate+ndeath ; j ++) { - fprintf(ficgp,",\\\n \"\" u 2:($4 == %d && $5==%d ? $9 : 1/0):($11/4.):5 t \"p%d%d\" with points pointtype 7 ps variable lc variable ",i,j,i,j); - } - 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 */ - /* 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,"\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\";",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 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)); + 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,"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); + 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,";\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 */ + /* 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,"\nset out;unset log\n"); + /* fprintf(ficgp,"\nset out \"%s.svg\"; replot; set out; # bug gnuplot",subdirf2(optionfilefiname,"ILK_")); */ strcpy(dirfileres,optionfilefiname); strcpy(optfileres,"vpl"); - /* 1eme*/ - fprintf(ficgp,"\n# 1st: Period (stable) prevalence with CI: 'VPL_' files\n"); - for (cpt=1; cpt<= nlstate ; cpt ++) { - for (k1=1; k1<= m ; k1 ++) { /* plot [100000000000000000000:-100000000000000000000] "mysbiaspar/vplrmysbiaspar.txt to check */ - 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,"set xlabel \"Age\" \n\ -set ylabel \"Probability\" \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); - - for (i=1; i<= nlstate ; i ++) { - if (i==cpt) 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); - for (i=1; i<= nlstate ; i ++) { - if (i==cpt) fprintf(ficgp," %%lf (%%lf)"); - else fprintf(ficgp," %%*lf (%%*lf)"); - } - fprintf(ficgp,"\" t\"95%% CI\" w l 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 ++) { - if (i==cpt) 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,"\nset out \n"); - } /* k1 */ - } /* cpt */ - /*2 eme*/ - fprintf(ficgp,"\n# 2nd: Total life expectancy with CI: 't' files\n"); - for (k1=1; k1<= m ; 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*/ - if(vpopbased==0) - fprintf(ficgp,"set ylabel \"Years\" \nset ter svg size 640, 480\nplot [%.f:%.f] ",ageminpar,fage); - else - fprintf(ficgp,"\nreplot "); - for (i=1; i<= nlstate+1 ; i ++) { - k=2*i; - fprintf(ficgp,"\"%s\" every :::%d::%d u 1:($2==%d && $4!=0 ?$4 : 1/0) \"%%lf %%lf %%lf",subdirf2(fileresu,"T_"),k1-1,k1-1, vpopbased); - for (j=1; j<= nlstate+1 ; j ++) { - if (j==i) fprintf(ficgp," %%lf (%%lf)"); - else fprintf(ficgp," %%*lf (%%*lf)"); - } - if (i== 1) fprintf(ficgp,"\" t\"TLE\" w l lt %d, \\\n",i); - else fprintf(ficgp,"\" t\"LE in state (%d)\" w l lt %d, \\\n",i-1,i+1); - fprintf(ficgp,"\"%s\" every :::%d::%d u 1:($2==%d && $4!=0 ? $4-$5*2 : 1/0) \"%%lf %%lf %%lf",subdirf2(fileresu,"T_"),k1-1,k1-1,vpopbased); - for (j=1; j<= nlstate+1 ; j ++) { - if (j==i) fprintf(ficgp," %%lf (%%lf)"); + /* 1eme*/ + for (cpt=1; cpt<= nlstate ; cpt ++){ /* For each live state */ + for (k1=1; k1<= m ; k1 ++){ /* For each valid combination of covariate */ + for(nres=1; nres <= nresult; nres++){ /* For each resultline */ + /* plot [100000000000000000000:-100000000000000000000] "mysbiaspar/vplrmysbiaspar.txt to check */ + if(m != 1 && TKresult[nres]!= k1) + continue; + /* We are interested in selected combination by the resultline */ + /* printf("\n# 1st: Period (stable) prevalence with CI: 'VPL_' files and live state =%d ", cpt); */ + fprintf(ficgp,"\n# 1st: Forward (stable period) prevalence with CI: 'VPL_' files and live state =%d ", cpt); + strcpy(gplotlabel,"("); + 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 value of the covariate 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]; /* vlv is the value of the covariate lv, 0 or 1 */ + /* For each combination of covariate k1 (V1=1, V3=0), we printed the current covariate k and its value vlv */ + /* printf(" V%d=%d ",Tvaraff[k],vlv); */ + fprintf(ficgp," V%d=%d ",Tvaraff[k],vlv); + sprintf(gplotlabel+strlen(gplotlabel)," V%d=%d ",Tvaraff[k],vlv); + } + for (k4=1; k4<= nsq; k4++){ /* For each selected (single) quantitative value */ + /* printf(" V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); */ + fprintf(ficgp," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); + sprintf(gplotlabel+strlen(gplotlabel)," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); + } + strcpy(gplotlabel+strlen(gplotlabel),")"); + /* printf("\n#\n"); */ + fprintf(ficgp,"\n#\n"); + if(invalidvarcomb[k1]){ + /*k1=k1-1;*/ /* To be checked */ + fprintf(ficgp,"#Combination (%d) ignored because no cases \n",k1); + continue; + } + + fprintf(ficgp,"\nset out \"%s_%d-%d-%d.svg\" \n",subdirf2(optionfilefiname,"V_"),cpt,k1,nres); + fprintf(ficgp,"\n#set out \"V_%s_%d-%d-%d.svg\" \n",optionfilefiname,cpt,k1,nres); + /* fprintf(ficgp,"set label \"Alive state %d %s\" at graph 0.98,0.5 center rotate font \"Helvetica,12\"\n",cpt,gplotlabel); */ + fprintf(ficgp,"set title \"Alive state %d %s\" font \"Helvetica,12\"\n",cpt,gplotlabel); + fprintf(ficgp,"set xlabel \"Age\" \nset ylabel \"Probability\" \nset ter svg size 640, 480\nplot [%.f:%.f] \"%s\" every :::%d::%d u 1:($2==%d ? $3:1/0) \"%%lf %%lf",ageminpar,fage,subdirf2(fileresu,"VPL_"),nres-1,nres-1,nres); + /* fprintf(ficgp,"set xlabel \"Age\" \nset ylabel \"Probability\" \nset ter svg size 640, 480\nplot [%.f:%.f] \"%s\" every :::%d::%d u 1:($2==%d ? $3:1/0) \"%%lf %%lf",ageminpar,fage,subdirf2(fileresu,"VPL_"),k1-1,k1-1,nres); */ + /* k1-1 error should be nres-1*/ + for (i=1; i<= nlstate ; i ++) { + if (i==cpt) fprintf(ficgp," %%lf (%%lf)"); + else fprintf(ficgp," %%*lf (%%*lf)"); + } + fprintf(ficgp,"\" t\"Forward prevalence\" w l lt 0,\"%s\" every :::%d::%d u 1:($2==%d ? $3+1.96*$4 : 1/0) \"%%lf %%lf",subdirf2(fileresu,"VPL_"),nres-1,nres-1,nres); + for (i=1; i<= nlstate ; i ++) { + if (i==cpt) fprintf(ficgp," %%lf (%%lf)"); else fprintf(ficgp," %%*lf (%%*lf)"); - } - fprintf(ficgp,"\" t\"\" w l lt 0,"); - fprintf(ficgp,"\"%s\" every :::%d::%d u 1:($2==%d && $4!=0 ? $4+$5*2 : 1/0) \"%%lf %%lf %%lf",subdirf2(fileresu,"T_"),k1-1,k1-1,vpopbased); - for (j=1; j<= nlstate+1 ; j ++) { - if (j==i) fprintf(ficgp," %%lf (%%lf)"); + } + fprintf(ficgp,"\" t\"95%% CI\" w l lt 1,\"%s\" every :::%d::%d u 1:($2==%d ? $3-1.96*$4 : 1/0) \"%%lf %%lf",subdirf2(fileresu,"VPL_"),nres-1,nres-1,nres); + for (i=1; i<= nlstate ; i ++) { + if (i==cpt) fprintf(ficgp," %%lf (%%lf)"); else fprintf(ficgp," %%*lf (%%*lf)"); - } - if (i== (nlstate+1)) fprintf(ficgp,"\" t\"\" w l lt 0"); - else fprintf(ficgp,"\" t\"\" w l lt 0,\\\n"); - } /* state */ - } /* vpopbased */ - fprintf(ficgp,"\nset out;set out \"%s_%d.svg\"; replot; set out; \n",subdirf2(optionfilefiname,"E_"),k1); /* Buggy gnuplot */ - } /* k1 */ - /*3eme*/ + } + /* 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\" u 1:((",subdirf2(fileresu,"P_")); + if(cptcoveff ==0){ + fprintf(ficgp,"$%d)) t 'Observed prevalence in state %d' with line lt 3", 2+3*(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 'Observed prevalence in state %d' w l lt 2",kl+1, Tvaraff[k],kl+1+1,nbcode[Tvaraff[k]][lv], \ + 2+cptcoveff*2+3*(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 */ + + if(prevbcast==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, nres in 2 to be fixed */ + if(cptcoveff ==0){ + fprintf(ficgp,"$%d)) t 'Backward prevalence in state %d' with line lt 3", 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' w l lt 3",kl+1, Tvaraff[k],kl+1+1,nbcode[Tvaraff[k]][lv], \ + 2+cptcoveff*2+(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 */ + if(prevbcast == 1){ + fprintf(ficgp,", \"%s\" every :::%d::%d u 1:($2==%d ? $3:1/0) \"%%lf %%lf",subdirf2(fileresu,"VBL_"),nres-1,nres-1,nres); + /* k1-1 error should be nres-1*/ + for (i=1; i<= nlstate ; i ++) { + if (i==cpt) fprintf(ficgp," %%lf (%%lf)"); + else fprintf(ficgp," %%*lf (%%*lf)"); + } + fprintf(ficgp,"\" t\"Backward (stable) prevalence\" w l lt 6 dt 3,\"%s\" every :::%d::%d u 1:($2==%d ? $3+1.96*$4 : 1/0) \"%%lf %%lf",subdirf2(fileresu,"VBL_"),nres-1,nres-1,nres); + for (i=1; i<= nlstate ; i ++) { + if (i==cpt) fprintf(ficgp," %%lf (%%lf)"); + else fprintf(ficgp," %%*lf (%%*lf)"); + } + fprintf(ficgp,"\" t\"95%% CI\" w l lt 4,\"%s\" every :::%d::%d u 1:($2==%d ? $3-1.96*$4 : 1/0) \"%%lf %%lf",subdirf2(fileresu,"VBL_"),nres-1,nres-1,nres); + for (i=1; i<= nlstate ; i ++) { + if (i==cpt) fprintf(ficgp," %%lf (%%lf)"); + else fprintf(ficgp," %%*lf (%%*lf)"); + } + fprintf(ficgp,"\" t\"\" w l lt 4"); + } /* end if backprojcast */ + } /* end if prevbcast */ + /* fprintf(ficgp,"\nset out ;unset label;\n"); */ + fprintf(ficgp,"\nset out ;unset title;\n"); + } /* nres */ + } /* k1 */ + } /* cpt */ + - for (k1=1; k1<= m ; k1 ++) { - for (cpt=1; cpt<= nlstate ; cpt ++) { - /* k=2+nlstate*(2*cpt-2); */ - k=2+(nlstate+1)*(cpt-1); - fprintf(ficgp,"\nset out \"%s_%d%d.svg\" \n",subdirf2(optionfilefiname,"EXP_"),cpt,k1); - fprintf(ficgp,"set ter svg size 640, 480\n\ -plot [%.f:%.f] \"%s\" every :::%d::%d u 1:%d t \"e%d1\" w l",ageminpar,fage,subdirf2(fileresu,"E_"),k1-1,k1-1,k,cpt); - /*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) "); - fprintf(ficgp,"\" t \"e%d1\" w l",cpt); - 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) "); - fprintf(ficgp,"\" t \"e%d1\" w l",cpt); + /*2 eme*/ + for (k1=1; k1<= m ; k1 ++){ + for(nres=1; nres <= nresult; nres++){ /* For each resultline */ + if(m != 1 && TKresult[nres]!= k1) + continue; + fprintf(ficgp,"\n# 2nd: Total life expectancy with CI: 't' files "); + strcpy(gplotlabel,"("); + 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); + sprintf(gplotlabel+strlen(gplotlabel)," V%d=%d ",Tvaraff[k],vlv); + } + /* for(k=1; k <= ncovds; k++){ */ + for (k4=1; k4<= nsq; k4++){ /* For each selected (single) quantitative value */ + printf(" V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); + fprintf(ficgp," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); + sprintf(gplotlabel+strlen(gplotlabel)," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); + } + strcpy(gplotlabel+strlen(gplotlabel),")"); + 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,"E_"),k1,nres); + for(vpopbased=0; vpopbased <= popbased; vpopbased++){ /* Done for vpopbased=0 and vpopbased=1 if popbased==1*/ + fprintf(ficgp,"\nset label \"popbased %d %s\" at graph 0.98,0.5 center rotate font \"Helvetica,12\"\n",vpopbased,gplotlabel); + if(vpopbased==0){ + fprintf(ficgp,"set ylabel \"Years\" \nset ter svg size 640, 480\nplot [%.f:%.f] ",ageminpar,fage); + }else + fprintf(ficgp,"\nreplot "); + for (i=1; i<= nlstate+1 ; i ++) { + k=2*i; + fprintf(ficgp,"\"%s\" every :::%d::%d u 1:($2==%d && $4!=0 ?$4 : 1/0) \"%%lf %%lf %%lf",subdirf2(fileresu,"T_"),nres-1,nres-1, vpopbased); + for (j=1; j<= nlstate+1 ; j ++) { + if (j==i) fprintf(ficgp," %%lf (%%lf)"); + else fprintf(ficgp," %%*lf (%%*lf)"); + } + if (i== 1) fprintf(ficgp,"\" t\"TLE\" w l lt %d, \\\n",i); + else fprintf(ficgp,"\" t\"LE in state (%d)\" w l lt %d, \\\n",i-1,i+1); + fprintf(ficgp,"\"%s\" every :::%d::%d u 1:($2==%d && $4!=0 ? $4-$5*2 : 1/0) \"%%lf %%lf %%lf",subdirf2(fileresu,"T_"),nres-1,nres-1,vpopbased); + for (j=1; j<= nlstate+1 ; j ++) { + if (j==i) fprintf(ficgp," %%lf (%%lf)"); + else fprintf(ficgp," %%*lf (%%*lf)"); + } + fprintf(ficgp,"\" t\"\" w l lt 0,"); + fprintf(ficgp,"\"%s\" every :::%d::%d u 1:($2==%d && $4!=0 ? $4+$5*2 : 1/0) \"%%lf %%lf %%lf",subdirf2(fileresu,"T_"),nres-1,nres-1,vpopbased); + for (j=1; j<= nlstate+1 ; j ++) { + if (j==i) fprintf(ficgp," %%lf (%%lf)"); + else fprintf(ficgp," %%*lf (%%*lf)"); + } + if (i== (nlstate+1)) fprintf(ficgp,"\" t\"\" w l lt 0"); + else fprintf(ficgp,"\" t\"\" w l lt 0,\\\n"); + } /* state */ + } /* vpopbased */ + fprintf(ficgp,"\nset out;set out \"%s_%d-%d.svg\"; replot; set out; unset label;\n",subdirf2(optionfilefiname,"E_"),k1,nres); /* Buggy gnuplot */ + } /* end nres */ + } /* k1 end 2 eme*/ - */ - 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(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); - } - } + /*3eme*/ + for (k1=1; k1<= m ; k1 ++){ + for(nres=1; nres <= nresult; nres++){ /* For each resultline */ + if(m != 1 && TKresult[nres]!= k1) + continue; + + for (cpt=1; cpt<= nlstate ; cpt ++) { + fprintf(ficgp,"\n\n# 3d: Life expectancy with EXP_ files: combination=%d state=%d",k1, cpt); + strcpy(gplotlabel,"("); + 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); + sprintf(gplotlabel+strlen(gplotlabel)," V%d=%d ",Tvaraff[k],vlv); + } + for (k4=1; k4<= nsq; k4++){ /* For each selected (single) quantitative value */ + fprintf(ficgp," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); + sprintf(gplotlabel+strlen(gplotlabel)," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); + } + strcpy(gplotlabel+strlen(gplotlabel),")"); + 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+1)*(cpt-1); + fprintf(ficgp,"\nset out \"%s_%d-%d-%d.svg\" \n",subdirf2(optionfilefiname,"EXP_"),cpt,k1,nres); + fprintf(ficgp,"set label \"%s\" at graph 0.98,0.5 center rotate font \"Helvetica,12\"\n",gplotlabel); + fprintf(ficgp,"set ter svg size 640, 480\n\ +plot [%.f:%.f] \"%s\" every :::%d::%d u 1:%d t \"e%d1\" w l",ageminpar,fage,subdirf2(fileresu,"E_"),nres-1,nres-1,k,cpt); + /*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) "); + fprintf(ficgp,"\" t \"e%d1\" w l",cpt); + 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) "); + fprintf(ficgp,"\" t \"e%d1\" w l",cpt); + + */ + for (i=1; i< nlstate ; i ++) { + fprintf(ficgp," ,\"%s\" every :::%d::%d u 1:%d t \"e%d%d\" w l",subdirf2(fileresu,"E_"),nres-1,nres-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.\" w l",subdirf2(fileresu,"E_"),nres-1,nres-1,k+nlstate,cpt); + } + fprintf(ficgp,"\nunset label;\n"); + } /* end nres */ + } /* end kl 3eme */ + /* 4eme */ /* 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 (cpt=1; cpt<=nlstate ; cpt ++) { /* For each life state */ - k=3; - fprintf(ficgp,"\n#\n#\n# Survival functions in state j : 'lij' files, cov=%d state=%d",k1, cpt); - 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\ -set ter svg size 640, 480\n\ -unset log y\n\ -plot [%.f:%.f] ", ageminpar, agemaxpar); - for (i=1; i<= nlstate ; i ++){ - if(i==1) - fprintf(ficgp,"\"%s\"",subdirf2(fileresu,"PIJ_")); - else - fprintf(ficgp,", '' "); - l=(nlstate+ndeath)*(i-1)+1; - fprintf(ficgp," u ($1==%d ? ($3):1/0):($%d/($%d",k1,k+l+(cpt-1),k+l); - for (j=2; j<= nlstate+ndeath ; j ++) - fprintf(ficgp,"+$%d",k+l+j-1); - fprintf(ficgp,")) t \"l(%d,%d)\" w l",i,cpt); - } /* nlstate */ - fprintf(ficgp,"\nset out\n"); - } /* end cpt state*/ - } /* end covariate */ + for (k1=1; k1<=m; k1++){ /* For each covariate and each value */ + for(nres=1; nres <= nresult; nres++){ /* For each resultline */ + if(m != 1 && TKresult[nres]!= k1) + continue; + for (cpt=1; cpt<=nlstate ; cpt ++) { /* For each life state cpt*/ + strcpy(gplotlabel,"("); + 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 */ + 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); + sprintf(gplotlabel+strlen(gplotlabel)," V%d=%d ",Tvaraff[k],vlv); + } + for (k4=1; k4<= nsq; k4++){ /* For each selected (single) quantitative value */ + fprintf(ficgp," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); + sprintf(gplotlabel+strlen(gplotlabel)," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); + } + strcpy(gplotlabel+strlen(gplotlabel),")"); + 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-%d.svg\" \n",subdirf2(optionfilefiname,"LIJ_"),cpt,k1,nres); + fprintf(ficgp,"set label \"Alive state %d %s\" at graph 0.98,0.5 center rotate font \"Helvetica,12\"\n",cpt,gplotlabel); + fprintf(ficgp,"set xlabel \"Age\" \nset ylabel \"Probability to be alive\" \n\ +set ter svg size 640, 480\nunset log y\nplot [%.f:%.f] ", ageminpar, agemaxpar); + k=3; + for (i=1; i<= nlstate ; i ++){ + if(i==1){ + fprintf(ficgp,"\"%s\"",subdirf2(fileresu,"PIJ_")); + }else{ + fprintf(ficgp,", '' "); + } + l=(nlstate+ndeath)*(i-1)+1; + fprintf(ficgp," u ($1==%d ? ($3):1/0):($%d/($%d",k1,k+l+(cpt-1),k+l); + for (j=2; j<= nlstate+ndeath ; j ++) + fprintf(ficgp,"+$%d",k+l+j-1); + fprintf(ficgp,")) t \"l(%d,%d)\" w l",i,cpt); + } /* nlstate */ + fprintf(ficgp,"\nset out; unset label;\n"); + } /* end cpt state*/ + } /* end nres */ + } /* end covariate k1 */ +/* 5eme */ /* 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 (cpt=1; cpt<=nlstate ; cpt ++) { /* For each inital state */ - k=3; - 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,"\nset out \"%s_%d-%d.svg\" \n",subdirf2(optionfilefiname,"LIJT_"),cpt,k1); - fprintf(ficgp,"set xlabel \"Age\" \nset ylabel \"Probability to be alive\" \n\ -set ter svg size 640, 480\n\ -unset log y\n\ -plot [%.f:%.f] ", ageminpar, agemaxpar); - for (j=1; j<= nlstate ; j ++){ /* Lived in state j */ - if(j==1) - fprintf(ficgp,"\"%s\"",subdirf2(fileresu,"PIJ_")); - else - fprintf(ficgp,", '' "); - l=(nlstate+ndeath)*(cpt-1) +j; - fprintf(ficgp," u (($1==%d && (floor($2)%%5 == 0)) ? ($3):1/0):($%d",k1,k+l); - /* for (i=2; i<= nlstate+ndeath ; i ++) */ - /* fprintf(ficgp,"+$%d",k+l+i-1); */ - fprintf(ficgp,") t \"l(%d,%d)\" w l",cpt,j); - } /* nlstate */ - fprintf(ficgp,", '' "); - fprintf(ficgp," u (($1==%d && (floor($2)%%5 == 0)) ? ($3):1/0):(",k1); - for (j=1; j<= nlstate ; j ++){ /* Lived in state j */ - l=(nlstate+ndeath)*(cpt-1) +j; - if(j < nlstate) - fprintf(ficgp,"$%d +",k+l); - else - fprintf(ficgp,"$%d) t\"l(%d,.)\" w l",k+l,cpt); - } - fprintf(ficgp,"\nset out\n"); - } /* end cpt state*/ - } /* end covariate */ - + for (k1=1; k1<= m ; k1++){ /* For each covariate combination if any */ + for(nres=1; nres <= nresult; nres++){ /* For each resultline */ + if(m != 1 && TKresult[nres]!= k1) + continue; + for (cpt=1; cpt<=nlstate ; cpt ++) { /* For each inital state */ + strcpy(gplotlabel,"("); + 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 */ + 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); + sprintf(gplotlabel+strlen(gplotlabel)," V%d=%d ",Tvaraff[k],vlv); + } + for (k4=1; k4<= nsq; k4++){ /* For each selected (single) quantitative value */ + fprintf(ficgp," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); + sprintf(gplotlabel+strlen(gplotlabel)," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); + } + strcpy(gplotlabel+strlen(gplotlabel),")"); + 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-%d.svg\" \n",subdirf2(optionfilefiname,"LIJT_"),cpt,k1,nres); + fprintf(ficgp,"set label \"Alive state %d %s\" at graph 0.98,0.5 center rotate font \"Helvetica,12\"\n",cpt,gplotlabel); + fprintf(ficgp,"set xlabel \"Age\" \nset ylabel \"Probability to be alive\" \n\ +set ter svg size 640, 480\nunset log y\nplot [%.f:%.f] ", ageminpar, agemaxpar); + k=3; + for (j=1; j<= nlstate ; j ++){ /* Lived in state j */ + if(j==1) + fprintf(ficgp,"\"%s\"",subdirf2(fileresu,"PIJ_")); + else + fprintf(ficgp,", '' "); + l=(nlstate+ndeath)*(cpt-1) +j; + fprintf(ficgp," u (($1==%d && (floor($2)%%5 == 0)) ? ($3):1/0):($%d",k1,k+l); + /* for (i=2; i<= nlstate+ndeath ; i ++) */ + /* fprintf(ficgp,"+$%d",k+l+i-1); */ + fprintf(ficgp,") t \"l(%d,%d)\" w l",cpt,j); + } /* nlstate */ + fprintf(ficgp,", '' "); + fprintf(ficgp," u (($1==%d && (floor($2)%%5 == 0)) ? ($3):1/0):(",k1); + for (j=1; j<= nlstate ; j ++){ /* Lived in state j */ + l=(nlstate+ndeath)*(cpt-1) +j; + if(j < nlstate) + fprintf(ficgp,"$%d +",k+l); + else + fprintf(ficgp,"$%d) t\"l(%d,.)\" w l",k+l,cpt); + } + fprintf(ficgp,"\nset out; unset label;\n"); + } /* end cpt state*/ + } /* end covariate */ + } /* end nres */ + +/* 6eme */ /* CV preval stable (period) for each covariate */ - for (k1=1; k1<= m ; k1 ++) { /* For each covariate if any */ - for (cpt=1; cpt<=nlstate ; cpt ++) { /* For each life state */ - k=3; - fprintf(ficgp,"\n#\n#\n#CV preval stable (period): 'pij' files, cov=%d state=%d",k1, cpt); - fprintf(ficgp,"\nset out \"%s_%d-%d.svg\" \n",subdirf2(optionfilefiname,"P_"),cpt,k1); + for (k1=1; k1<= m ; k1 ++) /* For each covariate combination if any */ + for(nres=1; nres <= nresult; nres++){ /* For each resultline */ + if(m != 1 && TKresult[nres]!= k1) + continue; + for (cpt=1; cpt<=nlstate ; cpt ++) { /* For each life state of arrival */ + strcpy(gplotlabel,"("); + fprintf(ficgp,"\n#\n#\n#CV preval stable (forward): 'pij' files, covariatecombination#=%d state=%d",k1, cpt); + 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); + sprintf(gplotlabel+strlen(gplotlabel)," V%d=%d ",Tvaraff[k],vlv); + } + for (k4=1; k4<= nsq; k4++){ /* For each selected (single) quantitative value */ + fprintf(ficgp," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); + sprintf(gplotlabel+strlen(gplotlabel)," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); + } + strcpy(gplotlabel+strlen(gplotlabel),")"); + 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-%d.svg\" \n",subdirf2(optionfilefiname,"P_"),cpt,k1,nres); + fprintf(ficgp,"set label \"Alive state %d %s\" at graph 0.98,0.5 center rotate font \"Helvetica,12\"\n",cpt,gplotlabel); 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); - for (i=1; i<= nlstate ; i ++){ +set ter svg size 640, 480\nunset log y\nplot [%.f:%.f] ", ageminpar, agemaxpar); + k=3; /* Offset */ + for (i=1; i<= nlstate ; i ++){ /* State of origin */ if(i==1) fprintf(ficgp,"\"%s\"",subdirf2(fileresu,"PIJ_")); else fprintf(ficgp,", '' "); - l=(nlstate+ndeath)*(i-1)+1; + l=(nlstate+ndeath)*(i-1)+1; /* 1, 1+ nlstate+ndeath, 1+2*(nlstate+ndeath) */ fprintf(ficgp," u ($1==%d ? ($3):1/0):($%d/($%d",k1,k+l+(cpt-1),k+l); for (j=2; j<= nlstate ; j ++) fprintf(ficgp,"+$%d",k+l+j-1); fprintf(ficgp,")) t \"prev(%d,%d)\" w l",i,cpt); } /* nlstate */ - fprintf(ficgp,"\nset out\n"); + fprintf(ficgp,"\nset out; unset label;\n"); } /* end cpt state*/ } /* end covariate */ - - /* proba elementaires */ - fprintf(ficgp,"\n##############\n#MLE estimated parameters\n#############\n"); + + +/* 7eme */ + if(prevbcast == 1){ + /* CV backward prevalence for each covariate */ + for (k1=1; k1<= m ; k1 ++) /* For each covariate combination if any */ + for(nres=1; nres <= nresult; nres++){ /* For each resultline */ + if(m != 1 && TKresult[nres]!= k1) + continue; + for (cpt=1; cpt<=nlstate ; cpt ++) { /* For each life origin state */ + strcpy(gplotlabel,"("); + fprintf(ficgp,"\n#\n#\n#CV Backward stable prevalence: 'pijb' files, covariatecombination#=%d state=%d",k1, cpt); + 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); + sprintf(gplotlabel+strlen(gplotlabel)," V%d=%d ",Tvaraff[k],vlv); + } + for (k4=1; k4<= nsq; k4++){ /* For each selected (single) quantitative value */ + fprintf(ficgp," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); + sprintf(gplotlabel+strlen(gplotlabel)," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); + } + strcpy(gplotlabel+strlen(gplotlabel),")"); + 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-%d.svg\" \n",subdirf2(optionfilefiname,"PB_"),cpt,k1,nres); + fprintf(ficgp,"set label \"Origin alive state %d %s\" at graph 0.98,0.5 center rotate font \"Helvetica,12\"\n",cpt,gplotlabel); + fprintf(ficgp,"set xlabel \"Age\" \nset ylabel \"Probability\" \n\ +set ter svg size 640, 480\nunset log y\nplot [%.f:%.f] ", ageminpar, agemaxpar); + k=3; /* Offset */ + for (i=1; i<= nlstate ; i ++){ /* State of arrival */ + if(i==1) + fprintf(ficgp,"\"%s\"",subdirf2(fileresu,"PIJB_")); + else + fprintf(ficgp,", '' "); + /* l=(nlstate+ndeath)*(i-1)+1; */ + l=(nlstate+ndeath)*(cpt-1)+1; /* fixed for i; cpt=1 1, cpt=2 1+ nlstate+ndeath, 1+2*(nlstate+ndeath) */ + /* fprintf(ficgp," u ($1==%d ? ($3):1/0):($%d/($%d",k1,k+l+(cpt-1),k+l); /\* a vérifier *\/ */ + /* 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," u ($1==%d ? ($3):1/0):($%d",k1,k+l+i-1); /* To be verified */ + /* for (j=2; j<= nlstate ; j ++) */ + /* fprintf(ficgp,"+$%d",k+l+j-1); */ + /* /\* fprintf(ficgp,"+$%d",k+l+j-1); *\/ */ + fprintf(ficgp,") t \"bprev(%d,%d)\" w l",cpt,i); + } /* nlstate */ + fprintf(ficgp,"\nset out; unset label;\n"); + } /* end cpt state*/ + } /* end covariate */ + } /* End if prevbcast */ + + /* 8eme */ + if(prevfcast==1){ + /* Projection from cross-sectional to forward stable (period) prevalence for each covariate */ + + for (k1=1; k1<= m ; k1 ++) /* For each covariate combination if any */ + for(nres=1; nres <= nresult; nres++){ /* For each resultline */ + if(m != 1 && TKresult[nres]!= k1) + continue; + for (cpt=1; cpt<=nlstate ; cpt ++) { /* For each life state */ + strcpy(gplotlabel,"("); + fprintf(ficgp,"\n#\n#\n#Projection of prevalence to forward stable prevalence (period): 'PROJ_' files, covariatecombination#=%d state=%d",k1, cpt); + for (k=1; k<=cptcoveff; k++){ /* For each correspondig covariate value */ + 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]; + fprintf(ficgp," V%d=%d ",Tvaraff[k],vlv); + sprintf(gplotlabel+strlen(gplotlabel)," V%d=%d ",Tvaraff[k],vlv); + } + for (k4=1; k4<= nsq; k4++){ /* For each selected (single) quantitative value */ + fprintf(ficgp," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); + sprintf(gplotlabel+strlen(gplotlabel)," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); + } + strcpy(gplotlabel+strlen(gplotlabel),")"); + 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,"\nset out \"%s_%d-%d-%d.svg\" \n",subdirf2(optionfilefiname,"PROJ_"),cpt,k1,nres); + fprintf(ficgp,"set label \"Alive state %d %s\" at graph 0.98,0.5 center rotate font \"Helvetica,12\"\n",cpt,gplotlabel); + fprintf(ficgp,"set xlabel \"Age\" \nset ylabel \"Prevalence\" \n\ +set ter svg size 640, 480\nunset log y\nplot [%.f:%.f] ", ageminpar, agemaxpar); + + /* for (i=1; i<= nlstate+1 ; i ++){ /\* nlstate +1 p11 p21 p.1 *\/ */ + istart=nlstate+1; /* Could be one if by state, but nlstate+1 is w.i projection only */ + /*istart=1;*/ /* Could be one if by state, but nlstate+1 is w.i projection only */ + for (i=istart; 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*/ + /*# 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 */ + /*# 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 */ + if(i==istart){ + fprintf(ficgp,"\"%s\"",subdirf2(fileresu,"F_")); + }else{ + fprintf(ficgp,",\\\n '' "); + } + if(cptcoveff ==0){ /* No covariate */ + 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*/ + /*# 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){ + fprintf(ficgp," $%d/(1.-$%d)):1 t 'pw.%d' with line lc variable ", \ + ioffset+(cpt-1)*(nlstate+1)+1+(i-1), ioffset+1+(i-1)+(nlstate+1)*nlstate,cpt ); + fprintf(ficgp,",\\\n '' "); + fprintf(ficgp," u %d:(",ioffset); + fprintf(ficgp," (($1-$2) == %d ) ? $%d/(1.-$%d) : 1/0):1 with labels center not ", \ + offyear, \ + ioffset+(cpt-1)*(nlstate+1)+1+(i-1), ioffset+1+(i-1)+(nlstate+1)*nlstate ); + }else + fprintf(ficgp," $%d/(1.-$%d)) t 'p%d%d' with line ", \ + ioffset+(cpt-1)*(nlstate+1)+1+(i-1), ioffset+1+(i-1)+(nlstate+1)*nlstate,i,cpt ); + }else{ /* more than 2 covariates */ + ioffset=2*cptcoveff+2; /* Age is in 4 or 6 or etc.*/ + /*# 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 */ + iyearc=ioffset-1; + iagec=ioffset; + fprintf(ficgp," u %d:(",ioffset); + kl=0; + strcpy(gplotcondition,"("); + 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,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]; /* Value of the modality of Tvaraff[k] */ + kl++; + sprintf(gplotcondition+strlen(gplotcondition),"$%d==%d && $%d==%d " ,kl,Tvaraff[k], kl+1, nbcode[Tvaraff[k]][lv]); + kl++; + if(k 1) + sprintf(gplotcondition+strlen(gplotcondition)," && "); + } + strcpy(gplotcondition+strlen(gplotcondition),")"); + /* 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(i==nlstate+1){ + fprintf(ficgp,"%s ? $%d/(1.-$%d) : 1/0):%d t 'p.%d' with line lc variable", gplotcondition, \ + ioffset+(cpt-1)*(nlstate+1)+1+(i-1), ioffset+1+(i-1)+(nlstate+1)*nlstate,iyearc, cpt ); + fprintf(ficgp,",\\\n '' "); + fprintf(ficgp," u %d:(",iagec); + fprintf(ficgp,"%s && (($%d-$%d) == %d ) ? $%d/(1.-$%d) : 1/0):%d with labels center not ", gplotcondition, \ + iyearc, iagec, offyear, \ + ioffset+(cpt-1)*(nlstate+1)+1+(i-1), ioffset+1+(i-1)+(nlstate+1)*nlstate, iyearc ); +/* '' u 6:(($1==1 && $2==0 && $3==2 && $4==0) && (($5-$6) == 1947) ? $10/(1.-$22) : 1/0):5 with labels center boxed not*/ + }else{ + fprintf(ficgp,"%s ? $%d/(1.-$%d) : 1/0) t 'p%d%d' with line ", gplotcondition, \ + ioffset+(cpt-1)*(nlstate+1)+1+(i-1), ioffset +1+(i-1)+(nlstate+1)*nlstate,i,cpt ); + } + } /* end if covariate */ + } /* nlstate */ + fprintf(ficgp,"\nset out; unset label;\n"); + } /* end cpt state*/ + } /* end covariate */ + } /* End if prevfcast */ + + if(prevbcast==1){ + /* Back projection from cross-sectional to stable (mixed) for each covariate */ + + for (k1=1; k1<= m ; k1 ++) /* For each covariate combination if any */ + for(nres=1; nres <= nresult; nres++){ /* For each resultline */ + if(m != 1 && TKresult[nres]!= k1) + continue; + for (cpt=1; cpt<=nlstate ; cpt ++) { /* For each life state */ + strcpy(gplotlabel,"("); + fprintf(ficgp,"\n#\n#\n#Back projection of prevalence to stable (mixed) back prevalence: 'BPROJ_' files, covariatecombination#=%d originstate=%d",k1, cpt); + for (k=1; k<=cptcoveff; k++){ /* For each correspondig covariate value */ + 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]; + fprintf(ficgp," V%d=%d ",Tvaraff[k],vlv); + sprintf(gplotlabel+strlen(gplotlabel)," V%d=%d ",Tvaraff[k],vlv); + } + for (k4=1; k4<= nsq; k4++){ /* For each selected (single) quantitative value */ + fprintf(ficgp," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); + sprintf(gplotlabel+strlen(gplotlabel)," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); + } + strcpy(gplotlabel+strlen(gplotlabel),")"); + fprintf(ficgp,"\n#\n"); + if(invalidvarcomb[k1]){ + fprintf(ficgp,"#Combination (%d) ignored because no cases \n",k1); + continue; + } + + fprintf(ficgp,"# hbijx=backprobability over h years, hb.jx is weighted by observed prev at destination state\n "); + fprintf(ficgp,"\nset out \"%s_%d-%d-%d.svg\" \n",subdirf2(optionfilefiname,"PROJB_"),cpt,k1,nres); + fprintf(ficgp,"set label \"Origin alive state %d %s\" at graph 0.98,0.5 center rotate font \"Helvetica,12\"\n",cpt,gplotlabel); + fprintf(ficgp,"set xlabel \"Age\" \nset ylabel \"Prevalence\" \n\ +set ter svg size 640, 480\nunset log y\nplot [%.f:%.f] ", ageminpar, agemaxpar); + + /* for (i=1; i<= nlstate+1 ; i ++){ /\* nlstate +1 p11 p21 p.1 *\/ */ + istart=nlstate+1; /* Could be one if by state, but nlstate+1 is w.i projection only */ + /*istart=1;*/ /* Could be one if by state, but nlstate+1 is w.i projection only */ + for (i=istart; 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*/ + /*# 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 */ + /*# 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 */ + if(i==istart){ + fprintf(ficgp,"\"%s\"",subdirf2(fileresu,"FB_")); + }else{ + fprintf(ficgp,",\\\n '' "); + } + if(cptcoveff ==0){ /* No covariate */ + 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*/ + /*# 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){ + fprintf(ficgp," $%d/(1.-$%d)):1 t 'bw%d' with line lc variable ", \ + ioffset+(cpt-1)*(nlstate+1)+1+(i-1), ioffset+1+(i-1)+(nlstate+1)*nlstate,cpt ); + fprintf(ficgp,",\\\n '' "); + fprintf(ficgp," u %d:(",ioffset); + fprintf(ficgp," (($1-$2) == %d ) ? $%d : 1/0):1 with labels center not ", \ + offbyear, \ + ioffset+(cpt-1)*(nlstate+1)+1+(i-1) ); + }else + fprintf(ficgp," $%d/(1.-$%d)) t 'b%d%d' with line ", \ + ioffset+(cpt-1)*(nlstate+1)+1+(i-1), ioffset+1+(i-1)+(nlstate+1)*nlstate,cpt,i ); + }else{ /* more than 2 covariates */ + ioffset=2*cptcoveff+2; /* Age is in 4 or 6 or etc.*/ + /*# 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 */ + iyearc=ioffset-1; + iagec=ioffset; + fprintf(ficgp," u %d:(",ioffset); + kl=0; + strcpy(gplotcondition,"("); + 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,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]; /* Value of the modality of Tvaraff[k] */ + kl++; + sprintf(gplotcondition+strlen(gplotcondition),"$%d==%d && $%d==%d " ,kl,Tvaraff[k], kl+1, nbcode[Tvaraff[k]][lv]); + kl++; + if(k 1) + sprintf(gplotcondition+strlen(gplotcondition)," && "); + } + strcpy(gplotcondition+strlen(gplotcondition),")"); + /* 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(i==nlstate+1){ + fprintf(ficgp,"%s ? $%d : 1/0):%d t 'bw%d' with line lc variable", gplotcondition, \ + ioffset+(cpt-1)*(nlstate+1)+1+(i-1),iyearc,cpt ); + fprintf(ficgp,",\\\n '' "); + fprintf(ficgp," u %d:(",iagec); + /* fprintf(ficgp,"%s && (($5-$6) == %d ) ? $%d/(1.-$%d) : 1/0):5 with labels center not ", gplotcondition, \ */ + fprintf(ficgp,"%s && (($%d-$%d) == %d ) ? $%d : 1/0):%d with labels center not ", gplotcondition, \ + iyearc,iagec,offbyear, \ + ioffset+(cpt-1)*(nlstate+1)+1+(i-1), iyearc ); +/* '' u 6:(($1==1 && $2==0 && $3==2 && $4==0) && (($5-$6) == 1947) ? $10/(1.-$22) : 1/0):5 with labels center boxed not*/ + }else{ + /* fprintf(ficgp,"%s ? $%d/(1.-$%d) : 1/0) t 'p%d%d' with line ", gplotcondition, \ */ + fprintf(ficgp,"%s ? $%d : 1/0) t 'b%d%d' with line ", gplotcondition, \ + ioffset+(cpt-1)*(nlstate+1)+1+(i-1), cpt,i ); + } + } /* end if covariate */ + } /* nlstate */ + fprintf(ficgp,"\nset out; unset label;\n"); + } /* end cpt state*/ + } /* end covariate */ + } /* End if prevbcast */ + + + /* 9eme writing MLE parameters */ + fprintf(ficgp,"\n##############\n#9eme MLE estimated parameters\n#############\n"); for(i=1,jk=1; i <=nlstate; i++){ fprintf(ficgp,"# initial state %d\n",i); for(k=1; k <=(nlstate+ndeath); k++){ @@ -5119,11 +7947,12 @@ plot [%.f:%.f] ", ageminpar, agemaxpar) fprintf(ficgp,"\n"); } } - } + } fprintf(ficgp,"##############\n#\n"); - + /*goto avoid;*/ - fprintf(ficgp,"\n##############\n#Graphics of probabilities or incidences\n#############\n"); + /* 10eme Graphics of probabilities or incidences using written MLE parameters */ + fprintf(ficgp,"\n##############\n#10eme 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)=p1 +p2*age +p3*age*age+ p4*V1+ p5*V1*age\n"); fprintf(ficgp,"# logi(p13/p11)=a13+b13*age+c13age*age+d13*V1+e13*V1*age\n"); @@ -5137,166 +7966,445 @@ plot [%.f:%.f] ", ageminpar, agemaxpar) 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,"#\n"); - 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,"# jk=1 to 2^%d=%d\n",cptcoveff,m); - for(jk=1; jk <=m; jk++) { - fprintf(ficgp,"# jk=%d\n",jk); - fprintf(ficgp,"\nset out \"%s_%d-%d.svg\" ",subdirf2(optionfilefiname,"PE_"),jk,ng); - fprintf(ficgp,"\nset ter svg size 640, 480 "); - if (ng==1){ - fprintf(ficgp,"\nset ylabel \"Value of the logit of the model\"\n"); /* exp(a12+b12*x) could be nice */ - fprintf(ficgp,"\nunset log y"); - }else if (ng==2){ - fprintf(ficgp,"\nset ylabel \"Probability\"\n"); - fprintf(ficgp,"\nset log y"); - }else if (ng==3){ - fprintf(ficgp,"\nset ylabel \"Quasi-incidence per year\"\n"); - fprintf(ficgp,"\nset log y"); - }else - fprintf(ficgp,"\nunset title "); - fprintf(ficgp,"\nplot [%.f:%.f] ",ageminpar,agemaxpar); - i=1; - for(k2=1; k2<=nlstate; k2++) { - k3=i; - for(k=1; k<=(nlstate+ndeath); k++) { - if (k != k2){ - switch( ng) { - case 1: - if(nagesqr==0) - fprintf(ficgp," p%d+p%d*x",i,i+1); - else /* nagesqr =1 */ - fprintf(ficgp," p%d+p%d*x+p%d*x*x",i,i+1,i+1+nagesqr); - break; - case 2: /* ng=2 */ - if(nagesqr==0) - fprintf(ficgp," exp(p%d+p%d*x",i,i+1); - else /* nagesqr =1 */ - fprintf(ficgp," exp(p%d+p%d*x+p%d*x*x",i,i+1,i+1+nagesqr); - break; - case 3: - if(nagesqr==0) - fprintf(ficgp," %f*exp(p%d+p%d*x",YEARM/stepm,i,i+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); - break; - } - ij=1;/* To be checked else nbcode[0][0] wrong */ - for(j=3; j <=ncovmodel-nagesqr; j++) { - /* printf("Tage[%d]=%d, j=%d\n", ij, Tage[ij], j); */ - if(ij <=cptcovage) { /* 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,Tvar[j-2])]); */ - ij++; - } - } - else - fprintf(ficgp,"+p%d*%d",i+j+nagesqr-1,nbcode[Tvar[j-2]][codtabm(jk,j-2)]); - } - 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])]); */ + for(ng=1; ng<=3;ng++){ /* Number of graphics: first is logit, 2nd is probabilities, third is incidences per year*/ + fprintf(ficgp,"#Number of graphics: first is logit, 2nd is probabilities, third is incidences per year\n"); + fprintf(ficgp,"#model=%s \n",model); + fprintf(ficgp,"# Type of graphic ng=%d\n",ng); + fprintf(ficgp,"# k1=1 to 2^%d=%d\n",cptcoveff,m);/* to be checked */ + for(k1=1; k1 <=m; k1++) /* For each combination of covariate */ + for(nres=1; nres <= nresult; nres++){ /* For each resultline */ + if(m != 1 && TKresult[nres]!= k1) + continue; + fprintf(ficgp,"\n\n# Combination of dummy k1=%d which is ",k1); + strcpy(gplotlabel,"("); + /*sprintf(gplotlabel+strlen(gplotlabel)," Dummy combination %d ",k1);*/ + for (k=1; k<=cptcoveff; k++){ /* For each correspondig covariate value */ + 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]; + fprintf(ficgp," V%d=%d ",Tvaraff[k],vlv); + sprintf(gplotlabel+strlen(gplotlabel)," V%d=%d ",Tvaraff[k],vlv); + } + for (k4=1; k4<= nsq; k4++){ /* For each selected (single) quantitative value */ + fprintf(ficgp," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); + sprintf(gplotlabel+strlen(gplotlabel)," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); + } + strcpy(gplotlabel+strlen(gplotlabel),")"); + fprintf(ficgp,"\n#\n"); + fprintf(ficgp,"\nset out \"%s_%d-%d-%d.svg\" ",subdirf2(optionfilefiname,"PE_"),k1,ng,nres); + fprintf(ficgp,"\nset key outside "); + /* fprintf(ficgp,"\nset label \"%s\" at graph 1.2,0.5 center rotate font \"Helvetica,12\"\n",gplotlabel); */ + fprintf(ficgp,"\nset title \"%s\" font \"Helvetica,12\"\n",gplotlabel); + fprintf(ficgp,"\nset ter svg size 640, 480 "); + if (ng==1){ + fprintf(ficgp,"\nset ylabel \"Value of the logit of the model\"\n"); /* exp(a12+b12*x) could be nice */ + fprintf(ficgp,"\nunset log y"); + }else if (ng==2){ + fprintf(ficgp,"\nset ylabel \"Probability\"\n"); + fprintf(ficgp,"\nset log y"); + }else if (ng==3){ + fprintf(ficgp,"\nset ylabel \"Quasi-incidence per year\"\n"); + fprintf(ficgp,"\nset log y"); + }else + fprintf(ficgp,"\nunset title "); + fprintf(ficgp,"\nplot [%.f:%.f] ",ageminpar,agemaxpar); + i=1; + for(k2=1; k2<=nlstate; k2++) { + k3=i; + for(k=1; k<=(nlstate+ndeath); k++) { + if (k != k2){ + switch( ng) { + case 1: + if(nagesqr==0) + fprintf(ficgp," p%d+p%d*x",i,i+1); + else /* nagesqr =1 */ + fprintf(ficgp," p%d+p%d*x+p%d*x*x",i,i+1,i+1+nagesqr); + break; + case 2: /* ng=2 */ + if(nagesqr==0) + fprintf(ficgp," exp(p%d+p%d*x",i,i+1); + else /* nagesqr =1 */ + fprintf(ficgp," exp(p%d+p%d*x+p%d*x*x",i,i+1,i+1+nagesqr); + break; + case 3: + if(nagesqr==0) + fprintf(ficgp," %f*exp(p%d+p%d*x",YEARM/stepm,i,i+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); + break; + } + ij=1;/* To be checked else nbcode[0][0] wrong */ + ijp=1; /* product no age */ + /* for(j=3; j <=ncovmodel-nagesqr; j++) { */ + for(j=1; j <=cptcovt; j++) { /* For each covariate of the simplified model */ + /* printf("Tage[%d]=%d, j=%d\n", ij, Tage[ij], j); */ + if(cptcovage >0){ /* V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1, 2 V5 and V1 */ + if(j==Tage[ij]) { /* Product by age To be looked at!!*/ + if(ij <=cptcovage) { /* V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1, 2 V5 and V1 */ + if(DummyV[j]==0){ + fprintf(ficgp,"+p%d*%d*x",i+j+2+nagesqr-1,Tinvresult[nres][Tvar[j]]);; + }else{ /* quantitative */ + fprintf(ficgp,"+p%d*%f*x",i+j+2+nagesqr-1,Tqinvresult[nres][Tvar[j]]); /* Tqinvresult in decoderesult */ + /* fprintf(ficgp,"+p%d*%d*x",i+j+nagesqr-1,nbcode[Tvar[j-2]][codtabm(k1,Tvar[j-2])]); */ + } + ij++; + } + } + }else if(cptcovprod >0){ + if(j==Tprod[ijp]) { /* */ + /* printf("Tprod[%d]=%d, j=%d\n", ij, Tprod[ijp], j); */ + if(ijp <=cptcovprod) { /* Product */ + if(DummyV[Tvard[ijp][1]]==0){/* Vn is dummy */ + if(DummyV[Tvard[ijp][2]]==0){/* Vn and Vm are dummy */ + /* fprintf(ficgp,"+p%d*%d*%d",i+j+2+nagesqr-1,nbcode[Tvard[ijp][1]][codtabm(k1,j)],nbcode[Tvard[ijp][2]][codtabm(k1,j)]); */ + fprintf(ficgp,"+p%d*%d*%d",i+j+2+nagesqr-1,Tinvresult[nres][Tvard[ijp][1]],Tinvresult[nres][Tvard[ijp][2]]); + }else{ /* Vn is dummy and Vm is quanti */ + /* fprintf(ficgp,"+p%d*%d*%f",i+j+2+nagesqr-1,nbcode[Tvard[ijp][1]][codtabm(k1,j)],Tqinvresult[nres][Tvard[ijp][2]]); */ + fprintf(ficgp,"+p%d*%d*%f",i+j+2+nagesqr-1,Tinvresult[nres][Tvard[ijp][1]],Tqinvresult[nres][Tvard[ijp][2]]); + } + }else{ /* Vn*Vm Vn is quanti */ + if(DummyV[Tvard[ijp][2]]==0){ + fprintf(ficgp,"+p%d*%d*%f",i+j+2+nagesqr-1,Tinvresult[nres][Tvard[ijp][2]],Tqinvresult[nres][Tvard[ijp][1]]); + }else{ /* Both quanti */ + fprintf(ficgp,"+p%d*%f*%f",i+j+2+nagesqr-1,Tqinvresult[nres][Tvard[ijp][1]],Tqinvresult[nres][Tvard[ijp][2]]); + } + } + ijp++; + } + } /* end Tprod */ + } else{ /* simple covariate */ + /* fprintf(ficgp,"+p%d*%d",i+j+2+nagesqr-1,nbcode[Tvar[j]][codtabm(k1,j)]); /\* Valgrind bug nbcode *\/ */ + if(Dummy[j]==0){ + fprintf(ficgp,"+p%d*%d",i+j+2+nagesqr-1,Tinvresult[nres][Tvar[j]]); /* */ + }else{ /* quantitative */ + fprintf(ficgp,"+p%d*%f",i+j+2+nagesqr-1,Tqinvresult[nres][Tvar[j]]); /* */ + /* fprintf(ficgp,"+p%d*%d*x",i+j+nagesqr-1,nbcode[Tvar[j-2]][codtabm(k1,Tvar[j-2])]); */ + } + } /* end simple */ + } /* end j */ + }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(cpt=1; cpt <=nlstate; cpt++){ + if(nagesqr==0) + fprintf(ficgp,"+exp(p%d+p%d*x",k3+(cpt-1)*ncovmodel,k3+(cpt-1)*ncovmodel+1); + else /* nagesqr =1 */ + fprintf(ficgp,"+exp(p%d+p%d*x+p%d*x*x",k3+(cpt-1)*ncovmodel,k3+(cpt-1)*ncovmodel+1,k3+(cpt-1)*ncovmodel+1+nagesqr); + + ij=1; + for(j=3; j <=ncovmodel-nagesqr; j++){ + if(cptcovage >0){ + if((j-2)==Tage[ij]) { /* Bug valgrind */ + if(ij <=cptcovage) { /* Bug valgrind */ + fprintf(ficgp,"+p%d*%d*x",k3+(cpt-1)*ncovmodel+1+j-2+nagesqr,nbcode[Tvar[j-2]][codtabm(k1,j-2)]); + /* fprintf(ficgp,"+p%d*%d*x",k3+(cpt-1)*ncovmodel+1+j-2+nagesqr,nbcode[Tvar[j-2]][codtabm(k1,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 */ - fprintf(ficgp," t \"logit(p%d%d)\" ", k2,k); - } - if ((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); + }else + fprintf(ficgp,"+p%d*%d",k3+(cpt-1)*ncovmodel+1+j-2+nagesqr,nbcode[Tvar[j-2]][codtabm(k1,j-2)]);/* Valgrind bug nbcode */ + } + fprintf(ficgp,")"); + } + fprintf(ficgp,")"); + if(ng ==2) + fprintf(ficgp," w l lw 2 lt (%d*%d+%d)%%%d+1 dt %d t \"p%d%d\" ", nlstate+ndeath, k2, k, nlstate+ndeath, k2, k2,k); + else /* ng= 3 */ + fprintf(ficgp," w l lw 2 lt (%d*%d+%d)%%%d+1 dt %d t \"i%d%d\" ", nlstate+ndeath, k2, k, nlstate+ndeath, k2, k2,k); + }else{ /* end ng <> 1 */ + if( k !=k2) /* logit p11 is hard to draw */ + fprintf(ficgp," w l lw 2 lt (%d*%d+%d)%%%d+1 dt %d t \"logit(p%d%d)\" ", nlstate+ndeath, k2, k, nlstate+ndeath, k2, 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; unset label;set key default;\n"); */ + fprintf(ficgp,"\n set out; unset title;set key default;\n"); + } /* end k1 */ + } /* end ng */ + /* avoid: */ + fflush(ficgp); } /* end gnuplot */ /*************** Moving average **************/ -int movingaverage(double ***probs, double bage,double fage, double ***mobaverage, int mobilav){ +/* 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; + int firstA1=0, firstA2=0; + + double sum=0., sumr=0.; + double age; + double *sumnewp, *sumnewm, *sumnewmr; + double *agemingood, *agemaxgood; + double *agemingoodr, *agemaxgoodr; + + + /* 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); + sumnewmr = vector(1,ncovcombmax); + agemingood = vector(1,ncovcombmax); + agemingoodr = vector(1,ncovcombmax); + agemaxgood = vector(1,ncovcombmax); + agemaxgoodr = vector(1,ncovcombmax); + + for (cptcod=1;cptcod<=ncovcombmax;cptcod++){ + sumnewm[cptcod]=0.; sumnewmr[cptcod]=0.; + sumnewp[cptcod]=0.; + agemingood[cptcod]=0, agemingoodr[cptcod]=0; + agemaxgood[cptcod]=0, agemaxgoodr[cptcod]=0; + } + if (cptcovn<1) ncovcombmax=1; /* At least 1 pass */ + + if(mobilav==-1 || mobilav==1||mobilav ==3 ||mobilav==5 ||mobilav== 7){ + if(mobilav==1 || 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 (cptcod=1;cptcod<=ncovcombmax;cptcod++){ + sumnewm[cptcod]=0.; + for (i=1; i<=nlstate;i++){ + 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; + sumnewm[cptcod]+=mobaverage[(int)age][i][cptcod]; + } /* end i */ + if(sumnewm[cptcod] >1.e-3) mobaverage[(int)age][i][cptcod]=mobaverage[(int)age][i][cptcod]/sumnewm[cptcod]; /* Rescaling to sum one */ + } /* end cptcod */ + }/* end age */ + }/* end mob */ + }else{ + printf("Error internal in movingaverage, mobilav=%d.\n",mobilav); + return -1; + } - 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 */ + for (cptcod=1;cptcod<=ncovcombmax;cptcod++){ /* for each combination */ + /* 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; + } + + for (age=fage-(mob-1)/2; age>=bage+(mob-1)/2; age--){ /*looking for the youngest and oldest good age */ + sumnewm[cptcod]=0.; + sumnewmr[cptcod]=0.; + for (i=1; i<=nlstate;i++){ + sumnewm[cptcod]+=mobaverage[(int)age][i][cptcod]; + sumnewmr[cptcod]+=probs[(int)age][i][cptcod]; + } + if(fabs(sumnewmr[cptcod] - 1.) <= 1.e-3) { /* good without smoothing */ + agemingoodr[cptcod]=age; + } + if(fabs(sumnewm[cptcod] - 1.) <= 1.e-3) { /* good */ + agemingood[cptcod]=age; + } + } /* age */ + for (age=bage+(mob-1)/2; age<=fage-(mob-1)/2; age++){ /*looking for the youngest and oldest good age */ + sumnewm[cptcod]=0.; + sumnewmr[cptcod]=0.; + for (i=1; i<=nlstate;i++){ + sumnewm[cptcod]+=mobaverage[(int)age][i][cptcod]; + sumnewmr[cptcod]+=probs[(int)age][i][cptcod]; + } + if(fabs(sumnewmr[cptcod] - 1.) <= 1.e-3) { /* good without smoothing */ + agemaxgoodr[cptcod]=age; + } + if(fabs(sumnewm[cptcod] - 1.) <= 1.e-3) { /* good */ + agemaxgood[cptcod]=age; + } + } /* age */ + /* Thus we have agemingood and agemaxgood as well as goodr for raw (preobs) */ + /* but they will change */ + firstA1=0;firstA2=0; + for (age=fage-(mob-1)/2; age>=bage; age--){/* From oldest to youngest, filling up to the youngest */ + sumnewm[cptcod]=0.; + sumnewmr[cptcod]=0.; + for (i=1; i<=nlstate;i++){ + sumnewm[cptcod]+=mobaverage[(int)age][i][cptcod]; + sumnewmr[cptcod]+=probs[(int)age][i][cptcod]; + } + if(mobilav==-1){ /* Forcing raw ages if good else agemingood */ + if(fabs(sumnewmr[cptcod] - 1.) <= 1.e-3) { /* good without smoothing */ + agemaxgoodr[cptcod]=age; /* age min */ + for (i=1; i<=nlstate;i++) + mobaverage[(int)age][i][cptcod]=probs[(int)age][i][cptcod]; + }else{ /* bad we change the value with the values of good ages */ + for (i=1; i<=nlstate;i++){ + mobaverage[(int)age][i][cptcod]=mobaverage[(int)agemaxgoodr[cptcod]][i][cptcod]; + } /* i */ + } /* end bad */ + }else{ + if(fabs(sumnewm[cptcod] - 1.) <= 1.e-3) { /* good */ + agemaxgood[cptcod]=age; + }else{ /* bad we change the value with the values of good ages */ + for (i=1; i<=nlstate;i++){ + mobaverage[(int)age][i][cptcod]=mobaverage[(int)agemaxgood[cptcod]][i][cptcod]; + } /* i */ + } /* end bad */ + }/* end else */ + sum=0.;sumr=0.; + for (i=1; i<=nlstate;i++){ + sum+=mobaverage[(int)age][i][cptcod]; + sumr+=probs[(int)age][i][cptcod]; + } + if(fabs(sum - 1.) > 1.e-3) { /* bad */ + if(!firstA1){ + firstA1=1; + printf("Moving average A1: For this combination of covariate cptcod=%d, we can't get a smoothed prevalence which sums to one (%f) at any descending age! age=%d, could you increase bage=%d. Others in log file...\n",cptcod,sumr, (int)age, (int)bage); + } + fprintf(ficlog,"Moving average A1: For this combination of covariate cptcod=%d, we can't get a smoothed prevalence which sums to one (%f) at any descending age! age=%d, could you increase bage=%d\n",cptcod,sumr, (int)age, (int)bage); + } /* end bad */ + /* else{ /\* We found some ages summing to one, we will smooth the oldest *\/ */ + if(fabs(sumr - 1.) > 1.e-3) { /* bad */ + if(!firstA2){ + firstA2=1; + printf("Moving average A2: For this combination of covariate cptcod=%d, the raw prevalence doesn't sums to one (%f) even with smoothed values at young ages! age=%d, could you increase bage=%d. Others in log file...\n",cptcod,sumr, (int)age, (int)bage); + } + fprintf(ficlog,"Moving average A2: For this combination of covariate cptcod=%d, the raw prevalence doesn't sums to one (%f) even with smoothed values at young ages! age=%d, could you increase bage=%d\n",cptcod,sumr, (int)age, (int)bage); + } /* end bad */ + }/* age */ + + for (age=bage+(mob-1)/2; age<=fage; age++){/* From youngest, finding the oldest wrong */ + sumnewm[cptcod]=0.; + sumnewmr[cptcod]=0.; + for (i=1; i<=nlstate;i++){ + sumnewm[cptcod]+=mobaverage[(int)age][i][cptcod]; + sumnewmr[cptcod]+=probs[(int)age][i][cptcod]; + } + if(mobilav==-1){ /* Forcing raw ages if good else agemingood */ + if(fabs(sumnewmr[cptcod] - 1.) <= 1.e-3) { /* good */ + agemingoodr[cptcod]=age; + for (i=1; i<=nlstate;i++) + mobaverage[(int)age][i][cptcod]=probs[(int)age][i][cptcod]; + }else{ /* bad we change the value with the values of good ages */ + for (i=1; i<=nlstate;i++){ + mobaverage[(int)age][i][cptcod]=mobaverage[(int)agemingoodr[cptcod]][i][cptcod]; + } /* i */ + } /* end bad */ + }else{ + 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 */ + }/* end else */ + sum=0.;sumr=0.; + for (i=1; i<=nlstate;i++){ + sum+=mobaverage[(int)age][i][cptcod]; + sumr+=mobaverage[(int)age][i][cptcod]; + } + if(fabs(sum - 1.) > 1.e-3) { /* bad */ + printf("Moving average B1: For this combination of covariate cptcod=%d, we can't get a smoothed prevalence which sums to one (%f) at any descending age! age=%d, could you decrease fage=%d?\n",cptcod, sum, (int) age, (int)fage); + } /* end bad */ + /* else{ /\* We found some ages summing to one, we will smooth the oldest *\/ */ + if(fabs(sumr - 1.) > 1.e-3) { /* bad */ + printf("Moving average B2: For this combination of covariate cptcod=%d, the raw prevalence doesn't sums to one (%f) even with smoothed values at young ages! age=%d, could you increase fage=%d\n",cptcod,sumr, (int)age, (int)fage); + } /* end bad */ + }/* age */ + + + 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(agemaxgoodr,1, ncovcombmax); + free_vector(agemaxgood,1, ncovcombmax); + free_vector(agemingood,1, ncovcombmax); + free_vector(agemingoodr,1, ncovcombmax); + free_vector(sumnewmr,1, ncovcombmax); + free_vector(sumnewm,1, ncovcombmax); + free_vector(sumnewp,1, ncovcombmax); + 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 +/* void prevforecast(char fileres[], double dateintmean, double anprojd, double mprojd, double jprojd, double ageminpar, double agemax, double dateprev1, double dateprev2, int mobilav, double ***prev, double bage, double fage, int firstpass, int lastpass, double anprojf, double p[], int cptcoveff)*/ +void prevforecast(char fileres[], double dateintmean, double dateprojd, double dateprojf, double ageminpar, double agemax, double dateprev1, double dateprev2, int mobilav, double ***prev, double bage, double fage, int firstpass, int lastpass, double p[], int cptcoveff){ + /* dateintemean, mean date of interviews + dateprojd, year, month, day of starting projection + dateprojf date of end of projection;year of end of projection (same day and month as proj1). 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 anprojd, mprojd, jprojd; */ + /* double anprojf, mprojf, jprojf; */ + int yearp, stepsize, hstepm, nhstepm, j, k, cptcod, i, h, i1, k4, nres=0; double agec; /* generic age */ - double agelim, ppij, yp,yp1,yp2,jprojmean,mprojmean,anprojmean; + double agelim, ppij, yp,yp1,yp2; double *popeffectif,*popcount; double ***p3mat; - double ***mobaverage; + /* double ***mobaverage; */ char fileresf[FILENAMELENGTH]; agelim=AGESUP; - prevalence(probs, ageminpar, agemax, s, agev, nlstate, imx, Tvar, nbcode, ncodemax, mint, anint, dateprev1, dateprev2, firstpass, lastpass); + /* 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); */ strcpy(fileresf,"F_"); strcat(fileresf,fileresu); @@ -5304,265 +8412,546 @@ void prevforecast(char fileres[], double printf("Problem with forecast resultfile: %s\n", fileresf); fprintf(ficlog,"Problem with forecast resultfile: %s\n", fileresf); } - printf("Computing forecasting: result on file '%s' \n", fileresf); - fprintf(ficlog,"Computing forecasting: result on file '%s' \n", fileresf); + printf("\nComputing forecasting: result on file '%s', please wait... \n", fileresf); + fprintf(ficlog,"\nComputing 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; + else{ + hstepm=estepm; + } + if(estepm > stepm){ /* Yes every two year */ + stepsize=2; + } + hstepm=hstepm/stepm; + + + /* yp1=modf(dateintmean,&yp);/\* extracts integral of datemean in yp and */ + /* fractional in yp1 *\/ */ + /* aintmean=yp; */ + /* yp2=modf((yp1*12),&yp); */ + /* mintmean=yp; */ + /* yp1=modf((yp2*30.5),&yp); */ + /* jintmean=yp; */ + /* if(jintmean==0) jintmean=1; */ + /* if(mintmean==0) mintmean=1; */ - 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; + /* date2dmy(dateintmean,&jintmean,&mintmean,&aintmean); */ + /* date2dmy(dateprojd,&jprojd, &mprojd, &anprojd); */ + /* date2dmy(dateprojf,&jprojf, &mprojf, &anprojf); */ + i1=pow(2,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,"# Mean day of interviews %.lf/%.lf/%.lf (%.2f) between %.2f and %.2f \n",jintmean,mintmean,aintmean,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#******"); - for(j=1;j<=cptcoveff;j++) { - fprintf(ficresf," V%d=%d, hpijx=probability over h years, hp.jx is weighted by observed prev ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); - } - fprintf(ficresf,"******\n"); - fprintf(ficresf,"# Covariate valuofcovar 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) { + for(nres=1; nres <= nresult; nres++) /* For each resultline */ + for(k=1; k<=i1;k++){ + if(i1 != 1 && TKresult[nres]!= k) + continue; + if(invalidvarcomb[k]){ + printf("\nCombination (%d) projection ignored because no cases \n",k); + continue; + } + 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)]); + } + for (k4=1; k4<= nsq; k4++){ /* For each selected (single) quantitative value */ + fprintf(ficresf," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); + } + 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," wp.%d",j); + } + for (yearp=0; yearp<=(anprojf-anprojd);yearp +=stepsize) { + fprintf(ficresf,"\n"); + fprintf(ficresf,"\n# Forecasting at date %.lf/%.lf/%.lf ",jprojd,mprojd,anprojd+yearp); + /* for (agec=fage; agec>=(ageminpar-1); agec--){ */ + for (agec=fage; agec>=(bage); 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; + /* We compute pii at age agec over nhstepm);*/ + hpxij(p3mat,nhstepm,agec,hstepm,p,nlstate,stepm,oldm,savm, k,nres); + /* Then we print p3mat for h corresponding to the right agec+h*stepms=yearp */ + for (h=0; h<=nhstepm; h++){ + if (h*hstepm/YEARM*stepm ==yearp) { + break; + } + } 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(j=1;j<=cptcoveff;j++) + fprintf(ficresf,"%d %d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); + fprintf(ficresf,"%.f %.f ",anprojd+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]*prev[(int)agec][i][k]; + else { /* even if mobilav==-1 we use mobaverage, probs may not sums to 1 */ + ppij=ppij+p3mat[i][j][h]*probs[(int)(agec)][i][k]; + } + fprintf(ficresf," %.3f", p3mat[i][j][h]); + } /* end i */ + fprintf(ficresf," %.3f", ppij); + }/* end j */ + free_ma3x(p3mat,1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); + } /* end agec */ + /* diffyear=(int) anproj1+yearp-ageminpar-1; */ + /*printf("Prevforecast %d+%d-%d=diffyear=%d\n",(int) anproj1, (int)yearp,(int)ageminpar,(int) anproj1-(int)ageminpar);*/ + } /* end yearp */ + } /* end 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]); - } - } /* end i */ - if (h*hstepm/YEARM*stepm==yearp) { - fprintf(ficresf," %.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(ficresf); + printf("End of Computing forecasting \n"); + fprintf(ficlog,"End of Computing forecasting\n"); + } -/************** Forecasting *****not tested NB*************/ -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){ - - int cpt, stepsize, hstepm, nhstepm, j,k,c, cptcod, i,h; - int *popage; - double calagedatem, agelim, kk1, kk2; +/************** Back Forecasting ******************/ + /* void prevbackforecast(char fileres[], double ***prevacurrent, 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 prevbackforecast(char fileres[], double ***prevacurrent, double dateintmean, double dateprojd, double dateprojf, double ageminpar, double agemax, double dateprev1, double dateprev2, int mobilav, double bage, double fage, int firstpass, int lastpass, double p[], int cptcoveff){ + /* back1, year, month, day of starting backprojection + agemin, agemax range of age + dateprev1 dateprev2 range of dates during which prevalence is computed + anback2 year of end of backprojection (same day and month as back1). + prevacurrent and prev are prevalences. + */ + int yearp, stepsize, hstepm, nhstepm, j, k, cptcod, i, h, i1, k4, nres=0; + double agec; /* generic age */ + double agelim, ppij, ppi, yp,yp1,yp2; /* ,jintmean,mintmean,aintmean;*/ double *popeffectif,*popcount; - double ***p3mat,***tabpop,***tabpopprev; - double ***mobaverage; - char filerespop[FILENAMELENGTH]; + double ***p3mat; + /* double ***mobaverage; */ + char fileresfb[FILENAMELENGTH]; + + agelim=AGEINF; + /* 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); */ - 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; + /*Do we need to compute prevalence again?*/ + + /* prevalence(probs, ageminpar, agemax, s, agev, nlstate, imx, Tvar, nbcode, ncodemax, mint, anint, dateprev1, dateprev2, firstpass, lastpass); */ - 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("\nComputing back forecasting: result on file '%s', please wait... \n", fileresfb); + fprintf(ficlog,"\nComputing back forecasting: result on file '%s', please wait... \n", fileresfb); + if (cptcoveff==0) ncodemax[cptcoveff]=1; - 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); + + stepsize=(int) (stepm+YEARM-1)/YEARM; + if (stepm<=12) stepsize=1; + if(estepm < stepm){ + printf ("Problem %d lower than %d\n",estepm, stepm); } - printf("Computing forecasting: result on file '%s' \n", filerespop); - fprintf(ficlog,"Computing forecasting: result on file '%s' \n", filerespop); + else{ + hstepm=estepm; + } + if(estepm >= stepm){ /* Yes every two year */ + stepsize=2; + } + + hstepm=hstepm/stepm; + /* yp1=modf(dateintmean,&yp);/\* extracts integral of datemean in yp and */ + /* fractional in yp1 *\/ */ + /* aintmean=yp; */ + /* yp2=modf((yp1*12),&yp); */ + /* mintmean=yp; */ + /* yp1=modf((yp2*30.5),&yp); */ + /* jintmean=yp; */ + /* if(jintmean==0) jintmean=1; */ + /* if(mintmean==0) jintmean=1; */ + + i1=pow(2,cptcoveff); + if (cptcovn < 1){i1=1;} + + fprintf(ficresfb,"# Mean day of interviews %.lf/%.lf/%.lf (%.2f) between %.2f and %.2f \n",jintmean,mintmean,aintmean,dateintmean,dateprev1,dateprev2); + printf("# Mean day of interviews %.lf/%.lf/%.lf (%.2f) between %.2f and %.2f \n",jintmean,mintmean,aintmean,dateintmean,dateprev1,dateprev2); + + fprintf(ficresfb,"#****** Routine prevbackforecast **\n"); + + for(nres=1; nres <= nresult; nres++) /* For each resultline */ + for(k=1; k<=i1;k++){ + if(i1 != 1 && TKresult[nres]!= k) + continue; + if(invalidvarcomb[k]){ + printf("\nCombination (%d) projection ignored because no cases \n",k); + continue; + } + fprintf(ficresfb,"\n#****** hbijx=probability over h years, hb.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)]); + } + for (k4=1; k4<= nsq; k4++){ /* For each selected (single) quantitative value */ + fprintf(ficresf," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); + } + fprintf(ficresfb," yearbproj age"); + for(j=1; j<=nlstate+ndeath;j++){ + for(i=1; i<=nlstate;i++) + fprintf(ficresfb," b%d%d",i,j); + fprintf(ficresfb," b.%d",j); + } + for (yearp=0; yearp>=(anbackf-anbackd);yearp -=stepsize) { + /* for (yearp=0; yearp<=(anproj2-anproj1);yearp +=stepsize) { */ + fprintf(ficresfb,"\n"); + fprintf(ficresfb,"\n# Back Forecasting at date %.lf/%.lf/%.lf ",jbackd,mbackd,anbackd+yearp); + /* printf("\n# Back Forecasting at date %.lf/%.lf/%.lf ",jback1,mback1,anback1+yearp); */ + /* for (agec=bage; agec<=agemax-1; agec++){ /\* testing *\/ */ + for (agec=bage; agec<=fage; agec++){ /* testing */ + /* We compute bij at age agec over nhstepm, nhstepm decreases when agec increases because of agemax;*/ + nhstepm=(int) (agec-agelim) *YEARM/stepm;/* nhstepm=(int) rint((agec-agelim)*YEARM/stepm);*/ + nhstepm = nhstepm/hstepm; + p3mat=ma3x(1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); + oldm=oldms;savm=savms; + /* computes hbxij at age agec over 1 to nhstepm */ + /* printf("####prevbackforecast debug agec=%.2f nhstepm=%d\n",agec, nhstepm);fflush(stdout); */ + hbxij(p3mat,nhstepm,agec,hstepm,p,prevacurrent,nlstate,stepm, k, nres); + /* hpxij(p3mat,nhstepm,agec,hstepm,p, nlstate,stepm,oldm,savm, k,nres); */ + /* Then we print p3mat for h corresponding to the right agec+h*stepms=yearp */ + /* printf(" agec=%.2f\n",agec);fflush(stdout); */ + for (h=0; h<=nhstepm; h++){ + if (h*hstepm/YEARM*stepm ==-yearp) { + break; + } + } + 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 ",anbackd+yearp,agec-h*hstepm/YEARM*stepm); + for(i=1; i<=nlstate+ndeath;i++) { + ppij=0.;ppi=0.; + for(j=1; j<=nlstate;j++) { + /* if (mobilav==1) */ + ppij=ppij+p3mat[i][j][h]*prevacurrent[(int)agec][j][k]; + ppi=ppi+prevacurrent[(int)agec][j][k]; + /* ppij=ppij+p3mat[i][j][h]*mobaverage[(int)agec][j][k]; */ + /* ppi=ppi+mobaverage[(int)agec][j][k]; */ + /* else { */ + /* ppij=ppij+p3mat[i][j][h]*probs[(int)(agec)][i][k]; */ + /* } */ + fprintf(ficresfb," %.3f", p3mat[i][j][h]); + } /* end j */ + if(ppi <0.99){ + printf("Error in prevbackforecast, prevalence doesn't sum to 1 for state %d: %3f\n",i, ppi); + fprintf(ficlog,"Error in prevbackforecast, prevalence doesn't sum to 1 for state %d: %3f\n",i, ppi); + } + fprintf(ficresfb," %.3f", ppij); + }/* end j */ + free_ma3x(p3mat,1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); + } /* end agec */ + } /* end yearp */ + } /* end k */ + + /* 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"); + +} - if (cptcoveff==0) ncodemax[cptcoveff]=1; +/* Variance of prevalence limit: varprlim */ + void varprlim(char fileresu[], int nresult, double ***prevacurrent, int mobilavproj, double bage, double fage, double **prlim, int *ncvyearp, double ftolpl, double p[], double **matcov, double *delti, int stepm, int cptcoveff){ + /*------- Variance of forward period (stable) prevalence------*/ + + char fileresvpl[FILENAMELENGTH]; + FILE *ficresvpl; + double **oldm, **savm; + double **varpl; /* Variances of prevalence limits by age */ + int i1, k, nres, j ; + + strcpy(fileresvpl,"VPL_"); + strcat(fileresvpl,fileresu); + if((ficresvpl=fopen(fileresvpl,"w"))==NULL) { + printf("Problem with variance of forward period (stable) prevalence resultfile: %s\n", fileresvpl); + exit(0); + } + printf("Computing Variance-covariance of forward period (stable) prevalence: file '%s' ...", fileresvpl);fflush(stdout); + fprintf(ficlog, "Computing Variance-covariance of forward period (stable) prevalence: file '%s' ...", fileresvpl);fflush(ficlog); + + /*for(cptcov=1,k=0;cptcov<=i1;cptcov++){ + for(cptcod=1;cptcod<=ncodemax[cptcov];cptcod++){*/ + + i1=pow(2,cptcoveff); + if (cptcovn < 1){i1=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); + for(nres=1; nres <= nresult; nres++) /* For each resultline */ + for(k=1; k<=i1;k++){ + if(i1 != 1 && TKresult[nres]!= k) + continue; + fprintf(ficresvpl,"\n#****** "); + printf("\n#****** "); + fprintf(ficlog,"\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)]); + } + for (j=1; j<= nsq; j++){ /* For each selected (single) quantitative value */ + printf(" V%d=%f ",Tvqresult[nres][j],Tqresult[nres][j]); + fprintf(ficresvpl," V%d=%f ",Tvqresult[nres][j],Tqresult[nres][j]); + fprintf(ficlog," V%d=%f ",Tvqresult[nres][j],Tqresult[nres][j]); + } + fprintf(ficresvpl,"******\n"); + printf("******\n"); + fprintf(ficlog,"******\n"); + + varpl=matrix(1,nlstate,(int) bage, (int) fage); + oldm=oldms;savm=savms; + varprevlim(fileresvpl, ficresvpl, varpl, matcov, p, delti, nlstate, stepm, (int) bage, (int) fage, oldm, savm, prlim, ftolpl, ncvyearp, k, strstart, nres); + free_matrix(varpl,1,nlstate,(int) bage, (int)fage); + /*}*/ } - } + + fclose(ficresvpl); + printf("done variance-covariance of forward period prevalence\n");fflush(stdout); + fprintf(ficlog,"done variance-covariance of forward period prevalence\n");fflush(ficlog); - stepsize=(int) (stepm+YEARM-1)/YEARM; - if (stepm<=12) stepsize=1; + } +/* Variance of back prevalence: varbprlim */ + void varbprlim(char fileresu[], int nresult, double ***prevacurrent, int mobilavproj, double bage, double fage, double **bprlim, int *ncvyearp, double ftolpl, double p[], double **matcov, double *delti, int stepm, int cptcoveff){ + /*------- Variance of back (stable) prevalence------*/ + + char fileresvbl[FILENAMELENGTH]; + FILE *ficresvbl; + + double **oldm, **savm; + double **varbpl; /* Variances of back prevalence limits by age */ + int i1, k, nres, j ; + + strcpy(fileresvbl,"VBL_"); + strcat(fileresvbl,fileresu); + if((ficresvbl=fopen(fileresvbl,"w"))==NULL) { + printf("Problem with variance of back (stable) prevalence resultfile: %s\n", fileresvbl); + exit(0); + } + printf("Computing Variance-covariance of back (stable) prevalence: file '%s' ...", fileresvbl);fflush(stdout); + fprintf(ficlog, "Computing Variance-covariance of back (stable) prevalence: file '%s' ...", fileresvbl);fflush(ficlog); + + + i1=pow(2,cptcoveff); + if (cptcovn < 1){i1=1;} + + for(nres=1; nres <= nresult; nres++) /* For each resultline */ + for(k=1; k<=i1;k++){ + if(i1 != 1 && TKresult[nres]!= k) + continue; + fprintf(ficresvbl,"\n#****** "); + printf("\n#****** "); + fprintf(ficlog,"\n#****** "); + for(j=1;j<=cptcoveff;j++) { + fprintf(ficresvbl,"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)]); + } + for (j=1; j<= nsq; j++){ /* For each selected (single) quantitative value */ + printf(" V%d=%f ",Tvqresult[nres][j],Tqresult[nres][j]); + fprintf(ficresvbl," V%d=%f ",Tvqresult[nres][j],Tqresult[nres][j]); + fprintf(ficlog," V%d=%f ",Tvqresult[nres][j],Tqresult[nres][j]); + } + fprintf(ficresvbl,"******\n"); + printf("******\n"); + fprintf(ficlog,"******\n"); + + varbpl=matrix(1,nlstate,(int) bage, (int) fage); + oldm=oldms;savm=savms; + + varbrevlim(fileresvbl, ficresvbl, varbpl, matcov, p, delti, nlstate, stepm, (int) bage, (int) fage, oldm, savm, bprlim, ftolpl, mobilavproj, ncvyearp, k, strstart, nres); + free_matrix(varbpl,1,nlstate,(int) bage, (int)fage); + /*}*/ + } + + fclose(ficresvbl); + printf("done variance-covariance of back prevalence\n");fflush(stdout); + fprintf(ficlog,"done variance-covariance of back prevalence\n");fflush(ficlog); + + } /* End of varbprlim */ + +/************** 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){ */ - agelim=AGESUP; +/* int cpt, stepsize, hstepm, nhstepm, j,k,c, cptcod, i,h; */ +/* int *popage; */ +/* double calagedatem, agelim, kk1, kk2; */ +/* double *popeffectif,*popcount; */ +/* double ***p3mat,***tabpop,***tabpopprev; */ +/* /\* double ***mobaverage; *\/ */ +/* char filerespop[FILENAMELENGTH]; */ + +/* 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 (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; */ - hstepm=1; - hstepm=hstepm/stepm; +/* agelim=AGESUP; */ - if (popforecast==1) { - if((ficpop=fopen(popfile,"r"))==NULL) { - printf("Problem with population file : %s\n",popfile);exit(0); - fprintf(ficlog,"Problem with population file : %s\n",popfile);exit(0); - } - popage=ivector(0,AGESUP); - popeffectif=vector(0,AGESUP); - popcount=vector(0,AGESUP); +/* hstepm=1; */ +/* hstepm=hstepm/stepm; */ + +/* if (popforecast==1) { */ +/* if((ficpop=fopen(popfile,"r"))==NULL) { */ +/* printf("Problem with population file : %s\n",popfile);exit(0); */ +/* fprintf(ficlog,"Problem with population file : %s\n",popfile);exit(0); */ +/* } */ +/* popage=ivector(0,AGESUP); */ +/* popeffectif=vector(0,AGESUP); */ +/* popcount=vector(0,AGESUP); */ - i=1; - while ((c=fscanf(ficpop,"%d %lf\n",&popage[i],&popcount[i])) != EOF) i=i+1; - - imx=i; - for (i=1; i=(ageminpar-((int)calagedatem %12)/12.); agedeb--){ - nhstepm=(int) rint((agelim-agedeb)*YEARM/stepm); - nhstepm = nhstepm/hstepm; +/* 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(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); */ +/* oldm=oldms;savm=savms; */ +/* hpxij(p3mat,nhstepm,agedeb,hstepm,p,nlstate,stepm,oldm,savm, k); */ - 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); - } - } - } - } +/* 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); */ +/* 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) { if((fichier=fopen(optionfich,"a"))==NULL) { @@ -5700,36 +9089,42 @@ void prwizard(int ncovmodel, int nlstate /******************* Gompertz Likelihood ******************************/ double gompertz(double x[]) { - double A,B,L=0.0,sump=0.,num=0.; + double A=0.0,B=0.,L=0.0,sump=0.,num=0.; 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+1;*/ num=num+1; } - - + L=0.0; + /* agegomp=AGEGOMP; */ /* for (i=0; i<=imx; i++) if (wav[i]>0) printf("i=%d ageex=%lf agecens=%lf agedc=%lf cens=%d %d\n" ,i,ageexmed[i],agecens[i],agedc[i],cens[i],wav[i]);*/ - for (i=1;i<=imx ; i++) - { - if (cens[i] == 1 && wav[i]>1) - A=-x[1]/(x[2])*(exp(x[2]*(agecens[i]-agegomp))-exp(x[2]*(ageexmed[i]-agegomp))); - - if (cens[i] == 0 && wav[i]>1) + for (i=1;i<=imx ; i++) { + /* mu(a)=mu(agecomp)*exp(teta*(age-agegomp)) + mu(a)=x[1]*exp(x[2]*(age-agegomp)); x[1] and x[2] are per year. + * L= Product mu(agedeces)exp(-\int_ageexam^agedc mu(u) du ) for a death between agedc (in month) + * and agedc +1 month, cens[i]=0: log(x[1]/YEARM) + * + + * exp(-\int_ageexam^agecens mu(u) du ) when censored, cens[i]=1 + */ + if (wav[i] > 1 || agedc[i] < AGESUP) { + if (cens[i] == 1){ + A=-x[1]/(x[2])*(exp(x[2]*(agecens[i]-agegomp))-exp(x[2]*(ageexmed[i]-agegomp))); + } else if (cens[i] == 0){ A=-x[1]/(x[2])*(exp(x[2]*(agedc[i]-agegomp))-exp(x[2]*(ageexmed[i]-agegomp))) - +log(x[1]/YEARM)+x[2]*(agedc[i]-agegomp)+log(YEARM); - + +log(x[1]/YEARM) +x[2]*(agedc[i]-agegomp)+log(YEARM); + } else + printf("Gompertz cens[%d] neither 1 nor 0\n",i); /*if (wav[i] > 1 && agecens[i] > 15) {*/ /* ??? */ - if (wav[i] > 1 ) { /* ??? */ - L=L+A*weight[i]; + L=L+A*weight[i]; /* printf("\ni=%d A=%f L=%lf x[1]=%lf x[2]=%lf ageex=%lf agecens=%lf cens=%d agedc=%lf weight=%lf\n",i,A,L,x[1],x[2],ageexmed[i]*12,agecens[i]*12,cens[i],agedc[i]*12,weight[i]);*/ - } - } + } + } - /*printf("x1=%2.9f x2=%2.9f x3=%2.9f L=%f\n",x[1],x[2],x[3],L);*/ + /*printf("x1=%2.9f x2=%2.9f x3=%2.9f L=%f\n",x[1],x[2],x[3],L);*/ return -2*L*num/sump; } @@ -5738,7 +9133,7 @@ double gompertz(double x[]) /******************* Gompertz_f Likelihood ******************************/ double gompertz_f(const gsl_vector *v, void *params) { - double A,B,LL=0.0,sump=0.,num=0.; + double A=0.,B=0.,LL=0.0,sump=0.,num=0.; double *x= (double *) v->data; int i,n=0; /* n is the size of the sample */ @@ -5828,21 +9223,90 @@ int readdata(char datafile[], int firsto /*-------- data file ----------*/ FILE *fic; char dummy[]=" "; - int i=0, j=0, n=0; + int i=0, j=0, n=0, iv=0, v; + int lstra; int linei, month, year,iout; + int noffset=0; /* This is the offset if BOM data file */ char line[MAXLINE], linetmp[MAXLINE]; char stra[MAXLINE], strb[MAXLINE]; char *stratrunc; - int lstra; + DummyV=ivector(1,NCOVMAX); /* 1 to 3 */ + FixedV=ivector(1,NCOVMAX); /* 1 to 3 */ + + for(v=1; v <=ncovcol;v++){ + DummyV[v]=0; + FixedV[v]=0; + } + for(v=ncovcol+1; v <=ncovcol+nqv;v++){ + DummyV[v]=1; + FixedV[v]=0; + } + for(v=ncovcol+nqv+1; v <=ncovcol+nqv+ntv;v++){ + DummyV[v]=0; + FixedV[v]=1; + } + for(v=ncovcol+nqv+ntv+1; v <=ncovcol+nqv+ntv+nqtv;v++){ + DummyV[v]=1; + FixedV[v]=1; + } + for(v=1; v <=ncovcol+nqv+ntv+nqtv;v++){ + printf("Covariate type in the data: V%d, DummyV(V%d)=%d, FixedV(V%d)=%d\n",v,v,DummyV[v],v,FixedV[v]); + fprintf(ficlog,"Covariate type in the data: V%d, DummyV(V%d)=%d, FixedV(V%d)=%d\n",v,v,DummyV[v],v,FixedV[v]); + } + + if((fic=fopen(datafile,"r"))==NULL) { + printf("Problem while opening datafile: %s with errno='%s'\n", datafile,strerror(errno));fflush(stdout); + fprintf(ficlog,"Problem while opening datafile: %s with errno='%s'\n", datafile,strerror(errno));fflush(ficlog);return 1; + } + /* Is it a BOM UTF-8 Windows file? */ + /* First data line */ + linei=0; + while(fgets(line, MAXLINE, fic)) { + noffset=0; + if( line[0] == (char)0xEF && line[1] == (char)0xBB) /* EF BB BF */ + { + noffset=noffset+3; + printf("# Data file '%s' is an UTF8 BOM file, please convert to UTF8 or ascii file and rerun.\n",datafile);fflush(stdout); + fprintf(ficlog,"# Data file '%s' is an UTF8 BOM file, please convert to UTF8 or ascii file and rerun.\n",datafile); + fflush(ficlog); return 1; + } + /* else if( line[0] == (char)0xFE && line[1] == (char)0xFF)*/ + else if( line[0] == (char)0xFF && line[1] == (char)0xFE) + { + noffset=noffset+2; + printf("# Error Data file '%s' is a huge UTF16BE BOM file, please convert to UTF8 or ascii file (for example with dos2unix) and rerun.\n",datafile);fflush(stdout); + fprintf(ficlog,"# Error Data file '%s' is a huge UTF16BE BOM file, please convert to UTF8 or ascii file (for example with dos2unix) and rerun.\n",datafile); + fflush(ficlog); return 1; + } + else if( line[0] == 0 && line[1] == 0) + { + if( line[2] == (char)0xFE && line[3] == (char)0xFF){ + noffset=noffset+4; + printf("# Error Data file '%s' is a huge UTF16BE BOM file, please convert to UTF8 or ascii file (for example with dos2unix) and rerun.\n",datafile);fflush(stdout); + fprintf(ficlog,"# Error Data file '%s' is a huge UTF16BE BOM file, please convert to UTF8 or ascii file (for example with dos2unix) and rerun.\n",datafile); + fflush(ficlog); return 1; + } + } else{ + ;/*printf(" Not a BOM file\n");*/ + } + /* If line starts with a # it is a comment */ + if (line[noffset] == '#') { + linei=linei+1; + break; + }else{ + break; + } + } + fclose(fic); if((fic=fopen(datafile,"r"))==NULL) { - printf("Problem while opening datafile: %s\n", datafile);fflush(stdout); - fprintf(ficlog,"Problem while opening datafile: %s\n", datafile);fflush(ficlog);return 1; + printf("Problem while opening datafile: %s with errno='%s'\n", datafile,strerror(errno));fflush(stdout); + fprintf(ficlog,"Problem while opening datafile: %s with errno='%s'\n", datafile,strerror(errno));fflush(ficlog);return 1; } - + /* Not a Bom file */ + i=1; - linei=0; while ((fgets(line, MAXLINE, fic) != NULL) &&((i >= firstobs) && (i <=lastobs))) { linei=linei+1; for(j=strlen(line); j>=0;j--){ /* Untabifies line */ @@ -5860,24 +9324,96 @@ int readdata(char datafile[], int firsto } trimbb(linetmp,line); /* Trims multiple blanks in line */ strcpy(line, linetmp); - - + + /* Loops on waves */ 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 */ + cotvar[j][ntv+iv][i]=-1; /* For performance reasons */ + 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; + cotvar[j][ntv+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, ' '); - if(strb[0]=='.') { /* Missing status */ + 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 (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 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); return 1; } } + s[j][i]=lval; + /* Date of Interview */ strcpy(line,stra); cutv(stra, strb,line,' '); if( (iout=sscanf(strb,"%d/%d",&month, &year)) != 0){ @@ -5891,10 +9427,15 @@ int readdata(char datafile[], int firsto return 1; } anint[j][i]= (double) year; - mint[j][i]= (double)month; + mint[j][i]= (double)month; + /* if( (int)anint[j][i]+ (int)(mint[j][i])/12. < (int) (moisnais[i]/12.+annais[i])){ */ + /* printf("Warning reading data around '%s' at line number %d for individual %d, '%s'\nThe date of interview (%2d/%4d) at wave %d occurred before the date of birth (%2d/%4d).\n",strb, linei,i, line, mint[j][i],anint[j][i], moisnais[i],annais[i]); */ + /* fprintf(ficlog,"Warning reading data around '%s' at line number %d for individual %d, '%s'\nThe date of interview (%2d/%4d) at wave %d occurred before the date of birth (%2d/%4d).\n",strb, linei,i, line, mint[j][i],anint[j][i], moisnais[i],annais[i]); */ + /* } */ strcpy(line,stra); - } /* ENd Waves */ + } /* End loop on waves */ + /* Date of death */ cutv(stra, strb,line,' '); if( (iout=sscanf(strb,"%d/%d",&month, &year)) != 0){ } @@ -5903,13 +9444,14 @@ int readdata(char datafile[], int firsto year=9999; }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); - 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; + 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; } andc[i]=(double) year; moisdc[i]=(double) month; strcpy(line,stra); + /* Date of birth */ cutv(stra, strb,line,' '); if( (iout=sscanf(strb,"%d/%d",&month, &year)) != 0){ } @@ -5919,18 +9461,26 @@ int readdata(char datafile[], int firsto }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); 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) { 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); - return 1; - + return 1; + } annais[i]=(double)(year); - moisnais[i]=(double)(month); + moisnais[i]=(double)(month); + for (j=1;j<=maxwav;j++){ + if( (int)anint[j][i]+ (int)(mint[j][i])/12. < (int) (moisnais[i]/12.+annais[i])){ + printf("Warning reading data around '%s' at line number %d for individual %d, '%s'\nThe date of interview (%2d/%4d) at wave %d occurred before the date of birth (%2d/%4d).\n",strb, linei,i, line, (int)mint[j][i],(int)anint[j][i], j,(int)moisnais[i],(int)annais[i]); + fprintf(ficlog,"Warning reading data around '%s' at line number %d for individual %d, '%s'\nThe date of interview (%2d/%4d) at wave %d occurred before the date of birth (%2d/%4d).\n",strb, linei,i, line, (int)mint[j][i],(int)anint[j][i], j, (int)moisnais[i],(int)annais[i]); + } + } + strcpy(line,stra); + /* Sample weight */ cutv(stra, strb,line,' '); errno=0; dval=strtod(strb,&endptr); @@ -5943,9 +9493,32 @@ int readdata(char datafile[], int firsto weight[i]=dval; 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--){ cutv(stra, strb,line,' '); - if(strb[0]=='.') { /* Missing status */ + if(strb[0]=='.') { /* Missing covariate value */ lval=-1; }else{ errno=0; @@ -5960,20 +9533,20 @@ int readdata(char datafile[], int firsto 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 \ + 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 \ + 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 \ + 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 \ + output of IMaCh is often meaningless.\n \ Exiting.\n",lval,linei, i,line,j);fflush(ficlog); return 1; } @@ -5981,7 +9554,7 @@ int readdata(char datafile[], int firsto strcpy(line,stra); } lstra=strlen(stra); - + if(lstra > 9){ /* More than 2**32 or max of what printf can write with %ld */ stratrunc = &(stra[lstra-9]); num[i]=atol(stratrunc); @@ -5993,44 +9566,169 @@ int readdata(char datafile[], int firsto i=i+1; } /* End loop reading data */ - + *imax=i-1; /* Number of individuals */ fclose(fic); - + return (0); /* endread: */ - printf("Exiting readdata: "); - fclose(fic); - return (1); + printf("Exiting readdata: "); + fclose(fic); + return (1); +} +void removefirstspace(char **stri){/*, char stro[]) {*/ + char *p1 = *stri, *p2 = *stri; + while (*p2 == ' ') + p2++; + /* while ((*p1++ = *p2++) !=0) */ + /* ; */ + /* do */ + /* while (*p2 == ' ') */ + /* p2++; */ + /* while (*p1++ == *p2++); */ + *stri=p2; +} + +int decoderesult ( char resultline[], int nres) +/**< This routine decode one result line and returns the combination # of dummy covariates only **/ +{ + int j=0, k=0, k1=0, k2=0, k3=0, k4=0, match=0, k2q=0, k3q=0, k4q=0; + char resultsav[MAXLINE]; + int resultmodel[MAXLINE]; + int modelresult[MAXLINE]; + char stra[80], strb[80], strc[80], strd[80],stre[80]; + removefirstspace(&resultline); + if (strstr(resultline,"v") !=0){ + printf("Error. 'v' must be in upper case 'V' result: %s ",resultline); + fprintf(ficlog,"Error. 'v' must be in upper case result: %s ",resultline);fflush(ficlog); + return 1; + } + trimbb(resultsav, resultline); + if (strlen(resultsav) >1){ + j=nbocc(resultsav,'='); /**< j=Number of covariate values'=' */ + } + if(j == 0){ /* Resultline but no = */ + TKresult[nres]=0; /* Combination for the nresult and the model */ + return (0); + } + if( j != cptcovs ){ /* Be careful if a variable is in a product but not single */ + printf("ERROR: the number of variable in the resultline, %d, differs from the number of variable used in the model line, %d.\n",j, cptcovs); + fprintf(ficlog,"ERROR: the number of variable in the resultline, %d, differs from the number of variable used in the model line, %d.\n",j, cptcovs); + } + for(k=1; k<=j;k++){ /* Loop on any covariate of the result line */ + if(nbocc(resultsav,'=') >1){ + cutl(stra,strb,resultsav,' '); /* keeps in strb after the first ' ' + resultsav= V4=1 V5=25.1 V3=0 strb=V3=0 stra= V4=1 V5=25.1 */ + cutl(strc,strd,strb,'='); /* strb:V4=1 strc=1 strd=V4 */ + }else + cutl(strc,strd,resultsav,'='); + Tvalsel[k]=atof(strc); /* 1 */ + + cutl(strc,stre,strd,'V'); /* strd='V4' strc=4 stre='V' */; + Tvarsel[k]=atoi(strc); + /* Typevarsel[k]=1; /\* 1 for age product *\/ */ + /* cptcovsel++; */ + if (nbocc(stra,'=') >0) + strcpy(resultsav,stra); /* and analyzes it */ + } + /* Checking for missing or useless values in comparison of current model needs */ + for(k1=1; k1<= cptcovt ;k1++){ /* model line V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ + if(Typevar[k1]==0){ /* Single covariate in model */ + match=0; + for(k2=1; k2 <=j;k2++){/* result line V4=1 V5=24.1 V3=1 V2=8 V1=0 */ + if(Tvar[k1]==Tvarsel[k2]) {/* Tvar[1]=5 == Tvarsel[2]=5 */ + modelresult[k2]=k1;/* modelresult[2]=1 modelresult[1]=2 modelresult[3]=3 modelresult[6]=4 modelresult[9]=5 */ + match=1; + break; + } + } + if(match == 0){ + printf("Error in result line: %d value missing; result: %s, model=%s\n",k1, resultline, model); + } + } + } + /* Checking for missing or useless values in comparison of current model needs */ + for(k2=1; k2 <=j;k2++){ /* result line V4=1 V5=24.1 V3=1 V2=8 V1=0 */ + match=0; + for(k1=1; k1<= cptcovt ;k1++){ /* model line V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ + if(Typevar[k1]==0){ /* Single */ + if(Tvar[k1]==Tvarsel[k2]) { /* Tvar[2]=4 == Tvarsel[1]=4 */ + resultmodel[k1]=k2; /* resultmodel[2]=1 resultmodel[1]=2 resultmodel[3]=3 resultmodel[6]=4 resultmodel[9]=5 */ + ++match; + } + } + } + if(match == 0){ + printf("Error in result line: %d value missing; result: %s, model=%s\n",k1, resultline, model); + }else if(match > 1){ + printf("Error in result line: %d doubled; result: %s, model=%s\n",k2, resultline, model); + } + } + + /* We need to deduce which combination number is chosen and save quantitative values */ + /* model line V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ + /* result line V4=1 V5=25.1 V3=0 V2=8 V1=1 */ + /* should give a combination of dummy V4=1, V3=0, V1=1 => V4*2**(0) + V3*2**(1) + V1*2**(2) = 5 + (1offset) = 6*/ + /* result line V4=1 V5=24.1 V3=1 V2=8 V1=0 */ + /* should give a combination of dummy V4=1, V3=1, V1=0 => V4*2**(0) + V3*2**(1) + V1*2**(2) = 3 + (1offset) = 4*/ + /* 1 0 0 0 */ + /* 2 1 0 0 */ + /* 3 0 1 0 */ + /* 4 1 1 0 */ /* V4=1, V3=1, V1=0 */ + /* 5 0 0 1 */ + /* 6 1 0 1 */ /* V4=1, V3=0, V1=1 */ + /* 7 0 1 1 */ + /* 8 1 1 1 */ + /* V(Tvresult)=Tresult V4=1 V3=0 V1=1 Tresult[nres=1][2]=0 */ + /* V(Tvqresult)=Tqresult V5=25.1 V2=8 Tqresult[nres=1][1]=25.1 */ + /* V5*age V5 known which value for nres? */ + /* Tqinvresult[2]=8 Tqinvresult[1]=25.1 */ + for(k1=1, k=0, k4=0, k4q=0; k1 <=cptcovt;k1++){ /* model line */ + if( Dummy[k1]==0 && Typevar[k1]==0 ){ /* Single dummy */ + k3= resultmodel[k1]; /* resultmodel[2(V4)] = 1=k3 */ + k2=(int)Tvarsel[k3]; /* Tvarsel[resultmodel[2]]= Tvarsel[1] = 4=k2 */ + k+=Tvalsel[k3]*pow(2,k4); /* Tvalsel[1]=1 */ + Tresult[nres][k4+1]=Tvalsel[k3];/* Tresult[nres][1]=1(V4=1) Tresult[nres][2]=0(V3=0) */ + Tvresult[nres][k4+1]=(int)Tvarsel[k3];/* Tvresult[nres][1]=4 Tvresult[nres][3]=1 */ + Tinvresult[nres][(int)Tvarsel[k3]]=Tvalsel[k3]; /* Tinvresult[nres][4]=1 */ + printf("Decoderesult Dummy k=%d, V(k2=V%d)= Tvalsel[%d]=%d, 2**(%d)\n",k, k2, k3, (int)Tvalsel[k3], k4); + k4++;; + } else if( Dummy[k1]==1 && Typevar[k1]==0 ){ /* Single quantitative */ + k3q= resultmodel[k1]; /* resultmodel[2] = 1=k3 */ + k2q=(int)Tvarsel[k3q]; /* Tvarsel[resultmodel[2]]= Tvarsel[1] = 4=k2 */ + Tqresult[nres][k4q+1]=Tvalsel[k3q]; /* Tqresult[nres][1]=25.1 */ + Tvqresult[nres][k4q+1]=(int)Tvarsel[k3q]; /* Tvqresult[nres][1]=5 */ + Tqinvresult[nres][(int)Tvarsel[k3q]]=Tvalsel[k3q]; /* Tqinvresult[nres][5]=25.1 */ + printf("Decoderesult Quantitative nres=%d, V(k2q=V%d)= Tvalsel[%d]=%d, Tvarsel[%d]=%f\n",nres, k2q, k3q, Tvarsel[k3q], k3q, Tvalsel[k3q]); + k4q++;; + } + } + + TKresult[nres]=++k; /* Combination for the nresult and the model */ + return (0); } -void removespace(char *str) { - char *p1 = str, *p2 = str; - do - while (*p2 == ' ') - p2++; - while (*p1++ == *p2++); -} - -int decodemodel ( char model[], int lastobs) /**< This routine decode the model and returns: - * Model V1+V2+V3+V8+V7*V8+V5*V6+V8*age+V3*age+age*age - * - nagesqr = 1 if age*age in the model, otherwise 0. - * - cptcovt total number of covariates of the model nbocc(+)+1 = 8 excepting constant and age and age*age - * - cptcovn or number of covariates k of the models excluding age*products =6 and age*age - * - cptcovage number of covariates with age*products =2 - * - cptcovs number of simple covariates - * - 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 - * which is a new column after the 9 (ncovcol) variables. - * - if k is a product Vn*Vm covar[k][i] is filled with correct values for each individual - * - Tprod[l] gives the kth covariates of the product Vn*Vm l=1 to cptcovprod-cptcovage - * 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 decodemodel( char model[], int lastobs) + /**< This routine decodes the model and returns: + * Model V1+V2+V3+V8+V7*V8+V5*V6+V8*age+V3*age+age*age + * - nagesqr = 1 if age*age in the model, otherwise 0. + * - cptcovt total number of covariates of the model nbocc(+)+1 = 8 excepting constant and age and age*age + * - cptcovn or number of covariates k of the models excluding age*products =6 and age*age + * - cptcovage number of covariates with age*products =2 + * - cptcovs number of simple covariates + * - 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 + * which is a new column after the 9 (ncovcol) variables. + * - if k is a product Vn*Vm covar[k][i] is filled with correct values for each individual + * - Tprod[l] gives the kth covariates of the product Vn*Vm l=1 to cptcovprod-cptcovage + * 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 j1, k1, k2; + int i, j, k, ks, v; + int j1, k1, k2, k3, k4; char modelsav[80]; char stra[80], strb[80], strc[80], strd[80],stre[80]; char *strpt; @@ -6052,15 +9750,14 @@ int decodemodel ( char model[], int last if ((strpt=strstr(model,"age*age")) !=0){ printf(" strpt=%s, model=%s\n",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 \ 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 \ corresponding column of parameters.\n",model); fflush(ficlog); - return 1; - } - + return 1; + } nagesqr=1; if (strstr(model,"+age*age") !=0) substrchaine(modelsav, model, "+age*age"); @@ -6073,17 +9770,17 @@ int decodemodel ( char model[], int last if (strlen(modelsav) >1){ j=nbocc(modelsav,'+'); /**< j=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 - * cst, age and age*age - * V1+V1*age+ V3 + V3*V4+age*age=> 4*/ - /* including age products which are counted in cptcovage. - * but the covariates which are products must be treated - * separately: ncovn=4- 2=2 (V1+V3). */ + * cst, age and age*age + * V1+V1*age+ V3 + V3*V4+age*age=> 3+1=4*/ + /* including age products which are counted in cptcovage. + * but the covariates which are products must be treated + * separately: ncovn=4- 2=2 (V1+V3). */ cptcovprod=j1; /**< Number of products V1*V2 +v3*age = 2 */ cptcovprodnoage=0; /**< Number of covariate products without age: V3*V4 =1 */ - - + + /* Design * V1 V2 V3 V4 V5 V6 V7 V8 V9 Weight * < ncovcol=8 > @@ -6091,8 +9788,8 @@ int decodemodel ( char model[], int last * k= 1 2 3 4 5 6 7 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[1][i]= (V2), covar[4][i]=(V3), covar[8][i]=(V8) - * Tvar[k] # of the kth covariate: Tvar[1]=2 Tvar[4]=3 Tvar[8]=8 + * covar[1][i]= (V1), covar[4][i]=(V4), covar[8][i]=(V8) + * 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 * Tage[++cptcovage]=k * if products, new covar are created after ncovcol with k1 @@ -6117,7 +9814,7 @@ int decodemodel ( char model[], int last * {2, 1, 4, 8, 5, 6, 3, 7} * Struct [] */ - + /* 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 */ /* modelsav=V2+V1+V4+age*V3 strb=age*V3 stra=V2+V1+V4 */ @@ -6132,8 +9829,9 @@ 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]; */ /* * 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 */ - Tvar[k]=0; + for(k=cptcovt; k>=1;k--){ /**< Number of covariates not including constant and age, neither age*age*/ + Tvar[k]=0; Tprod[k]=0; Tposprod[k]=0; + } cptcovage=0; for(k=1; k<=cptcovt;k++){ /* Loop on total covariates of the model */ cutl(stra,strb,modelsav,'+'); /* keeps in strb after the first '+' @@ -6148,6 +9846,7 @@ int decodemodel ( char model[], int last cptcovprod--; 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 */ + Typevar[k]=1; /* 1 for age 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 */ /*printf("stre=%s ", stre);*/ @@ -6155,6 +9854,7 @@ int decodemodel ( char model[], int last cptcovprod--; cutl(stre,strb,strc,'V'); Tvar[k]=atoi(stre); + Typevar[k]=1; /* 1 for age product */ cptcovage++; Tage[cptcovage]=k; } else { /* Age is not in the model product V2+V1+V1*V4+V3*age+V3*V2 strb=V3*V2*/ @@ -6162,18 +9862,22 @@ int decodemodel ( char model[], int last cptcovn++; cptcovprodnoage++;k1++; 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 - because this model-covariate is a construction we invent a new column - ncovcol + k1 - 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[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 + which is after existing variables ncovcol+nqv+ntv+nqtv + k1 + 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 */ + Typevar[k]=2; /* 2 for double fixed dummy covariates */ 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 */ + Tposprod[k]=k1; /* Tpsprod[3]=1, Tposprod[2]=5 */ Tvard[k1][1] =atoi(strc); /* m 1 for V1*/ Tvard[k1][2] =atoi(stre); /* n 4 for V4*/ - k2=k2+2; - 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) */ + 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+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++){ /* 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 */ @@ -6185,54 +9889,356 @@ int decodemodel ( char model[], int last /*printf("d=%s c=%s b=%s\n", strd,strc,strb);*/ /* scanf("%d",i);*/ cutl(strd,strc,strb,'V'); - ks++; /**< Number of simple covariates */ - cptcovn++; + ks++; /**< Number of simple covariates dummy or quantitative, fixe or varying */ + cptcovn++; /** V4+V3+V5: V4 and V3 timevarying dummy covariates, V5 timevarying quantitative */ Tvar[k]=atoi(strd); + Typevar[k]=0; /* 0 for simple covariates */ } strcpy(modelsav,stra); /* modelsav=V2+V1+V4 stra=V2+V1+V4 */ - /*printf("a=%s b=%s sav=%s\n", stra,strb,modelsav); - scanf("%d",i);*/ + /*printf("a=%s b=%s sav=%s\n", stra,strb,modelsav); + scanf("%d",i);*/ } /* end of loop + on total covariates */ } /* end if strlen(modelsave == 0) age*age might exist */ } /* 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. 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("cptcovprod=%d ", cptcovprod); - fprintf(ficlog,"cptcovprod=%d ", cptcovprod); - - scanf("%d ",i);*/ - - + printf("cptcovprod=%d ", cptcovprod); + fprintf(ficlog,"cptcovprod=%d ", cptcovprod); + scanf("%d ",i);*/ + + +/* Until here, 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. But we know the # of each. */ +/* 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;k<=cptcovt; k++){ Fixed[k]=0; Dummy[k]=0;} + for(k=1, ncovf=0, nsd=0, nsq=0, ncovv=0, ncova=0, ncoveff=0, nqfveff=0, ntveff=0, nqtveff=0;k<=cptcovt; k++){ /* or cptocvt */ + if (Tvar[k] <=ncovcol && Typevar[k]==0 ){ /* Simple fixed dummy (<=ncovcol) covariates */ + Fixed[k]= 0; + Dummy[k]= 0; + ncoveff++; + ncovf++; + nsd++; + modell[k].maintype= FTYPE; + TvarsD[nsd]=Tvar[k]; + TvarsDind[nsd]=k; + TvarF[ncovf]=Tvar[k]; + TvarFind[ncovf]=k; + TvarFD[ncoveff]=Tvar[k]; /* TvarFD[1]=V1 in V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ + TvarFDind[ncoveff]=k; /* TvarFDind[1]=9 in V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ + }else if( Tvar[k] <=ncovcol && Typevar[k]==2){ /* Product of fixed dummy (<=ncovcol) covariates */ + Fixed[k]= 0; + Dummy[k]= 0; + ncoveff++; + ncovf++; + modell[k].maintype= FTYPE; + TvarF[ncovf]=Tvar[k]; + TvarFind[ncovf]=k; + TvarFD[ncoveff]=Tvar[k]; /* TvarFD[1]=V1 in V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ + TvarFDind[ncoveff]=k; /* TvarFDind[1]=9 in V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ + }else if( Tvar[k] <=ncovcol+nqv && Typevar[k]==0){/* Remind that product Vn*Vm are added in k Only simple fixed quantitative variable */ + Fixed[k]= 0; + Dummy[k]= 1; + nqfveff++; + modell[k].maintype= FTYPE; + modell[k].subtype= FQ; + nsq++; + TvarsQ[nsq]=Tvar[k]; + TvarsQind[nsq]=k; + ncovf++; + TvarF[ncovf]=Tvar[k]; + TvarFind[ncovf]=k; + TvarFQ[nqfveff]=Tvar[k]-ncovcol; /* TvarFQ[1]=V2-1=1st in V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ /* Only simple fixed quantitative variable */ + TvarFQind[nqfveff]=k; /* TvarFQind[1]=6 in V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ /* Only simple fixed quantitative variable */ + }else if( Tvar[k] <=ncovcol+nqv+ntv && Typevar[k]==0){/* Only simple time varying dummy variables */ + Fixed[k]= 1; + Dummy[k]= 0; + ntveff++; /* Only simple time varying dummy variable */ + modell[k].maintype= VTYPE; + modell[k].subtype= VD; + nsd++; + TvarsD[nsd]=Tvar[k]; + TvarsDind[nsd]=k; + ncovv++; /* Only simple time varying variables */ + TvarV[ncovv]=Tvar[k]; + TvarVind[ncovv]=k; /* TvarVind[2]=2 TvarVind[3]=3 in V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ /* Any time varying singele */ + TvarVD[ntveff]=Tvar[k]; /* TvarVD[1]=V4 TvarVD[2]=V3 in V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ /* Only simple time varying dummy variable */ + TvarVDind[ntveff]=k; /* TvarVDind[1]=2 TvarVDind[2]=3 in V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ /* Only simple time varying dummy variable */ + printf("Quasi Tmodelind[%d]=%d,Tvar[Tmodelind[%d]]=V%d, ncovcol=%d, nqv=%d,Tvar[k]- ncovcol-nqv=%d\n",ntveff,k,ntveff,Tvar[k], ncovcol, nqv,Tvar[k]- ncovcol-nqv); + printf("Quasi TmodelInvind[%d]=%d\n",k,Tvar[k]- ncovcol-nqv); + }else if( Tvar[k] <=ncovcol+nqv+ntv+nqtv && Typevar[k]==0){ /* Only simple time varying quantitative variable V5*/ + Fixed[k]= 1; + Dummy[k]= 1; + nqtveff++; + modell[k].maintype= VTYPE; + modell[k].subtype= VQ; + ncovv++; /* Only simple time varying variables */ + nsq++; + TvarsQ[nsq]=Tvar[k]; + TvarsQind[nsq]=k; + TvarV[ncovv]=Tvar[k]; + TvarVind[ncovv]=k; /* TvarVind[1]=1 in V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ /* Any time varying singele */ + TvarVQ[nqtveff]=Tvar[k]; /* TvarVQ[1]=V5 in V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ /* Only simple time varying quantitative variable */ + TvarVQind[nqtveff]=k; /* TvarVQind[1]=1 in V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ /* Only simple time varying quantitative variable */ + TmodelInvQind[nqtveff]=Tvar[k]- ncovcol-nqv-ntv;/* Only simple time varying quantitative variable */ + /* Tmodeliqind[k]=nqtveff;/\* Only simple time varying quantitative variable *\/ */ + printf("Quasi TmodelQind[%d]=%d,Tvar[TmodelQind[%d]]=V%d, ncovcol=%d, nqv=%d, ntv=%d,Tvar[k]- ncovcol-nqv-ntv=%d\n",nqtveff,k,nqtveff,Tvar[k], ncovcol, nqv, ntv, Tvar[k]- ncovcol-nqv-ntv); + printf("Quasi TmodelInvQind[%d]=%d\n",k,Tvar[k]- ncovcol-nqv-ntv); + }else if (Typevar[k] == 1) { /* product with age */ + ncova++; + TvarA[ncova]=Tvar[k]; + TvarAind[ncova]=k; + if (Tvar[k] <=ncovcol ){ /* Product age with fixed dummy covariatee */ + Fixed[k]= 2; + Dummy[k]= 2; + modell[k].maintype= ATYPE; + modell[k].subtype= APFD; + /* ncoveff++; */ + }else if( Tvar[k] <=ncovcol+nqv) { /* Remind that product Vn*Vm are added in k*/ + Fixed[k]= 2; + Dummy[k]= 3; + modell[k].maintype= ATYPE; + modell[k].subtype= APFQ; /* Product age * fixed quantitative */ + /* nqfveff++; /\* Only simple fixed quantitative variable *\/ */ + }else if( Tvar[k] <=ncovcol+nqv+ntv ){ + Fixed[k]= 3; + Dummy[k]= 2; + modell[k].maintype= ATYPE; + modell[k].subtype= APVD; /* Product age * varying dummy */ + /* ntveff++; /\* Only simple time varying dummy variable *\/ */ + }else if( Tvar[k] <=ncovcol+nqv+ntv+nqtv){ + Fixed[k]= 3; + Dummy[k]= 3; + modell[k].maintype= ATYPE; + modell[k].subtype= APVQ; /* Product age * varying quantitative */ + /* 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; + modell[k].maintype= FTYPE; + modell[k].subtype= FPDD; /* Product fixed dummy * fixed dummy */ + ncovf++; /* Fixed variables without age */ + TvarF[ncovf]=Tvar[k]; + TvarFind[ncovf]=k; + }else if(Tvard[k1][2] <=ncovcol+nqv){ + Fixed[k]= 0; /* or 2 ?*/ + Dummy[k]= 1; + modell[k].maintype= FTYPE; + modell[k].subtype= FPDQ; /* Product fixed dummy * fixed quantitative */ + ncovf++; /* Varying variables without age */ + TvarF[ncovf]=Tvar[k]; + TvarFind[ncovf]=k; + }else if(Tvard[k1][2] <=ncovcol+nqv+ntv){ + Fixed[k]= 1; + Dummy[k]= 0; + modell[k].maintype= VTYPE; + modell[k].subtype= VPDD; /* Product fixed dummy * varying dummy */ + ncovv++; /* Varying variables without age */ + TvarV[ncovv]=Tvar[k]; + TvarVind[ncovv]=k; + }else if(Tvard[k1][2] <=ncovcol+nqv+ntv+nqtv){ + Fixed[k]= 1; + Dummy[k]= 1; + modell[k].maintype= VTYPE; + modell[k].subtype= VPDQ; /* Product fixed dummy * varying quantitative */ + ncovv++; /* Varying variables without age */ + TvarV[ncovv]=Tvar[k]; + TvarVind[ncovv]=k; + } + }else if(Tvard[k1][1] <=ncovcol+nqv){ + if(Tvard[k1][2] <=ncovcol){ + Fixed[k]= 0; /* or 2 ?*/ + Dummy[k]= 1; + modell[k].maintype= FTYPE; + modell[k].subtype= FPDQ; /* Product fixed quantitative * fixed dummy */ + ncovf++; /* Fixed variables without age */ + TvarF[ncovf]=Tvar[k]; + TvarFind[ncovf]=k; + }else if(Tvard[k1][2] <=ncovcol+nqv+ntv){ + Fixed[k]= 1; + Dummy[k]= 1; + modell[k].maintype= VTYPE; + modell[k].subtype= VPDQ; /* Product fixed quantitative * varying dummy */ + ncovv++; /* Varying variables without age */ + TvarV[ncovv]=Tvar[k]; + TvarVind[ncovv]=k; + }else if(Tvard[k1][2] <=ncovcol+nqv+ntv+nqtv){ + Fixed[k]= 1; + Dummy[k]= 1; + modell[k].maintype= VTYPE; + modell[k].subtype= VPQQ; /* Product fixed quantitative * varying quantitative */ + ncovv++; /* Varying variables without age */ + TvarV[ncovv]=Tvar[k]; + TvarVind[ncovv]=k; + ncovv++; /* Varying variables without age */ + TvarV[ncovv]=Tvar[k]; + TvarVind[ncovv]=k; + } + }else if(Tvard[k1][1] <=ncovcol+nqv+ntv){ + if(Tvard[k1][2] <=ncovcol){ + Fixed[k]= 1; + Dummy[k]= 1; + modell[k].maintype= VTYPE; + modell[k].subtype= VPDD; /* Product time varying dummy * fixed dummy */ + ncovv++; /* Varying variables without age */ + TvarV[ncovv]=Tvar[k]; + TvarVind[ncovv]=k; + }else if(Tvard[k1][2] <=ncovcol+nqv){ + Fixed[k]= 1; + Dummy[k]= 1; + modell[k].maintype= VTYPE; + modell[k].subtype= VPDQ; /* Product time varying dummy * fixed quantitative */ + ncovv++; /* Varying variables without age */ + TvarV[ncovv]=Tvar[k]; + TvarVind[ncovv]=k; + }else if(Tvard[k1][2] <=ncovcol+nqv+ntv){ + Fixed[k]= 1; + Dummy[k]= 0; + modell[k].maintype= VTYPE; + modell[k].subtype= VPDD; /* Product time varying dummy * time varying dummy */ + ncovv++; /* Varying variables without age */ + TvarV[ncovv]=Tvar[k]; + TvarVind[ncovv]=k; + }else if(Tvard[k1][2] <=ncovcol+nqv+ntv+nqtv){ + Fixed[k]= 1; + Dummy[k]= 1; + modell[k].maintype= VTYPE; + modell[k].subtype= VPDQ; /* Product time varying dummy * time varying quantitative */ + ncovv++; /* Varying variables without age */ + TvarV[ncovv]=Tvar[k]; + TvarVind[ncovv]=k; + } + }else if(Tvard[k1][1] <=ncovcol+nqv+ntv+nqtv){ + if(Tvard[k1][2] <=ncovcol){ + Fixed[k]= 1; + Dummy[k]= 1; + modell[k].maintype= VTYPE; + modell[k].subtype= VPDQ; /* Product time varying quantitative * fixed dummy */ + ncovv++; /* Varying variables without age */ + TvarV[ncovv]=Tvar[k]; + TvarVind[ncovv]=k; + }else if(Tvard[k1][2] <=ncovcol+nqv){ + Fixed[k]= 1; + Dummy[k]= 1; + modell[k].maintype= VTYPE; + modell[k].subtype= VPQQ; /* Product time varying quantitative * fixed quantitative */ + ncovv++; /* Varying variables without age */ + TvarV[ncovv]=Tvar[k]; + TvarVind[ncovv]=k; + }else if(Tvard[k1][2] <=ncovcol+nqv+ntv){ + Fixed[k]= 1; + Dummy[k]= 1; + modell[k].maintype= VTYPE; + modell[k].subtype= VPDQ; /* Product time varying quantitative * time varying dummy */ + ncovv++; /* Varying variables without age */ + TvarV[ncovv]=Tvar[k]; + TvarVind[ncovv]=k; + }else if(Tvard[k1][2] <=ncovcol+nqv+ntv+nqtv){ + Fixed[k]= 1; + Dummy[k]= 1; + modell[k].maintype= VTYPE; + modell[k].subtype= VPQQ; /* Product time varying quantitative * time varying quantitative */ + ncovv++; /* Varying variables without age */ + TvarV[ncovv]=Tvar[k]; + TvarVind[ncovv]=k; + } + }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]); + printf(" modell[%d].maintype=%d, modell[%d].subtype=%d\n",k,modell[k].maintype,k,modell[k].subtype); + 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 nlstate){ *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); - 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); - s[m][i]=-1; + if(firstone == 0){ + firstone=1; + printf("Warning (#%d)! Date of death (month %2d and year %4d) of individual %ld on line %d was unknown but status is a death state %d at wave %d. If you don't know the vital status, please enter -2. If he/she is still alive but don't know the state, please code with '-1 or '.'. Here, we do not believe in a death, skipped.\nOther similar cases in log file\n", *nberr,(int)moisdc[i],(int)andc[i],num[i],i,s[m][i],m); + } + fprintf(ficlog,"Warning (#%d)! Date of death (month %2d and year %4d) of individual %ld on line %d was unknown but status is a death state %d at wave %d. If you don't know the vital status, please enter -2. If he/she is still alive but don't know the state, please code with '-1 or '.'. Here, we do not believe in a death, skipped.\n", *nberr,(int)moisdc[i],(int)andc[i],num[i],i,s[m][i],m); + s[m][i]=-1; /* Droping the death status */ } if((int)moisdc[i]==99 && (int)andc[i]!=9999 && s[m][i]>nlstate){ (*nberr)++; - printf("Error! Month of death of individual %ld on line %d was unknown %2d, you should set it otherwise the information on the death is skipped and results are biased.\n",num[i],i,(int)moisdc[i]); - fprintf(ficlog,"Error! Month of death of individual %ld on line %d was unknown %f, you should set it otherwise the information on the death is skipped and results are biased.\n",num[i],i,moisdc[i]); - s[m][i]=-1; /* We prefer to skip it (and to skip it in version 0.8a1 too */ + printf("Error (#%d)! Month of death of individual %ld on line %d was unknown (%2d) (year of death is %4d) and status is a death state %d at wave %d. Please impute an arbitrary (or not) month and rerun. Currently this transition to death will be skipped (status is set to -2).\nOther similar cases in log file\n", *nberr, num[i],i,(int)moisdc[i],(int)andc[i],s[m][i],m); + fprintf(ficlog,"Error (#%d)! Month of death of individual %ld on line %d was unknown (%2d) (year of death is %4d) and status is a death state %d at wave %d. Please impute an arbitrary (or not) month and rerun. Currently this transition to death will be skipped (status is set to -2).\n", *nberr, num[i],i,(int)moisdc[i],(int)andc[i],s[m][i],m); + s[m][i]=-2; /* We prefer to skip it (and to skip it in version 0.8a1 too */ } } } @@ -6240,12 +10246,12 @@ int calandcheckages(int imx, int maxwav, for (i=1; i<=imx; i++) { agedc[i]=(moisdc[i]/12.+andc[i])-(moisnais[i]/12.+annais[i]); for(m=firstpass; (m<= lastpass); m++){ - if(s[m][i] >0 || s[m][i]==-2 || s[m][i]==-4 || s[m][i]==-5){ + if(s[m][i] >0 || s[m][i]==-1 || s[m][i]==-2 || s[m][i]==-4 || s[m][i]==-5){ /* What if s[m][i]=-1 */ if (s[m][i] >= nlstate+1) { if(agedc[i]>0){ if((int)moisdc[i]!=99 && (int)andc[i]!=9999){ agev[m][i]=agedc[i]; - /*if(moisdc[i]==99 && andc[i]==9999) s[m][i]=-1;*/ + /*if(moisdc[i]==99 && andc[i]==9999) s[m][i]=-1;*/ }else { if ((int)andc[i]!=9999){ nbwarn++; @@ -6255,7 +10261,7 @@ int calandcheckages(int imx, int maxwav, } } } /* agedc > 0 */ - } + } /* end if */ else if(s[m][i] !=9){ /* Standard case, age in fractional years but with the precision of a month */ agev[m][i]=(mint[m][i]/12.+1./24.+anint[m][i])-(moisnais[i]/12.+1./24.+annais[i]); @@ -6271,17 +10277,23 @@ int calandcheckages(int imx, int maxwav, } /*agev[m][i]=anint[m][i]-annais[i];*/ /* agev[m][i] = age[i]+2*m;*/ - } + } /* en if 9*/ else { /* =9 */ + /* printf("Debug num[%d]=%ld s[%d][%d]=%d\n",i,num[i], m,i, s[m][i]); */ agev[m][i]=1; s[m][i]=-1; } } - else /*= 0 Unknown */ + else if(s[m][i]==0) /*= 0 Unknown */ agev[m][i]=1; - } - + else{ + printf("Warning, num[%d]=%ld, s[%d][%d]=%d\n", i, num[i], m, i,s[m][i]); + fprintf(ficlog, "Warning, num[%d]=%ld, s[%d][%d]=%d\n", i, num[i], m, i,s[m][i]); + agev[m][i]=0; + } + } /* End for lastpass */ } + for (i=1; i<=imx; i++) { for(m=firstpass; (m<=lastpass); m++){ if (s[m][i] > (nlstate+ndeath)) { @@ -6348,8 +10360,10 @@ BOOL IsWow64() #endif void syscompilerinfo(int logged) - { - /* #include "syscompilerinfo.h"*/ +{ +#include + + /* #include "syscompilerinfo.h"*/ /* command line Intel compiler 32bit windows, XP compatible:*/ /* /GS /W3 /Gy /Zc:wchar_t /Zi /O2 /Fd"Release\vc120.pdb" /D "WIN32" /D "NDEBUG" /D @@ -6384,6 +10398,8 @@ void syscompilerinfo(int logged) /ManifestFile:"Release\IMaCh.exe.intermediate.manifest" /OPT:ICF /NOLOGO /TLBID:1 */ + + #if defined __INTEL_COMPILER #if defined(__GNUC__) struct utsname sysInfo; /* For Intel on Linux and OS/X */ @@ -6400,8 +10416,6 @@ void syscompilerinfo(int logged) } #endif -#include - printf("Compiled with:");if(logged)fprintf(ficlog,"Compiled with:"); #if defined(__clang__) printf(" Clang/LLVM");if(logged)fprintf(ficlog," Clang/LLVM"); /* Clang/LLVM. ---------------------------------------------- */ @@ -6487,7 +10501,7 @@ void syscompilerinfo(int logged) #endif #endif - // void main() + // void main () // { #if defined(_MSC_VER) if (IsWow64()){ @@ -6505,11 +10519,11 @@ void syscompilerinfo(int logged) #endif - } +} - int prevalence_limit(double *p, double **prlim, double ageminpar, double agemaxpar, double ftolpl, int *ncvyear){ - /*--------------- Prevalence limit (period or stable prevalence) --------------*/ - int i, j, k, i1 ; +int prevalence_limit(double *p, double **prlim, double ageminpar, double agemaxpar, double ftolpl, int *ncvyearp){ + /*--------------- Prevalence limit (forward period or forward stable prevalence) --------------*/ + int i, j, k, i1, k4=0, nres=0 ; /* double ftolpl = 1.e-10; */ double age, agebase, agelim; double tot; @@ -6517,68 +10531,195 @@ void syscompilerinfo(int logged) strcpy(filerespl,"PL_"); strcat(filerespl,fileresu); if((ficrespl=fopen(filerespl,"w"))==NULL) { - 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; + printf("Problem with forward period (stable) prevalence resultfile: %s\n", filerespl);return 1; + fprintf(ficlog,"Problem with forward period (stable) prevalence resultfile: %s\n", filerespl);return 1; } - printf("Computing period (stable) prevalence: result on file '%s' \n", filerespl); - fprintf(ficlog,"Computing period (stable) prevalence: result on file '%s' \n", filerespl); + printf("\nComputing forward period (stable) prevalence: result on file '%s' \n", filerespl); + fprintf(ficlog,"\nComputing forward period (stable) prevalence: result on file '%s' \n", filerespl); pstamp(ficrespl); - fprintf(ficrespl,"# Period (stable) prevalence. Precision given by ftolpl=%g \n", ftolpl); + fprintf(ficrespl,"# Forward period (stable) prevalence. Precision given by ftolpl=%g \n", ftolpl); fprintf(ficrespl,"#Age "); for(i=1; i<=nlstate;i++) fprintf(ficrespl,"%d-%d ",i,i); fprintf(ficrespl,"\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,ncoveff); */ + i1=pow(2,cptcoveff); /* Number of combination of dummy covariates */ + if (cptcovn < 1){i1=1;} - for(cptcov=1,k=0;cptcov<=i1;cptcov++){ - /* for(cptcov=1,k=0;cptcov<=1;cptcov++){ */ + for(k=1; k<=i1;k++){ /* For each combination k of dummy covariates in the model */ + for(nres=1; nres <= nresult; nres++){ /* For each resultline */ + if(i1 != 1 && TKresult[nres]!= k) + continue; + + /* for(cptcov=1,k=0;cptcov<=i1;cptcov++){ */ + /* for(cptcov=1,k=0;cptcov<=1;cptcov++){ */ //for(cptcod=1;cptcod<=ncodemax[cptcov];cptcod++){ - k=k+1; - /* to clean */ - //printf("cptcov=%d cptcod=%d codtab=%d\n",cptcov, cptcod,codtabm(cptcod,cptcov)); - fprintf(ficrespl,"#******"); - printf("#******"); - fprintf(ficlog,"#******"); - for(j=1;j<=cptcoveff;j++) { - fprintf(ficrespl," 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(ficrespl,"******\n"); - printf("******\n"); - fprintf(ficlog,"******\n"); - - fprintf(ficrespl,"#Age "); - for(j=1;j<=cptcoveff;j++) { - fprintf(ficrespl,"V%d %d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); - } - for(i=1; i<=nlstate;i++) fprintf(ficrespl," %d-%d ",i,i); - fprintf(ficrespl,"Total Years_to_converge\n"); - - for (age=agebase; age<=agelim; age++){ + /* k=k+1; */ + /* to clean */ + //printf("cptcov=%d cptcod=%d codtab=%d\n",cptcov, cptcod,codtabm(cptcod,cptcov)); + fprintf(ficrespl,"#******"); + printf("#******"); + fprintf(ficlog,"#******"); + for(j=1;j<=cptcoveff ;j++) {/* all covariates */ + 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)]); + fprintf(ficlog," V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); + } + for (k4=1; k4<= nsq; k4++){ /* For each selected (single) quantitative value */ + printf(" V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); + fprintf(ficrespl," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); + fprintf(ficlog," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); + } + fprintf(ficrespl,"******\n"); + printf("******\n"); + fprintf(ficlog,"******\n"); + if(invalidvarcomb[k]){ + printf("\nCombination (%d) ignored because no case \n",k); + fprintf(ficrespl,"#Combination (%d) ignored because no case \n",k); + fprintf(ficlog,"\nCombination (%d) ignored because no case \n",k); + continue; + } + + fprintf(ficrespl,"#Age "); + for(j=1;j<=cptcoveff;j++) { + fprintf(ficrespl,"V%d %d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); + } + for(i=1; i<=nlstate;i++) fprintf(ficrespl," %d-%d ",i,i); + fprintf(ficrespl,"Total Years_to_converge\n"); + + for (age=agebase; age<=agelim; age++){ /* for (age=agebase; age<=agebase; age++){ */ - prevalim(prlim, nlstate, p, age, oldm, savm, ftolpl, ncvyear, k); - fprintf(ficrespl,"%.0f ",age ); - for(j=1;j<=cptcoveff;j++) - fprintf(ficrespl,"%d %d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); - tot=0.; - for(i=1; i<=nlstate;i++){ - tot += prlim[i][i]; - fprintf(ficrespl," %.5f", prlim[i][i]); - } - fprintf(ficrespl," %.3f %d\n", tot, *ncvyear); - } /* Age */ - /* was end of cptcod */ + prevalim(prlim, nlstate, p, age, oldm, savm, ftolpl, ncvyearp, k, nres); + fprintf(ficrespl,"%.0f ",age ); + for(j=1;j<=cptcoveff;j++) + fprintf(ficrespl,"%d %d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); + tot=0.; + for(i=1; i<=nlstate;i++){ + tot += prlim[i][i]; + fprintf(ficrespl," %.5f", prlim[i][i]); + } + fprintf(ficrespl," %.3f %d\n", tot, *ncvyearp); + } /* Age */ + /* was end of cptcod */ } /* cptcov */ - return 0; + } /* nres */ + return 0; } +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 (backward 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, nres=0 ; + /* double ftolpl = 1.e-10; */ + double age, agebase, agelim; + double tot; + /* double ***mobaverage; */ + /* double **dnewm, **doldm, **dsavm; /\* for use *\/ */ + + strcpy(fileresplb,"PLB_"); + strcat(fileresplb,fileresu); + if((ficresplb=fopen(fileresplb,"w"))==NULL) { + printf("Problem with backward prevalence resultfile: %s\n", fileresplb);return 1; + fprintf(ficlog,"Problem with backward prevalence resultfile: %s\n", fileresplb);return 1; + } + printf("Computing backward prevalence: result on file '%s' \n", fileresplb); + fprintf(ficlog,"Computing backward prevalence: result on file '%s' \n", fileresplb); + pstamp(ficresplb); + fprintf(ficresplb,"# Backward prevalence. Precision given by ftolpl=%g \n", ftolpl); + fprintf(ficresplb,"#Age "); + for(i=1; i<=nlstate;i++) fprintf(ficresplb,"%d-%d ",i,i); + fprintf(ficresplb,"\n"); + + + /* prlim=matrix(1,nlstate,1,nlstate);*/ /* back in main */ + + agebase=ageminpar; + agelim=agemaxpar; + + + i1=pow(2,cptcoveff); + if (cptcovn < 1){i1=1;} + + for(nres=1; nres <= nresult; nres++){ /* For each resultline */ + for(k=1; k<=i1;k++){ /* For any combination of dummy covariates, fixed and varying */ + if(i1 != 1 && TKresult[nres]!= k) + continue; + //printf("cptcov=%d cptcod=%d codtab=%d\n",cptcov, cptcod,codtabm(cptcod,cptcov)); + fprintf(ficresplb,"#******"); + printf("#******"); + fprintf(ficlog,"#******"); + for(j=1;j<=cptcoveff ;j++) {/* all covariates */ + fprintf(ficresplb," 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)]); + } + for (j=1; j<= nsq; j++){ /* For each selected (single) quantitative value */ + printf(" V%d=%f ",Tvqresult[nres][j],Tqresult[nres][j]); + fprintf(ficresplb," V%d=%f ",Tvqresult[nres][j],Tqresult[nres][j]); + fprintf(ficlog," V%d=%f ",Tvqresult[nres][j],Tqresult[nres][j]); + } + fprintf(ficresplb,"******\n"); + printf("******\n"); + fprintf(ficlog,"******\n"); + if(invalidvarcomb[k]){ + printf("\nCombination (%d) ignored because no cases \n",k); + fprintf(ficresplb,"#Combination (%d) ignored because no cases \n",k); + fprintf(ficlog,"\nCombination (%d) ignored because no cases \n",k); + continue; + } + + fprintf(ficresplb,"#Age "); + for(j=1;j<=cptcoveff;j++) { + 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,"Total Years_to_converge\n"); + + + for (age=agebase; age<=agelim; age++){ + /* for (age=agebase; age<=agebase; age++){ */ + if(mobilavproj > 0){ + /* bprevalim(bprlim, mobaverage, nlstate, p, age, ageminpar, agemaxpar, oldm, savm, doldm, dsavm, ftolpl, ncvyearp, k); */ + /* bprevalim(bprlim, mobaverage, nlstate, p, age, oldm, savm, dnewm, doldm, dsavm, ftolpl, ncvyearp, k); */ + bprevalim(bprlim, mobaverage, nlstate, p, age, ftolpl, ncvyearp, k, nres); + }else if (mobilavproj == 0){ + 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); + 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); + exit(1); + }else{ + /* bprevalim(bprlim, probs, nlstate, p, age, oldm, savm, dnewm, doldm, dsavm, ftolpl, ncvyearp, k); */ + bprevalim(bprlim, probs, nlstate, p, age, ftolpl, ncvyearp, k,nres); + /* printf("TOTOT\n"); */ + /* exit(1); */ + } + 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 */ + /*fprintf(ficresplb,"\n");*/ /* Seems to be necessary for gnuplot only if two result lines and no covariate. */ + } /* end of any combination */ + } /* end of nres */ + /* hBijx(p, bage, fage); */ + /* fclose(ficrespijb); */ + + return 0; +} + int hPijx(double *p, int bage, int fage){ /*------------- h Pij x at various ages ------------*/ @@ -6586,7 +10727,7 @@ int hPijx(double *p, int bage, int fage) int agelim; int hstepm; int nhstepm; - int h, i, i1, j, k; + int h, i, i1, j, k, k4, nres=0; double agedeb; double ***p3mat; @@ -6605,18 +10746,25 @@ int hPijx(double *p, int bage, int fage) 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(ficrespij); fprintf(ficrespij,"#****** h Pij x Probability to be in state j at age x+h being in i 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++){ + /* for(cptcov=1,k=0;cptcov<=i1;cptcov++){ */ + /* /\*for(cptcod=1;cptcod<=ncodemax[cptcov];cptcod++){*\/ */ + /* k=k+1; */ + for(nres=1; nres <= nresult; nres++) /* For each resultline */ + for(k=1; k<=i1;k++){ + if(i1 != 1 && TKresult[nres]!= k) + continue; fprintf(ficrespij,"\n#****** "); for(j=1;j<=cptcoveff;j++) fprintf(ficrespij,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); + for (k4=1; k4<= nsq; k4++){ /* For each selected (single) quantitative value */ + printf(" V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); + fprintf(ficrespij," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); + } fprintf(ficrespij,"******\n"); for (agedeb=fage; agedeb>=bage; agedeb--){ /* If stepm=6 months */ @@ -6627,7 +10775,7 @@ int hPijx(double *p, int bage, int fage) 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); + hpxij(p3mat,nhstepm,agedeb,hstepm,p,nlstate,stepm,oldm,savm, k, nres); fprintf(ficrespij,"# Cov Agex agex+h hpijx with i,j="); for(i=1; i<=nlstate;i++) for(j=1; j<=nlstate+ndeath;j++) @@ -6646,8 +10794,97 @@ int hPijx(double *p, int bage, int fage) } /*}*/ } - return 0; + return 0; } + + int hBijx(double *p, int bage, int fage, double ***prevacurrent){ + /*------------- h Bij x at various ages ------------*/ + + int stepsize; + /* int agelim; */ + int ageminl; + int hstepm; + int nhstepm; + int h, i, i1, j, k, nres; + + double agedeb; + 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; */ + ageminl=AGEINF; /* was 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 Bij x Back probability to be in state i at age x-h being in j at x: B1j+B2j+...=1 "); + i1= pow(2,cptcoveff); + /* for(cptcov=1,k=0;cptcov<=i1;cptcov++){ */ + /* /\*for(cptcod=1;cptcod<=ncodemax[cptcov];cptcod++){*\/ */ + /* k=k+1; */ + for(nres=1; nres <= nresult; nres++){ /* For each resultline */ + for(k=1; k<=i1;k++){ /* For any combination of dummy covariates, fixed and varying */ + if(i1 != 1 && TKresult[nres]!= k) + continue; + fprintf(ficrespijb,"\n#****** "); + for(j=1;j<=cptcoveff;j++) + fprintf(ficrespijb,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); + for (j=1; j<= nsq; j++){ /* For each selected (single) quantitative value */ + fprintf(ficrespijb," V%d=%f ",Tvqresult[nres][j],Tqresult[nres][j]); + } + fprintf(ficrespijb,"******\n"); + if(invalidvarcomb[k]){ /* Is it necessary here? */ + 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+0.1)-1; /* Typically 20 years = 20*12/6=40 or 55*12/24=27.5-1.1=>27 */ + nhstepm = nhstepm/hstepm; /* Typically 40/4=10, because estepm=24 stepm=6 => hstepm=24/6=4 or 28*/ + + /* nhstepm=nhstepm*YEARM; aff par mois*/ + + p3mat=ma3x(1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); /* We can't have it at an upper level because of nhstepm */ + /* and memory limitations if stepm is small */ + + /* 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, nres); + /* hbxij(p3mat,nhstepm,agedeb,hstepm,p,prevacurrent,nlstate,stepm,oldm,savm, dnewm, doldm, dsavm, k); */ + fprintf(ficrespijb,"# Cov Agex agex-h hbijx 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(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"); + } /* end age deb */ + } /* end combination */ + } /* end nres */ + return 0; + } /* hBijx */ /***********************************************/ @@ -6664,16 +10901,20 @@ int main(int argc, char *argv[]) double ssval; #endif int movingaverage(double ***probs, double bage,double fage, double ***mobaverage, int mobilav); - int i,j, k, n=MAXN,iter=0,m,size=100, cptcod; - int ncvyearnp=0; - int *ncvyear=&ncvyearnp; /* Number of years needed for the period prevalence to converge */ + int i,j, k, iter=0,m,size=100, cptcod; /* Suppressing because nobs */ + /* int i,j, k, n=MAXN,iter=0,m,size=100, cptcod; */ + int ncvyear=0; /* Number of years needed for the period prevalence to converge */ int jj, ll, li, lj, lk; int numlinepar=0; /* Current linenumber of parameter file */ int num_filled; int itimes; int NDIM=2; int vpopbased=0; - + int nres=0; + int endishere=0; + int noffset=0; + int ncurrv=0; /* Temporary variable */ + char ca[32], cb[32]; /* FILE *fichtm; *//* Html File */ /* FILE *ficgp;*/ /*Gnuplot File */ @@ -6681,19 +10922,22 @@ int main(int argc, char *argv[]) double agedeb=0.; double ageminpar=AGEOVERFLOW,agemin=AGEOVERFLOW, agemaxpar=-AGEOVERFLOW, agemax=-AGEOVERFLOW; + double ageminout=-AGEOVERFLOW,agemaxout=AGEOVERFLOW; /* Smaller Age range redefined after movingaverage */ double fret; double dum=0.; /* Dummy variable */ double ***p3mat; - double ***mobaverage; + /* double ***mobaverage; */ char line[MAXLINE]; char path[MAXLINE],pathc[MAXLINE],pathcd[MAXLINE],pathtot[MAXLINE]; - char model[MAXLINE], modeltemp[MAXLINE]; + char modeltemp[MAXLINE]; + char resultline[MAXLINE]; + char pathr[MAXLINE], pathimach[MAXLINE]; char *tok, *val; /* pathtot */ - int firstobs=1, lastobs=10; + int firstobs=1, lastobs=10; /* nobs = lastobs-firstobs declared globally ;*/ int c, h , cpt, c2; int jl=0; int i1, j1, jk, stepsize=0; @@ -6701,6 +10945,14 @@ int main(int argc, char *argv[]) int *tab; int mobilavproj=0 , prevfcast=0 ; /* moving average of prev, If prevfcast=1 prevalence projection */ + /* double anprojd, mprojd, jprojd; /\* For eventual projections *\/ */ + /* double anprojf, mprojf, jprojf; */ + /* double jintmean,mintmean,aintmean; */ + int prvforecast = 0; /* Might be 1 (date of beginning of projection is a choice or 2 is the dateintmean */ + int prvbackcast = 0; /* Might be 1 (date of beginning of projection is a choice or 2 is the dateintmean */ + double yrfproj= 10.0; /* Number of years of forward projections */ + double yrbproj= 10.0; /* Number of years of backward projections */ + int prevbcast=0; /* defined as global for mlikeli and mle, replacing backcast */ int mobilav=0,popforecast=0; int hstepm=0, nhstepm=0; int agemortsup; @@ -6711,17 +10963,24 @@ int main(int argc, char *argv[]) double bage=0, fage=110., age, agelim=0., agebase=0.; double ftolpl=FTOL; double **prlim; + double **bprlim; double ***param; /* Matrix of parameters */ - double *p; + double ***paramstart; /* Matrix of starting parameter values */ + double *p, *pstart; /* p=param[1][1] pstart is for starting values guessed by freqsummary */ double **matcov; /* Matrix of covariance */ double **hess; /* Hessian matrix */ double ***delti3; /* Scale */ double *delti; /* Scale */ double ***eij, ***vareij; double **varpl; /* Variances of prevalence limits by age */ + double *epj, vepp; - double dateprev1, dateprev2,jproj1=1,mproj1=1,anproj1=2000,jproj2=1,mproj2=1,anproj2=2000; + double dateprev1, dateprev2; + double jproj1=1,mproj1=1,anproj1=2000,jproj2=1,mproj2=1,anproj2=2000, dateproj1=0, dateproj2=0, dateprojd=0, dateprojf=0; + double jback1=1,mback1=1,anback1=2000,jback2=1,mback2=1,anback2=2000, dateback1=0, dateback2=0, datebackd=0, datebackf=0; + + double **ximort; char *alph[]={"a","a","b","c","d","e"}, str[4]="1234"; int *dcwave; @@ -6798,8 +11057,13 @@ int main(int argc, char *argv[]) if(pathr[0] == '\0') break; /* Dirty */ } } + else if (argc<=2){ + strcpy(pathtot,argv[1]); + } else{ strcpy(pathtot,argv[1]); + strcpy(z,argv[2]); + printf("\nargv[2]=%s z=%c\n",argv[2],z[0]); } /*if(getcwd(pathcd, MAXLINE)!= NULL)printf ("Error pathcd\n");*/ /*cygwin_split_path(pathtot,path,optionfile); @@ -6877,8 +11141,6 @@ int main(int argc, char *argv[]) exit(70); } - - strcpy(filereso,"o"); strcat(filereso,fileresu); if((ficparo=fopen(filereso,"w"))==NULL) { /* opened on subdirectory */ @@ -6887,17 +11149,53 @@ int main(int argc, char *argv[]) fflush(ficlog); goto end; } + /*-------- Rewriting parameter file ----------*/ + strcpy(rfileres,"r"); /* "Rparameterfile */ + strcat(rfileres,optionfilefiname); /* Parameter file first name */ + strcat(rfileres,"."); /* */ + strcat(rfileres,optionfilext); /* Other files have txt extension */ + if((ficres =fopen(rfileres,"w"))==NULL) { + printf("Problem writing new parameter file: %s\n", rfileres);goto end; + fprintf(ficlog,"Problem writing new parameter file: %s\n", rfileres);goto end; + fflush(ficlog); + goto end; + } + fprintf(ficres,"#IMaCh %s\n",version); + /* Reads comments: lines beginning with '#' */ numlinepar=0; - - /* First parameter line */ + /* Is it a BOM UTF-8 Windows file? */ + /* First parameter line */ while(fgets(line, MAXLINE, ficpar)) { + noffset=0; + if( line[0] == (char)0xEF && line[1] == (char)0xBB) /* EF BB BF */ + { + noffset=noffset+3; + printf("# File is an UTF8 Bom.\n"); // 0xBF + } +/* else if( line[0] == (char)0xFE && line[1] == (char)0xFF)*/ + else if( line[0] == (char)0xFF && line[1] == (char)0xFE) + { + noffset=noffset+2; + printf("# File is an UTF16BE BOM file\n"); + } + else if( line[0] == 0 && line[1] == 0) + { + if( line[2] == (char)0xFE && line[3] == (char)0xFF){ + noffset=noffset+4; + printf("# File is an UTF16BE BOM file\n"); + } + } else{ + ;/*printf(" Not a BOM file\n");*/ + } + /* If line starts with a # it is a comment */ - if (line[0] == '#') { + if (line[noffset] == '#') { numlinepar++; fputs(line,stdout); fputs(line,ficparo); + fputs(line,ficres); fputs(line,ficlog); continue; }else @@ -6907,49 +11205,66 @@ int main(int argc, char *argv[]) title, datafile, &lastobs, &firstpass,&lastpass)) !=EOF){ if (num_filled != 5) { printf("Should be 5 parameters\n"); + fprintf(ficlog,"Should be 5 parameters\n"); } numlinepar++; printf("title=%s datafile=%s lastobs=%d firstpass=%d lastpass=%d\n", title, datafile, lastobs, firstpass,lastpass); + fprintf(ficparo,"title=%s datafile=%s lastobs=%d firstpass=%d lastpass=%d\n", title, datafile, lastobs, firstpass,lastpass); + fprintf(ficres,"title=%s datafile=%s lastobs=%d firstpass=%d lastpass=%d\n", title, datafile, lastobs, firstpass,lastpass); + fprintf(ficlog,"title=%s datafile=%s lastobs=%d firstpass=%d lastpass=%d\n", title, datafile, lastobs, firstpass,lastpass); } /* Second parameter line */ while(fgets(line, MAXLINE, ficpar)) { - /* If line starts with a # it is a comment */ + /* while(fscanf(ficpar,"%[^\n]", line)) { */ + /* If line starts with a # it is a comment. Strangely fgets reads the EOL and fputs doesn't */ if (line[0] == '#') { numlinepar++; - fputs(line,stdout); - fputs(line,ficparo); - fputs(line,ficlog); + printf("%s",line); + fprintf(ficres,"%s",line); + fprintf(ficparo,"%s",line); + fprintf(ficlog,"%s",line); continue; }else break; } - if((num_filled=sscanf(line,"ftol=%lf stepm=%d ncovcol=%d nlstate=%d ndeath=%d maxwav=%d mle=%d weight=%d\n", \ - &ftol, &stepm, &ncovcol, &nlstate, &ndeath, &maxwav, &mle, &weightopt)) !=EOF){ - if (num_filled != 8) { - printf("Not 8\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, &nqv, &ntv, &nqtv, &nlstate, &ndeath, &maxwav, &mle, &weightopt)) !=EOF){ + if (num_filled != 11) { + 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); + fprintf(ficlog,"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"); + fprintf(ficlog,"but line=%s\n",line); + } + if( lastpass > maxwav){ + printf("Error (lastpass = %d) > (maxwav = %d)\n",lastpass, maxwav); + fprintf(ficlog,"Error (lastpass = %d) > (maxwav = %d)\n",lastpass, maxwav); + fflush(ficlog); + goto end; } - 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); + fprintf(ficparo,"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); + fprintf(ficres,"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, 0, weightopt); + fprintf(ficlog,"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.e-3; /* 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 */ /* Third parameter line */ while(fgets(line, MAXLINE, ficpar)) { /* If line starts with a # it is a comment */ if (line[0] == '#') { numlinepar++; - fputs(line,stdout); - fputs(line,ficparo); - fputs(line,ficlog); + printf("%s",line); + fprintf(ficres,"%s",line); + fprintf(ficparo,"%s",line); + fprintf(ficlog,"%s",line); continue; }else break; } if((num_filled=sscanf(line,"model=1+age%[^.\n]", model)) !=EOF){ - if (num_filled == 0) - model[0]='\0'; - else if (num_filled != 1){ - printf("ERROR %d: Model should be at minimum 'model=1+age.' %s\n",num_filled, line); - fprintf(ficlog,"ERROR %d: Model should be at minimum 'model=1+age.' %s\n",num_filled, line); + if (num_filled != 1){ + printf("ERROR %d: Model should be at minimum 'model=1+age+' instead of '%s'\n",num_filled, line); + fprintf(ficlog,"ERROR %d: Model should be at minimum 'model=1+age+' instead of '%s'\n",num_filled, line); model[0]='\0'; goto end; } @@ -6962,20 +11277,23 @@ int main(int argc, char *argv[]) } /* printf(" model=1+age%s modeltemp= %s, model=%s\n",model, modeltemp, model);fflush(stdout); */ printf("model=1+age+%s\n",model);fflush(stdout); + fprintf(ficparo,"model=1+age+%s\n",model);fflush(stdout); + fprintf(ficres,"model=1+age+%s\n",model);fflush(stdout); + fprintf(ficlog,"model=1+age+%s\n",model);fflush(stdout); } /* 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 *\/ */ /* 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(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(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 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); /* if(model[0]=='#'|| model[0]== '\0'){ */ if(model[0]=='#'){ - printf("Error in 'model' line: model should start with 'model=1+age+' and end with '.' \n \ - 'model=1+age+.' or 'model=1+age+V1.' or 'model=1+age+age*age+V1+V1*age.' or \n \ - 'model=1+age+V1+V2.' or 'model=1+age+V1+V2+V1*V2.' etc. \n"); \ + printf("Error in 'model' line: model should start with 'model=1+age+' and end without space \n \ + 'model=1+age+' or 'model=1+age+V1.' or 'model=1+age+age*age+V1+V1*age' or \n \ + 'model=1+age+V1+V2' or 'model=1+age+V1+V2+V1*V2' etc. \n"); \ if(mle != -1){ - printf("Fix the model line and run imach with mle=-1 to get a correct template of the parameter file.\n"); + printf("Fix the model line and run imach with mle=-1 to get a correct template of the parameter vectors and subdiagonal covariance matrix.\n"); exit(1); } } @@ -6995,7 +11313,10 @@ int main(int argc, char *argv[]) ungetc(c,ficpar); - covar=matrix(0,NCOVMAX,1,n); /**< used in readdata */ + covar=matrix(0,NCOVMAX,firstobs,lastobs); /**< used in readdata */ + if(nqv>=1)coqvar=matrix(1,nqv,firstobs,lastobs); /**< Fixed quantitative covariate */ + if(nqtv>=1)cotqvar=ma3x(1,maxwav,1,nqtv,firstobs,lastobs); /**< Time varying quantitative covariate */ + if(ntv+nqtv>=1)cotvar=ma3x(1,maxwav,1,ntv+nqtv,firstobs,lastobs); /**< Time varying covariate (dummy and quantitative)*/ 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*age+v2*v3 makes cptcovn = 3 @@ -7017,6 +11338,12 @@ int main(int argc, char *argv[]) delti=delti3[1][1]; /*delti=vector(1,npar); *//* Scale of each paramater (output from hesscov)*/ if(mle==-1){ /* Print a wizard for help writing covariance matrix */ +/* We could also provide initial parameters values giving by simple logistic regression + * only one way, that is without matrix product. We will have nlstate maximizations */ + /* for(i=1;i16 */ ncodemaxwundef=ivector(1,NCOVMAX); /* Number of code per covariate; if - 1 O and 1 only, 2**ncov; V1+V2+V3+V4=>16 */ @@ -7223,13 +11568,38 @@ Please run with mle=-1 to get a correct goto end; /* Calculation of the number of parameters from char model */ - /* 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 k=4 (age*V3) Tvar[k=4]= 3 (from V3) Tag[cptcovage=1]=4 k=3 V4 Tvar[k=3]= 4 (from V4) k=2 V1 Tvar[k=2]= 1 (from V1) k=1 Tvar[1]=2 (from V2) - */ + */ + Tvar=ivector(1,NCOVMAX); /* Was 15 changed to NCOVMAX. */ + TvarsDind=ivector(1,NCOVMAX); /* */ + TvarsD=ivector(1,NCOVMAX); /* */ + TvarsQind=ivector(1,NCOVMAX); /* */ + TvarsQ=ivector(1,NCOVMAX); /* */ + TvarF=ivector(1,NCOVMAX); /* */ + TvarFind=ivector(1,NCOVMAX); /* */ + TvarV=ivector(1,NCOVMAX); /* */ + TvarVind=ivector(1,NCOVMAX); /* */ + TvarA=ivector(1,NCOVMAX); /* */ + TvarAind=ivector(1,NCOVMAX); /* */ + TvarFD=ivector(1,NCOVMAX); /* */ + TvarFDind=ivector(1,NCOVMAX); /* */ + TvarFQ=ivector(1,NCOVMAX); /* */ + TvarFQind=ivector(1,NCOVMAX); /* */ + TvarVD=ivector(1,NCOVMAX); /* */ + TvarVDind=ivector(1,NCOVMAX); /* */ + TvarVQ=ivector(1,NCOVMAX); /* */ + TvarVQind=ivector(1,NCOVMAX); /* */ + + Tvalsel=vector(1,NCOVMAX); /* */ + Tvarsel=ivector(1,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). 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. @@ -7239,9 +11609,11 @@ Please run with mle=-1 to get a correct ncovcol + k1 If already ncovcol=4 and model=V2+V1+V1*V4+age*V3 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 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 */ 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 @@ -7251,11 +11623,23 @@ Please run with mle=-1 to get a correct 4 covariates (3 plus signs) Tage[1=V3*age]= 4; Tage[2=age*V4] = 3 */ - + Tmodelind=ivector(1,NCOVMAX);/** gives 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 , + * V1 df, V2 qf, V3 & V4 dv, V5 qv + * Tmodelind[1]@9={9,0,3,2,}*/ + TmodelInvind=ivector(1,NCOVMAX); /* TmodelInvind=Tvar[k]- ncovcol-nqv={5-2-1=2,*/ + TmodelInvQind=ivector(1,NCOVMAX);/** gives the k model position of an + * individual quantitative, fixed or varying: + * Tmodelqind[1]=1,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 */ - 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; if((double)(lastobs-imx)/(double)imx > 1.10){ @@ -7276,48 +11660,72 @@ Please run with mle=-1 to get a correct agegomp=(int)agemin; - free_vector(moisnais,1,n); - free_vector(annais,1,n); + free_vector(moisnais,firstobs,lastobs); + free_vector(annais,firstobs,lastobs); /* free_matrix(mint,1,maxwav,1,n); free_matrix(anint,1,maxwav,1,n);*/ - free_vector(moisdc,1,n); - free_vector(andc,1,n); + /* free_vector(moisdc,1,n); */ + /* free_vector(andc,1,n); */ /* */ wav=ivector(1,imx); - dh=imatrix(1,lastpass-firstpass+1,1,imx); - bh=imatrix(1,lastpass-firstpass+1,1,imx); - mw=imatrix(1,lastpass-firstpass+1,1,imx); + /* dh=imatrix(1,lastpass-firstpass+1,1,imx); */ + /* bh=imatrix(1,lastpass-firstpass+1,1,imx); */ + /* mw=imatrix(1,lastpass-firstpass+1,1,imx); */ + dh=imatrix(1,lastpass-firstpass+2,1,imx); /* We are adding a wave if status is unknown at last wave but death occurs after last wave.*/ + bh=imatrix(1,lastpass-firstpass+2,1,imx); + mw=imatrix(1,lastpass-firstpass+2,1,imx); /* Concatenates waves */ + /* Concatenates waves: wav[i] is the number of effective (useful waves) of individual i. + Death is a valid wave (if date is known). + mw[mi][i] is the number of (mi=1 to wav[i]) effective wave out of mi of individual 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. + */ + concatwav(wav, dh, bh, mw, s, agedc, agev, firstpass, lastpass, imx, nlstate, stepm); - /* */ + /* Concatenates waves */ - /* Routine tricode is to calculate cptcoveff (real number of unique covariates) and to associate covariable number and modality */ + free_vector(moisdc,firstobs,lastobs); + free_vector(andc,firstobs,lastobs); + /* Routine tricode is to calculate cptcoveff (real number of unique covariates) and to associate covariable number and modality */ nbcode=imatrix(0,NCOVMAX,0,NCOVMAX); ncodemax[1]=1; Ndum =ivector(-1,NCOVMAX); - if (ncovmodel-nagesqr > 2 ) /* That is if covariate other than cst, age and age*age */ - tricode(Tvar,nbcode,imx, Ndum); /**< Fills nbcode[Tvar[j]][l]; */ - /* Nbcode gives the value of the lth modality of jth covariate, in + cptcoveff=0; + 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 0) */ - - m=pow(2,cptcoveff); /**< codtab(h,k) k = codtab[h,k]=( (h-1) - mod(k-1,2**(k-1) )/2**(k-1) + 1 - * For k=4 covariates, h goes from 1 to 2**k - * codtabm(h,k)= 1 & (h-1) >> (k-1) ; + * For k=4 covariates, h goes from 1 to m=2**k + * codtabm(h,k)= (1 & (h-1) >> (k-1)) + 1; + * #define codtabm(h,k) (1 & (h-1) >> (k-1))+1 * h\k 1 2 3 4 *______________________________ * 1 i=1 1 i=1 1 i=1 1 i=1 1 @@ -7337,38 +11745,50 @@ Please run with mle=-1 to get a correct * 15 i=8 1 2 2 2 * 16 2 2 2 2 */ - /* /\* 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);*/ + /* How to do the opposite? From combination h (=1 to 2**k) how to get the value on the covariates? */ + /* from h=5 and m, we get then number of covariates k=log(m)/log(2)=4 + * and the value of each covariate? + * V1=1, V2=1, V3=2, V4=1 ? + * h-1=4 and 4 is 0100 or reverse 0010, and +1 is 1121 ok. + * h=6, 6-1=5, 5 is 0101, 1010, 2121, V1=2nd, V2=1st, V3=2nd, V4=1st. + * In order to get the real value in the data, we use nbcode + * nbcode[Tvar[3][2nd]]=1 and nbcode[Tvar[4][1]]=0 + * We are keeping this crazy system in order to be able (in the future?) + * to have more than 2 values (0 or 1) for a covariate. + * #define codtabm(h,k) (1 & (h-1) >> (k-1))+1 + * h=6, k=2? h-1=5=0101, reverse 1010, +1=2121, k=2nd position: value is 1: codtabm(6,2)=1 + * bbbbbbbb + * 76543210 + * h-1 00000101 (6-1=5) + *(h-1)>>(k-1)= 00000010 >> (2-1) = 1 right shift + * & + * 1 00000001 (1) + * 00000000 = 1 & ((h-1) >> (k-1)) + * +1= 00000001 =1 + * + * h=14, k=3 => h'=h-1=13, k'=k-1=2 + * h' 1101 =2^3+2^2+0x2^1+2^0 + * >>k' 11 + * & 00000001 + * = 00000001 + * +1 = 00000010=2 = codtabm(14,3) + * Reverse h=6 and m=16? + * cptcoveff=log(16)/log(2)=4 covariate: 6-1=5=0101 reversed=1010 +1=2121 =>V1=2, V2=1, V3=2, V4=1. + * for (j=1 to cptcoveff) Vj=decodtabm(j,h,cptcoveff) + * decodtabm(h,j,cptcoveff)= (((h-1) >> (j-1)) & 1) +1 + * decodtabm(h,j,cptcoveff)= (h <= (1<> (j-1)) & 1) +1 : -1) + * V3=decodtabm(14,3,2**4)=2 + * h'=13 1101 =2^3+2^2+0x2^1+2^0 + *(h-1) >> (j-1) 0011 =13 >> 2 + * &1 000000001 + * = 000000001 + * +1= 000000010 =2 + * 2211 + * V1=1+1, V2=0+1, V3=1+1, V4=1+1 + * V3=2 + * codtabm and decodtabm are identical + */ + free_ivector(Ndum,-1,NCOVMAX); @@ -7415,7 +11835,7 @@ Title=%s
        Datafile=%s Firstpass=%d La optionfilehtmcov,version,fullversion,title,datafile,firstpass,lastpass,stepm, weightopt, model); } - fprintf(fichtm,"\n\n\nIMaCh %s\n IMaCh for Interpolated Markov Chain
        \nSponsored by Copyright (C) 2002-2015 INED-EUROREVES-Institut de longévité-Japan Society for the Promotion of Sciences 日本学術振興会 (Grant-in-Aid for Scientific Research 25293121) - Intel Software 2015
        \ + fprintf(fichtm,"\n\n\nIMaCh %s\n IMaCh for Interpolated Markov Chain
        \nSponsored by Copyright (C) 2002-2015 INED-EUROREVES-Institut de longévité-2013-2016-Japan Society for the Promotion of Sciences 日本学術振興会 (Grant-in-Aid for Scientific Research 25293121) - Intel Software 2015-2018
        \
        \n\ IMaCh-%s
        %s         \
        \n\ @@ -7443,22 +11863,44 @@ Title=%s
        Datafile=%s Firstpass=%d La #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'. */ - freqsummary(fileres, agemin, agemax, s, agev, nlstate, imx,Tvaraff,nbcode, ncodemax,mint,anint,strstart); + freqsummary(fileres, p, pstart, agemin, agemax, s, agev, nlstate, imx, Tvaraff, invalidvarcomb, nbcode, ncodemax,mint,anint,strstart, \ + firstpass, lastpass, stepm, weightopt, model); fprintf(fichtm,"\n"); - fprintf(fichtm,"
        Total number of observations=%d
        \n\ + fprintf(fichtm,"

        Parameter line 2

        • Tolerance for the convergence of the likelihood: ftol=%g \n
        • Interval for the elementary matrix (in month): stepm=%d",\ + ftol, stepm); + fprintf(fichtm,"\n
        • Number of fixed dummy covariates: ncovcol=%d ", ncovcol); + ncurrv=1; + for(i=ncurrv; i <=ncovcol; i++) fprintf(fichtm,"V%d ", i); + fprintf(fichtm,"\n
        • Number of fixed quantitative variables: nqv=%d ", nqv); + ncurrv=i; + for(i=ncurrv; i <=ncurrv-1+nqv; i++) fprintf(fichtm,"V%d ", i); + fprintf(fichtm,"\n
        • Number of time varying (wave varying) dummy covariates: ntv=%d ", ntv); + ncurrv=i; + for(i=ncurrv; i <=ncurrv-1+ntv; i++) fprintf(fichtm,"V%d ", i); + fprintf(fichtm,"\n
        • Number of time varying quantitative covariates: nqtv=%d ", nqtv); + ncurrv=i; + for(i=ncurrv; i <=ncurrv-1+nqtv; i++) fprintf(fichtm,"V%d ", i); + fprintf(fichtm,"\n
        • Weights column \n
          Number of alive states: nlstate=%d
          Number of death states (not really implemented): ndeath=%d \n
        • Number of waves: maxwav=%d \n
        • Parameter for maximization (1), using parameter values (0), for design of parameters and variance-covariance matrix: mle=%d \n
        • Does the weight column be taken into account (1), or not (0): weight=%d
        \n", \ + nlstate, ndeath, maxwav, mle, weightopt); + + fprintf(fichtm,"

        Diagram of states %s_.svg

        \n\ +", subdirf2(optionfilefiname,"D_"),subdirf2(optionfilefiname,"D_"),subdirf2(optionfilefiname,"D_")); + + + fprintf(fichtm,"\n

        Some descriptive statistics

        \n
        Total number of observations=%d
        \n\ Youngest age at first (selected) pass %.2f, oldest age %.2f
        \n\ Interval (in months) between two waves: Min=%d Max=%d Mean=%.2lf
        \n",\ - imx,agemin,agemax,jmin,jmax,jmean); + imx,agemin,agemax,jmin,jmax,jmean); pmmij= matrix(1,nlstate+ndeath,1,nlstate+ndeath); /* creation */ - oldms= matrix(1,nlstate+ndeath,1,nlstate+ndeath); /* creation */ - newms= matrix(1,nlstate+ndeath,1,nlstate+ndeath); /* creation */ - savms= matrix(1,nlstate+ndeath,1,nlstate+ndeath); /* creation */ - oldm=oldms; newm=newms; savm=savms; /* Keeps fixed addresses to free */ - - + oldms= matrix(1,nlstate+ndeath,1,nlstate+ndeath); /* creation */ + newms= matrix(1,nlstate+ndeath,1,nlstate+ndeath); /* creation */ + savms= matrix(1,nlstate+ndeath,1,nlstate+ndeath); /* creation */ + oldm=oldms; newm=newms; savm=savms; /* Keeps fixed addresses to free */ + /* For Powell, parameters are in a vector p[] starting at p[1] so we point p on param[1][1] so that p[1] maps on param[1][1][1] */ p=param[1][1]; /* *(*(*(param +1)+1)+0) */ @@ -7467,12 +11909,15 @@ Interval (in months) between two waves: /* For mortality only */ if (mle==-3){ 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); */ - cens=ivector(1,n); - ageexmed=vector(1,n); - agecens=vector(1,n); - dcwave=ivector(1,n); - + cens=ivector(firstobs,lastobs); + ageexmed=vector(firstobs,lastobs); + agecens=vector(firstobs,lastobs); + dcwave=ivector(firstobs,lastobs); + for (i=1; i<=imx; i++){ dcwave[i]=-1; for (m=firstpass; m<=lastpass; m++) @@ -7482,13 +11927,13 @@ Interval (in months) between two waves: break; } } - + for (i=1; i<=imx; i++) { if (wav[i]>0){ ageexmed[i]=agev[mw[1][i]][i]; j=wav[i]; agecens[i]=1.; - + if (ageexmed[i]> 1 && wav[i] > 0){ agecens[i]=agev[mw[j][i]][i]; cens[i]= 1; @@ -7505,8 +11950,8 @@ Interval (in months) between two waves: ximort[i][j]=(i == j ? 1.0 : 0.0); } - /*p[1]=0.0268; p[NDIM]=0.083;*/ - /*printf("%lf %lf", p[1], p[2]);*/ + p[1]=0.0268; p[NDIM]=0.083; + /* printf("%lf %lf", p[1], p[2]); */ #ifdef GSL @@ -7615,14 +12060,14 @@ Interval (in months) between two waves: for(i=1; i <=NDIM; i++) for(j=i+1;j<=NDIM;j++) - matcov[i][j]=matcov[j][i]; + matcov[i][j]=matcov[j][i]; printf("\nCovariance matrix\n "); fprintf(ficlog,"\nCovariance matrix\n "); for(i=1; i <=NDIM; i++) { for(j=1;j<=NDIM;j++){ - printf("%f ",matcov[i][j]); - fprintf(ficlog,"%f ",matcov[i][j]); + printf("%f ",matcov[i][j]); + fprintf(ficlog,"%f ",matcov[i][j]); } printf("\n "); fprintf(ficlog,"\n "); } @@ -7632,9 +12077,9 @@ Interval (in months) between two waves: printf("%f [%f ; %f]\n",p[i],p[i]-2*sqrt(matcov[i][i]),p[i]+2*sqrt(matcov[i][i])); fprintf(ficlog,"%f [%f ; %f]\n",p[i],p[i]-2*sqrt(matcov[i][i]),p[i]+2*sqrt(matcov[i][i])); } - lsurv=vector(1,AGESUP); - lpop=vector(1,AGESUP); - tpop=vector(1,AGESUP); + lsurv=vector(agegomp,AGESUP); + lpop=vector(agegomp,AGESUP); + tpop=vector(agegomp,AGESUP); lsurv[agegomp]=100000; for (k=agegomp;k<=AGESUP;k++) { @@ -7663,6 +12108,8 @@ Interval (in months) between two waves: replace_back_to_slash(pathc,pathcd); /* Even gnuplot wants a / */ + ageminpar=50; + agemaxpar=100; if(ageminpar == AGEOVERFLOW ||agemaxpar == AGEOVERFLOW){ 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\ @@ -7670,20 +12117,24 @@ Please run with mle=-1 to get a correct 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\ 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); + } printinghtmlmort(fileresu,title,datafile, firstpass, lastpass, \ stepm, weightopt,\ model,imx,p,matcov,agemortsup); - free_vector(lsurv,1,AGESUP); - free_vector(lpop,1,AGESUP); - free_vector(tpop,1,AGESUP); -#ifdef GSL - free_ivector(cens,1,n); - free_vector(agecens,1,n); - free_ivector(dcwave,1,n); + free_vector(lsurv,agegomp,AGESUP); + free_vector(lpop,agegomp,AGESUP); + free_vector(tpop,agegomp,AGESUP); free_matrix(ximort,1,NDIM,1,NDIM); + free_ivector(dcwave,firstobs,lastobs); + free_vector(agecens,firstobs,lastobs); + free_vector(ageexmed,firstobs,lastobs); + free_ivector(cens,firstobs,lastobs); +#ifdef GSL #endif } /* Endof if mle==-3 mortality only */ /* Standard */ @@ -7697,6 +12148,10 @@ Please run with mle=-1 to get a correct printf("\n"); if(mle>=1){ /* Could be 1 or 2, Real Maximization */ /* mlikeli uses func not funcone */ + /* for(i=1;i MAXRESULTLINES){ + printf("ERROR: Current version of IMaCh limits the number of resultlines to %d, you used %d\nYou can use the 'r' parameter file '%s' which uses option mle=0 to get other results. ",MAXRESULTLINES,nresult,rfileres); + fprintf(ficlog,"ERROR: Current version of IMaCh limits the number of resultlines to %d, you used %d\nYou can use the 'r' parameter file '%s' which uses option mle=0 to get other results. ",MAXRESULTLINES,nresult,rfileres); + goto end; + } + decoderesult(resultline, nresult); /* Fills TKresult[nresult] combination and Tresult[nresult][k4+1] combination values */ + fprintf(ficparo,"result: %s\n",resultline); + fprintf(ficres,"result: %s\n",resultline); + fprintf(ficlog,"result: %s\n",resultline); + break; + case 14: + printf("Error: Unknown command '%s'\n",line); + fprintf(ficlog,"Error: Unknown command '%s'\n",line); + if(ncovmodel >=2 && nresult==0 ){ + printf("ERROR: no result lines! It should be at minimum 'result: V2=0 V1=1 or result:.' %s\n",line); + fprintf(ficlog,"ERROR: no result lines! It should be at minimum 'result: V2=0 V1=1 or result:.' %s\n",line); + } + /* goto end; */ + break; + case 15: + printf("End of resultlines.\n"); + fprintf(ficlog,"End of resultlines.\n"); + break; + default: /* parameterline =0 */ + nresult=1; + decoderesult(".",nresult ); /* No covariate */ + } /* End switch parameterline */ + }while(endishere==0); /* End do */ - /* 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); */ replace_back_to_slash(pathc,pathcd); /* Even gnuplot wants a / */ 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\ 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\ Please run with mle=-1 to get a correct covariance matrix.\n",ageminpar,agemaxpar); - }else - printinggnuplot(fileresu, optionfilefiname,ageminpar,agemaxpar,fage, pathc,p); - - printinghtml(fileresu,title,datafile, firstpass, lastpass, stepm, weightopt,\ - model,imx,jmin,jmax,jmean,rfileres,popforecast,estepm,\ - jprev1,mprev1,anprev1,jprev2,mprev2,anprev2); + }else{ + /* printinggnuplot(fileresu, optionfilefiname,ageminpar,agemaxpar,fage, prevfcast, backcast, pathc,p, (int)anproj1-(int)agemin, (int)anback1-(int)agemax+1); */ + /* It seems that anprojd which is computed from the mean year at interview which is known yet because of freqsummary */ + /* date2dmy(dateintmean,&jintmean,&mintmean,&aintmean); */ /* Done in freqsummary */ + if(prvforecast==1){ + dateprojd=(jproj1+12*mproj1+365*anproj1)/365; + jprojd=jproj1; + mprojd=mproj1; + anprojd=anproj1; + dateprojf=(jproj2+12*mproj2+365*anproj2)/365; + jprojf=jproj2; + mprojf=mproj2; + anprojf=anproj2; + } else if(prvforecast == 2){ + dateprojd=dateintmean; + date2dmy(dateprojd,&jprojd, &mprojd, &anprojd); + dateprojf=dateintmean+yrfproj; + date2dmy(dateprojf,&jprojf, &mprojf, &anprojf); + } + if(prvbackcast==1){ + datebackd=(jback1+12*mback1+365*anback1)/365; + jbackd=jback1; + mbackd=mback1; + anbackd=anback1; + datebackf=(jback2+12*mback2+365*anback2)/365; + jbackf=jback2; + mbackf=mback2; + anbackf=anback2; + } else if(prvbackcast == 2){ + datebackd=dateintmean; + date2dmy(datebackd,&jbackd, &mbackd, &anbackd); + datebackf=dateintmean-yrbproj; + date2dmy(datebackf,&jbackf, &mbackf, &anbackf); + } - /*------------ free_vector -------------*/ - /* chdir(path); */ - - free_ivector(wav,1,imx); - free_imatrix(dh,1,lastpass-firstpass+1,1,imx); - free_imatrix(bh,1,lastpass-firstpass+1,1,imx); - free_imatrix(mw,1,lastpass-firstpass+1,1,imx); - free_lvector(num,1,n); - free_vector(agedc,1,n); + printinggnuplot(fileresu, optionfilefiname,ageminpar,agemaxpar,bage, fage, prevfcast, prevbcast, pathc,p, (int)anprojd-bage, (int)anbackd-fage); + } + printinghtml(fileresu,title,datafile, firstpass, lastpass, stepm, weightopt, \ + model,imx,jmin,jmax,jmean,rfileres,popforecast,mobilav,prevfcast,mobilavproj,prevbcast, estepm, \ + jprev1,mprev1,anprev1,dateprev1, dateprojd, datebackd,jprev2,mprev2,anprev2,dateprev2,dateprojf, datebackf); + + /*------------ free_vector -------------*/ + /* chdir(path); */ + + /* free_ivector(wav,1,imx); */ /* Moved after last prevalence call */ + /* free_imatrix(dh,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_lvector(num,firstobs,lastobs); + free_vector(agedc,firstobs,lastobs); /*free_matrix(covar,0,NCOVMAX,1,n);*/ /*free_matrix(covar,1,NCOVMAX,1,n);*/ fclose(ficparo); fclose(ficres); - - + + /* Other results (useful)*/ - - + + /*--------------- Prevalence limit (period or stable prevalence) --------------*/ /*#include "prevlim.h"*/ /* Use ficrespl, ficlog */ prlim=matrix(1,nlstate,1,nlstate); - prevalence_limit(p, prlim, ageminpar, agemaxpar, ftolpl, ncvyear); + prevalence_limit(p, prlim, ageminpar, agemaxpar, ftolpl, &ncvyear); fclose(ficrespl); -#ifdef FREEEXIT2 -#include "freeexit2.h" -#endif - /*------------- h Pij x at various ages ------------*/ /*#include "hpijx.h"*/ hPijx(p, bage, fage); fclose(ficrespij); - - /*-------------- Variance of one-step probabilities---*/ + + /* ncovcombmax= pow(2,cptcoveff); */ + /*-------------- Variance of one-step probabilities---*/ k=1; varprob(optionfilefiname, matcov, p, delti, nlstate, bage, fage,k,Tvar,nbcode, ncodemax,strstart); - - - probs= ma3x(1,AGESUP,1,NCOVMAX, 1,NCOVMAX); - for(i=1;i<=AGESUP;i++) - for(j=1;j<=NCOVMAX;j++) - for(k=1;k<=NCOVMAX;k++) + + /* Prevalence for each covariate combination in probs[age][status][cov] */ + probs= ma3x(AGEINF,AGESUP,1,nlstate+ndeath, 1,ncovcombmax); + for(i=AGEINF;i<=AGESUP;i++) + for(j=1;j<=nlstate+ndeath;j++) /* ndeath is useless but a necessity to be compared with mobaverages */ + for(k=1;k<=ncovcombmax;k++) 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(AGEINF, AGESUP,1,nlstate+ndeath, 1,ncovcombmax); + for(i=AGEINF;i<=AGESUP;i++) + for(j=1;j<=nlstate+ndeath;j++) + for(k=1;k<=ncovcombmax;k++) + mobaverages[i][j][k]=0.; + mobaverage=mobaverages; + if (mobilav!=0) { + printf("Movingaveraging observed prevalence\n"); + fprintf(ficlog,"Movingaveraging observed prevalence\n"); + 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); + } + } else if (mobilavproj !=0) { + printf("Movingaveraging projected observed prevalence\n"); + fprintf(ficlog,"Movingaveraging projected observed prevalence\n"); + 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); + } + }else{ + printf("Internal error moving average\n"); + fflush(stdout); + exit(1); + } + }/* end if moving average */ + /*---------- Forecasting ------------------*/ - /*if((stepm == 1) && (strcmp(model,".")==0)){*/ - if(prevfcast==1){ - /* if(stepm ==1){*/ - prevforecast(fileresu, anproj1, mproj1, jproj1, agemin, agemax, dateprev1, dateprev2, mobilavproj, bage, fage, firstpass, lastpass, anproj2, p, cptcoveff); - /* (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------------ */ - - /* 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); - */ + if(prevfcast==1){ + /* /\* if(stepm ==1){*\/ */ + /* /\* anproj1, mproj1, jproj1 either read explicitly or yrfproj *\/ */ + /*This done previously after freqsummary.*/ + /* dateprojd=(jproj1+12*mproj1+365*anproj1)/365; */ + /* dateprojf=(jproj2+12*mproj2+365*anproj2)/365; */ + + /* } else if (prvforecast==2){ */ + /* /\* if(stepm ==1){*\/ */ + /* /\* anproj1, mproj1, jproj1 either read explicitly or yrfproj *\/ */ + /* } */ + /*prevforecast(fileresu, dateintmean, anproj1, mproj1, jproj1, agemin, agemax, dateprev1, dateprev2, mobilavproj, mobaverage, bage, fage, firstpass, lastpass, anproj2, p, cptcoveff);*/ + prevforecast(fileresu,dateintmean, dateprojd, dateprojf, agemin, agemax, dateprev1, dateprev2, mobilavproj, mobaverage, bage, fage, firstpass, lastpass, p, cptcoveff); + } + + /* Prevbcasting */ + if(prevbcast==1){ + 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); + + /* /\* prevbackforecast(fileresu, mobaverage, anback1, mback1, jback1, agemin, agemax, dateprev1, dateprev2, *\/ */ + /* /\* mobilavproj, bage, fage, firstpass, lastpass, anback2, p, cptcoveff); *\/ */ + /* prevbackforecast(fileresu, mobaverage, anback1, mback1, jback1, agemin, agemax, dateprev1, dateprev2, */ + /* mobilavproj, bage, fage, firstpass, lastpass, anback2, p, cptcoveff); */ + prevbackforecast(fileresu, mobaverage, dateintmean, dateprojd, dateprojf, agemin, agemax, dateprev1, dateprev2, + mobilavproj, bage, fage, firstpass, lastpass, p, cptcoveff); - 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); - } - } + + varbprlim(fileresu, nresult, mobaverage, mobilavproj, bage, fage, bprlim, &ncvyear, ftolpl, p, matcov, delti, stepm, cptcoveff); + + free_matrix(bprlim,1,nlstate,1,nlstate); /*here or after loop ? */ + 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); + } /* end Prevbcasting */ + + + /* ------ Other prevalence ratios------------ */ + free_ivector(wav,1,imx); + free_imatrix(dh,1,lastpass-firstpass+2,1,imx); + free_imatrix(bh,1,lastpass-firstpass+2,1,imx); + free_imatrix(mw,1,lastpass-firstpass+2,1,imx); + + /*---------- Health expectancies, no variances ------------*/ - + strcpy(filerese,"E_"); strcat(filerese,fileresu); if((ficreseij=fopen(filerese,"w"))==NULL) { printf("Problem with Health Exp. resultfile: %s\n", filerese); exit(0); fprintf(ficlog,"Problem with Health Exp. resultfile: %s\n", filerese); exit(0); } - printf("Computing Health Expectancies: result on file '%s' \n", filerese); - fprintf(ficlog,"Computing Health Expectancies: result on file '%s' \n", filerese); - /*for(cptcov=1,k=0;cptcov<=i1;cptcov++){ - for(cptcod=1;cptcod<=ncodemax[cptcov];cptcod++){*/ - - for (k=1; k <= (int) pow(2,cptcoveff); k++){ - fprintf(ficreseij,"\n#****** "); - for(j=1;j<=cptcoveff;j++) { - fprintf(ficreseij,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); - } - fprintf(ficreseij,"******\n"); + printf("Computing Health Expectancies: result on file '%s' ...", filerese);fflush(stdout); + fprintf(ficlog,"Computing Health Expectancies: result on file '%s' ...", filerese);fflush(ficlog); - 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); + pstamp(ficreseij); + + i1=pow(2,cptcoveff); /* Number of combination of dummy covariates */ + if (cptcovn < 1){i1=1;} + + for(nres=1; nres <= nresult; nres++) /* For each resultline */ + for(k=1; k<=i1;k++){ /* For any combination of dummy covariates, fixed and varying */ + if(i1 != 1 && TKresult[nres]!= k) + continue; + fprintf(ficreseij,"\n#****** "); + printf("\n#****** "); + for(j=1;j<=cptcoveff;j++) { + fprintf(ficreseij,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); + printf("V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); + } + for (j=1; j<= nsq; j++){ /* For each selected (single) quantitative value */ + printf(" V%d=%f ",Tvqresult[nres][j],Tqresult[nres][j]); + fprintf(ficreseij," V%d=%f ",Tvqresult[nres][j],Tqresult[nres][j]); + } + fprintf(ficreseij,"******\n"); + printf("******\n"); - 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, nres); + + free_ma3x(eij,1,nlstate,1,nlstate,(int) bage, (int)fage); } fclose(ficreseij); + printf("done evsij\n");fflush(stdout); + fprintf(ficlog,"done evsij\n");fflush(ficlog); - - /*---------- Health expectancies and variances ------------*/ - - + + /*---------- State-specific expectancies and variances ------------*/ + strcpy(filerest,"T_"); strcat(filerest,fileresu); if((ficrest=fopen(filerest,"w"))==NULL) { printf("Problem with total LE resultfile: %s\n", filerest);goto end; fprintf(ficlog,"Problem with total LE resultfile: %s\n", filerest);goto end; } - printf("Computing Total Life expectancies with their standard errors: file '%s' \n", filerest); - fprintf(ficlog,"Computing Total Life expectancies with their standard errors: file '%s' \n", filerest); - - + 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); strcpy(fileresstde,"STDE_"); strcat(fileresstde,fileresu); if((ficresstdeij=fopen(fileresstde,"w"))==NULL) { - printf("Problem with Health 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); + printf("Problem with State specific 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); - fprintf(ficlog,"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 State-specific Expectancies and standard errors: result on file '%s' \n", fileresstde); strcpy(filerescve,"CVE_"); strcat(filerescve,fileresu); if((ficrescveij=fopen(filerescve,"w"))==NULL) { - printf("Problem with Covar. Health Exp. resultfile: %s\n", filerescve); exit(0); - fprintf(ficlog,"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. State-specific Exp. resultfile: %s\n", filerescve); exit(0); } - printf("Computing Covar. of Health Expectancies: result on file '%s' \n", filerescve); - fprintf(ficlog,"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 State-specific Expectancies: result on file '%s' \n", filerescve); strcpy(fileresv,"V_"); strcat(fileresv,fileresu); @@ -8098,172 +12787,221 @@ Please run with mle=-1 to get a correct printf("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' \n", fileresv); - fprintf(ficlog,"Computing Variance-covariance of DFLEs: file '%s' \n", fileresv); - - /*for(cptcov=1,k=0;cptcov<=i1;cptcov++){ - for(cptcod=1;cptcod<=ncodemax[cptcov];cptcod++){*/ - - for (k=1; k <= (int) pow(2,cptcoveff); k++){ - fprintf(ficrest,"\n#****** "); - for(j=1;j<=cptcoveff;j++) - fprintf(ficrest,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); - fprintf(ficrest,"******\n"); - - fprintf(ficresstdeij,"\n#****** "); - fprintf(ficrescveij,"\n#****** "); - for(j=1;j<=cptcoveff;j++) { - fprintf(ficresstdeij,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); - fprintf(ficrescveij,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); - } - fprintf(ficresstdeij,"******\n"); - fprintf(ficrescveij,"******\n"); - - fprintf(ficresvij,"\n#****** "); - for(j=1;j<=cptcoveff;j++) - fprintf(ficresvij,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); - fprintf(ficresvij,"******\n"); - - eij=ma3x(1,nlstate,1,nlstate,(int) bage, (int) fage); - oldm=oldms;savm=savms; - cvevsij(eij, p, nlstate, stepm, (int) bage, (int)fage, oldm, savm, k, estepm, delti, matcov, strstart); - /* - */ - /* goto endfree; */ - - vareij=ma3x(1,nlstate,1,nlstate,(int) bage, (int) fage); - pstamp(ficrest); + printf(" Computing Variance-covariance of State-specific Expectancies: file '%s' ... ", fileresv);fflush(stdout); + fprintf(ficlog," Computing Variance-covariance of State-specific Expectancies: file '%s' ... ", fileresv);fflush(ficlog); - - for(vpopbased=0; vpopbased <= popbased; vpopbased++){ /* Done for vpopbased=0 and vpopbased=1 if popbased==1*/ - oldm=oldms;savm=savms; /* ZZ Segmentation fault */ - cptcod= 0; /* To be deleted */ - 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 "); - if(vpopbased==1) - fprintf(ficrest,"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(ficrest,"the age specific period (stable) prevalences in each health state \n"); - fprintf(ficrest,"# Age popbased mobilav e.. (std) "); - for (i=1;i<=nlstate;i++) fprintf(ficrest,"e.%d (std) ",i); - fprintf(ficrest,"\n"); - /* printf("Which p?\n"); for(i=1;i<=npar;i++)printf("p[i=%d]=%lf,",i,p[i]);printf("\n"); */ - epj=vector(1,nlstate+1); - for(age=bage; age <=fage ;age++){ - prevalim(prlim, nlstate, p, age, oldm, savm, ftolpl, ncvyear, k); /*ZZ Is it the correct prevalim */ - if (vpopbased==1) { - if(mobilav ==0){ - for(i=1; i<=nlstate;i++) - prlim[i][i]=probs[(int)age][i][k]; - }else{ /* mobilav */ - for(i=1; i<=nlstate;i++) - prlim[i][i]=mobaverage[(int)age][i][k]; - } - } - - fprintf(ficrest," %4.0f %d %d",age, vpopbased, mobilav); - /* fprintf(ficrest," %4.0f %d %d %d %d",age, vpopbased, mobilav,Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); */ /* to be done */ - /* printf(" age %4.0f ",age); */ - for(j=1, epj[nlstate+1]=0.;j <=nlstate;j++){ - for(i=1, epj[j]=0.;i <=nlstate;i++) { - epj[j] += prlim[i][i]*eij[i][j][(int)age]; - /*ZZZ printf("%lf %lf ", prlim[i][i] ,eij[i][j][(int)age]);*/ - /* printf("%lf %lf ", prlim[i][i] ,eij[i][j][(int)age]); */ - } - epj[nlstate+1] +=epj[j]; + i1=pow(2,cptcoveff); /* Number of combination of dummy covariates */ + if (cptcovn < 1){i1=1;} + + for(nres=1; nres <= nresult; nres++) /* For each resultline */ + for(k=1; k<=i1;k++){ /* For any combination of dummy covariates, fixed and varying */ + if(i1 != 1 && TKresult[nres]!= k) + continue; + printf("\n#****** Result for:"); + fprintf(ficrest,"\n#****** Result for:"); + fprintf(ficlog,"\n#****** Result for:"); + 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(ficlog,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); + } + for (j=1; j<= nsq; j++){ /* For each selected (single) quantitative value */ + printf(" V%d=%f ",Tvqresult[nres][j],Tqresult[nres][j]); + fprintf(ficrest," V%d=%f ",Tvqresult[nres][j],Tqresult[nres][j]); + fprintf(ficlog," V%d=%f ",Tvqresult[nres][j],Tqresult[nres][j]); + } + fprintf(ficrest,"******\n"); + fprintf(ficlog,"******\n"); + printf("******\n"); + + fprintf(ficresstdeij,"\n#****** "); + fprintf(ficrescveij,"\n#****** "); + for(j=1;j<=cptcoveff;j++) { + fprintf(ficresstdeij,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); + fprintf(ficrescveij,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); + } + for (j=1; j<= nsq; j++){ /* For each selected (single) quantitative value */ + fprintf(ficresstdeij," V%d=%f ",Tvqresult[nres][j],Tqresult[nres][j]); + fprintf(ficrescveij," V%d=%f ",Tvqresult[nres][j],Tqresult[nres][j]); + } + fprintf(ficresstdeij,"******\n"); + fprintf(ficrescveij,"******\n"); + + fprintf(ficresvij,"\n#****** "); + /* pstamp(ficresvij); */ + for(j=1;j<=cptcoveff;j++) + fprintf(ficresvij,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); + for (j=1; j<= nsq; j++){ /* For each selected (single) quantitative value */ + fprintf(ficresvij," V%d=%f ",Tvqresult[nres][j],Tqresult[nres][j]); + } + fprintf(ficresvij,"******\n"); + + eij=ma3x(1,nlstate,1,nlstate,(int) bage, (int) fage); + oldm=oldms;savm=savms; + printf(" cvevsij "); + fprintf(ficlog, " cvevsij "); + cvevsij(eij, p, nlstate, stepm, (int) bage, (int)fage, oldm, savm, k, estepm, delti, matcov, strstart, nres); + printf(" end cvevsij \n "); + fprintf(ficlog, " end cvevsij \n "); + + /* + */ + /* goto endfree; */ + + vareij=ma3x(1,nlstate,1,nlstate,(int) bage, (int) fage); + pstamp(ficrest); + + epj=vector(1,nlstate+1); + for(vpopbased=0; vpopbased <= popbased; vpopbased++){ /* Done for vpopbased=0 and vpopbased=1 if popbased==1*/ + oldm=oldms;savm=savms; /* ZZ Segmentation fault */ + cptcod= 0; /* To be deleted */ + printf("varevsij vpopbased=%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, nres); /* 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 "); + if(vpopbased==1) + fprintf(ficrest,"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(ficrest,"the age specific forward period (stable) prevalences in each health state \n"); + fprintf(ficrest,"# Age popbased mobilav e.. (std) "); + for (i=1;i<=nlstate;i++) fprintf(ficrest,"e.%d (std) ",i); + fprintf(ficrest,"\n"); + /* printf("Which p?\n"); for(i=1;i<=npar;i++)printf("p[i=%d]=%lf,",i,p[i]);printf("\n"); */ + printf("Computing age specific forward period (stable) prevalences in each health state \n"); + fprintf(ficlog,"Computing age specific forward period (stable) prevalences in each health state \n"); + for(age=bage; age <=fage ;age++){ + prevalim(prlim, nlstate, p, age, oldm, savm, ftolpl, &ncvyear, k, nres); /*ZZ Is it the correct prevalim */ + if (vpopbased==1) { + if(mobilav ==0){ + for(i=1; i<=nlstate;i++) + prlim[i][i]=probs[(int)age][i][k]; + }else{ /* mobilav */ + for(i=1; i<=nlstate;i++) + prlim[i][i]=mobaverage[(int)age][i][k]; } - /* printf(" age %4.0f \n",age); */ - - for(i=1, vepp=0.;i <=nlstate;i++) - for(j=1;j <=nlstate;j++) - vepp += vareij[i][j][(int)age]; - fprintf(ficrest," %7.3f (%7.3f)", epj[nlstate+1],sqrt(vepp)); - for(j=1;j <=nlstate;j++){ - fprintf(ficrest," %7.3f (%7.3f)", epj[j],sqrt(vareij[j][j][(int)age])); + } + + fprintf(ficrest," %4.0f %d %d",age, vpopbased, mobilav); + /* fprintf(ficrest," %4.0f %d %d %d %d",age, vpopbased, mobilav,Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); */ /* to be done */ + /* printf(" age %4.0f ",age); */ + for(j=1, epj[nlstate+1]=0.;j <=nlstate;j++){ + for(i=1, epj[j]=0.;i <=nlstate;i++) { + epj[j] += prlim[i][i]*eij[i][j][(int)age]; + /*ZZZ printf("%lf %lf ", prlim[i][i] ,eij[i][j][(int)age]);*/ + /* printf("%lf %lf ", prlim[i][i] ,eij[i][j][(int)age]); */ } - fprintf(ficrest,"\n"); + epj[nlstate+1] +=epj[j]; + } + /* printf(" age %4.0f \n",age); */ + + for(i=1, vepp=0.;i <=nlstate;i++) + for(j=1;j <=nlstate;j++) + vepp += vareij[i][j][(int)age]; + fprintf(ficrest," %7.3f (%7.3f)", epj[nlstate+1],sqrt(vepp)); + for(j=1;j <=nlstate;j++){ + fprintf(ficrest," %7.3f (%7.3f)", epj[j],sqrt(vareij[j][j][(int)age])); } + fprintf(ficrest,"\n"); } - free_ma3x(eij,1,nlstate,1,nlstate,(int) bage, (int)fage); - free_ma3x(vareij,1,nlstate,1,nlstate,(int) bage, (int)fage); - free_vector(epj,1,nlstate+1); - /*}*/ - } - free_vector(weight,1,n); + } /* End vpopbased */ + free_vector(epj,1,nlstate+1); + free_ma3x(eij,1,nlstate,1,nlstate,(int) bage, (int)fage); + free_ma3x(vareij,1,nlstate,1,nlstate,(int) bage, (int)fage); + printf("done selection\n");fflush(stdout); + fprintf(ficlog,"done selection\n");fflush(ficlog); + + } /* End k selection */ + + printf("done State-specific expectancies\n");fflush(stdout); + fprintf(ficlog,"done State-specific expectancies\n");fflush(ficlog); + + /* variance-covariance of forward period prevalence*/ + varprlim(fileresu, nresult, mobaverage, mobilavproj, bage, fage, prlim, &ncvyear, ftolpl, p, matcov, delti, stepm, cptcoveff); + + + free_vector(weight,firstobs,lastobs); 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_imatrix(s,1,maxwav+1,firstobs,lastobs); + free_matrix(anint,1,maxwav,firstobs,lastobs); + free_matrix(mint,1,maxwav,firstobs,lastobs); + free_ivector(cod,firstobs,lastobs); free_ivector(tab,1,NCOVMAX); fclose(ficresstdeij); fclose(ficrescveij); fclose(ficresvij); fclose(ficrest); fclose(ficpar); - - /*------- Variance of period (stable) prevalence------*/ - - strcpy(fileresvpl,"VPL_"); - strcat(fileresvpl,fileresu); - if((ficresvpl=fopen(fileresvpl,"w"))==NULL) { - printf("Problem with variance of period (stable) prevalence resultfile: %s\n", fileresvpl); - exit(0); - } - printf("Computing Variance-covariance of period (stable) prevalence: file '%s' \n", fileresvpl); - - /*for(cptcov=1,k=0;cptcov<=i1;cptcov++){ - for(cptcod=1;cptcod<=ncodemax[cptcov];cptcod++){*/ - - for (k=1; k <= (int) pow(2,cptcoveff); k++){ - fprintf(ficresvpl,"\n#****** "); - for(j=1;j<=cptcoveff;j++) - fprintf(ficresvpl,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); - fprintf(ficresvpl,"******\n"); - - varpl=matrix(1,nlstate,(int) bage, (int) fage); - oldm=oldms;savm=savms; - 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); - /*}*/ - } - - fclose(ficresvpl); - + + /*---------- End : free ----------------*/ - if (mobilav!=0) free_ma3x(mobaverage,1, AGESUP,1,NCOVMAX, 1,NCOVMAX); - free_ma3x(probs,1,AGESUP,1,NCOVMAX, 1,NCOVMAX); - } /* mle==-3 arrives here for freeing */ - /* endfree:*/ + if (mobilav!=0 ||mobilavproj !=0) + free_ma3x(mobaverages,AGEINF, AGESUP,1,nlstate+ndeath, 1,ncovcombmax); /* We need to have a squared matrix with prevalence of the dead! */ + free_ma3x(probs,AGEINF,AGESUP,1,nlstate+ndeath, 1,ncovcombmax); free_matrix(prlim,1,nlstate,1,nlstate); /*here or after loop ? */ free_matrix(pmmij,1,nlstate+ndeath,1,nlstate+ndeath); - free_matrix(oldms, 1,nlstate+ndeath,1,nlstate+ndeath); - free_matrix(newms, 1,nlstate+ndeath,1,nlstate+ndeath); - free_matrix(savms, 1,nlstate+ndeath,1,nlstate+ndeath); - free_matrix(covar,0,NCOVMAX,1,n); - free_matrix(matcov,1,npar,1,npar); - free_matrix(hess,1,npar,1,npar); - /*free_vector(delti,1,npar);*/ - free_ma3x(delti3,1,nlstate,1, nlstate+ndeath-1,1,ncovmodel); - free_matrix(agev,1,maxwav,1,imx); - free_ma3x(param,1,nlstate,1, nlstate+ndeath-1,1,ncovmodel); - - free_ivector(ncodemax,1,NCOVMAX); - free_ivector(ncodemaxwundef,1,NCOVMAX); - free_ivector(Tvar,1,NCOVMAX); - free_ivector(Tprod,1,NCOVMAX); - free_ivector(Tvaraff,1,NCOVMAX); - free_ivector(Tage,1,NCOVMAX); - - free_imatrix(nbcode,0,NCOVMAX,0,NCOVMAX); - /* free_imatrix(codtab,1,100,1,10); */ + } /* mle==-3 arrives here for freeing */ + /* endfree:*/ + free_matrix(oldms, 1,nlstate+ndeath,1,nlstate+ndeath); + free_matrix(newms, 1,nlstate+ndeath,1,nlstate+ndeath); + free_matrix(savms, 1,nlstate+ndeath,1,nlstate+ndeath); + if(ntv+nqtv>=1)free_ma3x(cotvar,1,maxwav,1,ntv+nqtv,firstobs,lastobs); + if(nqtv>=1)free_ma3x(cotqvar,1,maxwav,1,nqtv,firstobs,lastobs); + if(nqv>=1)free_matrix(coqvar,1,nqv,firstobs,lastobs); + free_matrix(covar,0,NCOVMAX,firstobs,lastobs); + free_matrix(matcov,1,npar,1,npar); + free_matrix(hess,1,npar,1,npar); + /*free_vector(delti,1,npar);*/ + free_ma3x(delti3,1,nlstate,1, nlstate+ndeath-1,1,ncovmodel); + free_matrix(agev,1,maxwav,1,imx); + free_ma3x(paramstart,1,nlstate,1, nlstate+ndeath-1,1,ncovmodel); + free_ma3x(param,1,nlstate,1, nlstate+ndeath-1,1,ncovmodel); + + free_ivector(ncodemax,1,NCOVMAX); + free_ivector(ncodemaxwundef,1,NCOVMAX); + free_ivector(Dummy,-1,NCOVMAX); + free_ivector(Fixed,-1,NCOVMAX); + free_ivector(DummyV,1,NCOVMAX); + free_ivector(FixedV,1,NCOVMAX); + free_ivector(Typevar,-1,NCOVMAX); + free_ivector(Tvar,1,NCOVMAX); + free_ivector(TvarsQ,1,NCOVMAX); + free_ivector(TvarsQind,1,NCOVMAX); + free_ivector(TvarsD,1,NCOVMAX); + free_ivector(TvarsDind,1,NCOVMAX); + free_ivector(TvarFD,1,NCOVMAX); + free_ivector(TvarFDind,1,NCOVMAX); + free_ivector(TvarF,1,NCOVMAX); + free_ivector(TvarFind,1,NCOVMAX); + free_ivector(TvarV,1,NCOVMAX); + free_ivector(TvarVind,1,NCOVMAX); + free_ivector(TvarA,1,NCOVMAX); + free_ivector(TvarAind,1,NCOVMAX); + free_ivector(TvarFQ,1,NCOVMAX); + free_ivector(TvarFQind,1,NCOVMAX); + free_ivector(TvarVD,1,NCOVMAX); + free_ivector(TvarVDind,1,NCOVMAX); + free_ivector(TvarVQ,1,NCOVMAX); + free_ivector(TvarVQind,1,NCOVMAX); + free_ivector(Tvarsel,1,NCOVMAX); + free_vector(Tvalsel,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_ivector(TmodelInvind,1,NCOVMAX); + free_ivector(TmodelInvQind,1,NCOVMAX); + + free_imatrix(nbcode,0,NCOVMAX,0,NCOVMAX); + /* free_imatrix(codtab,1,100,1,10); */ fflush(fichtm); fflush(ficgp); - + if((nberr >0) || (nbwarn>0)){ - printf("End of Imach with %d errors and/or %d warnings\n",nberr,nbwarn); - fprintf(ficlog,"End of Imach with %d errors and/or warnings %d\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); }else{ printf("End of Imach\n"); fprintf(ficlog,"End of Imach\n"); @@ -8278,7 +13016,7 @@ Please run with mle=-1 to get a correct 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); 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)); 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)); @@ -8291,17 +13029,19 @@ Please run with mle=-1 to get a correct fclose(ficgp); fclose(ficlog); /*------ End -----------*/ + - - printf("Before Current directory %s!\n",pathcd); +/* Executes gnuplot */ + + printf("Before Current directory %s!\n",pathcd); #ifdef WIN32 - if (_chdir(pathcd) != 0) - printf("Can't move to directory %s!\n",path); - if(_getcwd(pathcd,MAXLINE) > 0) + if (_chdir(pathcd) != 0) + printf("Can't move to directory %s!\n",path); + if(_getcwd(pathcd,MAXLINE) > 0) #else - if(chdir(pathcd) != 0) - printf("Can't move to directory %s!\n", path); - if (getcwd(pathcd, MAXLINE) > 0) + if(chdir(pathcd) != 0) + printf("Can't move to directory %s!\n", path); + if (getcwd(pathcd, MAXLINE) > 0) #endif printf("Current directory %s!\n",pathcd); /*strcat(plotcmd,CHARSEPARATOR);*/ @@ -8327,13 +13067,16 @@ Please run with mle=-1 to get a correct sprintf(plotcmd,"%s %s",pplotcmd, optionfilegnuplot); printf("Starting graphs with: '%s'\n",plotcmd);fflush(stdout); - + strcpy(pplotcmd,plotcmd); + if((outcmd=system(plotcmd)) != 0){ - printf("gnuplot command might not be in your path: '%s', err=%d\n", plotcmd, outcmd); + printf("Error in 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"); sprintf(plotcmd,"%sgnuplot %s", pathimach, optionfilegnuplot); - if((outcmd=system(plotcmd)) != 0) + if((outcmd=system(plotcmd)) != 0){ printf("\n Still a problem with gnuplot command %s, err=%d\n", plotcmd, outcmd); + strcpy(plotcmd,pplotcmd); + } } printf(" Successful, please wait..."); while (z[0] != 'q') { @@ -8355,9 +13098,11 @@ Please run with mle=-1 to get a correct else if (z[0] == 'g') system(plotcmd); else if (z[0] == 'q') exit(0); } - end: +end: while (z[0] != 'q') { printf("\nType q for exiting: "); fflush(stdout); scanf("%s",z); } + printf("End\n"); + exit(0); }