version 1.209, 2015/11/17 22:12:03
|
version 1.278, 2017/07/19 14:09:02
|
Line 1
|
Line 1
|
/* $Id$ |
/* $Id$ |
$State$ |
$State$ |
$Log$ |
$Log$ |
Revision 1.209 2015/11/17 22:12:03 brouard |
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 |
Summary: Adding ftolpl parameter |
Author: N Brouard |
Author: N Brouard |
|
|
Line 584
|
Line 794
|
|
|
Short summary of the programme: |
Short summary of the programme: |
|
|
This program computes Healthy Life Expectancies from |
This program computes Healthy Life Expectancies or State-specific |
cross-longitudinal data. Cross-longitudinal data consist in: -1- a |
(if states aren't health statuses) Expectancies from |
first survey ("cross") where individuals from different ages are |
cross-longitudinal data. Cross-longitudinal data consist in: |
interviewed on their health status or degree of disability (in the |
|
case of a health survey which is our main interest) -2- at least a |
-1- a first survey ("cross") where individuals from different ages |
second wave of interviews ("longitudinal") which measure each change |
are interviewed on their health status or degree of disability (in |
(if any) in individual health status. Health expectancies are |
the case of a health survey which is our main interest) |
computed from the time spent in each health state according to a |
|
model. More health states you consider, more time is necessary to reach the |
-2- at least a second wave of interviews ("longitudinal") which |
Maximum Likelihood of the parameters involved in the model. The |
measure each change (if any) in individual health status. Health |
simplest model is the multinomial logistic model where pij is the |
expectancies are computed from the time spent in each health state |
probability to be observed in state j at the second wave |
according to a model. More health states you consider, more time is |
conditional to be observed in state i at the first wave. Therefore |
necessary to reach the Maximum Likelihood of the parameters involved |
the model is: log(pij/pii)= aij + bij*age+ cij*sex + etc , where |
in the model. The simplest model is the multinomial logistic model |
'age' is age and 'sex' is a covariate. If you want to have a more |
where pij is the probability to be observed in state j at the second |
complex model than "constant and age", you should modify the program |
wave conditional to be observed in state i at the first |
where the markup *Covariates have to be included here again* invites |
wave. Therefore the model is: log(pij/pii)= aij + bij*age+ cij*sex + |
you to do it. More covariates you add, slower the |
etc , where 'age' is age and 'sex' is a covariate. If you want to |
|
have a more complex model than "constant and age", you should modify |
|
the program where the markup *Covariates have to be included here |
|
again* invites you to do it. More covariates you add, slower the |
convergence. |
convergence. |
|
|
The advantage of this computer programme, compared to a simple |
The advantage of this computer programme, compared to a simple |
Line 620
|
Line 833
|
hPijx. |
hPijx. |
|
|
Also this programme outputs the covariance matrix of the parameters but also |
Also this programme outputs the covariance matrix of the parameters but also |
of the life expectancies. It also computes the period (stable) prevalence. |
of the life expectancies. It also computes the period (stable) prevalence. |
|
|
|
Back prevalence and projections: |
|
|
|
- back_prevalence_limit(double *p, double **bprlim, double ageminpar, |
|
double agemaxpar, double ftolpl, int *ncvyearp, double |
|
dateprev1,double dateprev2, int firstpass, int lastpass, int |
|
mobilavproj) |
|
|
|
Computes the back prevalence limit for any combination of |
|
covariate values k at any age between ageminpar and agemaxpar and |
|
returns it in **bprlim. In the loops, |
|
|
|
- **bprevalim(**bprlim, ***mobaverage, nlstate, *p, age, **oldm, |
|
**savm, **dnewm, **doldm, **dsavm, ftolpl, ncvyearp, k); |
|
|
|
- hBijx Back Probability to be in state i at age x-h being in j at x |
|
Computes for any combination of covariates k and any age between bage and fage |
|
p3mat=ma3x(1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); |
|
oldm=oldms;savm=savms; |
|
|
|
- hbxij(p3mat,nhstepm,agedeb,hstepm,p,nlstate,stepm,oldm,savm, k, 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). |
Authors: Nicolas Brouard (brouard@ined.fr) and Agnès Lièvre (lievre@ined.fr). |
Institut national d'études démographiques, Paris. |
Institut national d'études démographiques, Paris. |
Line 682
|
Line 943
|
/* #define DEBUGLINMIN */ |
/* #define DEBUGLINMIN */ |
/* #define DEBUGHESS */ |
/* #define DEBUGHESS */ |
#define DEBUGHESSIJ |
#define DEBUGHESSIJ |
/* #define LINMINORIGINAL /\* Don't use loop on scale in linmin (accepting nan)*\/ */ |
/* #define LINMINORIGINAL /\* Don't use loop on scale in linmin (accepting nan) *\/ */ |
#define POWELL /* Instead of NLOPT */ |
#define POWELL /* Instead of NLOPT */ |
#define POWELLF1F3 /* Skip test */ |
#define POWELLNOF3INFF1TEST /* Skip test */ |
/* #define POWELLORIGINAL /\* Don't use Directest to decide new direction but original Powell test *\/ */ |
/* #define POWELLORIGINAL /\* Don't use Directest to decide new direction but original Powell test *\/ */ |
/* #define MNBRAKORIGINAL /\* Don't use mnbrak fix *\/ */ |
/* #define MNBRAKORIGINAL /\* Don't use mnbrak fix *\/ */ |
|
|
Line 692
|
Line 953
|
#include <stdio.h> |
#include <stdio.h> |
#include <stdlib.h> |
#include <stdlib.h> |
#include <string.h> |
#include <string.h> |
|
#include <ctype.h> |
|
|
#ifdef _WIN32 |
#ifdef _WIN32 |
#include <io.h> |
#include <io.h> |
Line 737 typedef struct {
|
Line 999 typedef struct {
|
/* #include <libintl.h> */ |
/* #include <libintl.h> */ |
/* #define _(String) gettext (String) */ |
/* #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 "gnuplot" |
/*#define GNUPLOTPROGRAM "..\\gp37mgw\\wgnuplot"*/ |
/*#define GNUPLOTPROGRAM "..\\gp37mgw\\wgnuplot"*/ |
Line 754 typedef struct {
|
Line 1016 typedef struct {
|
#define NDEATHMAX 8 /**< Maximum number of dead 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 codtabm(h,k) (1 & (h-1) >> (k-1))+1 |
|
/*#define decodtabm(h,k,cptcoveff)= (h <= (1<<cptcoveff)?(((h-1) >> (k-1)) & 1) +1 : -1)*/ |
|
#define decodtabm(h,k,cptcoveff) (((h-1) >> (k-1)) & 1) +1 |
#define MAXN 20000 |
#define MAXN 20000 |
#define YEARM 12. /**< Number of months per year */ |
#define YEARM 12. /**< Number of months per year */ |
#define AGESUP 130 |
/* #define AGESUP 130 */ |
|
#define AGESUP 150 |
|
#define AGEINF 0 |
|
#define AGEMARGE 25 /* Marge for agemin and agemax for(iage=agemin-AGEMARGE; iage <= agemax+3+AGEMARGE; iage++) */ |
#define AGEBASE 40 |
#define AGEBASE 40 |
#define AGEOVERFLOW 1.e20 |
#define AGEOVERFLOW 1.e20 |
#define AGEGOMP 10 /**< Minimal age for Gompertz adjustment */ |
#define AGEGOMP 10 /**< Minimal age for Gompertz adjustment */ |
Line 774 typedef struct {
|
Line 1041 typedef struct {
|
/* $State$ */ |
/* $State$ */ |
#include "version.h" |
#include "version.h" |
char version[]=__IMACH_VERSION__; |
char version[]=__IMACH_VERSION__; |
char copyright[]="October 2015,INED-EUROREVES-Institut de longevite-Japan Society for the Promotion of Science (Grant-in-Aid for Scientific Research 25293121), Intel Software 2015"; |
char copyright[]="February 2016,INED-EUROREVES-Institut de longevite-Japan Society for the Promotion of Science (Grant-in-Aid for Scientific Research 25293121), Intel Software 2015-2018"; |
char fullversion[]="$Revision$ $Date$"; |
char fullversion[]="$Revision$ $Date$"; |
char strstart[80]; |
char strstart[80]; |
char optionfilext[10], optionfilefiname[FILENAMELENGTH]; |
char optionfilext[10], optionfilefiname[FILENAMELENGTH]; |
Line 783 int nagesqr=0, nforce=0; /* nagesqr=1 if
|
Line 1050 int nagesqr=0, nforce=0; /* nagesqr=1 if
|
/* Number of covariates model=V2+V1+ V3*age+V2*V4 */ |
/* Number of covariates model=V2+V1+ V3*age+V2*V4 */ |
int cptcovn=0; /**< cptcovn number of covariates added in the model (excepting constant and age and age*product) */ |
int cptcovn=0; /**< cptcovn number of covariates added in the model (excepting constant and age and age*product) */ |
int cptcovt=0; /**< cptcovt number of covariates added in the model (excepting constant and age) */ |
int cptcovt=0; /**< cptcovt number of covariates added in the model (excepting constant and age) */ |
int cptcovs=0; /**< cptcovs number of simple covariates V2+V1 =2 */ |
int cptcovs=0; /**< cptcovs number of simple covariates in the model V2+V1 =2 */ |
|
int cptcovsnq=0; /**< cptcovsnq number of simple covariates in the model but non quantitative V2+V1 =2 */ |
int cptcovage=0; /**< Number of covariates with age: V3*age only =1 */ |
int cptcovage=0; /**< Number of covariates with age: V3*age only =1 */ |
int cptcovprodnoage=0; /**< Number of covariate products without age */ |
int cptcovprodnoage=0; /**< Number of covariate products without age */ |
int cptcoveff=0; /* Total number of covariates to vary for printing results */ |
int cptcoveff=0; /* Total number of covariates to vary for printing results */ |
|
int 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 cptcov=0; /* Working variable */ |
|
int ncovcombmax=NCOVMAX; /* Maximum calculated number of covariate combination = pow(2, cptcoveff) */ |
int npar=NPARMAX; |
int npar=NPARMAX; |
int nlstate=2; /* Number of live states */ |
int nlstate=2; /* Number of live states */ |
int ndeath=1; /* Number of dead states */ |
int ndeath=1; /* Number of dead states */ |
int ncovmodel=0, ncovcol=0; /* Total number of covariables including constant a12*1 +b12*x ncovmodel=2 */ |
int ncovmodel=0, ncovcol=0; /* Total number of covariables including constant a12*1 +b12*x ncovmodel=2 */ |
|
int nqv=0, ntv=0, nqtv=0; /* Total number of quantitative variables, time variable (dummy), quantitative and time variable */ |
int popbased=0; |
int popbased=0; |
|
|
int *wav; /* Number of waves for this individuual 0 is possible */ |
int *wav; /* Number of waves for this individuual 0 is possible */ |
Line 806 int **dh; /* dh[mi][i] is number of step
|
Line 1085 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 |
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. */ |
* wave mi and wave mi+1 is not an exact multiple of stepm. */ |
int countcallfunc=0; /* Count the number of calls to func */ |
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 jmean=1; /* Mean space between 2 waves */ |
double **matprod2(); /* test */ |
double **matprod2(); /* test */ |
double **oldm, **newm, **savm; /* Working pointers to matrices */ |
double **oldm, **newm, **savm; /* Working pointers to matrices */ |
double **oldms, **newms, **savms; /* Fixed working pointers to matrices */ |
double **oldms, **newms, **savms; /* Fixed working pointers to matrices */ |
|
double **ddnewms, **ddoldms, **ddsavms; /* for freeing later */ |
|
|
/*FILE *fic ; */ /* Used in readdata only */ |
/*FILE *fic ; */ /* Used in readdata only */ |
FILE *ficpar, *ficparo,*ficres, *ficresp, *ficrespl, *ficrespij, *ficrest,*ficresf,*ficrespop; |
FILE *ficpar, *ficparo,*ficres, *ficresp, *ficresphtm, *ficresphtmfr, *ficrespl, *ficresplb,*ficrespij, *ficrespijb, *ficrest,*ficresf, *ficresfb,*ficrespop; |
FILE *ficlog, *ficrespow; |
FILE *ficlog, *ficrespow; |
int globpr=0; /* Global variable for printing or not */ |
int globpr=0; /* Global variable for printing or not */ |
double fretone; /* Only one call to likelihood */ |
double fretone; /* Only one call to likelihood */ |
Line 831 FILE *ficrescveij;
|
Line 1114 FILE *ficrescveij;
|
char filerescve[FILENAMELENGTH]; |
char filerescve[FILENAMELENGTH]; |
FILE *ficresvij; |
FILE *ficresvij; |
char fileresv[FILENAMELENGTH]; |
char fileresv[FILENAMELENGTH]; |
FILE *ficresvpl; |
|
char fileresvpl[FILENAMELENGTH]; |
|
char title[MAXLINE]; |
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 plotcmd[FILENAMELENGTH], pplotcmd[FILENAMELENGTH]; |
char tmpout[FILENAMELENGTH], tmpout2[FILENAMELENGTH]; |
char tmpout[FILENAMELENGTH], tmpout2[FILENAMELENGTH]; |
char command[FILENAMELENGTH]; |
char command[FILENAMELENGTH]; |
int outcmd=0; |
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 fileresu[FILENAMELENGTH]; /* fileres without r in front */ |
char filelog[FILENAMELENGTH]; /* Log file */ |
char filelog[FILENAMELENGTH]; /* Log file */ |
char filerest[FILENAMELENGTH]; |
char filerest[FILENAMELENGTH]; |
Line 871 double dval;
|
Line 1154 double dval;
|
#define FTOL 1.0e-10 |
#define FTOL 1.0e-10 |
|
|
#define NRANSI |
#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 |
#define TOL 2.0e-4 |
|
|
Line 917 int *ncodemaxwundef; /* ncodemax[j]= Nu
|
Line 1201 int *ncodemaxwundef; /* ncodemax[j]= Nu
|
covariate for which somebody answered including |
covariate for which somebody answered including |
undefined. Usually 3: -1, 0 and 1. */ |
undefined. Usually 3: -1, 0 and 1. */ |
double **agev,*moisnais, *annais, *moisdc, *andc,**mint, **anint; |
double **agev,*moisnais, *annais, *moisdc, *andc,**mint, **anint; |
double **pmmij, ***probs; |
double **pmmij, ***probs; /* Global pointer */ |
|
double ***mobaverage, ***mobaverages; /* New global variable */ |
double *ageexmed,*agecens; |
double *ageexmed,*agecens; |
double dateintmean=0; |
double dateintmean=0; |
|
|
Line 927 double *agedc;
|
Line 1212 double *agedc;
|
double **covar; /**< covar[j,i], value of jth covariate for individual i, |
double **covar; /**< covar[j,i], value of jth covariate for individual i, |
* covar=matrix(0,NCOVMAX,1,n); |
* covar=matrix(0,NCOVMAX,1,n); |
* cov[Tage[kk]+2]=covar[Tvar[Tage[kk]]][i]*age; */ |
* cov[Tage[kk]+2]=covar[Tvar[Tage[kk]]][i]*age; */ |
|
double **coqvar; /* Fixed quantitative covariate nqv */ |
|
double ***cotvar; /* Time varying covariate ntv */ |
|
double ***cotqvar; /* Time varying quantitative covariate itqv */ |
double idx; |
double idx; |
int **nbcode, *Tvar; /**< model=V2 => Tvar[1]= 2 */ |
int **nbcode, *Tvar; /**< model=V2 => Tvar[1]= 2 */ |
|
/* 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 *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 *Ndum; /** Freq of modality (tricode */ |
/* int **codtab;*/ /**< codtab=imatrix(1,100,1,10); */ |
/* int **codtab;*/ /**< codtab=imatrix(1,100,1,10); */ |
int **Tvard, *Tprod, cptcovprod, *Tvaraff; |
int **Tvard; |
|
int *Tprod;/**< Gives the k position of the k1 product */ |
|
/* 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; |
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 ftol=FTOL; /**< Tolerance for computing Max Likelihood */ |
double ftolhess; /**< Tolerance for computing hessian */ |
double ftolhess; /**< Tolerance for computing hessian */ |
|
|
Line 1130 int nbocc(char *s, char occ)
|
Line 1512 int nbocc(char *s, char occ)
|
i=0; |
i=0; |
lg=strlen(s); |
lg=strlen(s); |
for(i=0; i<= lg; i++) { |
for(i=0; i<= lg; i++) { |
if (s[i] == occ ) j++; |
if (s[i] == occ ) j++; |
} |
} |
return j; |
return j; |
} |
} |
Line 1373 char *subdirf3(char fileres[], char *pre
|
Line 1755 char *subdirf3(char fileres[], char *pre
|
strcat(tmpout,fileres); |
strcat(tmpout,fileres); |
return tmpout; |
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[]) |
char *asc_diff_time(long time_sec, char ascdiff[]) |
{ |
{ |
long sec_left, days, hours, minutes; |
long sec_left, days, hours, minutes; |
Line 1451 double brent(double ax, double bx, doubl
|
Line 1856 double brent(double ax, double bx, doubl
|
etemp=e; |
etemp=e; |
e=d; |
e=d; |
if (fabs(p) >= fabs(0.5*q*etemp) || p <= q*(a-x) || p >= q*(b-x)) |
if (fabs(p) >= fabs(0.5*q*etemp) || p <= q*(a-x) || p >= q*(b-x)) |
d=CGOLD*(e=(x >= xm ? a-x : b-x)); |
d=CGOLD*(e=(x >= xm ? a-x : b-x)); |
else { |
else { |
d=p/q; |
d=p/q; |
u=x+d; |
u=x+d; |
if (u-a < tol2 || b-u < tol2) |
if (u-a < tol2 || b-u < tol2) |
d=SIGN(tol1,xm-x); |
d=SIGN(tol1,xm-x); |
} |
} |
} else { |
} else { |
d=CGOLD*(e=(x >= xm ? a-x : b-x)); |
d=CGOLD*(e=(x >= xm ? a-x : b-x)); |
Line 1470 double brent(double ax, double bx, doubl
|
Line 1875 double brent(double ax, double bx, doubl
|
} else { |
} else { |
if (u < x) a=u; else b=u; |
if (u < x) a=u; else b=u; |
if (fu <= fw || w == x) { |
if (fu <= fw || w == x) { |
v=w; |
v=w; |
w=u; |
w=u; |
fv=fw; |
fv=fw; |
fw=fu; |
fw=fu; |
} else if (fu <= fv || v == x || v == w) { |
} else if (fu <= fv || v == x || v == w) { |
v=u; |
v=u; |
fv=fu; |
fv=fu; |
} |
} |
} |
} |
} |
} |
Line 1517 values at the three points, fa, fb , and
|
Line 1922 values at the three points, fa, fb , and
|
*cx=(*bx)+GOLD*(*bx-*ax); |
*cx=(*bx)+GOLD*(*bx-*ax); |
*fc=(*func)(*cx); |
*fc=(*func)(*cx); |
#ifdef DEBUG |
#ifdef DEBUG |
printf("mnbrak0 *fb=%.12e *fc=%.12e\n",*fb,*fc); |
printf("mnbrak0 a=%lf *fa=%lf, b=%lf *fb=%lf, c=%lf *fc=%lf\n",*ax,*fa,*bx,*fb,*cx, *fc); |
fprintf(ficlog,"mnbrak0 *fb=%.12e *fc=%.12e\n",*fb,*fc); |
fprintf(ficlog,"mnbrak0 a=%lf *fa=%lf, b=%lf *fb=%lf, c=%lf *fc=%lf\n",*ax,*fa,*bx,*fb,*cx, *fc); |
#endif |
#endif |
while (*fb > *fc) { /* Declining a,b,c with fa> fb > fc */ |
while (*fb > *fc) { /* Declining a,b,c with fa> fb > fc. If fc=inf it exits and if flat fb=fc it exits too.*/ |
r=(*bx-*ax)*(*fb-*fc); |
r=(*bx-*ax)*(*fb-*fc); |
q=(*bx-*cx)*(*fb-*fa); |
q=(*bx-*cx)*(*fb-*fa); /* What if fa=inf */ |
u=(*bx)-((*bx-*cx)*q-(*bx-*ax)*r)/ |
u=(*bx)-((*bx-*cx)*q-(*bx-*ax)*r)/ |
(2.0*SIGN(FMAX(fabs(q-r),TINY),q-r)); /* Minimum abscissa of a parabolic estimated from (a,fa), (b,fb) and (c,fc). */ |
(2.0*SIGN(FMAX(fabs(q-r),TINY),q-r)); /* Minimum abscissa of a parabolic estimated from (a,fa), (b,fb) and (c,fc). */ |
ulim=(*bx)+GLIMIT*(*cx-*bx); /* Maximum abscissa where function should be evaluated */ |
ulim=(*bx)+GLIMIT*(*cx-*bx); /* Maximum abscissa where function should be evaluated */ |
Line 1533 values at the three points, fa, fb , and
|
Line 1938 values at the three points, fa, fb , and
|
double A, fparabu; |
double A, fparabu; |
A= (*fb - *fa)/(*bx-*ax)/(*bx+*ax-2*u); |
A= (*fb - *fa)/(*bx-*ax)/(*bx+*ax-2*u); |
fparabu= *fa - A*(*ax-u)*(*ax-u); |
fparabu= *fa - A*(*ax-u)*(*ax-u); |
printf("mnbrak (*ax=%.12f, *fa=%.12lf), (*bx=%.12f, *fb=%.12lf), (*cx=%.12f, *fc=%.12lf), (*u=%.12f, fu=%.12lf, fparabu=%.12f)\n",*ax,*fa,*bx,*fb,*cx,*fc,u,fu, fparabu); |
printf("\nmnbrak (*ax=%.12f, *fa=%.12lf), (*bx=%.12f, *fb=%.12lf), (*cx=%.12f, *fc=%.12lf), (*u=%.12f, fu=%.12lf, fparabu=%.12f, q=%lf < %lf=r)\n",*ax,*fa,*bx,*fb,*cx,*fc,u,fu, fparabu,q,r); |
fprintf(ficlog, "mnbrak (*ax=%.12f, *fa=%.12lf), (*bx=%.12f, *fb=%.12lf), (*cx=%.12f, *fc=%.12lf), (*u=%.12f, fu=%.12lf, fparabu=%.12f)\n",*ax,*fa,*bx,*fb,*cx,*fc,u,fu, fparabu); |
fprintf(ficlog,"\nmnbrak (*ax=%.12f, *fa=%.12lf), (*bx=%.12f, *fb=%.12lf), (*cx=%.12f, *fc=%.12lf), (*u=%.12f, fu=%.12lf, fparabu=%.12f, q=%lf < %lf=r)\n",*ax,*fa,*bx,*fb,*cx,*fc,u,fu, fparabu,q,r); |
/* And thus,it can be that fu > *fc even if fparabu < *fc */ |
/* And thus,it can be that fu > *fc even if fparabu < *fc */ |
/* mnbrak (*ax=7.666299858533, *fa=299039.693133272231), (*bx=8.595447774979, *fb=298976.598289369489), |
/* mnbrak (*ax=7.666299858533, *fa=299039.693133272231), (*bx=8.595447774979, *fb=298976.598289369489), |
(*cx=10.098840694817, *fc=298946.631474258087), (*u=9.852501168332, fu=298948.773013752128, fparabu=298945.434711494134) */ |
(*cx=10.098840694817, *fc=298946.631474258087), (*u=9.852501168332, fu=298948.773013752128, fparabu=298945.434711494134) */ |
Line 1567 values at the three points, fa, fb , and
|
Line 1972 values at the three points, fa, fb , and
|
/* fu = *fc; */ |
/* fu = *fc; */ |
/* *fc =dum; */ |
/* *fc =dum; */ |
/* } */ |
/* } */ |
#ifdef DEBUG |
#ifdef DEBUGMNBRAK |
printf("mnbrak34 fu < or >= fc \n"); |
double A, fparabu; |
fprintf(ficlog, "mnbrak34 fu < fc\n"); |
A= (*fb - *fa)/(*bx-*ax)/(*bx+*ax-2*u); |
|
fparabu= *fa - A*(*ax-u)*(*ax-u); |
|
printf("\nmnbrak35 ax=%lf fa=%lf bx=%lf fb=%lf, u=%lf fp=%lf fu=%lf < or >= fc=%lf cx=%lf, q=%lf < %lf=r \n",*ax, *fa, *bx,*fb,u,fparabu,fu,*fc,*cx,q,r); |
|
fprintf(ficlog,"\nmnbrak35 ax=%lf fa=%lf bx=%lf fb=%lf, u=%lf fp=%lf fu=%lf < or >= fc=%lf cx=%lf, q=%lf < %lf=r \n",*ax, *fa, *bx,*fb,u,fparabu,fu,*fc,*cx,q,r); |
#endif |
#endif |
dum=u; /* Shifting c and u */ |
dum=u; /* Shifting c and u */ |
u = *cx; |
u = *cx; |
Line 1580 values at the three points, fa, fb , and
|
Line 1988 values at the three points, fa, fb , and
|
#endif |
#endif |
} else if ((*cx-u)*(u-ulim) > 0.0) { /* u is after c but before ulim */ |
} else if ((*cx-u)*(u-ulim) > 0.0) { /* u is after c but before ulim */ |
#ifdef DEBUG |
#ifdef DEBUG |
printf("mnbrak2 u after c but before ulim\n"); |
printf("\nmnbrak2 u=%lf after c=%lf but before ulim\n",u,*cx); |
fprintf(ficlog, "mnbrak2 u after c but before ulim\n"); |
fprintf(ficlog,"\nmnbrak2 u=%lf after c=%lf but before ulim\n",u,*cx); |
#endif |
#endif |
fu=(*func)(u); |
fu=(*func)(u); |
if (fu < *fc) { |
if (fu < *fc) { |
#ifdef DEBUG |
#ifdef DEBUG |
printf("mnbrak2 u after c but before ulim AND fu < fc\n"); |
printf("\nmnbrak2 u=%lf after c=%lf but before ulim=%lf AND fu=%lf < %lf=fc\n",u,*cx,ulim,fu, *fc); |
fprintf(ficlog, "mnbrak2 u after c but before ulim AND fu <fc \n"); |
fprintf(ficlog,"\nmnbrak2 u=%lf after c=%lf but before ulim=%lf AND fu=%lf < %lf=fc\n",u,*cx,ulim,fu, *fc); |
|
#endif |
|
SHFT(*bx,*cx,u,*cx+GOLD*(*cx-*bx)) |
|
SHFT(*fb,*fc,fu,(*func)(u)) |
|
#ifdef DEBUG |
|
printf("\nmnbrak2 shift GOLD c=%lf",*cx+GOLD*(*cx-*bx)); |
#endif |
#endif |
SHFT(*bx,*cx,u,*cx+GOLD*(*cx-*bx)) |
|
SHFT(*fb,*fc,fu,(*func)(u)) |
|
} |
} |
} else if ((u-ulim)*(ulim-*cx) >= 0.0) { /* u outside ulim (verifying that ulim is beyond c) */ |
} else if ((u-ulim)*(ulim-*cx) >= 0.0) { /* u outside ulim (verifying that ulim is beyond c) */ |
#ifdef DEBUG |
#ifdef DEBUG |
printf("mnbrak2 u outside ulim (verifying that ulim is beyond c)\n"); |
printf("\nmnbrak2 u=%lf outside ulim=%lf (verifying that ulim is beyond c=%lf)\n",u,ulim,*cx); |
fprintf(ficlog, "mnbrak2 u outside ulim (verifying that ulim is beyond c)\n"); |
fprintf(ficlog,"\nmnbrak2 u=%lf outside ulim=%lf (verifying that ulim is beyond c=%lf)\n",u,ulim,*cx); |
#endif |
#endif |
u=ulim; |
u=ulim; |
fu=(*func)(u); |
fu=(*func)(u); |
} else { /* u could be left to b (if r > q parabola has a maximum) */ |
} else { /* u could be left to b (if r > q parabola has a maximum) */ |
#ifdef DEBUG |
#ifdef DEBUG |
printf("mnbrak2 u could be left to b (if r > q parabola has a maximum)\n"); |
printf("\nmnbrak2 u=%lf could be left to b=%lf (if r=%lf > q=%lf parabola has a maximum)\n",u,*bx,r,q); |
fprintf(ficlog, "mnbrak2 u could be left to b (if r > q parabola has a maximum)\n"); |
fprintf(ficlog,"\nmnbrak2 u=%lf could be left to b=%lf (if r=%lf > q=%lf parabola has a maximum)\n",u,*bx,r,q); |
#endif |
#endif |
u=(*cx)+GOLD*(*cx-*bx); |
u=(*cx)+GOLD*(*cx-*bx); |
fu=(*func)(u); |
fu=(*func)(u); |
|
#ifdef DEBUG |
|
printf("\nmnbrak2 new u=%lf fu=%lf shifted gold left from c=%lf and b=%lf \n",u,fu,*cx,*bx); |
|
fprintf(ficlog,"\nmnbrak2 new u=%lf fu=%lf shifted gold left from c=%lf and b=%lf \n",u,fu,*cx,*bx); |
|
#endif |
} /* end tests */ |
} /* end tests */ |
SHFT(*ax,*bx,*cx,u) |
SHFT(*ax,*bx,*cx,u) |
SHFT(*fa,*fb,*fc,fu) |
SHFT(*fa,*fb,*fc,fu) |
#ifdef DEBUG |
#ifdef DEBUG |
printf("mnbrak2 (*ax=%.12f, *fa=%.12lf), (*bx=%.12f, *fb=%.12lf), (*cx=%.12f, *fc=%.12lf), (*u=%.12f, fu=%.12lf)\n",*ax,*fa,*bx,*fb,*cx,*fc,u,fu); |
printf("\nmnbrak2 shift (*ax=%.12f, *fa=%.12lf), (*bx=%.12f, *fb=%.12lf), (*cx=%.12f, *fc=%.12lf)\n",*ax,*fa,*bx,*fb,*cx,*fc); |
fprintf(ficlog, "mnbrak2 (*ax=%.12f, *fa=%.12lf), (*bx=%.12f, *fb=%.12lf), (*cx=%.12f, *fc=%.12lf), (*u=%.12f, fu=%.12lf)\n",*ax,*fa,*bx,*fb,*cx,*fc,u,fu); |
fprintf(ficlog, "\nmnbrak2 shift (*ax=%.12f, *fa=%.12lf), (*bx=%.12f, *fb=%.12lf), (*cx=%.12f, *fc=%.12lf)\n",*ax,*fa,*bx,*fb,*cx,*fc); |
#endif |
#endif |
} /* end while; ie return (a, b, c, fa, fb, fc) such that a < b < c with f(a) > f(b) and fb < f(c) */ |
} /* end while; ie return (a, b, c, fa, fb, fc) such that a < b < c with f(a) > f(b) and fb < f(c) */ |
} |
} |
Line 1626 int ncom;
|
Line 2041 int ncom;
|
double *pcom,*xicom; |
double *pcom,*xicom; |
double (*nrfunc)(double []); |
double (*nrfunc)(double []); |
|
|
|
#ifdef LINMINORIGINAL |
void linmin(double p[], double xi[], int n, double *fret,double (*func)(double [])) |
void linmin(double p[], double xi[], int n, double *fret,double (*func)(double [])) |
|
#else |
|
void linmin(double p[], double xi[], int n, double *fret,double (*func)(double []), int *flat) |
|
#endif |
{ |
{ |
double brent(double ax, double bx, double cx, |
double brent(double ax, double bx, double cx, |
double (*f)(double), double tol, double *xmin); |
double (*f)(double), double tol, double *xmin); |
Line 1670 void linmin(double p[], double xi[], int
|
Line 2089 void linmin(double p[], double xi[], int
|
#ifdef LINMINORIGINAL |
#ifdef LINMINORIGINAL |
#else |
#else |
if (fx != fx){ |
if (fx != fx){ |
xxs=xxs/scale; /* Trying a smaller xx, closer to initial ax=0 */ |
xxs=xxs/scale; /* Trying a smaller xx, closer to initial ax=0 */ |
printf("|"); |
printf("|"); |
fprintf(ficlog,"|"); |
fprintf(ficlog,"|"); |
#ifdef DEBUGLINMIN |
#ifdef DEBUGLINMIN |
printf("\nLinmin NAN : input [axs=%lf:xxs=%lf], mnbrak outputs fx=%lf <(fb=%lf and fa=%lf) with xx=%lf in [ax=%lf:bx=%lf] \n", axs, xxs, fx,fb, fa, xx, ax, bx); |
printf("\nLinmin NAN : input [axs=%lf:xxs=%lf], mnbrak outputs fx=%lf <(fb=%lf and fa=%lf) with xx=%lf in [ax=%lf:bx=%lf] \n", axs, xxs, fx,fb, fa, xx, ax, bx); |
#endif |
#endif |
} |
} |
}while(fx != fx); |
}while(fx != fx && xxs > 1.e-5); |
#endif |
#endif |
|
|
#ifdef DEBUGLINMIN |
#ifdef DEBUGLINMIN |
printf("\nLinmin after mnbrak: ax=%12.7f xx=%12.7f bx=%12.7f fa=%12.2f fx=%12.2f fb=%12.2f\n", ax,xx,bx,fa,fx,fb); |
printf("\nLinmin after mnbrak: ax=%12.7f xx=%12.7f bx=%12.7f fa=%12.2f fx=%12.2f fb=%12.2f\n", ax,xx,bx,fa,fx,fb); |
fprintf(ficlog,"\nLinmin after mnbrak: ax=%12.7f xx=%12.7f bx=%12.7f fa=%12.2f fx=%12.2f fb=%12.2f\n", ax,xx,bx,fa,fx,fb); |
fprintf(ficlog,"\nLinmin after mnbrak: ax=%12.7f xx=%12.7f bx=%12.7f fa=%12.2f fx=%12.2f fb=%12.2f\n", ax,xx,bx,fa,fx,fb); |
#endif |
#endif |
|
#ifdef LINMINORIGINAL |
|
#else |
|
if(fb == fx){ /* Flat function in the direction */ |
|
xmin=xx; |
|
*flat=1; |
|
}else{ |
|
*flat=0; |
|
#endif |
|
/*Flat mnbrak2 shift (*ax=0.000000000000, *fa=51626.272983130431), (*bx=-1.618034000000, *fb=51590.149499362531), (*cx=-4.236068025156, *fc=51590.149499362531) */ |
*fret=brent(ax,xx,bx,f1dim,TOL,&xmin); /* Giving a bracketting triplet (ax, xx, bx), find a minimum, xmin, according to f1dim, *fret(xmin),*/ |
*fret=brent(ax,xx,bx,f1dim,TOL,&xmin); /* Giving a bracketting triplet (ax, xx, bx), find a minimum, xmin, according to f1dim, *fret(xmin),*/ |
/* fa = f(p[j] + ax * xi[j]), fx = f(p[j] + xx * xi[j]), fb = f(p[j] + bx * xi[j]) */ |
/* fa = f(p[j] + ax * xi[j]), fx = f(p[j] + xx * xi[j]), fb = f(p[j] + bx * xi[j]) */ |
/* fmin = f(p[j] + xmin * xi[j]) */ |
/* fmin = f(p[j] + xmin * xi[j]) */ |
/* P+lambda n in that direction (lambdamin), with TOL between abscisses */ |
/* P+lambda n in that direction (lambdamin), with TOL between abscisses */ |
/* f1dim(xmin): for (j=1;j<=ncom;j++) xt[j]=pcom[j]+xmin*xicom[j]; */ |
/* f1dim(xmin): for (j=1;j<=ncom;j++) xt[j]=pcom[j]+xmin*xicom[j]; */ |
#ifdef DEBUG |
#ifdef DEBUG |
printf("retour brent fret=%.12e xmin=%.12e\n",*fret,xmin); |
printf("retour brent from bracket (a=%lf fa=%lf, xx=%lf fx=%lf, b=%lf fb=%lf): fret=%lf xmin=%lf\n",ax,fa,xx,fx,bx,fb,*fret,xmin); |
fprintf(ficlog,"retour brent fret=%.12e xmin=%.12e\n",*fret,xmin); |
fprintf(ficlog,"retour brent from bracket (a=%lf fa=%lf, xx=%lf fx=%lf, b=%lf fb=%lf): fret=%lf xmin=%lf\n",ax,fa,xx,fx,bx,fb,*fret,xmin); |
|
#endif |
|
#ifdef LINMINORIGINAL |
|
#else |
|
} |
#endif |
#endif |
#ifdef DEBUGLINMIN |
#ifdef DEBUGLINMIN |
printf("linmin end "); |
printf("linmin end "); |
Line 1741 such that failure to decrease by more th
|
Line 2173 such that failure to decrease by more th
|
output, p is set to the best point found, xi is the then-current direction set, fret is the returned |
output, p is set to the best point found, xi is the then-current direction set, fret is the returned |
function value at p , and iter is the number of iterations taken. The routine linmin is used. |
function value at p , and iter is the number of iterations taken. The routine linmin is used. |
*/ |
*/ |
|
#ifdef LINMINORIGINAL |
|
#else |
|
int *flatdir; /* Function is vanishing in that direction */ |
|
int flat=0, flatd=0; /* Function is vanishing in that direction */ |
|
#endif |
void powell(double p[], double **xi, int n, double ftol, int *iter, double *fret, |
void powell(double p[], double **xi, int n, double ftol, int *iter, double *fret, |
double (*func)(double [])) |
double (*func)(double [])) |
{ |
{ |
void linmin(double p[], double xi[], int n, double *fret, |
#ifdef LINMINORIGINAL |
|
void linmin(double p[], double xi[], int n, double *fret, |
double (*func)(double [])); |
double (*func)(double [])); |
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 del,t,*pt,*ptt,*xit; |
double directest; |
double directest; |
double fp,fptt; |
double fp,fptt; |
double *xits; |
double *xits; |
int niterf, itmp; |
int niterf, itmp; |
|
#ifdef LINMINORIGINAL |
|
#else |
|
|
|
flatdir=ivector(1,n); |
|
for (j=1;j<=n;j++) flatdir[j]=0; |
|
#endif |
|
|
pt=vector(1,n); |
pt=vector(1,n); |
ptt=vector(1,n); |
ptt=vector(1,n); |
Line 1772 void powell(double p[], double **xi, int
|
Line 2220 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(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); */ |
/* fprintf(ficrespow,"%d %.12f %ld",*iter,*fret,curr_time.tm_sec-start_time.tm_sec); */ |
for (i=1;i<=n;i++) { |
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," %.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("\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(ficlog,"\n"); |
fprintf(ficrespow,"\n");fflush(ficrespow); |
for(i=1,jk=1; i <=nlstate; i++){ |
if(*iter <=3){ |
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); |
tml = *localtime(&rcurr_time); |
strcpy(strcurr,asctime(&tml)); |
strcpy(strcurr,asctime(&tml)); |
rforecast_time=rcurr_time; |
rforecast_time=rcurr_time; |
Line 1794 void powell(double p[], double **xi, int
|
Line 2275 void powell(double p[], double **xi, int
|
strcpy(strfor,asctime(&forecast_time)); |
strcpy(strfor,asctime(&forecast_time)); |
itmp = strlen(strfor); |
itmp = strlen(strfor); |
if(strfor[itmp-1]=='\n') |
if(strfor[itmp-1]=='\n') |
strfor[itmp-1]='\0'; |
strfor[itmp-1]='\0'; |
printf(" - if your program needs %d iterations to converge, convergence will be \n reached in %s i.e.\n on %s (current time is %s);\n",niterf, asc_diff_time(rforecast_time-rcurr_time,tmpout),strfor,strcurr); |
printf(" - if your program needs %d iterations to converge, convergence will be \n reached in %s i.e.\n on %s (current time is %s);\n",niterf, asc_diff_time(rforecast_time-rcurr_time,tmpout),strfor,strcurr); |
fprintf(ficlog," - if your program needs %d iterations to converge, convergence will be \n reached in %s i.e.\n on %s (current time is %s);\n",niterf, asc_diff_time(rforecast_time-rcurr_time,tmpout),strfor,strcurr); |
fprintf(ficlog," - if your program needs %d iterations to converge, convergence will be \n reached in %s i.e.\n on %s (current time is %s);\n",niterf, asc_diff_time(rforecast_time-rcurr_time,tmpout),strfor,strcurr); |
} |
} |
Line 1808 void powell(double p[], double **xi, int
|
Line 2289 void powell(double p[], double **xi, int
|
#endif |
#endif |
printf("%d",i);fflush(stdout); /* print direction (parameter) i */ |
printf("%d",i);fflush(stdout); /* print direction (parameter) i */ |
fprintf(ficlog,"%d",i);fflush(ficlog); |
fprintf(ficlog,"%d",i);fflush(ficlog); |
|
#ifdef LINMINORIGINAL |
linmin(p,xit,n,fret,func); /* Point p[n]. xit[n] has been loaded for direction i as input.*/ |
linmin(p,xit,n,fret,func); /* Point p[n]. xit[n] has been loaded for direction i as input.*/ |
/* Outputs are fret(new point p) p is updated and xit rescaled */ |
#else |
|
linmin(p,xit,n,fret,func,&flat); /* Point p[n]. xit[n] has been loaded for direction i as input.*/ |
|
flatdir[i]=flat; /* Function is vanishing in that direction i */ |
|
#endif |
|
/* Outputs are fret(new point p) p is updated and xit rescaled */ |
if (fabs(fptt-(*fret)) > del) { /* We are keeping the max gain on each of the n directions */ |
if (fabs(fptt-(*fret)) > del) { /* We are keeping the max gain on each of the n directions */ |
/* because that direction will be replaced unless the gain del is small */ |
/* because that direction will be replaced unless the gain del is small */ |
/* in comparison with the 'probable' gain, mu^2, with the last average direction. */ |
/* in comparison with the 'probable' gain, mu^2, with the last average direction. */ |
/* Unless the n directions are conjugate some gain in the determinant may be obtained */ |
/* Unless the n directions are conjugate some gain in the determinant may be obtained */ |
/* with the new direction. */ |
/* with the new direction. */ |
del=fabs(fptt-(*fret)); |
del=fabs(fptt-(*fret)); |
ibig=i; |
ibig=i; |
} |
} |
#ifdef DEBUG |
#ifdef DEBUG |
printf("%d %.12e",i,(*fret)); |
printf("%d %.12e",i,(*fret)); |
fprintf(ficlog,"%d %.12e",i,(*fret)); |
fprintf(ficlog,"%d %.12e",i,(*fret)); |
for (j=1;j<=n;j++) { |
for (j=1;j<=n;j++) { |
xits[j]=FMAX(fabs(p[j]-pt[j]),1.e-5); |
xits[j]=FMAX(fabs(p[j]-pt[j]),1.e-5); |
printf(" x(%d)=%.12e",j,xit[j]); |
printf(" x(%d)=%.12e",j,xit[j]); |
fprintf(ficlog," x(%d)=%.12e",j,xit[j]); |
fprintf(ficlog," x(%d)=%.12e",j,xit[j]); |
} |
} |
for(j=1;j<=n;j++) { |
for(j=1;j<=n;j++) { |
printf(" p(%d)=%.12e",j,p[j]); |
printf(" p(%d)=%.12e",j,p[j]); |
fprintf(ficlog," p(%d)=%.12e",j,p[j]); |
fprintf(ficlog," p(%d)=%.12e",j,p[j]); |
} |
} |
printf("\n"); |
printf("\n"); |
fprintf(ficlog,"\n"); |
fprintf(ficlog,"\n"); |
Line 1837 void powell(double p[], double **xi, int
|
Line 2323 void powell(double p[], double **xi, int
|
/* Convergence test will use last linmin estimation (fret) and compare former iteration (fp) */ |
/* Convergence test will use last linmin estimation (fret) and compare former iteration (fp) */ |
/* But p and xit have been updated at the end of linmin, *fret corresponds to new p, xit */ |
/* But p and xit have been updated at the end of linmin, *fret corresponds to new p, xit */ |
/* New value of last point Pn is not computed, P(n-1) */ |
/* New value of last point Pn is not computed, P(n-1) */ |
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 */ |
/* We could compare with a chi^2. chisquare(0.95,ddl=1)=3.84 */ |
/* By adding age*age in a model, the new -2LL should be lower and the difference follows a */ |
/* By adding age*age in a model, the new -2LL should be lower and the difference follows a */ |
/* a chisquare statistics with 1 degree. To be significant at the 95% level, it should have */ |
/* a chisquare statistics with 1 degree. To be significant at the 95% level, it should have */ |
Line 1845 void powell(double p[], double **xi, int
|
Line 2340 void powell(double p[], double **xi, int
|
/* By adding age*age and V1*age the gain (-2LL) should be more than 5.99 (ddl=2) */ |
/* By adding age*age and V1*age the gain (-2LL) should be more than 5.99 (ddl=2) */ |
/* By using V1+V2+V3, the gain should be 7.82, compared with basic 1+age. */ |
/* By using V1+V2+V3, the gain should be 7.82, compared with basic 1+age. */ |
/* By adding 10 parameters more the gain should be 18.31 */ |
/* By adding 10 parameters more the gain should be 18.31 */ |
|
|
/* Starting the program with initial values given by a former maximization will simply change */ |
/* Starting the program with initial values given by a former maximization will simply change */ |
/* the scales of the directions and the directions, because the are reset to canonical directions */ |
/* the scales of the directions and the directions, because the are reset to canonical directions */ |
/* Thus the first calls to linmin will give new points and better maximizations until fp-(*fret) is */ |
/* Thus the first calls to linmin will give new points and better maximizations until fp-(*fret) is */ |
Line 1873 void powell(double p[], double **xi, int
|
Line 2368 void powell(double p[], double **xi, int
|
} |
} |
#endif |
#endif |
|
|
|
#ifdef LINMINORIGINAL |
|
#else |
|
free_ivector(flatdir,1,n); |
|
#endif |
free_vector(xit,1,n); |
free_vector(xit,1,n); |
free_vector(xits,1,n); |
free_vector(xits,1,n); |
free_vector(ptt,1,n); |
free_vector(ptt,1,n); |
free_vector(pt,1,n); |
free_vector(pt,1,n); |
return; |
return; |
} /* enough precision */ |
} /* 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) */ |
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]; |
ptt[j]=2.0*p[j]-pt[j]; |
xit[j]=p[j]-pt[j]; |
xit[j]=p[j]-pt[j]; |
pt[j]=p[j]; |
pt[j]=p[j]; |
} |
} |
fptt=(*func)(ptt); /* f_3 */ |
fptt=(*func)(ptt); /* f_3 */ |
#ifdef POWELLF1F3 |
#ifdef NODIRECTIONCHANGEDUNTILNITER /* No change in drections until some iterations are done */ |
|
if (*iter <=4) { |
|
#else |
|
#endif |
|
#ifdef POWELLNOF3INFF1TEST /* skips test F3 <F1 */ |
#else |
#else |
if (fptt < fp) { /* If extrapolated point is better, decide if we keep that new direction or not */ |
if (fptt < fp) { /* If extrapolated point is better, decide if we keep that new direction or not */ |
#endif |
#endif |
Line 1896 void powell(double p[], double **xi, int
|
Line 2398 void powell(double p[], double **xi, int
|
/* Let f"(x2) be the 2nd derivative equal everywhere. */ |
/* Let f"(x2) be the 2nd derivative equal everywhere. */ |
/* Then the parabolic through (x1,f1), (x2,f2) and (x3,f3) */ |
/* Then the parabolic through (x1,f1), (x2,f2) and (x3,f3) */ |
/* will reach at f3 = fm + h^2/2 f"m ; f" = (f1 -2f2 +f3 ) / h**2 */ |
/* will reach at f3 = fm + h^2/2 f"m ; f" = (f1 -2f2 +f3 ) / h**2 */ |
/* Conditional for using this new direction is that mu^2 = (f1-2f2+f3)^2 /2 < del */ |
/* Conditional for using this new direction is that mu^2 = (f1-2f2+f3)^2 /2 < del or directest <0 */ |
|
/* also lamda^2=(f1-f2)^2/mu² is a parasite solution of powell */ |
|
/* For powell, inclusion of this average direction is only if t(del)<0 or del inbetween mu^2 and lambda^2 */ |
/* t=2.0*(fp-2.0*(*fret)+fptt)*SQR(fp-(*fret)-del)-del*SQR(fp-fptt); */ |
/* t=2.0*(fp-2.0*(*fret)+fptt)*SQR(fp-(*fret)-del)-del*SQR(fp-fptt); */ |
|
/* Even if f3 <f1, directest can be negative and t >0 */ |
|
/* mu² and del² are equal when f3=f1 */ |
|
/* f3 < f1 : mu² < del <= lambda^2 both test are equivalent */ |
|
/* f3 < f1 : mu² < lambda^2 < del then directtest is negative and powell t is positive */ |
|
/* f3 > f1 : lambda² < mu^2 < del then t is negative and directest >0 */ |
|
/* f3 > f1 : lambda² < del < mu^2 then t is positive and directest >0 */ |
#ifdef NRCORIGINAL |
#ifdef NRCORIGINAL |
t=2.0*(fp-2.0*(*fret)+fptt)*SQR(fp-(*fret)-del)- del*SQR(fp-fptt); /* Original Numerical Recipes in C*/ |
t=2.0*(fp-2.0*(*fret)+fptt)*SQR(fp-(*fret)-del)- del*SQR(fp-fptt); /* Original Numerical Recipes in C*/ |
#else |
#else |
Line 1919 void powell(double p[], double **xi, int
|
Line 2429 void powell(double p[], double **xi, int
|
if (t < 0.0) { /* Then we use it for new direction */ |
if (t < 0.0) { /* Then we use it for new direction */ |
#else |
#else |
if (directest*t < 0.0) { /* Contradiction between both tests */ |
if (directest*t < 0.0) { /* Contradiction between both tests */ |
printf("directest= %.12lf (if <0 we include P0 Pn as new direction), t= %.12lf, f1= %.12lf,f2= %.12lf,f3= %.12lf, del= %.12lf\n",directest, t, fp,(*fret),fptt,del); |
printf("directest= %.12lf (if <0 we include P0 Pn as new direction), t= %.12lf, f1= %.12lf,f2= %.12lf,f3= %.12lf, del= %.12lf\n",directest, t, fp,(*fret),fptt,del); |
printf("f1-2f2+f3= %.12lf, f1-f2-del= %.12lf, f1-f3= %.12lf\n",fp-2.0*(*fret)+fptt, fp -(*fret) -del, fp-fptt); |
printf("f1-2f2+f3= %.12lf, f1-f2-del= %.12lf, f1-f3= %.12lf\n",fp-2.0*(*fret)+fptt, fp -(*fret) -del, fp-fptt); |
fprintf(ficlog,"directest= %.12lf (if <0 we include P0 Pn as new direction), t= %.12lf, f1= %.12lf,f2= %.12lf,f3= %.12lf, del= %.12lf\n",directest, t, fp,(*fret),fptt, del); |
fprintf(ficlog,"directest= %.12lf (if directest<0 or t<0 we include P0 Pn as new direction), t= %.12lf, f1= %.12lf,f2= %.12lf,f3= %.12lf, del= %.12lf\n",directest, t, fp,(*fret),fptt, del); |
fprintf(ficlog,"f1-2f2+f3= %.12lf, f1-f2-del= %.12lf, f1-f3= %.12lf\n",fp-2.0*(*fret)+fptt, fp -(*fret) -del, fp-fptt); |
fprintf(ficlog,"f1-2f2+f3= %.12lf, f1-f2-del= %.12lf, f1-f3= %.12lf\n",fp-2.0*(*fret)+fptt, fp -(*fret) -del, fp-fptt); |
} |
} |
if (directest < 0.0) { /* Then we use it for new direction */ |
if (directest < 0.0) { /* Then we use it for new direction */ |
#endif |
#endif |
#ifdef DEBUGLINMIN |
#ifdef DEBUGLINMIN |
printf("Before linmin in direction P%d-P0\n",n); |
printf("Before linmin in direction P%d-P0\n",n); |
for (j=1;j<=n;j++) { |
for (j=1;j<=n;j++) { |
printf(" Before xit[%d]= %12.7f p[%d]= %12.7f",j,xit[j],j,p[j]); |
printf(" Before xit[%d]= %12.7f p[%d]= %12.7f",j,xit[j],j,p[j]); |
fprintf(ficlog," Before xit[%d]= %12.7f p[%d]= %12.7f",j,xit[j],j,p[j]); |
fprintf(ficlog," Before xit[%d]= %12.7f p[%d]= %12.7f",j,xit[j],j,p[j]); |
if(j % ncovmodel == 0){ |
if(j % ncovmodel == 0){ |
Line 1937 void powell(double p[], double **xi, int
|
Line 2447 void powell(double p[], double **xi, int
|
} |
} |
} |
} |
#endif |
#endif |
|
#ifdef LINMINORIGINAL |
linmin(p,xit,n,fret,func); /* computes minimum on the extrapolated direction: changes p and rescales xit.*/ |
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 |
#ifdef DEBUGLINMIN |
for (j=1;j<=n;j++) { |
for (j=1;j<=n;j++) { |
printf("After xit[%d]= %12.7f p[%d]= %12.7f",j,xit[j],j,p[j]); |
printf("After xit[%d]= %12.7f p[%d]= %12.7f",j,xit[j],j,p[j]); |
Line 1952 void powell(double p[], double **xi, int
|
Line 2468 void powell(double p[], double **xi, int
|
xi[j][ibig]=xi[j][n]; /* Replace direction with biggest decrease by last direction n */ |
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 */ |
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); |
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); |
fprintf(ficlog,"Gaining to use new average direction of P0 P%d instead of biggest increase direction %d :\n",n,ibig); |
|
|
#ifdef DEBUG |
#ifdef DEBUG |
printf("Direction changed last moved %d in place of ibig=%d, new last is the average:\n",n,ibig); |
printf("Direction changed last moved %d in place of ibig=%d, new last is the average:\n",n,ibig); |
fprintf(ficlog,"Direction changed last moved %d in place of ibig=%d, new last is the average:\n",n,ibig); |
fprintf(ficlog,"Direction changed last moved %d in place of ibig=%d, new last is the average:\n",n,ibig); |
for(j=1;j<=n;j++){ |
for(j=1;j<=n;j++){ |
printf(" %.12e",xit[j]); |
printf(" %lf",xit[j]); |
fprintf(ficlog," %.12e",xit[j]); |
fprintf(ficlog," %lf",xit[j]); |
} |
} |
printf("\n"); |
printf("\n"); |
fprintf(ficlog,"\n"); |
fprintf(ficlog,"\n"); |
#endif |
#endif |
} /* end of t or directest negative */ |
} /* end of t or directest negative */ |
#ifdef POWELLF1F3 |
#ifdef POWELLNOF3INFF1TEST |
|
#else |
|
} /* end if (fptt < fp) */ |
|
#endif |
|
#ifdef NODIRECTIONCHANGEDUNTILNITER /* No change in drections until some iterations are done */ |
|
} /*NODIRECTIONCHANGEDUNTILNITER No change in drections until some iterations are done */ |
#else |
#else |
} /* end if (fptt < fp) */ |
|
#endif |
#endif |
} /* loop iteration */ |
} /* loop iteration */ |
} |
} |
|
|
/**** Prevalence limit (stable or period prevalence) ****************/ |
/**** 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) |
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 by left multiplying the unit |
/* Computes the prevalence limit in each live state at age x and for covariate combination ij |
matrix by transitions matrix until convergence is reached with precision ftolpl */ |
(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= Wx-1 Px-1= Wx-2 Px-2 Px-1 = Wx-n Px-n ... Px-2 Px-1 I */ |
/* Wx is row vector: population in state 1, population in state 2, population dead */ |
/* Wx is row vector: population in state 1, population in state 2, population dead */ |
/* or prevalence in state 1, prevalence in state 2, 0 */ |
/* or prevalence in state 1, prevalence in state 2, 0 */ |
Line 1996 double **prevalim(double **prlim, int nl
|
Line 2537 double **prevalim(double **prlim, int nl
|
/* {0.51571254859325999, 0.4842874514067399, */ |
/* {0.51571254859325999, 0.4842874514067399, */ |
/* 0.51326036147820708, 0.48673963852179264} */ |
/* 0.51326036147820708, 0.48673963852179264} */ |
/* If we start from prlim again, prlim tends to a constant matrix */ |
/* If we start from prlim again, prlim tends to a constant matrix */ |
|
|
int i, ii,j,k; |
int i, ii,j,k; |
double *min, *max, *meandiff, maxmax,sumnew=0.; |
double *min, *max, *meandiff, maxmax,sumnew=0.; |
/* double **matprod2(); */ /* test */ |
/* double **matprod2(); */ /* test */ |
double **out, cov[NCOVMAX+1], **pmij(); |
double **out, cov[NCOVMAX+1], **pmij(); /* **pmmij is a global variable feeded with oldms etc */ |
double **newm; |
double **newm; |
double agefin, delaymax=200. ; /* 100 Max number of years to converge */ |
double agefin, delaymax=200. ; /* 100 Max number of years to converge */ |
int ncvloop=0; |
int ncvloop=0; |
Line 2009 double **prevalim(double **prlim, int nl
|
Line 2550 double **prevalim(double **prlim, int nl
|
max=vector(1,nlstate); |
max=vector(1,nlstate); |
meandiff=vector(1,nlstate); |
meandiff=vector(1,nlstate); |
|
|
|
/* Starting with matrix unity */ |
for (ii=1;ii<=nlstate+ndeath;ii++) |
for (ii=1;ii<=nlstate+ndeath;ii++) |
for (j=1;j<=nlstate+ndeath;j++){ |
for (j=1;j<=nlstate+ndeath;j++){ |
oldm[ii][j]=(ii==j ? 1.0 : 0.0); |
oldm[ii][j]=(ii==j ? 1.0 : 0.0); |
Line 2025 double **prevalim(double **prlim, int nl
|
Line 2567 double **prevalim(double **prlim, int nl
|
cov[2]=agefin; |
cov[2]=agefin; |
if(nagesqr==1) |
if(nagesqr==1) |
cov[3]= agefin*agefin;; |
cov[3]= agefin*agefin;; |
for (k=1; k<=cptcovn;k++) { |
for (k=1; k<=nsd;k++) { /* For single dummy covariates only */ |
/* cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(ij,Tvar[k])]; */ |
/* Here comes the value of the covariate 'ij' after renumbering k with single dummy covariates */ |
cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(ij,k)]; |
cov[2+nagesqr+TvarsDind[k]]=nbcode[TvarsD[k]][codtabm(ij,k)]; |
/* printf("prevalim ij=%d k=%d Tvar[%d]=%d nbcode=%d cov=%lf codtabm(%d,Tvar[%d])=%d \n",ij,k, k, Tvar[k],nbcode[Tvar[k]][codtabm(ij,Tvar[k])],cov[2+k], ij, k, codtabm(ij,Tvar[k])]); */ |
/* printf("prevalim 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)); */ |
} |
} |
/*wrong? for (k=1; k<=cptcovage;k++) cov[2+Tage[k]]=cov[2+Tage[k]]*cov[2]; */ |
for (k=1; k<=nsq;k++) { /* For single varying covariates only */ |
/* for (k=1; k<=cptcovage;k++) cov[2+nagesqr+Tage[k]]=nbcode[Tvar[k]][codtabm(ij,Tvar[k])]*cov[2]; */ |
/* Here comes the value of quantitative after renumbering k with single quantitative covariates */ |
for (k=1; k<=cptcovage;k++) cov[2+nagesqr+Tage[k]]=nbcode[Tvar[k]][codtabm(ij,k)]*cov[2]; |
cov[2+nagesqr+TvarsQind[k]]=Tqresult[nres][k]; |
for (k=1; k<=cptcovprod;k++) /* Useless */ |
/* 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]); */ |
/* 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)]; |
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 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 cov[4]=%lf \n",ij, cov[3],cov[4]);*/ |
/*printf("ij=%d cov[3]=%lf \n",ij, cov[3]);*/ |
/*printf("ij=%d cov[3]=%lf \n",ij, cov[3]);*/ |
/* savm=pmij(pmmij,cov,ncovmodel,x,nlstate); */ |
/* savm=pmij(pmmij,cov,ncovmodel,x,nlstate); */ |
/* out=matprod2(newm, pmij(pmmij,cov,ncovmodel,x,nlstate),1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, oldm); /\* Bug Valgrind *\/ */ |
/* out=matprod2(newm, pmij(pmmij,cov,ncovmodel,x,nlstate),1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, oldm); /\* Bug Valgrind *\/ */ |
|
/* age and covariate values of ij are in 'cov' */ |
out=matprod2(newm, pmij(pmmij,cov,ncovmodel,x,nlstate),1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, oldm); /* Bug Valgrind */ |
out=matprod2(newm, pmij(pmmij,cov,ncovmodel,x,nlstate),1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, oldm); /* Bug Valgrind */ |
|
|
savm=oldm; |
savm=oldm; |
Line 2088 Earliest age to start was %d-%d=%d, ncvl
|
Line 2653 Earliest age to start was %d-%d=%d, ncvl
|
return prlim; /* should not reach here */ |
return prlim; /* 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 |
|
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-1)*ncovmodel |
|
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; j<i;j++){ |
|
for (nc=1, lnpijopii=0.;nc <=ncovmodel; nc++){ |
|
/*lnpijopii += param[i][j][nc]*cov[nc];*/ |
|
lnpijopii += x[nc+((i-1)*(nlstate+ndeath-1)+j-1)*ncovmodel]*cov[nc]; |
|
/* printf("Int j<i s1=%.17e, lnpijopii=%.17e\n",s1,lnpijopii); */ |
|
} |
|
ps[i][j]=lnpijopii; /* In fact ln(pij/pii) */ |
|
/* printf("s1=%.17e, lnpijopii=%.17e\n",s1,lnpijopii); */ |
|
} |
|
for(j=i+1; j<=nlstate+ndeath;j++){ |
|
for (nc=1, lnpijopii=0.;nc <=ncovmodel; nc++){ |
|
/*lnpijopii += x[(i-1)*nlstate*ncovmodel+(j-2)*ncovmodel+nc+(i-1)*(ndeath-1)*ncovmodel]*cov[nc];*/ |
|
lnpijopii += x[nc + ((i-1)*(nlstate+ndeath-1)+(j-2))*ncovmodel]*cov[nc]; |
|
/* printf("Int j>i s1=%.17e, lnpijopii=%.17e %lx %lx\n",s1,lnpijopii,s1,lnpijopii); */ |
|
} |
|
ps[i][j]=lnpijopii; /* In fact ln(pij/pii) */ |
|
} |
|
} |
|
|
|
for(i=1; i<= nlstate; i++){ |
|
s1=0; |
|
for(j=1; j<i; j++){ |
|
s1+=exp(ps[i][j]); /* In fact sums pij/pii */ |
|
/*printf("debug1 %d %d ps=%lf exp(ps)=%lf s1+=%lf\n",i,j,ps[i][j],exp(ps[i][j]),s1); */ |
|
} |
|
for(j=i+1; j<=nlstate+ndeath; j++){ |
|
s1+=exp(ps[i][j]); /* In fact sums pij/pii */ |
|
/*printf("debug2 %d %d ps=%lf exp(ps)=%lf s1+=%lf\n",i,j,ps[i][j],exp(ps[i][j]),s1); */ |
|
} |
|
/* s1= sum_{j<>i} pij/pii=(1-pii)/pii and thus pii is known from s1 */ |
|
ps[i][i]=1./(s1+1.); |
|
/* Computing other pijs */ |
|
for(j=1; j<i; j++) |
|
ps[i][j]= exp(ps[i][j])*ps[i][i]; |
|
for(j=i+1; j<=nlstate+ndeath; j++) |
|
ps[i][j]= exp(ps[i][j])*ps[i][i]; |
|
/* ps[i][nlstate+1]=1.-s1- ps[i][i];*/ /* Sum should be 1 */ |
|
} /* end i */ |
|
|
|
for(ii=nlstate+1; ii<= nlstate+ndeath; ii++){ |
|
for(jj=1; jj<= nlstate+ndeath; jj++){ |
|
ps[ii][jj]=0; |
|
ps[ii][ii]=1; |
|
} |
|
} |
|
|
|
|
|
/* for(ii=1; ii<= nlstate+ndeath; ii++){ */ |
|
/* for(jj=1; jj<= nlstate+ndeath; jj++){ */ |
|
/* printf(" pmij ps[%d][%d]=%lf ",ii,jj,ps[ii][jj]); */ |
|
/* } */ |
|
/* printf("\n "); */ |
|
/* } */ |
|
/* printf("\n ");printf("%lf ",cov[2]);*/ |
|
/* |
|
for(i=1; i<= npar; i++) printf("%f ",x[i]); |
|
goto end;*/ |
|
return ps; |
|
} |
|
|
|
/**************** Product of 2 matrices ******************/ |
/**** Back Prevalence limit (stable or period prevalence) ****************/ |
|
|
double **matprod2(double **out, double **in,int nrl, int nrh, int ncl, int nch, int ncolol, int ncoloh, double **b) |
/* 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 matrix product of in(1,nrh-nrl+1)(1,nch-ncl+1) times |
/* Computes the prevalence limit in each live state at age x and for covariate combination ij (<=2**cptcoveff) by left multiplying the unit |
b(1,nch-ncl+1)(1,ncoloh-ncolol+1) into out(...) */ |
matrix by transitions matrix until convergence is reached with precision ftolpl */ |
/* in, b, out are matrice of pointers which should have been initialized |
/* Wx= Wx-1 Px-1= Wx-2 Px-2 Px-1 = Wx-n Px-n ... Px-2 Px-1 I */ |
before: only the contents of out is modified. The function returns |
/* Wx is row vector: population in state 1, population in state 2, population dead */ |
a pointer to pointers identical to out */ |
/* or prevalence in state 1, prevalence in state 2, 0 */ |
int i, j, k; |
/* newm is the matrix after multiplications, its rows are identical at a factor */ |
for(i=nrl; i<= nrh; i++) |
/* Initial matrix pimij */ |
for(k=ncolol; k<=ncoloh; k++){ |
/* {0.85204250825084937, 0.13044499163996345, 0.017512500109187184, */ |
out[i][k]=0.; |
/* 0.090851990222114765, 0.88271245433047185, 0.026435555447413338, */ |
for(j=ncl; j<=nch; j++) |
/* 0, 0 , 1} */ |
out[i][k] +=in[i][j]*b[j][k]; |
/* |
|
* 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<AGESUP; agefin=agefin+stepm/YEARM){ /* A changer en age */ |
|
ncvloop++; |
|
newm=savm; /* oldm should be kept from previous iteration or unity at start */ |
|
/* newm points to the allocated table savm passed by the function it can be written, savm could be reallocated */ |
|
/* Covariates have to be included here again */ |
|
cov[2]=agefin; |
|
if(nagesqr==1) |
|
cov[3]= agefin*agefin;; |
|
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("bprevalim Dummy agefin=%.0f combi=%d k=%d TvarsD[%d]=V%d TvarsDind[%d]=%d nbcode=%d cov[%d]=%lf codtabm(%d,Tvar[%d])=%d \n",agefin,ij,k, k, TvarsD[k],k,TvarsDind[k],nbcode[TvarsD[k]][codtabm(ij,k)],2+nagesqr+TvarsDind[k],cov[2+nagesqr+TvarsDind[k]], ij, k, codtabm(ij,k)); */ |
|
} |
|
/* for (k=1; k<=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])]); *\/ */ |
|
/* } */ |
|
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++) 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)]; */ |
|
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 *\/ */ |
|
/* ij should be linked to the correct index of cov */ |
|
/* age and covariate values ij are in 'cov', but we need to pass |
|
* ij for the observed prevalence at age and status and covariate |
|
* number: prevacurrent[(int)agefin][ii][ij] |
|
*/ |
|
/* out=matprod2(newm,oldm,1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, bmij(pmmij,cov,ncovmodel,x,nlstate,prevacurrent, ageminpar, agemaxpar, dnewm, doldm, dsavm,ij)); /\* Bug Valgrind *\/ */ |
|
/* out=matprod2(newm,oldm,1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, bmij(pmmij,cov,ncovmodel,x,nlstate,prevacurrent, dnewm, doldm, dsavm,ij)); /\* Bug Valgrind *\/ */ |
|
out=matprod2(newm,oldm,1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, bmij(pmmij,cov,ncovmodel,x,nlstate,prevacurrent,ij)); /* Bug Valgrind */ |
|
/* if((int)age == 86 || (int)age == 87){ */ |
|
/* printf(" Backward prevalim age=%d agefin=%d \n", (int) age, (int) agefin); */ |
|
/* for(i=1; i<=nlstate+ndeath; i++) { */ |
|
/* printf("%d newm= ",i); */ |
|
/* for(j=1;j<=nlstate+ndeath;j++) { */ |
|
/* printf("%f ",newm[i][j]); */ |
|
/* } */ |
|
/* printf("oldm * "); */ |
|
/* for(j=1;j<=nlstate+ndeath;j++) { */ |
|
/* printf("%f ",oldm[i][j]); */ |
|
/* } */ |
|
/* printf(" bmmij "); */ |
|
/* for(j=1;j<=nlstate+ndeath;j++) { */ |
|
/* printf("%f ",pmmij[i][j]); */ |
|
/* } */ |
|
/* printf("\n"); */ |
|
/* } */ |
|
/* } */ |
|
savm=oldm; |
|
oldm=newm; |
|
|
|
for(j=1; j<=nlstate; j++){ |
|
max[j]=0.; |
|
min[j]=1.; |
|
} |
|
for(j=1; j<=nlstate; j++){ |
|
for(i=1;i<=nlstate;i++){ |
|
/* bprlim[i][j]= newm[i][j]/(1-sumnew); */ |
|
bprlim[i][j]= newm[i][j]; |
|
max[i]=FMAX(max[i],bprlim[i][j]); /* Max in line */ |
|
min[i]=FMIN(min[i],bprlim[i][j]); |
|
} |
|
} |
|
|
|
maxmax=0.; |
|
for(i=1; i<=nlstate; i++){ |
|
meandiff[i]=(max[i]-min[i])/(max[i]+min[i])*2.; /* mean difference for each column */ |
|
maxmax=FMAX(maxmax,meandiff[i]); |
|
/* printf("Back age= %d meandiff[%d]=%f, agefin=%d max[%d]=%f min[%d]=%f maxmax=%f\n", (int)age, i, meandiff[i],(int)agefin, i, max[i], i, min[i],maxmax); */ |
|
} /* i loop */ |
|
*ncvyear= -( (int)age- (int)agefin); |
|
/* printf("Back maxmax=%lf ncvloop=%d, age=%d, agefin=%d ncvyear=%d \n", maxmax, ncvloop, (int)age, (int)agefin, *ncvyear); */ |
|
if(maxmax < ftolpl){ |
|
/* printf("OK Back maxmax=%lf ncvloop=%d, age=%d, agefin=%d ncvyear=%d \n", maxmax, ncvloop, (int)age, (int)agefin, *ncvyear); */ |
|
free_vector(min,1,nlstate); |
|
free_vector(max,1,nlstate); |
|
free_vector(meandiff,1,nlstate); |
|
return bprlim; |
|
} |
|
} /* age loop */ |
|
/* After some age loop it doesn't converge */ |
|
if(first){ |
|
first=1; |
|
printf("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'. 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 (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 |
|
ncth covariate in the global vector x is given by the formula: |
|
j<i nc+((i-1)*(nlstate+ndeath-1)+j-1)*ncovmodel |
|
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] 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; j<i;j++){ |
|
for (nc=1, lnpijopii=0.;nc <=ncovmodel; nc++){ |
|
/*lnpijopii += param[i][j][nc]*cov[nc];*/ |
|
lnpijopii += x[nc+((i-1)*(nlstate+ndeath-1)+j-1)*ncovmodel]*cov[nc]; |
|
/* printf("Int j<i s1=%.17e, lnpijopii=%.17e\n",s1,lnpijopii); */ |
|
} |
|
ps[i][j]=lnpijopii; /* In fact ln(pij/pii) */ |
|
/* printf("s1=%.17e, lnpijopii=%.17e\n",s1,lnpijopii); */ |
|
} |
|
for(j=i+1; j<=nlstate+ndeath;j++){ |
|
for (nc=1, lnpijopii=0.;nc <=ncovmodel; nc++){ |
|
/*lnpijopii += x[(i-1)*nlstate*ncovmodel+(j-2)*ncovmodel+nc+(i-1)*(ndeath-1)*ncovmodel]*cov[nc];*/ |
|
lnpijopii += x[nc + ((i-1)*(nlstate+ndeath-1)+(j-2))*ncovmodel]*cov[nc]; |
|
/* printf("Int j>i s1=%.17e, lnpijopii=%.17e %lx %lx\n",s1,lnpijopii,s1,lnpijopii); */ |
|
} |
|
ps[i][j]=lnpijopii; /* In fact ln(pij/pii) */ |
|
} |
|
} |
|
|
|
for(i=1; i<= nlstate; i++){ |
|
s1=0; |
|
for(j=1; j<i; j++){ |
|
s1+=exp(ps[i][j]); /* In fact sums pij/pii */ |
|
/*printf("debug1 %d %d ps=%lf exp(ps)=%lf s1+=%lf\n",i,j,ps[i][j],exp(ps[i][j]),s1); */ |
|
} |
|
for(j=i+1; j<=nlstate+ndeath; j++){ |
|
s1+=exp(ps[i][j]); /* In fact sums pij/pii */ |
|
/*printf("debug2 %d %d ps=%lf exp(ps)=%lf s1+=%lf\n",i,j,ps[i][j],exp(ps[i][j]),s1); */ |
|
} |
|
/* s1= sum_{j<>i} pij/pii=(1-pii)/pii and thus pii is known from s1 */ |
|
ps[i][i]=1./(s1+1.); |
|
/* Computing other pijs */ |
|
for(j=1; j<i; j++) |
|
ps[i][j]= exp(ps[i][j])*ps[i][i]; |
|
for(j=i+1; j<=nlstate+ndeath; j++) |
|
ps[i][j]= exp(ps[i][j])*ps[i][i]; |
|
/* ps[i][nlstate+1]=1.-s1- ps[i][i];*/ /* Sum should be 1 */ |
|
} /* end i */ |
|
|
|
for(ii=nlstate+1; ii<= nlstate+ndeath; ii++){ |
|
for(jj=1; jj<= nlstate+ndeath; jj++){ |
|
ps[ii][jj]=0; |
|
ps[ii][ii]=1; |
|
} |
|
} |
|
|
|
|
|
/* for(ii=1; ii<= nlstate+ndeath; ii++){ */ |
|
/* for(jj=1; jj<= nlstate+ndeath; jj++){ */ |
|
/* printf(" pmij ps[%d][%d]=%lf ",ii,jj,ps[ii][jj]); */ |
|
/* } */ |
|
/* printf("\n "); */ |
|
/* } */ |
|
/* printf("\n ");printf("%lf ",cov[2]);*/ |
|
/* |
|
for(i=1; i<= npar; i++) printf("%f ",x[i]); |
|
goto end;*/ |
|
return ps; /* Pointer is unchanged since its call */ |
|
} |
|
|
|
/*************** backward transition probabilities ***************/ |
|
|
|
/* double **bmij(double **ps, double *cov, int ncovmodel, double *x, int nlstate, double ***prevacurrent, double ageminpar, double agemaxpar, double ***dnewm, double **doldm, double **dsavm, int ij ) */ |
|
/* double **bmij(double **ps, double *cov, int ncovmodel, double *x, int nlstate, double ***prevacurrent, double ***dnewm, double **doldm, double **dsavm, int ij ) */ |
|
double **bmij(double **ps, double *cov, int ncovmodel, double *x, int nlstate, double ***prevacurrent, int ij ) |
|
{ |
|
/* Computes the backward probability at age agefin and covariate combination ij. In fact cov is already filled and x too. |
|
* Call to pmij(cov and x), call to cross prevalence, sums and inverses, left multiply, and returns in **ps as well as **bmij. |
|
*/ |
|
int i, ii, j,k; |
|
|
|
double **out, **pmij(); |
|
double sumnew=0.; |
|
double agefin; |
|
double k3=0.; /* constant of the w_x diagonal matrixe (in order for B to sum to 1 even for death state) */ |
|
double **dnewm, **dsavm, **doldm; |
|
double **bbmij; |
|
|
|
doldm=ddoldms; /* global pointers */ |
|
dnewm=ddnewms; |
|
dsavm=ddsavms; |
|
|
|
agefin=cov[2]; |
|
/* Bx = Diag(w_x) P_x Diag(Sum_i w^i_x p^ij_x */ |
|
/* bmij *//* age is cov[2], ij is included in cov, but we need for |
|
the observed prevalence (with this covariate ij) at beginning of transition */ |
|
/* dsavm=pmij(pmmij,cov,ncovmodel,x,nlstate); */ |
|
|
|
/* P_x */ |
|
pmmij=pmij(pmmij,cov,ncovmodel,x,nlstate); /*This is forward probability from agefin to agefin + stepm */ |
|
/* outputs pmmij which is a stochastic matrix in row */ |
|
|
|
/* Diag(w_x) */ |
|
/* Problem with prevacurrent which can be zero */ |
|
sumnew=0.; |
|
/*for (ii=1;ii<=nlstate+ndeath;ii++){*/ |
|
for (ii=1;ii<=nlstate;ii++){ /* Only on live states */ |
|
/* printf(" agefin=%d, ii=%d, ij=%d, prev=%f\n",(int)agefin,ii, ij, prevacurrent[(int)agefin][ii][ij]); */ |
|
sumnew+=prevacurrent[(int)agefin][ii][ij]; |
|
} |
|
if(sumnew >0.01){ /* At least some value in the prevalence */ |
|
for (ii=1;ii<=nlstate+ndeath;ii++){ |
|
for (j=1;j<=nlstate+ndeath;j++) |
|
doldm[ii][j]=(ii==j ? prevacurrent[(int)agefin][ii][ij]/sumnew : 0.0); |
|
} |
|
}else{ |
|
for (ii=1;ii<=nlstate+ndeath;ii++){ |
|
for (j=1;j<=nlstate+ndeath;j++) |
|
doldm[ii][j]=(ii==j ? 1./nlstate : 0.0); |
|
} |
|
/* if(sumnew <0.9){ */ |
|
/* printf("Problem internal bmij B: sum on i wi <0.9: j=%d, sum_i wi=%lf,agefin=%d\n",j,sumnew, (int)agefin); */ |
|
/* } */ |
|
} |
|
k3=0.0; /* We put the last diagonal to 0 */ |
|
for (ii=nlstate+1;ii<=nlstate+ndeath;ii++){ |
|
doldm[ii][ii]= k3; |
|
} |
|
/* End doldm, At the end doldm is diag[(w_i)] */ |
|
|
|
/* left Product of this diag matrix by pmmij=Px (dnewm=dsavm*doldm) */ |
|
bbmij=matprod2(dnewm, doldm,1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, pmmij); /* Bug Valgrind */ |
|
|
|
/* Diag(Sum_i w^i_x p^ij_x */ |
|
/* w1 p11 + w2 p21 only on live states N1./N..*N11/N1. + N2./N..*N21/N2.=(N11+N21)/N..=N.1/N.. */ |
|
for (j=1;j<=nlstate+ndeath;j++){ |
|
sumnew=0.; |
|
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); /* 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-1)*ncovmodel |
|
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; j<i;j++){ |
|
for (nc=1, lnpijopii=0.;nc <=ncovmodel; nc++){ |
|
/*lnpijopii += param[i][j][nc]*cov[nc];*/ |
|
lnpijopii += x[nc+((i-1)*(nlstate+ndeath-1)+j-1)*ncovmodel]*cov[nc]; |
|
/* printf("Int j<i s1=%.17e, lnpijopii=%.17e\n",s1,lnpijopii); */ |
|
} |
|
ps[i][j]=lnpijopii; /* In fact ln(pij/pii) */ |
|
/* printf("s1=%.17e, lnpijopii=%.17e\n",s1,lnpijopii); */ |
|
} |
|
for(j=i+1; j<=nlstate+ndeath;j++){ |
|
for (nc=1, lnpijopii=0.;nc <=ncovmodel; nc++){ |
|
/*lnpijopii += x[(i-1)*nlstate*ncovmodel+(j-2)*ncovmodel+nc+(i-1)*(ndeath-1)*ncovmodel]*cov[nc];*/ |
|
lnpijopii += x[nc + ((i-1)*(nlstate+ndeath-1)+(j-2))*ncovmodel]*cov[nc]; |
|
/* printf("Int j>i s1=%.17e, lnpijopii=%.17e %lx %lx\n",s1,lnpijopii,s1,lnpijopii); */ |
|
} |
|
ps[i][j]=lnpijopii; /* In fact ln(pij/pii) */ |
|
} |
|
} |
|
|
|
for(i=1; i<= nlstate; i++){ |
|
s1=0; |
|
for(j=1; j<i; j++){ |
|
s1+=exp(ps[i][j]); /* In fact sums pij/pii */ |
|
/*printf("debug1 %d %d ps=%lf exp(ps)=%lf s1+=%lf\n",i,j,ps[i][j],exp(ps[i][j]),s1); */ |
|
} |
|
for(j=i+1; j<=nlstate+ndeath; j++){ |
|
s1+=exp(ps[i][j]); /* In fact sums pij/pii */ |
|
/*printf("debug2 %d %d ps=%lf exp(ps)=%lf s1+=%lf\n",i,j,ps[i][j],exp(ps[i][j]),s1); */ |
|
} |
|
/* s1= sum_{j<>i} pij/pii=(1-pii)/pii and thus pii is known from s1 */ |
|
ps[i][i]=1./(s1+1.); |
|
/* Computing other pijs */ |
|
for(j=1; j<i; j++) |
|
ps[i][j]= exp(ps[i][j])*ps[i][i]; |
|
for(j=i+1; j<=nlstate+ndeath; j++) |
|
ps[i][j]= exp(ps[i][j])*ps[i][i]; |
|
/* ps[i][nlstate+1]=1.-s1- ps[i][i];*/ /* Sum should be 1 */ |
|
} /* end i */ |
|
|
|
for(ii=nlstate+1; ii<= nlstate+ndeath; ii++){ |
|
for(jj=1; jj<= nlstate+ndeath; jj++){ |
|
ps[ii][jj]=0; |
|
ps[ii][ii]=1; |
|
} |
|
} |
|
/* Added for backcast */ /* Transposed matrix too */ |
|
for(jj=1; jj<= nlstate+ndeath; jj++){ |
|
s1=0.; |
|
for(ii=1; ii<= nlstate+ndeath; ii++){ |
|
s1+=ps[ii][jj]; |
|
} |
|
for(ii=1; ii<= nlstate; ii++){ |
|
ps[ii][jj]=ps[ii][jj]/s1; |
|
} |
|
} |
|
/* Transposition */ |
|
for(jj=1; jj<= nlstate+ndeath; jj++){ |
|
for(ii=jj; ii<= nlstate+ndeath; ii++){ |
|
s1=ps[ii][jj]; |
|
ps[ii][jj]=ps[jj][ii]; |
|
ps[jj][ii]=s1; |
|
} |
|
} |
|
/* for(ii=1; ii<= nlstate+ndeath; ii++){ */ |
|
/* for(jj=1; jj<= nlstate+ndeath; jj++){ */ |
|
/* printf(" pmij ps[%d][%d]=%lf ",ii,jj,ps[ii][jj]); */ |
|
/* } */ |
|
/* printf("\n "); */ |
|
/* } */ |
|
/* printf("\n ");printf("%lf ",cov[2]);*/ |
|
/* |
|
for(i=1; i<= npar; i++) printf("%f ",x[i]); |
|
goto end;*/ |
|
return ps; |
|
} |
|
|
|
|
|
/**************** Product of 2 matrices ******************/ |
|
|
|
double **matprod2(double **out, double **in,int nrl, int nrh, int ncl, int nch, int ncolol, int ncoloh, double **b) |
|
{ |
|
/* Computes the matrix product of in(1,nrh-nrl+1)(1,nch-ncl+1) times |
|
b(1,nch-ncl+1)(1,ncoloh-ncolol+1) into out(...) */ |
|
/* in, b, out are matrice of pointers which should have been initialized |
|
before: only the contents of out is modified. The function returns |
|
a pointer to pointers identical to out */ |
|
int i, j, k; |
|
for(i=nrl; i<= nrh; i++) |
|
for(k=ncolol; k<=ncoloh; k++){ |
|
out[i][k]=0.; |
|
for(j=ncl; j<=nch; j++) |
|
out[i][k] +=in[i][j]*b[j][k]; |
} |
} |
return out; |
return out; |
} |
} |
Line 2192 double **matprod2(double **out, double *
|
Line 3131 double **matprod2(double **out, double *
|
|
|
/************* Higher Matrix Product ***************/ |
/************* Higher Matrix Product ***************/ |
|
|
double ***hpxij(double ***po, int nhstepm, double age, int hstepm, double *x, int nlstate, int stepm, double **oldm, double **savm, int ij ) |
double ***hpxij(double ***po, int nhstepm, double age, int hstepm, double *x, int nlstate, int stepm, double **oldm, double **savm, int ij, int nres ) |
{ |
{ |
/* Computes the transition matrix starting at age 'age' over |
/* Computes the transition matrix starting at age 'age' and combination of covariate values corresponding to ij over |
'nhstepm*hstepm*stepm' months (i.e. until |
'nhstepm*hstepm*stepm' months (i.e. until |
age (in years) age+nhstepm*hstepm*stepm/12) by multiplying |
age (in years) age+nhstepm*hstepm*stepm/12) by multiplying |
nhstepm*hstepm matrices. |
nhstepm*hstepm matrices. |
Line 2210 double ***hpxij(double ***po, int nhstep
|
Line 3149 double ***hpxij(double ***po, int nhstep
|
double **out, cov[NCOVMAX+1]; |
double **out, cov[NCOVMAX+1]; |
double **newm; |
double **newm; |
double agexact; |
double agexact; |
|
double agebegin, ageend; |
|
|
/* Hstepm could be zero and should return the unit matrix */ |
/* Hstepm could be zero and should return the unit matrix */ |
for (i=1;i<=nlstate+ndeath;i++) |
for (i=1;i<=nlstate+ndeath;i++) |
Line 2223 double ***hpxij(double ***po, int nhstep
|
Line 3163 double ***hpxij(double ***po, int nhstep
|
newm=savm; |
newm=savm; |
/* Covariates have to be included here again */ |
/* Covariates have to be included here again */ |
cov[1]=1.; |
cov[1]=1.; |
agexact=age+((h-1)*hstepm + (d-1))*stepm/YEARM; |
agexact=age+((h-1)*hstepm + (d-1))*stepm/YEARM; /* age just before transition */ |
cov[2]=agexact; |
cov[2]=agexact; |
if(nagesqr==1) |
if(nagesqr==1) |
cov[3]= agexact*agexact; |
cov[3]= agexact*agexact; |
for (k=1; k<=cptcovn;k++) |
for (k=1; k<=nsd;k++) { /* For single dummy covariates only */ |
cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(ij,k)]; |
/* Here comes the value of the covariate 'ij' after renumbering k with single dummy covariates */ |
/* cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(ij,Tvar[k])]; */ |
cov[2+nagesqr+TvarsDind[k]]=nbcode[TvarsD[k]][codtabm(ij,k)]; |
for (k=1; k<=cptcovage;k++) /* Should start at cptcovn+1 */ |
/* printf("hpxij 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)); */ |
/* cov[2+Tage[k]]=cov[2+Tage[k]]*cov[2]; */ |
} |
cov[2+nagesqr+Tage[k]]=nbcode[Tvar[Tage[k]]][codtabm(ij,k)]*cov[2]; |
for (k=1; k<=nsq;k++) { /* For single varying covariates only */ |
/* cov[2+nagesqr+Tage[k]]=nbcode[Tvar[Tage[k]]][codtabm(ij,Tvar[Tage[k]])]*cov[2]; */ |
/* Here comes the value of quantitative after renumbering k with single quantitative covariates */ |
for (k=1; k<=cptcovprod;k++) /* Useless because included in cptcovn */ |
cov[2+nagesqr+TvarsQind[k]]=Tqresult[nres][k]; |
cov[2+nagesqr+Tprod[k]]=nbcode[Tvard[k][1]][codtabm(ij,k)]*nbcode[Tvard[k][2]][codtabm(ij,k)]; |
/* printf("hPxij Quantitative k=%d TvarsQind[%d]=%d, TvarsQ[%d]=V%d,Tqresult[%d][%d]=%f\n",k,k,TvarsQind[k],k,TvarsQ[k],nres,k,Tqresult[nres][k]); */ |
/* cov[2+nagesqr+Tprod[k]]=nbcode[Tvard[k][1]][codtabm(ij,Tvard[k][1])]*nbcode[Tvard[k][2]][codtabm(ij,Tvard[k][2])]; */ |
} |
|
for (k=1; k<=cptcovage;k++){ |
|
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("hPxij 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++){ /* */ |
|
/* printf("hPxij 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]); */ |
|
cov[2+nagesqr+Tprod[k]]=nbcode[Tvard[k][1]][codtabm(ij,k)] * nbcode[Tvard[k][2]][codtabm(ij,k)]; |
|
} |
|
/* for (k=1; k<=cptcovn;k++) */ |
|
/* cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(ij,k)]; */ |
|
/* for (k=1; k<=cptcovage;k++) /\* Should start at cptcovn+1 *\/ */ |
|
/* cov[2+nagesqr+Tage[k]]=nbcode[Tvar[Tage[k]]][codtabm(ij,k)]*cov[2]; */ |
|
/* for (k=1; k<=cptcovprod;k++) /\* Useless because included in cptcovn *\/ */ |
|
/* cov[2+nagesqr+Tprod[k]]=nbcode[Tvard[k][1]][codtabm(ij,k)]*nbcode[Tvard[k][2]][codtabm(ij,k)]; */ |
|
|
|
|
/*printf("hxi cptcov=%d cptcode=%d\n",cptcov,cptcode);*/ |
/*printf("hxi cptcov=%d cptcode=%d\n",cptcov,cptcode);*/ |
/*printf("h=%d d=%d age=%f cov=%f\n",h,d,age,cov[2]);*/ |
/*printf("h=%d d=%d age=%f cov=%f\n",h,d,age,cov[2]);*/ |
|
/* right multiplication of oldm by the current matrix */ |
out=matprod2(newm,oldm,1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, |
out=matprod2(newm,oldm,1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, |
pmij(pmmij,cov,ncovmodel,x,nlstate)); |
pmij(pmmij,cov,ncovmodel,x,nlstate)); |
|
/* if((int)age == 70){ */ |
|
/* printf(" Forward hpxij age=%d agexact=%f d=%d nhstepm=%d hstepm=%d\n", (int) age, agexact, d, nhstepm, hstepm); */ |
|
/* for(i=1; i<=nlstate+ndeath; i++) { */ |
|
/* printf("%d pmmij ",i); */ |
|
/* for(j=1;j<=nlstate+ndeath;j++) { */ |
|
/* printf("%f ",pmmij[i][j]); */ |
|
/* } */ |
|
/* printf(" oldm "); */ |
|
/* for(j=1;j<=nlstate+ndeath;j++) { */ |
|
/* printf("%f ",oldm[i][j]); */ |
|
/* } */ |
|
/* printf("\n"); */ |
|
/* } */ |
|
/* } */ |
savm=oldm; |
savm=oldm; |
oldm=newm; |
oldm=newm; |
} |
} |
Line 2253 double ***hpxij(double ***po, int nhstep
|
Line 3226 double ***hpxij(double ***po, int nhstep
|
} |
} |
/*printf("h=%d ",h);*/ |
/*printf("h=%d ",h);*/ |
} /* end h */ |
} /* end h */ |
/* printf("\n H=%d \n",h); */ |
/* printf("\n H=%d \n",h); */ |
|
return po; |
|
} |
|
|
|
/************* Higher Back Matrix Product ***************/ |
|
/* double ***hbxij(double ***po, int nhstepm, double age, int hstepm, double *x, double ***prevacurrent, int nlstate, int stepm, double **oldm, double **savm, double **dnewm, double **doldm, double **dsavm, int ij ) */ |
|
double ***hbxij(double ***po, int nhstepm, double age, int hstepm, double *x, double ***prevacurrent, int nlstate, int stepm, int ij, int nres ) |
|
{ |
|
/* For a combination of dummy covariate ij, computes the transition matrix starting at age 'age' over |
|
'nhstepm*hstepm*stepm' months (i.e. until |
|
age (in years) age+nhstepm*hstepm*stepm/12) by multiplying |
|
nhstepm*hstepm matrices. |
|
Output is stored in matrix po[i][j][h] for h every 'hstepm' step |
|
(typically every 2 years instead of every month which is too big |
|
for the memory). |
|
Model is determined by parameters x and covariates have to be |
|
included manually here. Then we use a call to bmij(x and cov) |
|
The addresss of po (p3mat allocated to the dimension of nhstepm) should be stored for output |
|
*/ |
|
|
|
int i, j, d, h, k; |
|
double **out, cov[NCOVMAX+1], **bmij(); |
|
double **newm, ***newmm; |
|
double agexact; |
|
double agebegin, ageend; |
|
double **oldm, **savm; |
|
|
|
newmm=po; /* To be saved */ |
|
oldm=oldms;savm=savms; /* Global pointers */ |
|
/* Hstepm could be zero and should return the unit matrix */ |
|
for (i=1;i<=nlstate+ndeath;i++) |
|
for (j=1;j<=nlstate+ndeath;j++){ |
|
oldm[i][j]=(i==j ? 1.0 : 0.0); |
|
po[i][j][0]=(i==j ? 1.0 : 0.0); |
|
} |
|
/* Even if hstepm = 1, at least one multiplication by the unit matrix */ |
|
for(h=1; h <=nhstepm; h++){ |
|
for(d=1; d <=hstepm; d++){ |
|
newm=savm; |
|
/* Covariates have to be included here again */ |
|
cov[1]=1.; |
|
agexact=age-( (h-1)*hstepm + (d) )*stepm/YEARM; /* age just before transition, d or d-1? */ |
|
/* agexact=age+((h-1)*hstepm + (d-1))*stepm/YEARM; /\* age just before transition *\/ */ |
|
cov[2]=agexact; |
|
if(nagesqr==1) |
|
cov[3]= agexact*agexact; |
|
for (k=1; k<=cptcovn;k++){ |
|
/* cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(ij,k)]; */ |
|
/* /\* cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(ij,Tvar[k])]; *\/ */ |
|
cov[2+nagesqr+TvarsDind[k]]=nbcode[TvarsD[k]][codtabm(ij,k)]; |
|
/* printf("hbxij Dummy agexact=%.0f combi=%d k=%d TvarsD[%d]=V%d TvarsDind[%d]=%d nbcode=%d cov[%d]=%lf codtabm(%d,Tvar[%d])=%d \n",agexact,ij,k, k, TvarsD[k],k,TvarsDind[k],nbcode[TvarsD[k]][codtabm(ij,k)],2+nagesqr+TvarsDind[k],cov[2+nagesqr+TvarsDind[k]], ij, k, codtabm(ij,k)); */ |
|
} |
|
for (k=1; k<=nsq;k++) { /* For single varying covariates only */ |
|
/* Here comes the value of quantitative after renumbering k with single quantitative covariates */ |
|
cov[2+nagesqr+TvarsQind[k]]=Tqresult[nres][k]; |
|
/* printf("hPxij Quantitative k=%d TvarsQind[%d]=%d, TvarsQ[%d]=V%d,Tqresult[%d][%d]=%f\n",k,k,TvarsQind[k],k,TvarsQ[k],nres,k,Tqresult[nres][k]); */ |
|
} |
|
for (k=1; k<=cptcovage;k++){ /* Should start at cptcovn+1 */ |
|
if(Dummy[Tvar[Tage[k]]]){ |
|
cov[2+nagesqr+Tage[k]]=nbcode[Tvar[Tage[k]]][codtabm(ij,k)]*cov[2]; |
|
} else{ |
|
cov[2+nagesqr+Tage[k]]=Tqresult[nres][k]; |
|
} |
|
/* printf("hBxij Age combi=%d k=%d Tage[%d]=V%d Tqresult[%d][%d]=%f\n",ij,k,k,Tage[k],nres,k,Tqresult[nres][k]); */ |
|
} |
|
for (k=1; k<=cptcovprod;k++){ /* Useless because included in cptcovn */ |
|
cov[2+nagesqr+Tprod[k]]=nbcode[Tvard[k][1]][codtabm(ij,k)]*nbcode[Tvard[k][2]][codtabm(ij,k)]; |
|
} |
|
/*printf("hxi cptcov=%d cptcode=%d\n",cptcov,cptcode);*/ |
|
/*printf("h=%d d=%d age=%f cov=%f\n",h,d,age,cov[2]);*/ |
|
|
|
/* Careful transposed matrix */ |
|
/* age is in cov[2], prevacurrent at beginning of transition. */ |
|
/* out=matprod2(newm, bmij(pmmij,cov,ncovmodel,x,nlstate,prevacurrent, dnewm, doldm, dsavm,ij),\ */ |
|
/* 1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, oldm); */ |
|
out=matprod2(newm, bmij(pmmij,cov,ncovmodel,x,nlstate,prevacurrent,ij),\ |
|
1,nlstate+ndeath,1,nlstate+ndeath,1,nlstate+ndeath, oldm); |
|
/* if((int)age == 70){ */ |
|
/* printf(" Backward hbxij age=%d agexact=%f d=%d nhstepm=%d hstepm=%d\n", (int) age, agexact, d, nhstepm, hstepm); */ |
|
/* for(i=1; i<=nlstate+ndeath; i++) { */ |
|
/* printf("%d pmmij ",i); */ |
|
/* for(j=1;j<=nlstate+ndeath;j++) { */ |
|
/* printf("%f ",pmmij[i][j]); */ |
|
/* } */ |
|
/* printf(" oldm "); */ |
|
/* for(j=1;j<=nlstate+ndeath;j++) { */ |
|
/* printf("%f ",oldm[i][j]); */ |
|
/* } */ |
|
/* printf("\n"); */ |
|
/* } */ |
|
/* } */ |
|
savm=oldm; |
|
oldm=newm; |
|
} |
|
for(i=1; i<=nlstate+ndeath; i++) |
|
for(j=1;j<=nlstate+ndeath;j++) { |
|
po[i][j][h]=newm[i][j]; |
|
/* if(h==nhstepm) */ |
|
/* printf("po[%d][%d][%d]=%f ",i,j,h,po[i][j][h]); */ |
|
} |
|
/* printf("h=%d %.1f ",h, agexact); */ |
|
} /* end h */ |
|
/* printf("\n H=%d nhs=%d \n",h, nhstepm); */ |
return po; |
return po; |
} |
} |
|
|
|
|
#ifdef NLOPT |
#ifdef NLOPT |
double myfunc(unsigned n, const double *p1, double *grad, void *pd){ |
double myfunc(unsigned n, const double *p1, double *grad, void *pd){ |
double fret; |
double fret; |
Line 2281 double ***hpxij(double ***po, int nhstep
|
Line 3357 double ***hpxij(double ***po, int nhstep
|
double func( double *x) |
double func( double *x) |
{ |
{ |
int i, ii, j, k, mi, d, kk; |
int i, ii, j, k, mi, d, kk; |
|
int ioffset=0; |
double l, ll[NLSTATEMAX+1], cov[NCOVMAX+1]; |
double l, ll[NLSTATEMAX+1], cov[NCOVMAX+1]; |
double **out; |
double **out; |
double sw; /* Sum of weights */ |
|
double lli; /* Individual log likelihood */ |
double lli; /* Individual log likelihood */ |
int s1, s2; |
int s1, s2; |
|
int iv=0, iqv=0, itv=0, iqtv=0 ; /* Index of varying covariate, fixed quantitative cov, time varying covariate, quantitative time varying covariate */ |
double bbh, survp; |
double bbh, survp; |
long ipmx; |
long ipmx; |
double agexact; |
double agexact; |
Line 2301 double func( double *x)
|
Line 3378 double func( double *x)
|
cov[1]=1.; |
cov[1]=1.; |
|
|
for(k=1; k<=nlstate; k++) ll[k]=0.; |
for(k=1; k<=nlstate; k++) ll[k]=0.; |
|
ioffset=0; |
if(mle==1){ |
if(mle==1){ |
for (i=1,ipmx=0, sw=0.; i<=imx; i++){ |
for (i=1,ipmx=0, sw=0.; i<=imx; i++){ |
/* Computes the values of the ncovmodel covariates of the model |
/* Computes the values of the ncovmodel covariates of the model |
depending if the covariates are fixed or variying (age dependent) and stores them in cov[] |
depending if the covariates are fixed or varying (age dependent) and stores them in cov[] |
Then computes with function pmij which return a matrix p[i][j] giving the elementary probability |
Then computes with function pmij which return a matrix p[i][j] giving the elementary probability |
to be observed in j being in i according to the model. |
to be observed in j being in i according to the model. |
*/ |
*/ |
for (k=1; k<=cptcovn;k++){ /* Simple and product covariates without age* products */ |
ioffset=2+nagesqr ; |
cov[2+nagesqr+k]=covar[Tvar[k]][i]; |
/* Fixed */ |
|
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)*/ |
} |
} |
/* In model V2+V1*V4+age*V3+V3*V2 Tvar[1] is V2, Tvar[2=V1*V4] |
/* In model V2+V1*V4+age*V3+V3*V2 Tvar[1] is V2, Tvar[2=V1*V4] |
is 6, Tvar[3=age*V3] should not be computed because of age Tvar[4=V3*V2] |
is 6, Tvar[3=age*V3] should not be computed because of age Tvar[4=V3*V2] |
has been calculated etc */ |
has been calculated etc */ |
|
/* For an individual i, wav[i] gives the number of effective waves */ |
|
/* We compute the contribution to Likelihood of each effective transition |
|
mw[mi][i] is real wave of the mi th effectve wave */ |
|
/* Then statuses are computed at each begin and end of an effective wave s1=s[ mw[mi][i] ][i]; |
|
s2=s[mw[mi+1][i]][i]; |
|
And the iv th varying covariate is the cotvar[mw[mi+1][i]][iv][i] |
|
But if the variable is not in the model TTvar[iv] is the real variable effective in the model: |
|
meaning that decodemodel should be used cotvar[mw[mi+1][i]][TTvar[iv]][i] |
|
*/ |
for(mi=1; mi<= wav[i]-1; mi++){ |
for(mi=1; mi<= wav[i]-1; mi++){ |
|
for(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 (ii=1;ii<=nlstate+ndeath;ii++) |
for (ii=1;ii<=nlstate+ndeath;ii++) |
for (j=1;j<=nlstate+ndeath;j++){ |
for (j=1;j<=nlstate+ndeath;j++){ |
oldm[ii][j]=(ii==j ? 1.0 : 0.0); |
oldm[ii][j]=(ii==j ? 1.0 : 0.0); |
Line 2326 double func( double *x)
|
Line 3418 double func( double *x)
|
agexact=agev[mw[mi][i]][i]+d*stepm/YEARM; |
agexact=agev[mw[mi][i]][i]+d*stepm/YEARM; |
cov[2]=agexact; |
cov[2]=agexact; |
if(nagesqr==1) |
if(nagesqr==1) |
cov[3]= agexact*agexact; |
cov[3]= agexact*agexact; /* Should be changed here */ |
for (kk=1; kk<=cptcovage;kk++) { |
for (kk=1; kk<=cptcovage;kk++) { |
|
if(!FixedV[Tvar[Tage[kk]]]) |
cov[Tage[kk]+2+nagesqr]=covar[Tvar[Tage[kk]]][i]*agexact; /* Tage[kk] gives the data-covariate associated with age */ |
cov[Tage[kk]+2+nagesqr]=covar[Tvar[Tage[kk]]][i]*agexact; /* Tage[kk] gives the data-covariate associated with age */ |
|
else |
|
cov[Tage[kk]+2+nagesqr]=cotvar[mw[mi][i]][Tvar[Tage[kk]]-ncovcol-nqv][i]*agexact; |
} |
} |
out=matprod2(newm,oldm,1,nlstate+ndeath,1,nlstate+ndeath, |
out=matprod2(newm,oldm,1,nlstate+ndeath,1,nlstate+ndeath, |
1,nlstate+ndeath,pmij(pmmij,cov,ncovmodel,x,nlstate)); |
1,nlstate+ndeath,pmij(pmmij,cov,ncovmodel,x,nlstate)); |
savm=oldm; |
savm=oldm; |
oldm=newm; |
oldm=newm; |
} /* end mult */ |
} /* end mult */ |
|
|
/*lli=log(out[s[mw[mi][i]][i]][s[mw[mi+1][i]][i]]);*/ /* Original formula */ |
/*lli=log(out[s[mw[mi][i]][i]][s[mw[mi+1][i]][i]]);*/ /* Original formula */ |
/* But now since version 0.9 we anticipate for bias at large stepm. |
/* But now since version 0.9 we anticipate for bias at large stepm. |
* If stepm is larger than one month (smallest stepm) and if the exact delay |
* If stepm is larger than one month (smallest stepm) and if the exact delay |
Line 2344 double func( double *x)
|
Line 3439 double func( double *x)
|
* we keep into memory the bias bh[mi][i] and also the previous matrix product |
* we keep into memory the bias bh[mi][i] and also the previous matrix product |
* (i.e to dh[mi][i]-1) saved in 'savm'. Then we inter(extra)polate the |
* (i.e to dh[mi][i]-1) saved in 'savm'. Then we inter(extra)polate the |
* probability in order to take into account the bias as a fraction of the way |
* probability in order to take into account the bias as a fraction of the way |
* from savm to out if bh is negative or even beyond if bh is positive. bh varies |
* from savm to out if bh is negative or even beyond if bh is positive. bh varies |
* -stepm/2 to stepm/2 . |
* -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 the same as for previous versions of Imach. |
* For stepm > 1 the results are less biased than in previous versions. |
* For stepm > 1 the results are less biased than in previous versions. |
*/ |
*/ |
s1=s[mw[mi][i]][i]; |
s1=s[mw[mi][i]][i]; |
s2=s[mw[mi+1][i]][i]; |
s2=s[mw[mi+1][i]][i]; |
bbh=(double)bh[mi][i]/(double)stepm; |
bbh=(double)bh[mi][i]/(double)stepm; |
Line 2363 double func( double *x)
|
Line 3458 double func( double *x)
|
which is also equal to probability to die before dh |
which is also equal to probability to die before dh |
minus probability to die before dh-stepm . |
minus probability to die before dh-stepm . |
In version up to 0.92 likelihood was computed |
In version up to 0.92 likelihood was computed |
as if date of death was unknown. Death was treated as any other |
as if date of death was unknown. Death was treated as any other |
health state: the date of the interview describes the actual state |
health state: the date of the interview describes the actual state |
and not the date of a change in health state. The former idea was |
and not the date of a change in health state. The former idea was |
to consider that at each interview the state was recorded |
to consider that at each interview the state was recorded |
(healthy, disable or death) and IMaCh was corrected; but when we |
(healthy, disable or death) and IMaCh was corrected; but when we |
introduced the exact date of death then we should have modified |
introduced the exact date of death then we should have modified |
the contribution of an exact death to the likelihood. This new |
the contribution of an exact death to the likelihood. This new |
contribution is smaller and very dependent of the step unit |
contribution is smaller and very dependent of the step unit |
stepm. It is no more the probability to die between last interview |
stepm. It is no more the probability to die between last interview |
and month of death but the probability to survive from last |
and month of death but the probability to survive from last |
interview up to one month before death multiplied by the |
interview up to one month before death multiplied by the |
probability to die within a month. Thanks to Chris |
probability to die within a month. Thanks to Chris |
Jackson for correcting this bug. Former versions increased |
Jackson for correcting this bug. Former versions increased |
mortality artificially. The bad side is that we add another loop |
mortality artificially. The bad side is that we add another loop |
which slows down the processing. The difference can be up to 10% |
which slows down the processing. The difference can be up to 10% |
lower mortality. |
lower mortality. |
|
*/ |
|
/* If, at the beginning of the maximization mostly, the |
|
cumulative probability or probability to be dead is |
|
constant (ie = 1) over time d, the difference is equal to |
|
0. out[s1][3] = savm[s1][3]: probability, being at state |
|
s1 at precedent wave, to be dead a month before current |
|
wave is equal to probability, being at state s1 at |
|
precedent wave, to be dead at mont of the current |
|
wave. Then the observed probability (that this person died) |
|
is null according to current estimated parameter. In fact, |
|
it should be very low but not zero otherwise the log go to |
|
infinity. |
*/ |
*/ |
/* If, at the beginning of the maximization mostly, the |
|
cumulative probability or probability to be dead is |
|
constant (ie = 1) over time d, the difference is equal to |
|
0. out[s1][3] = savm[s1][3]: probability, being at state |
|
s1 at precedent wave, to be dead a month before current |
|
wave is equal to probability, being at state s1 at |
|
precedent wave, to be dead at mont of the current |
|
wave. Then the observed probability (that this person died) |
|
is null according to current estimated parameter. In fact, |
|
it should be very low but not zero otherwise the log go to |
|
infinity. |
|
*/ |
|
/* #ifdef INFINITYORIGINAL */ |
/* #ifdef INFINITYORIGINAL */ |
/* lli=log(out[s1][s2] - savm[s1][s2]); */ |
/* lli=log(out[s1][s2] - savm[s1][s2]); */ |
/* #else */ |
/* #else */ |
Line 2400 double func( double *x)
|
Line 3495 double func( double *x)
|
/* else */ |
/* else */ |
/* lli=log(out[s1][s2] - savm[s1][s2]); */ |
/* lli=log(out[s1][s2] - savm[s1][s2]); */ |
/* #endif */ |
/* #endif */ |
lli=log(out[s1][s2] - savm[s1][s2]); |
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++) |
for (j=1,survp=0. ; j<=nlstate; j++) |
survp += (1.+bbh)*out[s1][j]- bbh*savm[s1][j]; |
survp += (1.+bbh)*out[s1][j]- bbh*savm[s1][j]; |
/*survp += out[s1][j]; */ |
/*survp += out[s1][j]; */ |
lli= log(survp); |
lli= log(survp); |
} |
} |
|
else if (s2==-4) { |
else if (s2==-4) { |
|
for (j=3,survp=0. ; j<=nlstate; j++) |
for (j=3,survp=0. ; j<=nlstate; j++) |
survp += (1.+bbh)*out[s1][j]- bbh*savm[s1][j]; |
survp += (1.+bbh)*out[s1][j]- bbh*savm[s1][j]; |
lli= log(survp); |
lli= log(survp); |
} |
} |
|
else if (s2==-5) { |
else if (s2==-5) { |
for (j=1,survp=0. ; j<=2; j++) |
for (j=1,survp=0. ; j<=2; j++) |
|
survp += (1.+bbh)*out[s1][j]- bbh*savm[s1][j]; |
survp += (1.+bbh)*out[s1][j]- bbh*savm[s1][j]; |
lli= log(survp); |
lli= log(survp); |
} |
} |
|
|
else{ |
else{ |
lli= log((1.+bbh)*out[s1][s2]- bbh*savm[s1][s2]); /* linear interpolation */ |
lli= log((1.+bbh)*out[s1][s2]- bbh*savm[s1][s2]); /* linear interpolation */ |
/* lli= (savm[s1][s2]>(double)1.e-8 ?log((1.+bbh)*out[s1][s2]- bbh*(savm[s1][s2])):log((1.+bbh)*out[s1][s2]));*/ /* linear interpolation */ |
/* lli= (savm[s1][s2]>(double)1.e-8 ?log((1.+bbh)*out[s1][s2]- bbh*(savm[s1][s2])):log((1.+bbh)*out[s1][s2]));*/ /* linear interpolation */ |
Line 2428 double func( double *x)
|
Line 3520 double func( double *x)
|
/*lli=(1.+bbh)*log(out[s1][s2])- bbh*log(savm[s1][s2]);*/ |
/*lli=(1.+bbh)*log(out[s1][s2])- bbh*log(savm[s1][s2]);*/ |
/*if(lli ==000.0)*/ |
/*if(lli ==000.0)*/ |
/*printf("bbh= %f lli=%f savm=%f out=%f %d\n",bbh,lli,savm[s1][s2], out[s[mw[mi][i]][i]][s[mw[mi+1][i]][i]],i); */ |
/*printf("bbh= %f lli=%f savm=%f out=%f %d\n",bbh,lli,savm[s1][s2], out[s[mw[mi][i]][i]][s[mw[mi+1][i]][i]],i); */ |
ipmx +=1; |
ipmx +=1; |
sw += weight[i]; |
sw += weight[i]; |
ll[s[mw[mi][i]][i]] += 2*weight[i]*lli; |
ll[s[mw[mi][i]][i]] += 2*weight[i]*lli; |
/* if (lli < log(mytinydouble)){ */ |
/* if (lli < log(mytinydouble)){ */ |
Line 2532 double func( double *x)
|
Line 3624 double func( double *x)
|
s2=s[mw[mi+1][i]][i]; |
s2=s[mw[mi+1][i]][i]; |
if( s2 > nlstate){ |
if( s2 > nlstate){ |
lli=log(out[s1][s2] - savm[s1][s2]); |
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{ |
}else{ |
lli=log(out[s[mw[mi][i]][i]][s[mw[mi+1][i]][i]]); /* Original formula */ |
lli=log(out[s[mw[mi][i]][i]][s[mw[mi+1][i]][i]]); /* Original formula */ |
} |
} |
Line 2585 double func( double *x)
|
Line 3681 double func( double *x)
|
/*************** log-likelihood *************/ |
/*************** log-likelihood *************/ |
double funcone( double *x) |
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 i, ii, j, k, mi, d, kk; |
|
int ioffset=0; |
double l, ll[NLSTATEMAX+1], cov[NCOVMAX+1]; |
double l, ll[NLSTATEMAX+1], cov[NCOVMAX+1]; |
double **out; |
double **out; |
double lli; /* Individual log likelihood */ |
double lli; /* Individual log likelihood */ |
double llt; |
double llt; |
int s1, s2; |
int s1, s2; |
|
int iv=0, iqv=0, itv=0, iqtv=0 ; /* Index of varying covariate, fixed quantitative cov, time varying covariate, quantitative time varying covariate */ |
|
|
double bbh, survp; |
double bbh, survp; |
double agexact; |
double agexact; |
|
double agebegin, ageend; |
/*extern weight */ |
/*extern weight */ |
/* We are differentiating ll according to initial status */ |
/* We are differentiating ll according to initial status */ |
/* for (i=1;i<=npar;i++) printf("%f ", x[i]);*/ |
/* for (i=1;i<=npar;i++) printf("%f ", x[i]);*/ |
Line 2603 double funcone( double *x)
|
Line 3703 double funcone( double *x)
|
cov[1]=1.; |
cov[1]=1.; |
|
|
for(k=1; k<=nlstate; k++) ll[k]=0.; |
for(k=1; k<=nlstate; k++) ll[k]=0.; |
|
ioffset=0; |
for (i=1,ipmx=0, sw=0.; i<=imx; i++){ |
for (i=1,ipmx=0, sw=0.; i<=imx; i++){ |
for (k=1; k<=cptcovn;k++) cov[2+nagesqr+k]=covar[Tvar[k]][i]; |
/* ioffset=2+nagesqr+cptcovage; */ |
for(mi=1; mi<= wav[i]-1; mi++){ |
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 (ii=1;ii<=nlstate+ndeath;ii++) |
for (j=1;j<=nlstate+ndeath;j++){ |
for (j=1;j<=nlstate+ndeath;j++){ |
oldm[ii][j]=(ii==j ? 1.0 : 0.0); |
oldm[ii][j]=(ii==j ? 1.0 : 0.0); |
savm[ii][j]=(ii==j ? 1.0 : 0.0); |
savm[ii][j]=(ii==j ? 1.0 : 0.0); |
} |
} |
for(d=0; d<dh[mi][i]; d++){ |
|
|
agebegin=agev[mw[mi][i]][i]; /* Age at beginning of effective wave */ |
|
ageend=agev[mw[mi][i]][i] + (dh[mi][i])*stepm/YEARM; /* Age at end of effective wave and at the end of transition */ |
|
for(d=0; d<dh[mi][i]; d++){ /* Delay between two effective waves */ |
|
/* for(d=0; d<=0; d++){ /\* Delay between two effective waves Only one matrix to speed up*\/ */ |
|
/*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.*/ |
newm=savm; |
newm=savm; |
agexact=agev[mw[mi][i]][i]+d*stepm/YEARM; |
agexact=agev[mw[mi][i]][i]+d*stepm/YEARM; /* Here d is needed */ |
cov[2]=agexact; |
cov[2]=agexact; |
if(nagesqr==1) |
if(nagesqr==1) |
cov[3]= agexact*agexact; |
cov[3]= agexact*agexact; |
for (kk=1; kk<=cptcovage;kk++) { |
for (kk=1; kk<=cptcovage;kk++) { |
cov[Tage[kk]+2+nagesqr]=covar[Tvar[Tage[kk]]][i]*agexact; |
if(!FixedV[Tvar[Tage[kk]]]) |
|
cov[Tage[kk]+2+nagesqr]=covar[Tvar[Tage[kk]]][i]*agexact; |
|
else |
|
cov[Tage[kk]+2+nagesqr]=cotvar[mw[mi][i]][Tvar[Tage[kk]]-ncovcol-nqv][i]*agexact; |
} |
} |
|
/* printf("i=%d,mi=%d,d=%d,mw[mi][i]=%d\n",i, mi,d,mw[mi][i]); */ |
/* savm=pmij(pmmij,cov,ncovmodel,x,nlstate); */ |
/* savm=pmij(pmmij,cov,ncovmodel,x,nlstate); */ |
out=matprod2(newm,oldm,1,nlstate+ndeath,1,nlstate+ndeath, |
out=matprod2(newm,oldm,1,nlstate+ndeath,1,nlstate+ndeath, |
1,nlstate+ndeath,pmij(pmmij,cov,ncovmodel,x,nlstate)); |
1,nlstate+ndeath,pmij(pmmij,cov,ncovmodel,x,nlstate)); |
Line 2633 double funcone( double *x)
|
Line 3782 double funcone( double *x)
|
|
|
s1=s[mw[mi][i]][i]; |
s1=s[mw[mi][i]][i]; |
s2=s[mw[mi+1][i]][i]; |
s2=s[mw[mi+1][i]][i]; |
|
/* if(s2==-1){ */ |
|
/* printf(" ERROR s1=%d, s2=%d i=%d \n", s1, s2, i); */ |
|
/* /\* exit(1); *\/ */ |
|
/* } */ |
bbh=(double)bh[mi][i]/(double)stepm; |
bbh=(double)bh[mi][i]/(double)stepm; |
/* bias is positive if real duration |
/* bias is positive if real duration |
* is higher than the multiple of stepm and negative otherwise. |
* is higher than the multiple of stepm and negative otherwise. |
*/ |
*/ |
if( s2 > nlstate && (mle <5) ){ /* Jackson */ |
if( s2 > nlstate && (mle <5) ){ /* Jackson */ |
lli=log(out[s1][s2] - savm[s1][s2]); |
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++) |
for (j=1,survp=0. ; j<=nlstate; j++) |
survp += (1.+bbh)*out[s1][j]- bbh*savm[s1][j]; |
survp += (1.+bbh)*out[s1][j]- bbh*savm[s1][j]; |
lli= log(survp); |
lli= log(survp); |
Line 2660 double funcone( double *x)
|
Line 3813 double funcone( double *x)
|
ll[s[mw[mi][i]][i]] += 2*weight[i]*lli; |
ll[s[mw[mi][i]][i]] += 2*weight[i]*lli; |
/*printf("i=%6d s1=%1d s2=%1d mi=%1d mw=%1d dh=%3d prob=%10.6f w=%6.4f out=%10.6f sav=%10.6f\n",i,s1,s2,mi,mw[mi][i],dh[mi][i],exp(lli),weight[i],out[s1][s2],savm[s1][s2]); */ |
/*printf("i=%6d s1=%1d s2=%1d mi=%1d mw=%1d dh=%3d prob=%10.6f w=%6.4f out=%10.6f sav=%10.6f\n",i,s1,s2,mi,mw[mi][i],dh[mi][i],exp(lli),weight[i],out[s1][s2],savm[s1][s2]); */ |
if(globpr){ |
if(globpr){ |
fprintf(ficresilk,"%9ld %6.1f %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 ", \ |
%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, |
num[i], agebegin, ageend, i,s1,s2,mi,mw[mi][i],dh[mi][i],exp(lli),weight[i],weight[i]*gipmx/gsw, |
2*weight[i]*lli,out[s1][s2],savm[s1][s2]); |
2*weight[i]*lli,(s2==-1? -1: out[s1][s2]),(s2==-1? -1: savm[s1][s2])); |
for(k=1,llt=0.,l=0.; k<=nlstate; k++){ |
for(k=1,llt=0.,l=0.; k<=nlstate; k++){ |
llt +=ll[k]*gipmx/gsw; |
llt +=ll[k]*gipmx/gsw; |
fprintf(ficresilk," %10.6f",-ll[k]*gipmx/gsw); |
fprintf(ficresilk," %10.6f",-ll[k]*gipmx/gsw); |
} |
} |
fprintf(ficresilk," %10.6f\n", -llt); |
fprintf(ficresilk," %10.6f\n", -llt); |
} |
} |
} /* end of wave */ |
} /* end of wave */ |
} /* end of individual */ |
} /* end of individual */ |
for(k=1,l=0.; k<=nlstate; k++) l += ll[k]; |
for(k=1,l=0.; k<=nlstate; k++) l += ll[k]; |
/* printf("l1=%f l2=%f ",ll[1],ll[2]); */ |
/* 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 */ |
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 */ |
if(globpr==0){ /* First time we count the contributions and weights */ |
gipmx=ipmx; |
gipmx=ipmx; |
gsw=sw; |
gsw=sw; |
} |
} |
return -l; |
return -l; |
} |
} |
|
|
|
|
Line 2700 void likelione(FILE *ficres,double p[],
|
Line 3853 void likelione(FILE *ficres,double p[],
|
printf("Problem with resultfile: %s\n", fileresilk); |
printf("Problem with resultfile: %s\n", fileresilk); |
fprintf(ficlog,"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, "#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 age i s1 s2 mi mw dh likeli weight %%weight 2wlli out sav "); |
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]); */ |
/* 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++) |
for(k=1; k<=nlstate; k++) |
fprintf(ficresilk," -2*gipw/gsw*weight*ll[%d]++",k); |
fprintf(ficresilk," -2*gipw/gsw*weight*ll[%d]++",k); |
Line 2716 void likelione(FILE *ficres,double p[],
|
Line 3869 void likelione(FILE *ficres,double p[],
|
else if(mle >=1) |
else if(mle >=1) |
fprintf(fichtm,"\n<br>File of contributions to the likelihood computed with optimized parameters mle = %d.",mle); |
fprintf(fichtm,"\n<br>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: <a href=\"%s\">%s</a><br>\n",subdirf(fileresilk),subdirf(fileresilk)); |
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: <a href=\"%s\">%s</a><br>\n",subdirf(fileresilk),subdirf(fileresilk)); |
|
fprintf(fichtm,"\n<br>Equation of the model: <b>model=1+age+%s</b><br>\n",model); |
|
|
for (k=1; k<= nlstate ; k++) { |
for (k=1; k<= nlstate ; k++) { |
fprintf(fichtm,"<br>- Probability p%dj by origin %d and destination j <a href=\"%s-p%dj.png\">%s-p%dj.png</a><br> \ |
fprintf(fichtm,"<br>- Probability p<sub>%dj</sub> by origin %d and destination j. Dot's sizes are related to corresponding weight: <a href=\"%s-p%dj.png\">%s-p%dj.png</a><br> \ |
<img src=\"%s-p%dj.png\">",k,k,subdirf2(optionfilefiname,"ILK_"),k,subdirf2(optionfilefiname,"ILK_"),k,subdirf2(optionfilefiname,"ILK_"),k); |
<img src=\"%s-p%dj.png\">",k,k,subdirf2(optionfilefiname,"ILK_"),k,subdirf2(optionfilefiname,"ILK_"),k,subdirf2(optionfilefiname,"ILK_"),k); |
} |
} |
fprintf(fichtm,"<br>- The function drawn is -2Log(L) in Log scale: by state of origin <a href=\"%s-ori.png\">%s-ori.png</a><br> \ |
fprintf(fichtm,"<br>- The function drawn is -2Log(L) in Log scale: by state of origin <a href=\"%s-ori.png\">%s-ori.png</a><br> \ |
Line 3018 double hessij( double x[], double **hess
|
Line 4171 double hessij( double x[], double **hess
|
kmax=kmax+10; |
kmax=kmax+10; |
} |
} |
if(kmax >=10 || firstime ==1){ |
if(kmax >=10 || firstime ==1){ |
printf("Warning: directions %d-%d, you are not estimating the Hessian at the exact maximum likelihood; increase ftol=%.2e\n",thetai,thetaj, ftol); |
printf("Warning: directions %d-%d, you are not estimating the Hessian at the exact maximum likelihood; you 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; 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); |
printf("%d %d k=%d, k1=%.12e k2=%.12e k3=%.12e k4=%.12e delti*k=%.12e deltj*k=%.12e, xi-de*k=%.12e xj-de*k=%.12e res=%.12e k1234=%.12e,k1-2=%.12e,k3-4=%.12e\n",thetai,thetaj,k,k1,k2,k3,k4,delti[thetai]/k,delti[thetaj]/k,x[thetai]-delti[thetai]/k,x[thetaj]-delti[thetaj]/k, res,k1-k2-k3+k4,k1-k2,k3-k4); |
fprintf(ficlog,"%d %d k=%d, k1=%.12e k2=%.12e k3=%.12e k4=%.12e delti*k=%.12e deltj*k=%.12e, xi-de*k=%.12e xj-de*k=%.12e res=%.12e k1234=%.12e,k1-2=%.12e,k3-4=%.12e\n",thetai,thetaj,k,k1,k2,k3,k4,delti[thetai]/k,delti[thetaj]/k,x[thetai]-delti[thetai]/k,x[thetaj]-delti[thetaj]/k, res,k1-k2-k3+k4,k1-k2,k3-k4); |
fprintf(ficlog,"%d %d k=%d, k1=%.12e k2=%.12e k3=%.12e k4=%.12e delti*k=%.12e deltj*k=%.12e, xi-de*k=%.12e xj-de*k=%.12e res=%.12e k1234=%.12e,k1-2=%.12e,k3-4=%.12e\n",thetai,thetaj,k,k1,k2,k3,k4,delti[thetai]/k,delti[thetaj]/k,x[thetai]-delti[thetai]/k,x[thetaj]-delti[thetaj]/k, res,k1-k2-k3+k4,k1-k2,k3-k4); |
} |
} |
Line 3108 void ludcmp(double **a, int n, int *indx
|
Line 4261 void ludcmp(double **a, int n, int *indx
|
big=0.0; |
big=0.0; |
for (j=1;j<=n;j++) |
for (j=1;j<=n;j++) |
if ((temp=fabs(a[i][j])) > big) big=temp; |
if ((temp=fabs(a[i][j])) > big) big=temp; |
if (big == 0.0) nrerror("Singular matrix in routine ludcmp"); |
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; |
vv[i]=1.0/big; |
} |
} |
for (j=1;j<=n;j++) { |
for (j=1;j<=n;j++) { |
Line 3174 void pstamp(FILE *fichier)
|
Line 4336 void pstamp(FILE *fichier)
|
fprintf(fichier,"# %s.%s\n#IMaCh version %s, %s\n#%s\n# %s", optionfilefiname,optionfilext,version,copyright, fullversion, strstart); |
fprintf(fichier,"# %s.%s\n#IMaCh version %s, %s\n#%s\n# %s", optionfilefiname,optionfilext,version,copyright, fullversion, strstart); |
} |
} |
|
|
|
|
|
|
/************ Frequencies ********************/ |
/************ Frequencies ********************/ |
void freqsummary(char fileres[], int iagemin, int iagemax, int **s, double **agev, int nlstate, int imx, int *Tvaraff, int **nbcode, int *ncodemax,double **mint,double **anint, char strstart[]) |
void freqsummary(char fileres[], double p[], double pstart[], int iagemin, int iagemax, int **s, double **agev, int nlstate, int imx, \ |
{ /* Some frequencies */ |
int *Tvaraff, int *invalidvarcomb, int **nbcode, int *ncodemax,double **mint,double **anint, char strstart[], \ |
|
int firstpass, int lastpass, int stepm, int weightopt, char model[]) |
int i, m, jk, j1, bool, z1,j; |
{ /* Some frequencies as well as proposing some starting values */ |
|
|
|
int i, m, jk, j1, bool, z1,j, nj, nl, k, iv, jj=0, s1=1, s2=1; |
|
int iind=0, iage=0; |
|
int mi; /* Effective wave */ |
int first; |
int first; |
double ***freq; /* Frequencies */ |
double ***freq; /* Frequencies */ |
double *pp, **prop; |
double *x, *y, a=0.,b=0.,r=1., sa=0., sb=0.; /* for regression, y=b+m*x and r is the correlation coefficient */ |
double pos,posprop, k2, dateintsum=0,k2cpt=0; |
int no=0, linreg(int ifi, int ila, int *no, const double x[], const double y[], double* a, double* b, double* r, double* sa, double * sb); |
char fileresp[FILENAMELENGTH]; |
double *meanq; |
|
double **meanqt; |
|
double *pp, **prop, *posprop, *pospropt; |
|
double pos=0., posproptt=0., pospropta=0., k2, dateintsum=0,k2cpt=0; |
|
char fileresp[FILENAMELENGTH], fileresphtm[FILENAMELENGTH], fileresphtmfr[FILENAMELENGTH]; |
|
double agebegin, ageend; |
|
|
pp=vector(1,nlstate); |
pp=vector(1,nlstate); |
prop=matrix(1,nlstate,iagemin,iagemax+3); |
prop=matrix(1,nlstate,iagemin-AGEMARGE,iagemax+4+AGEMARGE); |
|
posprop=vector(1,nlstate); /* Counting the number of transition starting from a live state per age */ |
|
pospropt=vector(1,nlstate); /* Counting the number of transition starting from a live state */ |
|
/* prop=matrix(1,nlstate,iagemin,iagemax+3); */ |
|
meanq=vector(1,nqfveff); /* Number of Quantitative Fixed Variables Effective */ |
|
meanqt=matrix(1,lastpass,1,nqtveff); |
strcpy(fileresp,"P_"); |
strcpy(fileresp,"P_"); |
strcat(fileresp,fileresu); |
strcat(fileresp,fileresu); |
|
/*strcat(fileresphtm,fileresu);*/ |
if((ficresp=fopen(fileresp,"w"))==NULL) { |
if((ficresp=fopen(fileresp,"w"))==NULL) { |
printf("Problem with prevalence resultfile: %s\n", fileresp); |
printf("Problem with prevalence resultfile: %s\n", fileresp); |
fprintf(ficlog,"Problem with prevalence resultfile: %s\n", fileresp); |
fprintf(ficlog,"Problem with prevalence resultfile: %s\n", fileresp); |
exit(0); |
exit(0); |
} |
} |
freq= ma3x(-5,nlstate+ndeath,-5,nlstate+ndeath,iagemin,iagemax+3); |
|
|
strcpy(fileresphtm,subdirfext(optionfilefiname,"PHTM_",".htm")); |
|
if((ficresphtm=fopen(fileresphtm,"w"))==NULL) { |
|
printf("Problem with prevalence HTM resultfile '%s' with errno='%s'\n",fileresphtm,strerror(errno)); |
|
fprintf(ficlog,"Problem with prevalence HTM resultfile '%s' with errno='%s'\n",fileresphtm,strerror(errno)); |
|
fflush(ficlog); |
|
exit(70); |
|
} |
|
else{ |
|
fprintf(ficresphtm,"<html><head>\n<title>IMaCh PHTM_ %s</title></head>\n <body><font size=\"2\">%s <br> %s</font> \ |
|
<hr size=\"2\" color=\"#EC5E5E\"> \n \ |
|
Title=%s <br>Datafile=%s Firstpass=%d Lastpass=%d Stepm=%d Weight=%d Model=1+age+%s<br>\n",\ |
|
fileresphtm,version,fullversion,title,datafile,firstpass,lastpass,stepm, weightopt, model); |
|
} |
|
fprintf(ficresphtm,"Current page is file <a href=\"%s\">%s</a><br>\n\n<h4>Frequencies and prevalence by age at begin of transition and dummy covariate value at beginning of transition</h4>\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,"<html><head>\n<title>IMaCh PHTM_Frequency table %s</title></head>\n <body><font size=\"2\">%s <br> %s</font> \ |
|
<hr size=\"2\" color=\"#EC5E5E\"> \n \ |
|
Title=%s <br>Datafile=%s Firstpass=%d Lastpass=%d Stepm=%d Weight=%d Model=1+age+%s<br>\n",\ |
|
fileresphtmfr,version,fullversion,title,datafile,firstpass,lastpass,stepm, weightopt, model); |
|
} |
|
fprintf(ficresphtmfr,"Current page is file <a href=\"%s\">%s</a><br>\n\n<h4>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) </h4>Unknown status is -1<br/>\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; |
j1=0; |
|
|
j=cptcoveff; |
/* j=ncoveff; /\* Only fixed dummy covariates *\/ */ |
|
j=cptcoveff; /* Only dummy covariates of the model */ |
if (cptcovn<1) {j=1;ncodemax[1]=1;} |
if (cptcovn<1) {j=1;ncodemax[1]=1;} |
|
|
|
|
|
/* 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 */ |
/* if a constant only model, one pass to compute frequency tables and to write it on ficresp */ |
/* for(i1=1; i1<=ncodemax[k1];i1++){ */ /* Now it is 2 */ |
/* Loop on nj=1 or 2 if dummy covariates j!=0 |
/* j1++; */ |
* Loop on j1(1 to 2**cptcoveff) covariate combination |
for (j1 = 1; j1 <= (int) pow(2,cptcoveff); j1++){ |
* 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]); |
/*printf("cptcoveff=%d Tvaraff=%d", cptcoveff,Tvaraff[1]); |
scanf("%d", i);*/ |
scanf("%d", i);*/ |
for (i=-5; i<=nlstate+ndeath; 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++) |
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++) |
for(m=iagemin; m <= iagemax+3; m++) |
prop[i][m]=0; |
prop[i][m]=0; |
|
posprop[i]=0; |
|
pospropt[i]=0; |
|
} |
|
/* for (z1=1; z1<= nqfveff; z1++) { */ |
|
/* meanq[z1]+=0.; */ |
|
/* for(m=1;m<=lastpass;m++){ */ |
|
/* meanqt[m][z1]=0.; */ |
|
/* } */ |
|
/* } */ |
|
|
dateintsum=0; |
/* dateintsum=0; */ |
k2cpt=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; |
bool=1; |
if (cptcovn>0) { /* Filter is here: Must be looked at for model=V1+V2+V3+V4 */ |
if(j !=0){ |
for (z1=1; z1<=cptcoveff; z1++) |
if(anyvaryingduminmodel==0){ /* If All fixed covariates */ |
if (covar[Tvaraff[z1]][i]!= nbcode[Tvaraff[z1]][codtabm(j1,z1)]){ |
if (cptcoveff >0) { /* Filter is here: Must be looked at for model=V1+V2+V3+V4 */ |
/* Tests if the value of each of the covariates of i is equal to filter j1 */ |
/* for (z1=1; z1<= nqfveff; z1++) { */ |
bool=0; |
/* meanq[z1]+=coqvar[Tvar[z1]][iind]; /\* Computes mean of quantitative with selected filter *\/ */ |
/* 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), |
for (z1=1; z1<=cptcoveff; z1++) { /* loops on covariates in the model */ |
j1,z1,nbcode[Tvaraff[z1]][codtabm(j1,z1)],j1);*/ |
/* if(Tvaraff[z1] ==-20){ */ |
/* For j1=7 in V1+V2+V3+V4 = 0 1 1 0 and codtabm(7,3)=1 and nbcde[3][?]=1*/ |
/* /\* sumnew+=cotvar[mw[mi][iind]][z1][iind]; *\/ */ |
} |
/* }else if(Tvaraff[z1] ==-10){ */ |
} |
/* /\* sumnew+=coqvar[z1][iind]; *\/ */ |
|
/* }else */ |
if (bool==1){ |
if (covar[Tvaraff[z1]][iind]!= nbcode[Tvaraff[z1]][codtabm(j1,z1)]){ /* for combination j1 of covariates */ |
for(m=firstpass; m<=lastpass; m++){ |
/* Tests if the value of the covariate z1 for this individual iind responded to combination j1 (V4=1 V3=0) */ |
k2=anint[m][i]+(mint[m][i]/12.); |
bool=0; /* bool should be equal to 1 to be selected, one covariate value failed */ |
/*if ((k2>=dateprev1) && (k2<=dateprev2)) {*/ |
/* 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", |
if(agev[m][i]==0) agev[m][i]=iagemax+1; |
bool,i,z1, z1, Tvaraff[z1],i,covar[Tvaraff[z1]][i],j1,z1,codtabm(j1,z1), |
if(agev[m][i]==1) agev[m][i]=iagemax+2; |
j1,z1,nbcode[Tvaraff[z1]][codtabm(j1,z1)],j1);*/ |
if (s[m][i]>0 && s[m][i]<=nlstate) prop[s[m][i]][(int)agev[m][i]] += weight[i]; |
/* For j1=7 in V1+V2+V3+V4 = 0 1 1 0 and codtabm(7,3)=1 and nbcde[3][?]=1*/ |
if (m<lastpass) { |
} /* Onlyf fixed */ |
freq[s[m][i]][s[m+1][i]][(int)agev[m][i]] += weight[i]; |
} /* end z1 */ |
freq[s[m][i]][s[m+1][i]][iagemax+3] += weight[i]; |
} /* cptcovn > 0 */ |
} |
} /* end any */ |
|
}/* end j==0 */ |
if ((agev[m][i]>1) && (agev[m][i]< (iagemax+3))) { |
if (bool==1){ /* We selected an individual iind satisfying combination j1 (V4=1 V3=0) or all fixed covariates */ |
dateintsum=dateintsum+k2; |
/* for(m=firstpass; m<=lastpass; m++){ */ |
|
for(mi=1; mi<wav[iind];mi++){ /* For that wave */ |
|
m=mw[mi][iind]; |
|
if(j!=0){ |
|
if(anyvaryingduminmodel==1){ /* Some are varying covariates */ |
|
for (z1=1; z1<=cptcoveff; z1++) { |
|
if( Fixed[Tmodelind[z1]]==1){ |
|
iv= Tvar[Tmodelind[z1]]-ncovcol-nqv; |
|
if (cotvar[m][iv][iind]!= nbcode[Tvaraff[z1]][codtabm(j1,z1)]) /* iv=1 to ntv, right modality. If covariate's |
|
value is -1, we don't select. It differs from the |
|
constant and age model which counts them. */ |
|
bool=0; /* not selected */ |
|
}else if( Fixed[Tmodelind[z1]]== 0) { /* fixed */ |
|
if (covar[Tvaraff[z1]][iind]!= nbcode[Tvaraff[z1]][codtabm(j1,z1)]) { |
|
bool=0; |
|
} |
|
} |
|
} |
|
}/* Some are varying covariates, we tried to speed up if all fixed covariates in the model, avoiding waves loop */ |
|
} /* end j==0 */ |
|
/* bool =0 we keep that guy which corresponds to the combination of dummy values */ |
|
if(bool==1){ |
|
/* dh[m][iind] or dh[mw[mi][iind]][iind] is the delay between two effective (mi) waves m=mw[mi][iind] |
|
and mw[mi+1][iind]. dh depends on stepm. */ |
|
agebegin=agev[m][iind]; /* Age at beginning of wave before transition*/ |
|
ageend=agev[m][iind]+(dh[m][iind])*stepm/YEARM; /* Age at end of wave and transition */ |
|
if(m >=firstpass && m <=lastpass){ |
|
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 (m<lastpass) { |
|
/* if(s[m][iind]==4 && s[m+1][iind]==4) */ |
|
/* printf(" num=%ld m=%d, iind=%d s1=%d s2=%d agev at m=%d\n", num[iind], m, iind,s[m][iind],s[m+1][iind], (int)agev[m][iind]); */ |
|
if(s[m][iind]==-1) |
|
printf(" num=%ld m=%d, iind=%d s1=%d s2=%d agev at m=%d agebegin=%.2f ageend=%.2f, agemed=%d\n", num[iind], m, iind,s[m][iind],s[m+1][iind], (int)agev[m][iind],agebegin, ageend, (int)((agebegin+ageend)/2.)); |
|
freq[s[m][iind]][s[m+1][iind]][(int)agev[m][iind]] += weight[iind]; /* At age of beginning of transition, where status is known */ |
|
/* if((int)agev[m][iind] == 55) */ |
|
/* printf("j=%d, j1=%d Age %d, iind=%d, num=%09ld m=%d\n",j,j1,(int)agev[m][iind],iind, num[iind],m); */ |
|
/* freq[s[m][iind]][s[m+1][iind]][(int)((agebegin+ageend)/2.)] += weight[iind]; */ |
|
freq[s[m][iind]][s[m+1][iind]][iagemax+3] += weight[iind]; /* Total is in iagemax+3 *//* At age of beginning of transition, where status is known */ |
|
} |
|
} /* end if between passes */ |
|
if ((agev[m][iind]>1) && (agev[m][iind]< (iagemax+3)) && (anint[m][iind]!=9999) && (mint[m][iind]!=99) && (j==0)) { |
|
dateintsum=dateintsum+k2; /* on all covariates ?*/ |
k2cpt++; |
k2cpt++; |
|
/* printf("iind=%ld dateintmean = %lf dateintsum=%lf k2cpt=%lf k2=%lf\n",iind, dateintsum/k2cpt, dateintsum,k2cpt, k2); */ |
} |
} |
/*}*/ |
}else{ |
} |
bool=1; |
} |
}/* end bool 2 */ |
} /* end i */ |
} /* end m */ |
|
} /* 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);*/ |
/* fprintf(ficresp, "#Count between %.lf/%.lf/%.lf and %.lf/%.lf/%.lf\n",jprev1, mprev1,anprev1,jprev2, mprev2,anprev2);*/ |
pstamp(ficresp); |
if(cptcoveff==0 && nj==1) /* no covariate and first pass */ |
if (cptcovn>0) { |
pstamp(ficresp); |
|
if (cptcoveff>0 && j!=0){ |
|
pstamp(ficresp); |
|
printf( "\n#********** Variable "); |
fprintf(ficresp, "\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(ficresphtm, "\n<br/><br/><h3>********** Variable "); |
fprintf(ficresp, "**********\n#"); |
fprintf(ficresphtmfr, "\n<br/><br/><h3>********** Variable "); |
fprintf(ficlog, "\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)]); |
for (z1=1; z1<=cptcoveff; z1++){ |
fprintf(ficlog, "**********\n#"); |
if(!FixedV[Tvaraff[z1]]){ |
} |
printf( "V%d(fixed)=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); |
for(i=1; i<=nlstate;i++) |
fprintf(ficresp, "V%d(fixed)=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); |
fprintf(ficresp, " Age Prev(%d) N(%d) N",i,i); |
fprintf(ficresphtm, "V%d(fixed)=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); |
fprintf(ficresp, "\n"); |
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)]); |
for(i=iagemin; i <= iagemax+3; i++){ |
}else{ |
if(i==iagemax+3){ |
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, "**********</h3>\n"); |
|
fprintf(ficresphtmfr, "**********</h3>\n"); |
|
fprintf(ficlog, "**********\n"); |
|
} |
|
fprintf(ficresphtm,"<table style=\"text-align:center; border: 1px solid\">"); |
|
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, "<th>Age</th><th>Prev(%d)</th><th>N(%d)</th><th>N</th>",i,i); |
|
} |
|
if((cptcoveff==0 && nj==1)|| nj==2 ) fprintf(ficresp, "\n"); |
|
fprintf(ficresphtm, "\n"); |
|
|
|
/* Header of frequency table by age */ |
|
fprintf(ficresphtmfr,"<table style=\"text-align:center; border: 1px solid\">"); |
|
fprintf(ficresphtmfr,"<th>Age</th> "); |
|
for(s2=-1; s2 <=nlstate+ndeath; s2++){ |
|
for(m=-1; m <=nlstate+ndeath; m++){ |
|
if(s2!=0 && m!=0) |
|
fprintf(ficresphtmfr,"<th>%d%d</th> ",s2,m); |
|
} |
|
} |
|
fprintf(ficresphtmfr, "\n"); |
|
|
|
/* For each age */ |
|
for(iage=iagemin; iage <= iagemax+3; iage++){ |
|
fprintf(ficresphtm,"<tr>"); |
|
if(iage==iagemax+1){ |
|
fprintf(ficlog,"1"); |
|
fprintf(ficresphtmfr,"<tr><th>0</th> "); |
|
}else if(iage==iagemax+2){ |
|
fprintf(ficlog,"0"); |
|
fprintf(ficresphtmfr,"<tr><th>Unknown</th> "); |
|
}else if(iage==iagemax+3){ |
fprintf(ficlog,"Total"); |
fprintf(ficlog,"Total"); |
|
fprintf(ficresphtmfr,"<tr><th>Total</th> "); |
}else{ |
}else{ |
if(first==1){ |
if(first==1){ |
first=0; |
first=0; |
printf("See log file for details...\n"); |
printf("See log file for details...\n"); |
} |
} |
fprintf(ficlog,"Age %d", i); |
fprintf(ficresphtmfr,"<tr><th>%d</th> ",iage); |
|
fprintf(ficlog,"Age %d", iage); |
} |
} |
for(jk=1; jk <=nlstate ; jk++){ |
for(s1=1; s1 <=nlstate ; s1++){ |
for(m=-1, pp[jk]=0; m <=nlstate+ndeath ; m++) |
for(m=-1, pp[s1]=0; m <=nlstate+ndeath ; m++) |
pp[jk] += freq[jk][m][i]; |
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++) |
for(m=-1, pos=0; m <=0 ; m++) |
pos += freq[jk][m][i]; |
pos += freq[s1][m][iage]; |
if(pp[jk]>=1.e-10){ |
if(pp[s1]>=1.e-10){ |
if(first==1){ |
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{ |
}else{ |
if(first==1) |
if(first==1) |
printf(" %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%%",jk,pp[jk],jk); |
fprintf(ficlog," %d.=%.0f loss[%d]=NaNQ%%",s1,pp[s1],s1); |
} |
} |
} |
} |
|
|
for(jk=1; jk <=nlstate ; jk++){ |
for(s1=1; s1 <=nlstate ; s1++){ |
for(m=0, pp[jk]=0; m <=nlstate+ndeath; m++) |
/* posprop[s1]=0; */ |
pp[jk] += freq[jk][m][i]; |
for(m=0, pp[s1]=0; m <=nlstate+ndeath; m++)/* Summing on all ages */ |
} |
pp[s1] += freq[s1][m][iage]; |
for(jk=1,pos=0,posprop=0; jk <=nlstate ; jk++){ |
} /* pp[s1] is the total number of transitions starting from state s1 and any ending status until this age */ |
pos += pp[jk]; |
|
posprop += prop[jk][i]; |
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] */ |
|
} |
|
|
|
/* 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(jk=1; jk <=nlstate ; jk++){ |
for(s1=1; s1 <=nlstate ; s1++){ |
if(pos>=1.e-5){ |
if(pos>=1.e-5){ |
if(first==1) |
if(first==1) |
printf(" %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%%",jk,pp[jk],jk,100*pp[jk]/pos); |
fprintf(ficlog," %d.=%.0f prev[%d]=%.1f%%",s1,pp[s1],s1,100*pp[s1]/pos); |
}else{ |
}else{ |
if(first==1) |
if(first==1) |
printf(" %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%%",jk,pp[jk],jk); |
fprintf(ficlog," %d.=%.0f prev[%d]=NaNQ%%",s1,pp[s1],s1); |
} |
} |
if( i <= iagemax){ |
if( iage <= iagemax){ |
if(pos>=1.e-5){ |
if(pos>=1.e-5){ |
fprintf(ficresp," %d %.5f %.0f %.0f",i,prop[jk][i]/posprop, prop[jk][i],posprop); |
if(cptcoveff==0 && nj==1){ /* no covariate and first pass */ |
/*probs[i][jk][j1]= pp[jk]/pos;*/ |
fprintf(ficresp," %.5f %.0f %.0f",prop[s1][iage]/pospropta, prop[s1][iage],pospropta); |
/*printf("\ni=%d jk=%d j1=%d %.5f %.0f %.0f %f",i,jk,j1,pp[jk]/pos, pp[jk],pos,probs[i][jk][j1]);*/ |
}else if( nj==2){ |
|
fprintf(ficresp," %.5f %.0f %.0f",prop[s1][iage]/pospropta, prop[s1][iage],pospropta); |
|
} |
|
fprintf(ficresphtm,"<th>%d</th><td>%.5f</td><td>%.0f</td><td>%.0f</td>",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,"<th>%d</th><td>NaNq</td><td>%.0f</td><td>%.0f</td>",iage, prop[s1][iage],pospropta); |
} |
} |
else |
|
fprintf(ficresp," %d NaNq %.0f %.0f",i,prop[jk][i],posprop); |
|
} |
} |
} |
pospropt[s1] +=posprop[s1]; |
|
} /* end loop s1 */ |
for(jk=-1; jk <=nlstate+ndeath; jk++) |
/* pospropt=0.; */ |
for(m=-1; m <=nlstate+ndeath; m++) |
for(s1=-1; s1 <=nlstate+ndeath; s1++){ |
if(freq[jk][m][i] !=0 ) { |
for(m=-1; m <=nlstate+ndeath; m++){ |
if(first==1) |
if(freq[s1][m][iage] !=0 ) { /* minimizing output */ |
printf(" %d%d=%.0f",jk,m,freq[jk][m][i]); |
if(first==1){ |
fprintf(ficlog," %d%d=%.0f",jk,m,freq[jk][m][i]); |
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) |
if(s1!=0 && m!=0) |
fprintf(ficresp,"\n"); |
fprintf(ficresphtmfr,"<td>%.0f</td> ",freq[s1][m][iage]); |
|
} |
|
} /* end loop s1 */ |
|
posproptt=0.; |
|
for(s1=1; s1 <=nlstate; s1++){ |
|
posproptt += pospropt[s1]; |
|
} |
|
fprintf(ficresphtmfr,"</tr>\n "); |
|
fprintf(ficresphtm,"</tr>\n"); |
|
if((cptcoveff==0 && nj==1)|| nj==2 ) { |
|
if(iage <= iagemax) |
|
fprintf(ficresp,"\n"); |
|
} |
if(first==1) |
if(first==1) |
printf("Others in log...\n"); |
printf("Others in log...\n"); |
fprintf(ficlog,"\n"); |
fprintf(ficlog,"\n"); |
|
} /* end loop age iage */ |
|
|
|
fprintf(ficresphtm,"<tr><th>Tot</th>"); |
|
for(s1=1; s1 <=nlstate ; s1++){ |
|
if(posproptt < 1.e-5){ |
|
fprintf(ficresphtm,"<td>Nanq</td><td>%.0f</td><td>%.0f</td>",pospropt[s1],posproptt); |
|
}else{ |
|
fprintf(ficresphtm,"<td>%.5f</td><td>%.0f</td><td>%.0f</td>",pospropt[s1]/posproptt,pospropt[s1],posproptt); |
|
} |
} |
} |
/*}*/ |
fprintf(ficresphtm,"</tr>\n"); |
} |
fprintf(ficresphtm,"</table>\n"); |
|
fprintf(ficresphtmfr,"</table>\n"); |
|
if(posproptt < 1.e-5){ |
|
fprintf(ficresphtm,"\n <p><b> This combination (%d) is not valid and no result will be produced</b></p>",j1); |
|
fprintf(ficresphtmfr,"\n <p><b> This combination (%d) is not valid and no result will be produced</b></p>",j1); |
|
fprintf(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 <p> This combination (%d) is valid and result will be produced.</p>",j1); |
|
invalidvarcomb[j1]=0; |
|
} |
|
fprintf(ficresphtmfr,"</table>\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"); |
|
} |
|
} |
|
} |
|
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; |
dateintmean=dateintsum/k2cpt; |
|
|
fclose(ficresp); |
fclose(ficresp); |
free_ma3x(freq,-5,nlstate+ndeath,-5,nlstate+ndeath, iagemin, iagemax+3); |
fclose(ficresphtm); |
|
fclose(ficresphtmfr); |
|
free_vector(meanq,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_vector(pp,1,nlstate); |
free_matrix(prop,1,nlstate,iagemin, iagemax+3); |
/* End of freqsummary */ |
/* End of Freq */ |
} |
|
|
|
/* 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 ********************/ |
/************ Prevalence ********************/ |
Line 3358 void prevalence(double ***probs, double
|
Line 4967 void prevalence(double ***probs, double
|
We still use firstpass and lastpass as another selection. |
We still use firstpass and lastpass as another selection. |
*/ |
*/ |
|
|
int i, m, jk, j1, bool, z1,j; |
int i, m, jk, j1, bool, z1,j, iv; |
|
int mi; /* Effective wave */ |
|
int iage; |
|
double agebegin, ageend; |
|
|
double **prop; |
double **prop; |
double posprop; |
double posprop; |
Line 3369 void prevalence(double ***probs, double
|
Line 4981 void prevalence(double ***probs, double
|
iagemin= (int) agemin; |
iagemin= (int) agemin; |
iagemax= (int) agemax; |
iagemax= (int) agemax; |
/*pp=vector(1,nlstate);*/ |
/*pp=vector(1,nlstate);*/ |
prop=matrix(1,nlstate,iagemin,iagemax+3); |
prop=matrix(1,nlstate,iagemin-AGEMARGE,iagemax+4+AGEMARGE); |
/* freq=ma3x(-1,nlstate+ndeath,-1,nlstate+ndeath,iagemin,iagemax+3);*/ |
/* freq=ma3x(-1,nlstate+ndeath,-1,nlstate+ndeath,iagemin,iagemax+3);*/ |
j1=0; |
j1=0; |
|
|
Line 3377 void prevalence(double ***probs, double
|
Line 4989 void prevalence(double ***probs, double
|
if (cptcovn<1) {j=1;ncodemax[1]=1;} |
if (cptcovn<1) {j=1;ncodemax[1]=1;} |
|
|
first=1; |
first=1; |
for(j1=1; j1<= (int) pow(2,cptcoveff);j1++){ |
for(j1=1; j1<= (int) pow(2,cptcoveff);j1++){ /* For each combination of covariate */ |
/*for(i1=1; i1<=ncodemax[k1];i1++){ |
for (i=1; i<=nlstate; i++) |
j1++;*/ |
for(iage=iagemin-AGEMARGE; iage <= iagemax+4+AGEMARGE; iage++) |
|
prop[i][iage]=0.0; |
for (i=1; i<=nlstate; i++) |
printf("Prevalence combination of varying and fixed dummies %d\n",j1); |
for(m=iagemin; m <= iagemax+3; m++) |
/* fprintf(ficlog," V%d=%d ",Tvaraff[j1],nbcode[Tvaraff[j1]][codtabm(k,j1)]); */ |
prop[i][m]=0.0; |
fprintf(ficlog,"Prevalence combination of varying and fixed dummies %d\n",j1); |
|
|
for (i=1; i<=imx; i++) { /* Each individual */ |
for (i=1; i<=imx; i++) { /* Each individual */ |
bool=1; |
bool=1; |
if (cptcovn>0) { |
/* for(m=firstpass; m<=lastpass; m++){/\* Other selection (we can limit to certain interviews*\/ */ |
for (z1=1; z1<=cptcoveff; z1++) |
for(mi=1; mi<wav[i];mi++){ /* For this wave too look where individual can be counted V4=0 V3=0 */ |
if (covar[Tvaraff[z1]][i]!= nbcode[Tvaraff[z1]][codtabm(j1,z1)]) |
m=mw[mi][i]; |
|
/* Tmodelind[z1]=k is the position of the varying covariate in the model, but which # within 1 to ntv? */ |
|
/* Tvar[Tmodelind[z1]] is the n of Vn; n-ncovcol-nqv is the first time varying covariate or iv */ |
|
for (z1=1; z1<=cptcoveff; z1++){ |
|
if( Fixed[Tmodelind[z1]]==1){ |
|
iv= Tvar[Tmodelind[z1]]-ncovcol-nqv; |
|
if (cotvar[m][iv][i]!= nbcode[Tvaraff[z1]][codtabm(j1,z1)]) /* iv=1 to ntv, right modality */ |
bool=0; |
bool=0; |
} |
}else if( Fixed[Tmodelind[z1]]== 0) /* fixed */ |
if (bool==1) { |
if (covar[Tvaraff[z1]][i]!= nbcode[Tvaraff[z1]][codtabm(j1,z1)]) { |
for(m=firstpass; m<=lastpass; m++){/* Other selection (we can limit to certain interviews*/ |
bool=0; |
|
} |
|
} |
|
if(bool==1){ /* Otherwise we skip that wave/person */ |
|
agebegin=agev[m][i]; /* Age at beginning of wave before transition*/ |
|
/* ageend=agev[m][i]+(dh[m][i])*stepm/YEARM; /\* Age at end of wave and transition *\/ */ |
|
if(m >=firstpass && m <=lastpass){ |
y2=anint[m][i]+(mint[m][i]/12.); /* Fractional date in year */ |
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 ((y2>=dateprev1) && (y2<=dateprev2)) { /* Here is the main selection (fractional years) */ |
if(agev[m][i]==0) agev[m][i]=iagemax+1; |
if(agev[m][i]==0) agev[m][i]=iagemax+1; |
if(agev[m][i]==1) agev[m][i]=iagemax+2; |
if(agev[m][i]==1) agev[m][i]=iagemax+2; |
if((int)agev[m][i] <iagemin || (int)agev[m][i] >iagemax+3) printf("Error on individual =%d agev[m][i]=%f m=%d\n",i, agev[m][i],m); |
if((int)agev[m][i] <iagemin-AGEMARGE || (int)agev[m][i] >iagemax+4+AGEMARGE){ |
if (s[m][i]>0 && s[m][i]<=nlstate) { |
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]]);*/ |
/*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]][(int)agev[m][i]] += weight[i];/* At age of beginning of transition, where status is known */ |
prop[s[m][i]][iagemax+3] += weight[i]; |
prop[s[m][i]][iagemax+3] += weight[i]; |
} |
} /* end valid statuses */ |
} |
} /* end selection of dates */ |
} /* end selection of waves */ |
} /* end selection of waves */ |
} |
} /* end bool */ |
} |
} /* end wave */ |
for(i=iagemin; i <= iagemax+3; i++){ |
} /* end individual */ |
for(jk=1,posprop=0; jk <=nlstate ; jk++) { |
for(i=iagemin; i <= iagemax+3; i++){ |
posprop += prop[jk][i]; |
for(jk=1,posprop=0; jk <=nlstate ; jk++) { |
} |
posprop += prop[jk][i]; |
|
} |
for(jk=1; jk <=nlstate ; jk++){ |
|
if( i <= iagemax){ |
for(jk=1; jk <=nlstate ; jk++){ |
if(posprop>=1.e-5){ |
if( i <= iagemax){ |
probs[i][jk][j1]= prop[jk][i]/posprop; |
if(posprop>=1.e-5){ |
} else{ |
probs[i][jk][j1]= prop[jk][i]/posprop; |
if(first==1){ |
} else{ |
first=0; |
if(first==1){ |
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]); |
first=0; |
} |
printf("Warning Observed prevalence doesn't sum to 1 for state %d: probs[%d][%d][%d]=%lf because of lack of cases\nSee others in log file...\n",jk,i,jk, j1,probs[i][jk][j1]); |
|
fprintf(ficlog,"Warning Observed prevalence doesn't sum to 1 for state %d: probs[%d][%d][%d]=%lf because of lack of cases\nSee others in log file...\n",jk,i,jk, j1,probs[i][jk][j1]); |
|
}else{ |
|
fprintf(ficlog,"Warning Observed prevalence doesn't sum to 1 for state %d: probs[%d][%d][%d]=%lf because of lack of cases\nSee others in log file...\n",jk,i,jk, j1,probs[i][jk][j1]); |
} |
} |
} |
} |
}/* end jk */ |
} |
}/* end i */ |
}/* end jk */ |
/*} *//* end i1 */ |
}/* end i */ |
|
/*} *//* end i1 */ |
} /* end j1 */ |
} /* end j1 */ |
|
|
/* free_ma3x(freq,-1,nlstate+ndeath,-1,nlstate+ndeath, iagemin, iagemax+3);*/ |
/* free_ma3x(freq,-1,nlstate+ndeath,-1,nlstate+ndeath, iagemin, iagemax+3);*/ |
/*free_vector(pp,1,nlstate);*/ |
/*free_vector(pp,1,nlstate);*/ |
free_matrix(prop,1,nlstate, iagemin,iagemax+3); |
free_matrix(prop,1,nlstate, iagemin-AGEMARGE,iagemax+4+AGEMARGE); |
} /* End of prevalence */ |
} /* End of prevalence */ |
|
|
/************* Waves Concatenation ***************/ |
/************* Waves Concatenation ***************/ |
Line 3443 void concatwav(int wav[], int **dh, int
|
Line 5074 void concatwav(int wav[], int **dh, int
|
mw[mi][i] is the mi (mi=1 to wav[i]) effective wave of individual i |
mw[mi][i] is the mi (mi=1 to wav[i]) effective wave of individual i |
dh[m][i] or dh[mw[mi][i]][i] is the delay between two effective waves m=mw[mi][i] |
dh[m][i] or dh[mw[mi][i]][i] is the delay between two effective waves m=mw[mi][i] |
and mw[mi+1][i]. dh depends on stepm. |
and mw[mi+1][i]. dh depends on stepm. |
*/ |
*/ |
|
|
int i, mi, m; |
int i=0, mi=0, m=0, mli=0; |
/* int j, k=0,jk, ju, jl,jmin=1e+5, jmax=-1; |
/* int j, k=0,jk, ju, jl,jmin=1e+5, jmax=-1; |
double sum=0., jmean=0.;*/ |
double sum=0., jmean=0.;*/ |
int first; |
int first=0, firstwo=0, firsthree=0, firstfour=0, firstfiv=0; |
int j, k=0,jk, ju, jl; |
int j, k=0,jk, ju, jl; |
double sum=0.; |
double sum=0.; |
first=0; |
first=0; |
|
firstwo=0; |
|
firsthree=0; |
|
firstfour=0; |
jmin=100000; |
jmin=100000; |
jmax=-1; |
jmax=-1; |
jmean=0.; |
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; |
m=firstpass; |
while(s[m][i] <= nlstate){ |
while(s[m][i] <= nlstate){ /* a live state */ |
if(s[m][i]>=1 || s[m][i]==-2 || s[m][i]==-4 || s[m][i]==-5) |
if(m >firstpass && s[m][i]==s[m-1][i] && mint[m][i]==mint[m-1][i] && anint[m][i]==anint[m-1][i]){/* Two succesive identical information on wave m */ |
|
mli=m-1;/* mw[++mi][i]=m-1; */ |
|
}else if(s[m][i]>=1 || s[m][i]==-4 || s[m][i]==-5){ /* Since 0.98r4 if status=-2 vital status is really unknown, wave should be skipped */ |
mw[++mi][i]=m; |
mw[++mi][i]=m; |
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; |
break; |
else |
#else |
m++; |
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 */ |
}/* 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 */ |
mi++; /* Death is another wave */ |
/* if(mi==0) never been interviewed correctly before death */ |
/* if(mi==0) never been interviewed correctly before death */ |
/* Only death is a correct wave */ |
/* Only death is a correct wave */ |
mw[mi][i]=m; |
mw[mi][i]=m; |
} |
} /* else not in a death state */ |
|
#ifndef DISPATCHINGKNOWNDEATHAFTERLASTWAVE |
wav[i]=mi; |
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){ |
if(mi==0){ |
nbwarn++; |
nbwarn++; |
if(first==0){ |
if(first==0){ |
Line 3485 void concatwav(int wav[], int **dh, int
|
Line 5184 void concatwav(int wav[], int **dh, int
|
} |
} |
} /* end mi==0 */ |
} /* end mi==0 */ |
} /* End individuals */ |
} /* End individuals */ |
|
/* wav and mw are no more changed */ |
|
|
|
|
for(i=1; i<=imx; i++){ |
for(i=1; i<=imx; i++){ |
for(mi=1; mi<wav[i];mi++){ |
for(mi=1; mi<wav[i];mi++){ |
if (stepm <=0) |
if (stepm <=0) |
dh[mi][i]=1; |
dh[mi][i]=1; |
else{ |
else{ |
if (s[mw[mi+1][i]][i] > nlstate) { /* A death */ |
if (s[mw[mi+1][i]][i] > nlstate) { /* A death, but what if date is unknown? */ |
if (agedc[i] < 2*AGESUP) { |
if (agedc[i] < 2*AGESUP) { |
j= rint(agedc[i]*12-agev[mw[mi][i]][i]*12); |
j= rint(agedc[i]*12-agev[mw[mi][i]][i]*12); |
if(j==0) j=1; /* Survives at least one month after exam */ |
if(j==0) j=1; /* Survives at least one month after exam */ |
Line 3520 void concatwav(int wav[], int **dh, int
|
Line 5221 void concatwav(int wav[], int **dh, int
|
else{ |
else{ |
j= rint( (agev[mw[mi+1][i]][i]*12 - agev[mw[mi][i]][i]*12)); |
j= rint( (agev[mw[mi+1][i]][i]*12 - agev[mw[mi][i]][i]*12)); |
/* if (j<0) printf("%d %lf %lf %d %d %d\n", i,agev[mw[mi+1][i]][i], agev[mw[mi][i]][i],j,s[mw[mi][i]][i] ,s[mw[mi+1][i]][i]); */ |
/* if (j<0) printf("%d %lf %lf %d %d %d\n", i,agev[mw[mi+1][i]][i], agev[mw[mi][i]][i],j,s[mw[mi][i]][i] ,s[mw[mi+1][i]][i]); */ |
|
|
k=k+1; |
k=k+1; |
if (j >= jmax) { |
if (j >= jmax) { |
jmax=j; |
jmax=j; |
Line 3574 void concatwav(int wav[], int **dh, int
|
Line 5275 void concatwav(int wav[], int **dh, int
|
jmean=sum/k; |
jmean=sum/k; |
printf("Delay (in months) between two waves Min=%d (for indiviudal %ld) Max=%d (%ld) Mean=%f\n\n ",jmin, num[ijmin], jmax, num[ijmax], jmean); |
printf("Delay (in months) between two waves Min=%d (for indiviudal %ld) Max=%d (%ld) Mean=%f\n\n ",jmin, num[ijmin], jmax, num[ijmax], jmean); |
fprintf(ficlog,"Delay (in months) between two waves Min=%d (for indiviudal %d) Max=%d (%d) Mean=%f\n\n ",jmin, ijmin, jmax, ijmax, jmean); |
fprintf(ficlog,"Delay (in months) between two waves Min=%d (for indiviudal %d) Max=%d (%d) Mean=%f\n\n ",jmin, ijmin, jmax, ijmax, jmean); |
} |
} |
|
|
/*********** Tricode ****************************/ |
/*********** Tricode ****************************/ |
void tricode(int *Tvar, int **nbcode, int imx, int *Ndum) |
void tricode(int *cptcov, int *Tvar, int **nbcode, int imx, int *Ndum) |
{ |
{ |
/**< Uses cptcovn+2*cptcovprod as the number of covariates */ |
/**< Uses cptcovn+2*cptcovprod as the number of covariates */ |
/* Tvar[i]=atoi(stre); find 'n' in Vn and stores in Tvar. If model=V2+V1 Tvar[1]=2 and Tvar[2]=1 |
/* Tvar[i]=atoi(stre); find 'n' in Vn and stores in Tvar. If model=V2+V1 Tvar[1]=2 and Tvar[2]=1 |
* Boring subroutine which should only output nbcode[Tvar[j]][k] |
* Boring subroutine which should only output nbcode[Tvar[j]][k] |
* Tvar[5] in V2+V1+V3*age+V2*V4 is 2 (V2) |
* Tvar[5] in V2+V1+V3*age+V2*V4 is 4 (V4) even it is a time varying or quantitative variable |
* nbcode[Tvar[j]][1]= |
* nbcode[Tvar[5]][1]= nbcode[4][1]=0, nbcode[4][2]=1 (usually); |
*/ |
*/ |
|
|
int ij=1, k=0, j=0, i=0, maxncov=NCOVMAX; |
int ij=1, k=0, j=0, i=0, maxncov=NCOVMAX; |
int modmaxcovj=0; /* Modality max of covariates j */ |
int modmaxcovj=0; /* Modality max of covariates j */ |
int cptcode=0; /* Modality max of covariates j */ |
int cptcode=0; /* Modality max of covariates j */ |
int modmincovj=0; /* Modality min of covariates j */ |
int modmincovj=0; /* Modality min of covariates j */ |
|
|
|
|
cptcoveff=0; |
/* cptcoveff=0; */ |
|
/* *cptcov=0; */ |
|
|
for (k=1; k <= maxncov; k++) ncodemax[k]=0; /* Horrible constant again replaced by NCOVMAX */ |
for (k=1; k <= maxncov; k++) ncodemax[k]=0; /* Horrible constant again replaced by NCOVMAX */ |
|
|
/* Loop on covariates without age and products */ |
/* Loop on covariates without age and products and no quantitative variable */ |
for (j=1; j<=(cptcovs); j++) { /* From model V1 + V2*age+ V3 + V3*V4 keeps V1 + V3 = 2 only */ |
/* for (j=1; j<=(cptcovs); j++) { /\* From model V1 + V2*age+ V3 + V3*V4 keeps V1 + V3 = 2 only *\/ */ |
for (k=-1; k < maxncov; k++) Ndum[k]=0; |
for (k=1; k<=cptcovt; k++) { /* From model V1 + V2*age + V3 + V3*V4 keeps V1 + V3 = 2 only */ |
for (i=1; i<=imx; i++) { /* Loop on individuals: reads the data file to get the maximum value of the |
for (j=-1; (j < maxncov); j++) Ndum[j]=0; |
modality of this covariate Vj*/ |
if(Dummy[k]==0 && Typevar[k] !=1){ /* Dummy covariate and not age product */ |
ij=(int)(covar[Tvar[j]][i]); /* ij=0 or 1 or -1. Value of the covariate Tvar[j] for individual i |
switch(Fixed[k]) { |
* If product of Vn*Vm, still boolean *: |
case 0: /* Testing on fixed dummy covariate, simple or product of fixed */ |
* If it was coded 1, 2, 3, 4 should be splitted into 3 boolean variables |
for (i=1; i<=imx; i++) { /* Loop on individuals: reads the data file to get the maximum value of the modality of this covariate Vj*/ |
* 1 => 0 0 0, 2 => 0 0 1, 3 => 0 1 1, 4=1 0 0 */ |
ij=(int)(covar[Tvar[k]][i]); |
/* Finds for covariate j, n=Tvar[j] of Vn . ij is the |
/* ij=0 or 1 or -1. Value of the covariate Tvar[j] for individual i |
modality of the nth covariate of individual i. */ |
* If product of Vn*Vm, still boolean *: |
if (ij > modmaxcovj) |
* If it was coded 1, 2, 3, 4 should be splitted into 3 boolean variables |
modmaxcovj=ij; |
* 1 => 0 0 0, 2 => 0 0 1, 3 => 0 1 1, 4=1 0 0 */ |
else if (ij < modmincovj) |
/* Finds for covariate j, n=Tvar[j] of Vn . ij is the |
modmincovj=ij; |
modality of the nth covariate of individual i. */ |
if ((ij < -1) && (ij > NCOVMAX)){ |
if (ij > modmaxcovj) |
printf( "Error: minimal is less than -1 or maximal is bigger than %d. Exiting. \n", NCOVMAX ); |
modmaxcovj=ij; |
exit(1); |
else if (ij < modmincovj) |
}else |
modmincovj=ij; |
Ndum[ij]++; /*counts and stores the occurence of this modality 0, 1, -1*/ |
if ((ij < -1) && (ij > NCOVMAX)){ |
/* If coded 1, 2, 3 , counts the number of 1 Ndum[1], number of 2, Ndum[2], etc */ |
printf( "Error: minimal is less than -1 or maximal is bigger than %d. Exiting. \n", NCOVMAX ); |
/*printf("i=%d ij=%d Ndum[ij]=%d imx=%d",i,ij,Ndum[ij],imx);*/ |
exit(1); |
/* getting the maximum value of the modality of the covariate |
}else |
(should be 0 or 1 now) Tvar[j]. If V=sex and male is coded 0 and |
Ndum[ij]++; /*counts and stores the occurence of this modality 0, 1, -1*/ |
female is 1, then modmaxcovj=1.*/ |
/* If coded 1, 2, 3 , counts the number of 1 Ndum[1], number of 2, Ndum[2], etc */ |
} /* end for loop on individuals i */ |
/*printf("i=%d ij=%d Ndum[ij]=%d imx=%d",i,ij,Ndum[ij],imx);*/ |
printf(" Minimal and maximal values of %d th covariate V%d: min=%d max=%d \n", j, Tvar[j], modmincovj, modmaxcovj); |
/* getting the maximum value of the modality of the covariate |
fprintf(ficlog," Minimal and maximal values of %d th covariate V%d: min=%d max=%d \n", j, Tvar[j], modmincovj, modmaxcovj); |
(should be 0 or 1 now) Tvar[j]. If V=sex and male is coded 0 and |
cptcode=modmaxcovj; |
female ies 1, then modmaxcovj=1. |
/* Ndum[0] = frequency of 0 for model-covariate j, Ndum[1] frequency of 1 etc. */ |
*/ |
/*for (i=0; i<=cptcode; i++) {*/ |
} /* end for loop on individuals i */ |
for (k=modmincovj; k<=modmaxcovj; k++) { /* k=-1 ? 0 and 1*//* For each value k of the modality of model-cov j */ |
printf(" Minimal and maximal values of %d th (fixed) covariate V%d: min=%d max=%d \n", k, Tvar[k], modmincovj, modmaxcovj); |
printf("Frequencies of covariates %d ie V%d with value %d: %d\n", j, Tvar[j], k, Ndum[k]); |
fprintf(ficlog," Minimal and maximal values of %d th (fixed) covariate V%d: min=%d max=%d \n", k, Tvar[k], modmincovj, modmaxcovj); |
fprintf(ficlog, "Frequencies of covariates %d ie V%d with value %d: %d\n", j, Tvar[j], k, Ndum[k]); |
cptcode=modmaxcovj; |
if( Ndum[k] != 0 ){ /* Counts if nobody answered modality k ie empty modality, we skip it and reorder */ |
/* Ndum[0] = frequency of 0 for model-covariate j, Ndum[1] frequency of 1 etc. */ |
if( k != -1){ |
/*for (i=0; i<=cptcode; i++) {*/ |
ncodemax[j]++; /* ncodemax[j]= Number of modalities of the j th |
for (j=modmincovj; j<=modmaxcovj; j++) { /* j=-1 ? 0 and 1*//* For each value j of the modality of model-cov k */ |
covariate for which somebody answered excluding |
printf("Frequencies of (fixed) covariate %d ie V%d with value %d: %d\n", k, Tvar[k], j, Ndum[j]); |
undefined. Usually 2: 0 and 1. */ |
fprintf(ficlog, "Frequencies of (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 */ |
ncodemaxwundef[j]++; /* ncodemax[j]= Number of modalities of the j th |
if( j != -1){ |
covariate for which somebody answered including |
ncodemax[k]++; /* ncodemax[k]= Number of modalities of the k th |
undefined. Usually 3: -1, 0 and 1. */ |
covariate for which somebody answered excluding |
} |
undefined. Usually 2: 0 and 1. */ |
/* In fact ncodemax[j]=2 (dichotom. variables only) but it could be more for |
} |
historical reasons: 3 if coded 1, 2, 3 and 4 and Ndum[2]=0 */ |
ncodemaxwundef[k]++; /* ncodemax[j]= Number of modalities of the k th |
} /* Ndum[-1] number of undefined modalities */ |
covariate for which somebody answered including |
|
undefined. Usually 3: -1, 0 and 1. */ |
/* j is a covariate, n=Tvar[j] of Vn; Fills nbcode */ |
} /* In fact ncodemax[k]=2 (dichotom. variables only) but it could be more for |
/* For covariate j, modalities could be 1, 2, 3, 4, 5, 6, 7. |
* historical reasons: 3 if coded 1, 2, 3 and 4 and Ndum[2]=0 */ |
If Ndum[1]=0, Ndum[2]=0, Ndum[3]= 635, Ndum[4]=0, Ndum[5]=0, Ndum[6]=27, Ndum[7]=125; |
} /* Ndum[-1] number of undefined modalities */ |
modmincovj=3; modmaxcovj = 7; |
|
There are only 3 modalities non empty 3, 6, 7 (or 2 if 27 is too few) : ncodemax[j]=3; |
/* j is a covariate, n=Tvar[j] of Vn; Fills nbcode */ |
which will be coded 0, 1, 2 which in binary on 2=3-1 digits are 0=00 1=01, 2=10; |
/* For covariate j, modalities could be 1, 2, 3, 4, 5, 6, 7. */ |
defining two dummy variables: variables V1_1 and V1_2. |
/* If Ndum[1]=0, Ndum[2]=0, Ndum[3]= 635, Ndum[4]=0, Ndum[5]=0, Ndum[6]=27, Ndum[7]=125; */ |
nbcode[Tvar[j]][ij]=k; |
/* modmincovj=3; modmaxcovj = 7; */ |
nbcode[Tvar[j]][1]=0; |
/* There are only 3 modalities non empty 3, 6, 7 (or 2 if 27 is too few) : ncodemax[j]=3; */ |
nbcode[Tvar[j]][2]=1; |
/* which will be coded 0, 1, 2 which in binary on 2=3-1 digits are 0=00 1=01, 2=10; */ |
nbcode[Tvar[j]][3]=2; |
/* defining two dummy variables: variables V1_1 and V1_2.*/ |
To be continued (not working yet). |
/* nbcode[Tvar[j]][ij]=k; */ |
*/ |
/* nbcode[Tvar[j]][1]=0; */ |
ij=0; /* ij is similar to i but can jump over null modalities */ |
/* nbcode[Tvar[j]][2]=1; */ |
for (i=modmincovj; i<=modmaxcovj; i++) { /* i= 1 to 2 for dichotomous, or from 1 to 3 or from -1 or 0 to 1 currently*/ |
/* nbcode[Tvar[j]][3]=2; */ |
if (Ndum[i] == 0) { /* If nobody responded to this modality k */ |
/* To be continued (not working yet). */ |
break; |
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*/ |
ij++; |
if (Ndum[i] == 0) { /* If nobody responded to this modality k */ |
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.*/ |
break; |
cptcode = ij; /* New max modality for covar j */ |
} |
} /* end of loop on modality i=-1 to 1 or more */ |
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*/ |
/* for (k=0; k<= cptcode; k++) { /\* k=-1 ? k=0 to 1 *\//\* Could be 1 to 4 *\//\* cptcode=modmaxcovj *\/ */ |
cptcode = ij; /* New max modality for covar j */ |
/* /\*recode from 0 *\/ */ |
} /* end of loop on modality i=-1 to 1 or more */ |
/* k is a modality. If we have model=V1+V1*sex */ |
break; |
/* then: nbcode[1][1]=0 ; nbcode[1][2]=1; nbcode[2][1]=0 ; nbcode[2][2]=1; */ |
case 1: /* Testing on varying covariate, could be simple and |
/* But if some modality were not used, it is recoded from 0 to a newer modmaxcovj=cptcode *\/ */ |
* should look at waves or product of fixed * |
/* } */ |
* varying. No time to test -1, assuming 0 and 1 only */ |
/* /\* cptcode = ij; *\/ /\* New max modality for covar j *\/ */ |
ij=0; |
/* if (ij > ncodemax[j]) { */ |
for(i=0; i<=1;i++){ |
/* printf( " Error ij=%d > ncodemax[%d]=%d\n", ij, j, ncodemax[j]); */ |
nbcode[Tvar[k]][++ij]=i; |
/* fprintf(ficlog, " Error ij=%d > ncodemax[%d]=%d\n", ij, j, ncodemax[j]); */ |
} |
/* break; */ |
break; |
/* } */ |
default: |
/* } /\* end of loop on modality k *\/ */ |
break; |
} /* end of loop on model-covariate j. nbcode[Tvarj][1]=0 and nbcode[Tvarj][2]=1 sets the value of covariate j*/ |
} /* end switch */ |
|
} /* end dummy test */ |
for (k=-1; k< maxncov; k++) Ndum[k]=0; |
|
|
/* for (k=0; k<= cptcode; k++) { /\* k=-1 ? k=0 to 1 *\//\* Could be 1 to 4 *\//\* cptcode=modmaxcovj *\/ */ |
for (i=1; i<=ncovmodel-2-nagesqr; i++) { /* -2, cste and age and eventually age*age */ |
/* /\*recode from 0 *\/ */ |
/* Listing of all covariables in statement model to see if some covariates appear twice. For example, V1 appears twice in V1+V1*V2.*/ |
/* k is a modality. If we have model=V1+V1*sex */ |
ij=Tvar[i]; /* Tvar might be -1 if status was unknown */ |
/* then: nbcode[1][1]=0 ; nbcode[1][2]=1; nbcode[2][1]=0 ; nbcode[2][2]=1; */ |
Ndum[ij]++; /* Might be supersed V1 + V1*age */ |
/* 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 *\/ */ |
ij=0; |
/* if (ij > ncodemax[j]) { */ |
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( " Error ij=%d > ncodemax[%d]=%d\n", ij, j, ncodemax[j]); */ |
/*printf("Ndum[%d]=%d\n",i, Ndum[i]);*/ |
/* fprintf(ficlog, " Error ij=%d > ncodemax[%d]=%d\n", ij, j, ncodemax[j]); */ |
if((Ndum[i]!=0) && (i<=ncovcol)){ |
/* break; */ |
ij++; |
/* } */ |
/*printf("diff Ndum[%d]=%d\n",i, Ndum[i]);*/ |
/* } /\* end of loop on modality k *\/ */ |
Tvaraff[ij]=i; /*For printing (unclear) */ |
} /* end of loop on model-covariate j. nbcode[Tvarj][1]=0 and nbcode[Tvarj][2]=1 sets the value of covariate j*/ |
}else{ |
|
/* Tvaraff[ij]=0; */ |
for (k=-1; k< maxncov; k++) Ndum[k]=0; |
|
/* Look at fixed dummy (single or product) covariates to check empty modalities */ |
|
for (i=1; i<=ncovmodel-2-nagesqr; i++) { /* -2, cste and age and eventually age*age */ |
|
/* 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 ****************/ |
/*********** 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 */ |
/* Health expectancies, no variances */ |
Line 3719 void evsij(double ***eij, double x[], in
|
Line 5460 void evsij(double ***eij, double x[], in
|
double ***p3mat; |
double ***p3mat; |
double eip; |
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,"# (a) Life expectancies by health status at initial age and (b) health expectancies by health status at initial age\n"); |
fprintf(ficreseij,"# Age"); |
fprintf(ficreseij,"# Age"); |
for(i=1; i<=nlstate;i++){ |
for(i=1; i<=nlstate;i++){ |
Line 3750 void evsij(double ***eij, double x[], in
|
Line 5491 void evsij(double ***eij, double x[], in
|
/* hstepm beeing the number of stepms, if hstepm=1 the length of hstepm is stepm. |
/* 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 |
nhstepm is the number of hstepm from age to agelim |
nstepm is the number of stepm from age to agelin. |
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 */ |
and note for a fixed period like estepm months */ |
/* We decided (b) to get a life expectancy respecting the most precise curvature of the |
/* 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 |
survival function given by stepm (the optimization length). Unfortunately it |
Line 3782 void evsij(double ***eij, double x[], in
|
Line 5523 void evsij(double ***eij, double x[], in
|
/* Computed by stepm unit matrices, product of hstepma matrices, stored |
/* Computed by stepm unit matrices, product of hstepma matrices, stored |
in an array of nhstepma length: nhstepma=10, hstepm=4, stepm=6 months */ |
in an array of nhstepma length: nhstepma=10, hstepm=4, stepm=6 months */ |
|
|
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. */ |
hf=hstepm*stepm/YEARM; /* Duration of hstepm expressed in year unit. */ |
|
|
Line 3817 void evsij(double ***eij, double x[], in
|
Line 5558 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 |
/* Covariances of health expectancies eij and of total life expectancies according |
to initial status i, ei. . |
to initial status i, ei. . |
*/ |
*/ |
int i, j, nhstepm, hstepm, h, nstepm, k, cptj, cptj2, i2, j2, ij, ji; |
int i, j, nhstepm, hstepm, h, nstepm, k, cptj, cptj2, i2, j2, ij, ji; |
int nhstepma, nstepma; /* Decreasing with age */ |
int nhstepma, nstepma; /* Decreasing with age */ |
Line 3915 void cvevsij(double ***eij, double x[],
|
Line 5656 void cvevsij(double ***eij, double x[],
|
/* Typically if 20 years nstepm = 20*12/6=40 stepm */ |
/* Typically if 20 years nstepm = 20*12/6=40 stepm */ |
/* if (stepm >= YEARM) hstepm=1;*/ |
/* if (stepm >= YEARM) hstepm=1;*/ |
nhstepma = nstepma/hstepm;/* Expressed in hstepm, typically nhstepma=40/4=10 */ |
nhstepma = nstepma/hstepm;/* Expressed in hstepm, typically nhstepma=40/4=10 */ |
|
|
/* If stepm=6 months */ |
/* If stepm=6 months */ |
/* Computed by stepm unit matrices, product of hstepma matrices, stored |
/* Computed by stepm unit matrices, product of hstepma matrices, stored |
in an array of nhstepma length: nhstepma=10, hstepm=4, stepm=6 months */ |
in an array of nhstepma length: nhstepma=10, hstepm=4, stepm=6 months */ |
|
|
hf=hstepm*stepm/YEARM; /* Duration of hstepm expressed in year unit. */ |
hf=hstepm*stepm/YEARM; /* Duration of hstepm expressed in year unit. */ |
|
|
/* Computing Variances of health expectancies */ |
/* Computing Variances of health expectancies */ |
/* Gradient is computed with plus gp and minus gm. Code is duplicated in order to |
/* Gradient is computed with plus gp and minus gm. Code is duplicated in order to |
decrease memory allocation */ |
decrease memory allocation */ |
Line 3930 void cvevsij(double ***eij, double x[],
|
Line 5671 void cvevsij(double ***eij, double x[],
|
xp[i] = x[i] + (i==theta ?delti[theta]:0); |
xp[i] = x[i] + (i==theta ?delti[theta]:0); |
xm[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(p3matp,nhstepm,age,hstepm,xp,nlstate,stepm,oldm,savm, cij, nres); |
hpxij(p3matm,nhstepm,age,hstepm,xm,nlstate,stepm,oldm,savm, cij); |
hpxij(p3matm,nhstepm,age,hstepm,xm,nlstate,stepm,oldm,savm, cij, nres); |
|
|
for(j=1; j<= nlstate; j++){ |
for(j=1; j<= nlstate; j++){ |
for(i=1; i<=nlstate; i++){ |
for(i=1; i<=nlstate; i++){ |
for(h=0; h<=nhstepm-1; h++){ |
for(h=0; h<=nhstepm-1; h++){ |
Line 3941 void cvevsij(double ***eij, double x[],
|
Line 5682 void cvevsij(double ***eij, double x[],
|
} |
} |
} |
} |
} |
} |
|
|
for(ij=1; ij<= nlstate*nlstate; ij++) |
for(ij=1; ij<= nlstate*nlstate; ij++) |
for(h=0; h<=nhstepm-1; h++){ |
for(h=0; h<=nhstepm-1; h++){ |
gradg[h][theta][ij]= (gp[h][ij]-gm[h][ij])/2./delti[theta]; |
gradg[h][theta][ij]= (gp[h][ij]-gm[h][ij])/2./delti[theta]; |
Line 3954 void cvevsij(double ***eij, double x[],
|
Line 5695 void cvevsij(double ***eij, double x[],
|
for(theta=1; theta <=npar; theta++) |
for(theta=1; theta <=npar; theta++) |
trgradg[h][j][theta]=gradg[h][theta][j]; |
trgradg[h][j][theta]=gradg[h][theta][j]; |
|
|
|
|
for(ij=1;ij<=nlstate*nlstate;ij++) |
for(ij=1;ij<=nlstate*nlstate;ij++) |
for(ji=1;ji<=nlstate*nlstate;ji++) |
for(ji=1;ji<=nlstate*nlstate;ji++) |
varhe[ij][ji][(int)age] =0.; |
varhe[ij][ji][(int)age] =0.; |
|
|
printf("%d|",(int)age);fflush(stdout); |
printf("%d|",(int)age);fflush(stdout); |
fprintf(ficlog,"%d|",(int)age);fflush(ficlog); |
fprintf(ficlog,"%d|",(int)age);fflush(ficlog); |
for(h=0;h<=nhstepm-1;h++){ |
for(h=0;h<=nhstepm-1;h++){ |
for(k=0;k<=nhstepm-1;k++){ |
for(k=0;k<=nhstepm-1;k++){ |
matprod2(dnewm,trgradg[h],1,nlstate*nlstate,1,npar,1,npar,matcov); |
matprod2(dnewm,trgradg[h],1,nlstate*nlstate,1,npar,1,npar,matcov); |
matprod2(doldm,dnewm,1,nlstate*nlstate,1,npar,1,nlstate*nlstate,gradg[k]); |
matprod2(doldm,dnewm,1,nlstate*nlstate,1,npar,1,nlstate*nlstate,gradg[k]); |
Line 3970 void cvevsij(double ***eij, double x[],
|
Line 5711 void cvevsij(double ***eij, double x[],
|
varhe[ij][ji][(int)age] += doldm[ij][ji]*hf*hf; |
varhe[ij][ji][(int)age] += doldm[ij][ji]*hf*hf; |
} |
} |
} |
} |
|
|
/* Computing expectancies */ |
/* Computing expectancies */ |
hpxij(p3matm,nhstepm,age,hstepm,x,nlstate,stepm,oldm, savm, cij); |
hpxij(p3matm,nhstepm,age,hstepm,x,nlstate,stepm,oldm, savm, cij,nres); |
for(i=1; i<=nlstate;i++) |
for(i=1; i<=nlstate;i++) |
for(j=1; j<=nlstate;j++) |
for(j=1; j<=nlstate;j++) |
for (h=0, eij[i][j][(int)age]=0; h<=nhstepm-1; h++){ |
for (h=0, eij[i][j][(int)age]=0; h<=nhstepm-1; h++){ |
eij[i][j][(int)age] += (p3matm[i][j][h]+p3matm[i][j][h+1])/2.0*hf; |
eij[i][j][(int)age] += (p3matm[i][j][h]+p3matm[i][j][h+1])/2.0*hf; |
|
|
/* if((int)age==70)printf("i=%2d,j=%2d,h=%2d,age=%3d,%9.4f,%9.4f,%9.4f\n",i,j,h,(int)age,p3mat[i][j][h],hf,eij[i][j][(int)age]);*/ |
/* if((int)age==70)printf("i=%2d,j=%2d,h=%2d,age=%3d,%9.4f,%9.4f,%9.4f\n",i,j,h,(int)age,p3mat[i][j][h],hf,eij[i][j][(int)age]);*/ |
|
|
} |
} |
|
|
|
/* Standard deviation of expectancies ij */ |
fprintf(ficresstdeij,"%3.0f",age ); |
fprintf(ficresstdeij,"%3.0f",age ); |
for(i=1; i<=nlstate;i++){ |
for(i=1; i<=nlstate;i++){ |
eip=0.; |
eip=0.; |
Line 3995 void cvevsij(double ***eij, double x[],
|
Line 5737 void cvevsij(double ***eij, double x[],
|
fprintf(ficresstdeij," %9.4f (%.4f)", eip, sqrt(vip)); |
fprintf(ficresstdeij," %9.4f (%.4f)", eip, sqrt(vip)); |
} |
} |
fprintf(ficresstdeij,"\n"); |
fprintf(ficresstdeij,"\n"); |
|
|
|
/* Variance of expectancies ij */ |
fprintf(ficrescveij,"%3.0f",age ); |
fprintf(ficrescveij,"%3.0f",age ); |
for(i=1; i<=nlstate;i++) |
for(i=1; i<=nlstate;i++) |
for(j=1; j<=nlstate;j++){ |
for(j=1; j<=nlstate;j++){ |
Line 4008 void cvevsij(double ***eij, double x[],
|
Line 5751 void cvevsij(double ***eij, double x[],
|
} |
} |
} |
} |
fprintf(ficrescveij,"\n"); |
fprintf(ficrescveij,"\n"); |
|
|
} |
} |
free_matrix(gm,0,nhstepm,1,nlstate*nlstate); |
free_matrix(gm,0,nhstepm,1,nlstate*nlstate); |
free_matrix(gp,0,nhstepm,1,nlstate*nlstate); |
free_matrix(gp,0,nhstepm,1,nlstate*nlstate); |
Line 4018 void cvevsij(double ***eij, double x[],
|
Line 5761 void cvevsij(double ***eij, double x[],
|
free_ma3x(p3matp,1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); |
free_ma3x(p3matp,1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); |
printf("\n"); |
printf("\n"); |
fprintf(ficlog,"\n"); |
fprintf(ficlog,"\n"); |
|
|
free_vector(xm,1,npar); |
free_vector(xm,1,npar); |
free_vector(xp,1,npar); |
free_vector(xp,1,npar); |
free_matrix(dnewm,1,nlstate*nlstate,1,npar); |
free_matrix(dnewm,1,nlstate*nlstate,1,npar); |
free_matrix(doldm,1,nlstate*nlstate,1,nlstate*nlstate); |
free_matrix(doldm,1,nlstate*nlstate,1,nlstate*nlstate); |
free_ma3x(varhe,1,nlstate*nlstate,1,nlstate*nlstate,(int) bage, (int)fage); |
free_ma3x(varhe,1,nlstate*nlstate,1,nlstate*nlstate,(int) bage, (int)fage); |
} |
} |
|
|
/************ Variance ******************/ |
/************ Variance ******************/ |
void varevsij(char optionfilefiname[], double ***vareij, double **matcov, double x[], double delti[], int nlstate, int stepm, double bage, double fage, double **oldm, double **savm, double **prlim, double ftolpl, int *ncvyearp, int ij, int estepm, int cptcov, int cptcod, int popbased, int mobilav, char strstart[]) |
void varevsij(char optionfilefiname[], double ***vareij, double **matcov, double x[], double delti[], int nlstate, int stepm, double bage, double fage, double **oldm, double **savm, double **prlim, double ftolpl, int *ncvyearp, int ij, int estepm, int cptcov, int cptcod, int popbased, int mobilav, char strstart[], int nres) |
{ |
{ |
/* Variance of health expectancies */ |
/* Variance of health expectancies */ |
/* double **prevalim(double **prlim, int nlstate, double *xp, double age, double **oldm, double ** savm,double ftolpl);*/ |
/* double **prevalim(double **prlim, int nlstate, double *xp, double age, double **oldm, double ** savm,double ftolpl);*/ |
/* double **newm;*/ |
/* double **newm;*/ |
/* int movingaverage(double ***probs, double bage,double fage, double ***mobaverage, int mobilav)*/ |
/* int movingaverage(double ***probs, double bage,double fage, double ***mobaverage, int mobilav)*/ |
|
|
int movingaverage(); |
/* int movingaverage(); */ |
double **dnewm,**doldm; |
double **dnewm,**doldm; |
double **dnewmp,**doldmp; |
double **dnewmp,**doldmp; |
int i, j, nhstepm, hstepm, h, nstepm ; |
int i, j, nhstepm, hstepm, h, nstepm ; |
int k; |
int k; |
double *xp; |
double *xp; |
double **gp, **gm; /* for var eij */ |
double **gp, **gm; /* for var eij */ |
double ***gradg, ***trgradg; /*for var eij */ |
double ***gradg, ***trgradg; /*for var eij */ |
double **gradgp, **trgradgp; /* for var p point j */ |
double **gradgp, **trgradgp; /* for var p point j */ |
double *gpp, *gmp; /* for var p point j */ |
double *gpp, *gmp; /* for var p point j */ |
double **varppt; /* for var p point j nlstate to nlstate+ndeath */ |
double **varppt; /* for var p point j nlstate to nlstate+ndeath */ |
double ***p3mat; |
double ***p3mat; |
double age,agelim, hf; |
double age,agelim, hf; |
double ***mobaverage; |
/* double ***mobaverage; */ |
int theta; |
int theta; |
char digit[4]; |
char digit[4]; |
char digitp[25]; |
char digitp[25]; |
|
|
char fileresprobmorprev[FILENAMELENGTH]; |
char fileresprobmorprev[FILENAMELENGTH]; |
|
|
if(popbased==1){ |
if(popbased==1){ |
if(mobilav!=0) |
if(mobilav!=0) |
strcpy(digitp,"-POPULBASED-MOBILAV_"); |
strcpy(digitp,"-POPULBASED-MOBILAV_"); |
else strcpy(digitp,"-POPULBASED-NOMOBIL_"); |
else strcpy(digitp,"-POPULBASED-NOMOBIL_"); |
} |
} |
else |
else |
strcpy(digitp,"-STABLBASED_"); |
strcpy(digitp,"-STABLBASED_"); |
|
|
if (mobilav!=0) { |
|
mobaverage= ma3x(1, AGESUP,1,NCOVMAX, 1,NCOVMAX); |
|
if (movingaverage(probs, bage, fage, mobaverage,mobilav)!=0){ |
|
fprintf(ficlog," Error in movingaverage mobilav=%d\n",mobilav); |
|
printf(" Error in movingaverage mobilav=%d\n",mobilav); |
|
} |
|
} |
|
|
|
strcpy(fileresprobmorprev,"PRMORPREV-"); |
|
sprintf(digit,"%-d",ij); |
|
/*printf("DIGIT=%s, ij=%d ijr=%-d|\n",digit, ij,ij);*/ |
|
strcat(fileresprobmorprev,digit); /* Tvar to be done */ |
|
strcat(fileresprobmorprev,digitp); /* Popbased or not, mobilav or not */ |
|
strcat(fileresprobmorprev,fileresu); |
|
if((ficresprobmorprev=fopen(fileresprobmorprev,"w"))==NULL) { |
|
printf("Problem with resultfile: %s\n", fileresprobmorprev); |
|
fprintf(ficlog,"Problem with resultfile: %s\n", fileresprobmorprev); |
|
} |
|
printf("Computing total mortality p.j=w1*p1j+w2*p2j+..: result on file '%s' \n",fileresprobmorprev); |
|
fprintf(ficlog,"Computing total mortality p.j=w1*p1j+w2*p2j+..: result on file '%s' \n",fileresprobmorprev); |
|
pstamp(ficresprobmorprev); |
|
fprintf(ficresprobmorprev,"# probabilities of dying before estepm=%d months for people of exact age and weighted probabilities w1*p1j+w2*p2j+... stand dev in()\n",estepm); |
|
fprintf(ficresprobmorprev,"# Age cov=%-d",ij); |
|
for(j=nlstate+1; j<=(nlstate+ndeath);j++){ |
|
fprintf(ficresprobmorprev," p.%-d SE",j); |
|
for(i=1; i<=nlstate;i++) |
|
fprintf(ficresprobmorprev," w%1d p%-d%-d",i,i,j); |
|
} |
|
fprintf(ficresprobmorprev,"\n"); |
|
|
|
fprintf(ficgp,"\n# Routine varevsij"); |
|
fprintf(ficgp,"\nunset title \n"); |
|
/* fprintf(fichtm, "#Local time at start: %s", strstart);*/ |
|
fprintf(fichtm,"\n<li><h4> Computing probabilities of dying over estepm months as a weighted average (i.e global mortality independent of initial healh state)</h4></li>\n"); |
|
fprintf(fichtm,"\n<br>%s <br>\n",digitp); |
|
/* } */ |
|
varppt = matrix(nlstate+1,nlstate+ndeath,nlstate+1,nlstate+ndeath); |
|
pstamp(ficresvij); |
|
fprintf(ficresvij,"# Variance and covariance of health expectancies e.j \n# (weighted average of eij where weights are "); |
|
if(popbased==1) |
|
fprintf(ficresvij,"the age specific prevalence observed (cross-sectionally) in the population i.e cross-sectionally\n in each health state (popbased=1) (mobilav=%d\n",mobilav); |
|
else |
|
fprintf(ficresvij,"the age specific period (stable) prevalences in each health state \n"); |
|
fprintf(ficresvij,"# Age"); |
|
for(i=1; i<=nlstate;i++) |
|
for(j=1; j<=nlstate;j++) |
|
fprintf(ficresvij," Cov(e.%1d, e.%1d)",i,j); |
|
fprintf(ficresvij,"\n"); |
|
|
|
xp=vector(1,npar); |
|
dnewm=matrix(1,nlstate,1,npar); |
|
doldm=matrix(1,nlstate,1,nlstate); |
|
dnewmp= matrix(nlstate+1,nlstate+ndeath,1,npar); |
|
doldmp= matrix(nlstate+1,nlstate+ndeath,nlstate+1,nlstate+ndeath); |
|
|
|
gradgp=matrix(1,npar,nlstate+1,nlstate+ndeath); |
/* if (mobilav!=0) { */ |
gpp=vector(nlstate+1,nlstate+ndeath); |
/* mobaverage= ma3x(1, AGESUP,1,NCOVMAX, 1,NCOVMAX); */ |
gmp=vector(nlstate+1,nlstate+ndeath); |
/* if (movingaverage(probs, bage, fage, mobaverage,mobilav)!=0){ */ |
trgradgp =matrix(nlstate+1,nlstate+ndeath,1,npar); /* mu or p point j*/ |
/* fprintf(ficlog," Error in movingaverage mobilav=%d\n",mobilav); */ |
|
/* printf(" Error in movingaverage mobilav=%d\n",mobilav); */ |
if(estepm < stepm){ |
/* } */ |
printf ("Problem %d lower than %d\n",estepm, stepm); |
/* } */ |
} |
|
else hstepm=estepm; |
strcpy(fileresprobmorprev,"PRMORPREV-"); |
/* For example we decided to compute the life expectancy with the smallest unit */ |
sprintf(digit,"%-d",ij); |
/* hstepm beeing the number of stepms, if hstepm=1 the length of hstepm is stepm. |
/*printf("DIGIT=%s, ij=%d ijr=%-d|\n",digit, ij,ij);*/ |
nhstepm is the number of hstepm from age to agelim |
strcat(fileresprobmorprev,digit); /* Tvar to be done */ |
nstepm is the number of stepm from age to agelim. |
strcat(fileresprobmorprev,digitp); /* Popbased or not, mobilav or not */ |
Look at function hpijx to understand why because of memory size limitations, |
strcat(fileresprobmorprev,fileresu); |
we decided (b) to get a life expectancy respecting the most precise curvature of the |
if((ficresprobmorprev=fopen(fileresprobmorprev,"w"))==NULL) { |
survival function given by stepm (the optimization length). Unfortunately it |
printf("Problem with resultfile: %s\n", fileresprobmorprev); |
means that if the survival funtion is printed every two years of age and if |
fprintf(ficlog,"Problem with resultfile: %s\n", fileresprobmorprev); |
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. |
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); |
hstepm=hstepm/stepm; /* Typically in stepm units, if stepm=6 & estepm=24 , = 24/6 months = 4 */ |
pstamp(ficresprobmorprev); |
agelim = AGESUP; |
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); |
for (age=bage; age<=fage; age ++){ /* If stepm=6 months */ |
fprintf(ficresprobmorprev,"# Selected quantitative variables and dummies"); |
nstepm=(int) rint((agelim-age)*YEARM/stepm); /* Typically 20 years = 20*12/6=40 */ |
for (j=1; j<= nsq; j++){ /* For each selected (single) quantitative value */ |
nhstepm = nstepm/hstepm;/* Expressed in hstepm, typically nhstepm=40/4=10 */ |
fprintf(ficresprobmorprev," V%d=%f ",Tvqresult[nres][j],Tqresult[nres][j]); |
p3mat=ma3x(1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); |
} |
gradg=ma3x(0,nhstepm,1,npar,1,nlstate); |
for(j=1;j<=cptcoveff;j++) |
gp=matrix(0,nhstepm,1,nlstate); |
fprintf(ficresprobmorprev,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(ij,j)]); |
gm=matrix(0,nhstepm,1,nlstate); |
fprintf(ficresprobmorprev,"\n"); |
|
|
|
fprintf(ficresprobmorprev,"# Age cov=%-d",ij); |
for(theta=1; theta <=npar; theta++){ |
for(j=nlstate+1; j<=(nlstate+ndeath);j++){ |
for(i=1; i<=npar; i++){ /* Computes gradient x + delta*/ |
fprintf(ficresprobmorprev," p.%-d SE",j); |
xp[i] = x[i] + (i==theta ?delti[theta]:0); |
for(i=1; i<=nlstate;i++) |
} |
fprintf(ficresprobmorprev," w%1d p%-d%-d",i,i,j); |
|
} |
prevalim(prlim,nlstate,xp,age,oldm,savm,ftolpl,ncvyearp,ij); |
fprintf(ficresprobmorprev,"\n"); |
|
|
if (popbased==1) { |
fprintf(ficgp,"\n# Routine varevsij"); |
if(mobilav ==0){ |
fprintf(ficgp,"\nunset title \n"); |
for(i=1; i<=nlstate;i++) |
/* fprintf(fichtm, "#Local time at start: %s", strstart);*/ |
prlim[i][i]=probs[(int)age][i][ij]; |
fprintf(fichtm,"\n<li><h4> Computing probabilities of dying over estepm months as a weighted average (i.e global mortality independent of initial healh state)</h4></li>\n"); |
}else{ /* mobilav */ |
fprintf(fichtm,"\n<br>%s <br>\n",digitp); |
for(i=1; i<=nlstate;i++) |
/* } */ |
prlim[i][i]=mobaverage[(int)age][i][ij]; |
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) |
hpxij(p3mat,nhstepm,age,hstepm,xp,nlstate,stepm,oldm,savm, ij); /* Returns p3mat[i][j][h] for h=1 to nhstepm */ |
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); |
for(j=1; j<= nlstate; j++){ |
else |
for(h=0; h<=nhstepm; h++){ |
fprintf(ficresvij,"the age specific period (stable) prevalences in each health state \n"); |
for(i=1, gp[h][j]=0.;i<=nlstate;i++) |
fprintf(ficresvij,"# Age"); |
gp[h][j] += prlim[i][i]*p3mat[i][j][h]; |
for(i=1; i<=nlstate;i++) |
} |
for(j=1; j<=nlstate;j++) |
} |
fprintf(ficresvij," Cov(e.%1d, e.%1d)",i,j); |
/* Next for computing probability of death (h=1 means |
fprintf(ficresvij,"\n"); |
computed over hstepm matrices product = hstepm*stepm months) |
|
as a weighted average of prlim. |
xp=vector(1,npar); |
*/ |
dnewm=matrix(1,nlstate,1,npar); |
for(j=nlstate+1;j<=nlstate+ndeath;j++){ |
doldm=matrix(1,nlstate,1,nlstate); |
for(i=1,gpp[j]=0.; i<= nlstate; i++) |
dnewmp= matrix(nlstate+1,nlstate+ndeath,1,npar); |
gpp[j] += prlim[i][i]*p3mat[i][j][1]; |
doldmp= matrix(nlstate+1,nlstate+ndeath,nlstate+1,nlstate+ndeath); |
} |
|
/* end probability of death */ |
gradgp=matrix(1,npar,nlstate+1,nlstate+ndeath); |
|
gpp=vector(nlstate+1,nlstate+ndeath); |
for(i=1; i<=npar; i++) /* Computes gradient x - delta */ |
gmp=vector(nlstate+1,nlstate+ndeath); |
xp[i] = x[i] - (i==theta ?delti[theta]:0); |
trgradgp =matrix(nlstate+1,nlstate+ndeath,1,npar); /* mu or p point j*/ |
|
|
prevalim(prlim,nlstate,xp,age,oldm,savm,ftolpl,ncvyearp, ij); |
|
|
|
if (popbased==1) { |
|
if(mobilav ==0){ |
|
for(i=1; i<=nlstate;i++) |
|
prlim[i][i]=probs[(int)age][i][ij]; |
|
}else{ /* mobilav */ |
|
for(i=1; i<=nlstate;i++) |
|
prlim[i][i]=mobaverage[(int)age][i][ij]; |
|
} |
|
} |
|
|
|
hpxij(p3mat,nhstepm,age,hstepm,xp,nlstate,stepm,oldm,savm, ij); |
|
|
|
for(j=1; j<= nlstate; j++){ /* Sum of wi * eij = e.j */ |
|
for(h=0; h<=nhstepm; h++){ |
|
for(i=1, gm[h][j]=0.;i<=nlstate;i++) |
|
gm[h][j] += prlim[i][i]*p3mat[i][j][h]; |
|
} |
|
} |
|
/* This for computing probability of death (h=1 means |
|
computed over hstepm matrices product = hstepm*stepm months) |
|
as a weighted average of prlim. |
|
*/ |
|
for(j=nlstate+1;j<=nlstate+ndeath;j++){ |
|
for(i=1,gmp[j]=0.; i<= nlstate; i++) |
|
gmp[j] += prlim[i][i]*p3mat[i][j][1]; |
|
} |
|
/* end probability of death */ |
|
|
|
for(j=1; j<= nlstate; j++) /* vareij */ |
|
for(h=0; h<=nhstepm; h++){ |
|
gradg[h][theta][j]= (gp[h][j]-gm[h][j])/2./delti[theta]; |
|
} |
|
|
|
for(j=nlstate+1; j<= nlstate+ndeath; j++){ /* var mu */ |
|
gradgp[theta][j]= (gpp[j]-gmp[j])/2./delti[theta]; |
|
} |
|
|
|
} /* End theta */ |
|
|
|
trgradg =ma3x(0,nhstepm,1,nlstate,1,npar); /* veij */ |
|
|
|
for(h=0; h<=nhstepm; h++) /* veij */ |
|
for(j=1; j<=nlstate;j++) |
|
for(theta=1; theta <=npar; theta++) |
|
trgradg[h][j][theta]=gradg[h][theta][j]; |
|
|
|
for(j=nlstate+1; j<=nlstate+ndeath;j++) /* mu */ |
|
for(theta=1; theta <=npar; theta++) |
|
trgradgp[j][theta]=gradgp[theta][j]; |
|
|
|
|
|
hf=hstepm*stepm/YEARM; /* Duration of hstepm expressed in year unit. */ |
|
for(i=1;i<=nlstate;i++) |
|
for(j=1;j<=nlstate;j++) |
|
vareij[i][j][(int)age] =0.; |
|
|
|
for(h=0;h<=nhstepm;h++){ |
|
for(k=0;k<=nhstepm;k++){ |
|
matprod2(dnewm,trgradg[h],1,nlstate,1,npar,1,npar,matcov); |
|
matprod2(doldm,dnewm,1,nlstate,1,npar,1,nlstate,gradg[k]); |
|
for(i=1;i<=nlstate;i++) |
|
for(j=1;j<=nlstate;j++) |
|
vareij[i][j][(int)age] += doldm[i][j]*hf*hf; |
|
} |
|
} |
|
|
|
/* pptj */ |
if(estepm < stepm){ |
matprod2(dnewmp,trgradgp,nlstate+1,nlstate+ndeath,1,npar,1,npar,matcov); |
printf ("Problem %d lower than %d\n",estepm, stepm); |
matprod2(doldmp,dnewmp,nlstate+1,nlstate+ndeath,1,npar,nlstate+1,nlstate+ndeath,gradgp); |
} |
for(j=nlstate+1;j<=nlstate+ndeath;j++) |
else hstepm=estepm; |
for(i=nlstate+1;i<=nlstate+ndeath;i++) |
/* For example we decided to compute the life expectancy with the smallest unit */ |
varppt[j][i]=doldmp[j][i]; |
/* hstepm beeing the number of stepms, if hstepm=1 the length of hstepm is stepm. |
/* end ppptj */ |
nhstepm is the number of hstepm from age to agelim |
/* x centered again */ |
nstepm is the number of stepm from age to agelim. |
|
Look at function hpijx to understand why because of memory size limitations, |
prevalim(prlim,nlstate,x,age,oldm,savm,ftolpl,ncvyearp,ij); |
we decided (b) to get a life expectancy respecting the most precise curvature of the |
|
survival function given by stepm (the optimization length). Unfortunately it |
if (popbased==1) { |
means that if the survival funtion is printed every two years of age and if |
if(mobilav ==0){ |
you sum them up and add 1 year (area under the trapezoids) you won't get the same |
for(i=1; i<=nlstate;i++) |
results. So we changed our mind and took the option of the best precision. |
prlim[i][i]=probs[(int)age][i][ij]; |
*/ |
}else{ /* mobilav */ |
hstepm=hstepm/stepm; /* Typically in stepm units, if stepm=6 & estepm=24 , = 24/6 months = 4 */ |
for(i=1; i<=nlstate;i++) |
agelim = AGESUP; |
prlim[i][i]=mobaverage[(int)age][i][ij]; |
for (age=bage; age<=fage; age ++){ /* If stepm=6 months */ |
} |
nstepm=(int) rint((agelim-age)*YEARM/stepm); /* Typically 20 years = 20*12/6=40 */ |
} |
nhstepm = nstepm/hstepm;/* Expressed in hstepm, typically nhstepm=40/4=10 */ |
|
p3mat=ma3x(1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); |
/* This for computing probability of death (h=1 means |
gradg=ma3x(0,nhstepm,1,npar,1,nlstate); |
computed over hstepm (estepm) matrices product = hstepm*stepm months) |
gp=matrix(0,nhstepm,1,nlstate); |
as a weighted average of prlim. |
gm=matrix(0,nhstepm,1,nlstate); |
|
|
|
|
|
for(theta=1; theta <=npar; theta++){ |
|
for(i=1; i<=npar; i++){ /* Computes gradient x + delta*/ |
|
xp[i] = x[i] + (i==theta ?delti[theta]:0); |
|
} |
|
|
|
prevalim(prlim,nlstate,xp,age,oldm,savm,ftolpl,ncvyearp,ij, 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); /* Returns p3mat[i][j][h] for h=1 to nhstepm */ |
|
for(j=1; j<= nlstate; j++){ |
|
for(h=0; h<=nhstepm; h++){ |
|
for(i=1, gp[h][j]=0.;i<=nlstate;i++) |
|
gp[h][j] += prlim[i][i]*p3mat[i][j][h]; |
|
} |
|
} |
|
/* Next for computing probability of death (h=1 means |
|
computed over hstepm matrices product = hstepm*stepm months) |
|
as a weighted average of prlim. |
|
*/ |
|
for(j=nlstate+1;j<=nlstate+ndeath;j++){ |
|
for(i=1,gpp[j]=0.; i<= nlstate; i++) |
|
gpp[j] += prlim[i][i]*p3mat[i][j][1]; |
|
} |
|
/* end probability of death */ |
|
|
|
for(i=1; i<=npar; i++) /* Computes gradient x - delta */ |
|
xp[i] = x[i] - (i==theta ?delti[theta]:0); |
|
|
|
prevalim(prlim,nlstate,xp,age,oldm,savm,ftolpl,ncvyearp, ij, 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 probability of death */ |
|
|
|
for(j=1; j<= nlstate; j++) /* vareij */ |
|
for(h=0; h<=nhstepm; h++){ |
|
gradg[h][theta][j]= (gp[h][j]-gm[h][j])/2./delti[theta]; |
|
} |
|
|
|
for(j=nlstate+1; j<= nlstate+ndeath; j++){ /* var mu */ |
|
gradgp[theta][j]= (gpp[j]-gmp[j])/2./delti[theta]; |
|
} |
|
|
|
} /* End theta */ |
|
|
|
trgradg =ma3x(0,nhstepm,1,nlstate,1,npar); /* veij */ |
|
|
|
for(h=0; h<=nhstepm; h++) /* veij */ |
|
for(j=1; j<=nlstate;j++) |
|
for(theta=1; theta <=npar; theta++) |
|
trgradg[h][j][theta]=gradg[h][theta][j]; |
|
|
|
for(j=nlstate+1; j<=nlstate+ndeath;j++) /* mu */ |
|
for(theta=1; theta <=npar; theta++) |
|
trgradgp[j][theta]=gradgp[theta][j]; |
|
|
|
|
|
hf=hstepm*stepm/YEARM; /* Duration of hstepm expressed in year unit. */ |
|
for(i=1;i<=nlstate;i++) |
|
for(j=1;j<=nlstate;j++) |
|
vareij[i][j][(int)age] =0.; |
|
|
|
for(h=0;h<=nhstepm;h++){ |
|
for(k=0;k<=nhstepm;k++){ |
|
matprod2(dnewm,trgradg[h],1,nlstate,1,npar,1,npar,matcov); |
|
matprod2(doldm,dnewm,1,nlstate,1,npar,1,nlstate,gradg[k]); |
|
for(i=1;i<=nlstate;i++) |
|
for(j=1;j<=nlstate;j++) |
|
vareij[i][j][(int)age] += doldm[i][j]*hf*hf; |
|
} |
|
} |
|
|
|
/* pptj */ |
|
matprod2(dnewmp,trgradgp,nlstate+1,nlstate+ndeath,1,npar,1,npar,matcov); |
|
matprod2(doldmp,dnewmp,nlstate+1,nlstate+ndeath,1,npar,nlstate+1,nlstate+ndeath,gradgp); |
|
for(j=nlstate+1;j<=nlstate+ndeath;j++) |
|
for(i=nlstate+1;i<=nlstate+ndeath;i++) |
|
varppt[j][i]=doldmp[j][i]; |
|
/* end ppptj */ |
|
/* x centered again */ |
|
|
|
prevalim(prlim,nlstate,x,age,oldm,savm,ftolpl,ncvyearp,ij, 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<br> File (multiple files are possible if covariates are present): <A href=\"%s\">%s</a>\n",subdirf(fileresprobmorprev),subdirf(fileresprobmorprev)); |
|
fprintf(fichtm,"\n<br> Probability is computed over estepm=%d months. <br> <img src=\"%s%s.svg\"> <br>\n", estepm,subdirf3(optionfilefiname,"VARMUPTJGR-",digitp),digit); |
|
/* fprintf(fichtm,"\n<br> Probability is computed over estepm=%d months and then divided by estepm and multiplied by %.0f in order to have the probability to die over a year <br> <img src=\"varmuptjgr%s%s.svg\"> <br>\n", stepm,YEARM,digitp,digit); |
*/ |
*/ |
hpxij(p3mat,nhstepm,age,hstepm,x,nlstate,stepm,oldm,savm, ij); |
/* fprintf(ficgp,"\nset out \"varmuptjgr%s%s%s.svg\";replot;",digitp,optionfilefiname,digit); */ |
for(j=nlstate+1;j<=nlstate+ndeath;j++){ |
fprintf(ficgp,"\nset out;\nset out \"%s%s.svg\";replot;set out;\n",subdirf3(optionfilefiname,"VARMUPTJGR-",digitp),digit); |
for(i=1,gmp[j]=0.;i<= nlstate; i++) |
|
gmp[j] += prlim[i][i]*p3mat[i][j][1]; |
|
} |
|
/* end probability of death */ |
|
|
|
fprintf(ficresprobmorprev,"%3d %d ",(int) age, ij); |
|
for(j=nlstate+1; j<=(nlstate+ndeath);j++){ |
|
fprintf(ficresprobmorprev," %11.3e %11.3e",gmp[j], sqrt(varppt[j][j])); |
|
for(i=1; i<=nlstate;i++){ |
|
fprintf(ficresprobmorprev," %11.3e %11.3e ",prlim[i][i],p3mat[i][j][1]); |
|
} |
|
} |
|
fprintf(ficresprobmorprev,"\n"); |
|
|
|
fprintf(ficresvij,"%.0f ",age ); |
|
for(i=1; i<=nlstate;i++) |
|
for(j=1; j<=nlstate;j++){ |
|
fprintf(ficresvij," %.4f", vareij[i][j][(int)age]); |
|
} |
|
fprintf(ficresvij,"\n"); |
|
free_matrix(gp,0,nhstepm,1,nlstate); |
|
free_matrix(gm,0,nhstepm,1,nlstate); |
|
free_ma3x(gradg,0,nhstepm,1,npar,1,nlstate); |
|
free_ma3x(trgradg,0,nhstepm,1,nlstate,1,npar); |
|
free_ma3x(p3mat,1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); |
|
} /* End age */ |
|
free_vector(gpp,nlstate+1,nlstate+ndeath); |
|
free_vector(gmp,nlstate+1,nlstate+ndeath); |
|
free_matrix(gradgp,1,npar,nlstate+1,nlstate+ndeath); |
|
free_matrix(trgradgp,nlstate+1,nlstate+ndeath,1,npar); /* mu or p point j*/ |
|
/* fprintf(ficgp,"\nunset parametric;unset label; set ter png small size 320, 240"); */ |
|
fprintf(ficgp,"\nunset parametric;unset label; set ter svg size 640, 480"); |
|
/* for(j=nlstate+1; j<= nlstate+ndeath; j++){ *//* Only the first actually */ |
|
fprintf(ficgp,"\n set log y; unset log x;set xlabel \"Age\"; set ylabel \"Force of mortality (year-1)\";"); |
|
fprintf(ficgp,"\nset out \"%s%s.svg\";",subdirf3(optionfilefiname,"VARMUPTJGR-",digitp),digit); |
|
/* fprintf(ficgp,"\n plot \"%s\" u 1:($3*%6.3f) not w l 1 ",fileresprobmorprev,YEARM/estepm); */ |
|
/* fprintf(ficgp,"\n replot \"%s\" u 1:(($3+1.96*$4)*%6.3f) t \"95\%% interval\" w l 2 ",fileresprobmorprev,YEARM/estepm); */ |
|
/* fprintf(ficgp,"\n replot \"%s\" u 1:(($3-1.96*$4)*%6.3f) not w l 2 ",fileresprobmorprev,YEARM/estepm); */ |
|
fprintf(ficgp,"\n plot \"%s\" u 1:($3) not w l lt 1 ",subdirf(fileresprobmorprev)); |
|
fprintf(ficgp,"\n replot \"%s\" u 1:(($3+1.96*$4)) t \"95%% interval\" w l lt 2 ",subdirf(fileresprobmorprev)); |
|
fprintf(ficgp,"\n replot \"%s\" u 1:(($3-1.96*$4)) not w l lt 2 ",subdirf(fileresprobmorprev)); |
|
fprintf(fichtm,"\n<br> File (multiple files are possible if covariates are present): <A href=\"%s\">%s</a>\n",subdirf(fileresprobmorprev),subdirf(fileresprobmorprev)); |
|
fprintf(fichtm,"\n<br> Probability is computed over estepm=%d months. <br> <img src=\"%s%s.svg\"> <br>\n", estepm,subdirf3(optionfilefiname,"VARMUPTJGR-",digitp),digit); |
|
/* fprintf(fichtm,"\n<br> Probability is computed over estepm=%d months and then divided by estepm and multiplied by %.0f in order to have the probability to die over a year <br> <img src=\"varmuptjgr%s%s.svg\"> <br>\n", stepm,YEARM,digitp,digit); |
|
*/ |
|
/* fprintf(ficgp,"\nset out \"varmuptjgr%s%s%s.svg\";replot;",digitp,optionfilefiname,digit); */ |
|
fprintf(ficgp,"\nset out;\nset out \"%s%s.svg\";replot;set out;\n",subdirf3(optionfilefiname,"VARMUPTJGR-",digitp),digit); |
|
|
|
free_vector(xp,1,npar); |
free_vector(xp,1,npar); |
free_matrix(doldm,1,nlstate,1,nlstate); |
free_matrix(doldm,1,nlstate,1,nlstate); |
free_matrix(dnewm,1,nlstate,1,npar); |
free_matrix(dnewm,1,nlstate,1,npar); |
free_matrix(doldmp,nlstate+1,nlstate+ndeath,nlstate+1,nlstate+ndeath); |
free_matrix(doldmp,nlstate+1,nlstate+ndeath,nlstate+1,nlstate+ndeath); |
free_matrix(dnewmp,nlstate+1,nlstate+ndeath,1,npar); |
free_matrix(dnewmp,nlstate+1,nlstate+ndeath,1,npar); |
free_matrix(varppt,nlstate+1,nlstate+ndeath,nlstate+1,nlstate+ndeath); |
free_matrix(varppt,nlstate+1,nlstate+ndeath,nlstate+1,nlstate+ndeath); |
if (mobilav!=0) free_ma3x(mobaverage,1, AGESUP,1,NCOVMAX, 1,NCOVMAX); |
/* if (mobilav!=0) free_ma3x(mobaverage,1, AGESUP,1,NCOVMAX, 1,NCOVMAX); */ |
fclose(ficresprobmorprev); |
fclose(ficresprobmorprev); |
fflush(ficgp); |
fflush(ficgp); |
fflush(fichtm); |
fflush(fichtm); |
} /* end varevsij */ |
} /* end varevsij */ |
|
|
/************ Variance of prevlim ******************/ |
/************ Variance of prevlim ******************/ |
void varprevlim(char fileres[], double **varpl, double **matcov, double x[], double delti[], int nlstate, int stepm, double bage, double fage, double **oldm, double **savm, double **prlim, double ftolpl, int *ncvyearp, int ij, char strstart[]) |
void varprevlim(char 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*/ |
/* 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 **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; |
int i, j, nhstepm, hstepm; |
double *xp; |
double *xp; |
double *gp, *gm; |
double *gp, *gm; |
Line 4357 void cvevsij(double ***eij, double x[],
|
Line 6108 void cvevsij(double ***eij, double x[],
|
|
|
pstamp(ficresvpl); |
pstamp(ficresvpl); |
fprintf(ficresvpl,"# Standard deviation of period (stable) prevalences \n"); |
fprintf(ficresvpl,"# Standard deviation of period (stable) prevalences \n"); |
fprintf(ficresvpl,"# Age"); |
fprintf(ficresvpl,"# Age "); |
|
if(nresult >=1) |
|
fprintf(ficresvpl," Result# "); |
for(i=1; i<=nlstate;i++) |
for(i=1; i<=nlstate;i++) |
fprintf(ficresvpl," %1d-%1d",i,i); |
fprintf(ficresvpl," %1d-%1d",i,i); |
fprintf(ficresvpl,"\n"); |
fprintf(ficresvpl,"\n"); |
|
|
xp=vector(1,npar); |
xp=vector(1,npar); |
dnewm=matrix(1,nlstate,1,npar); |
dnewmpar=matrix(1,nlstate,1,npar); |
doldm=matrix(1,nlstate,1,nlstate); |
doldm=matrix(1,nlstate,1,nlstate); |
|
|
hstepm=1*YEARM; /* Every year of age */ |
hstepm=1*YEARM; /* Every year of age */ |
Line 4384 void cvevsij(double ***eij, double x[],
|
Line 6137 void cvevsij(double ***eij, double x[],
|
xp[i] = x[i] + (i==theta ?delti[theta]:0); |
xp[i] = x[i] + (i==theta ?delti[theta]:0); |
} |
} |
if((int)age==79 ||(int)age== 80 ||(int)age== 81 ) |
if((int)age==79 ||(int)age== 80 ||(int)age== 81 ) |
prevalim(prlim,nlstate,xp,age,oldm,savm,ftolpl,ncvyearp,ij); |
prevalim(prlim,nlstate,xp,age,oldm,savm,ftolpl,ncvyearp,ij,nres); |
else |
else |
prevalim(prlim,nlstate,xp,age,oldm,savm,ftolpl,ncvyearp,ij); |
prevalim(prlim,nlstate,xp,age,oldm,savm,ftolpl,ncvyearp,ij,nres); |
for(i=1;i<=nlstate;i++){ |
for(i=1;i<=nlstate;i++){ |
gp[i] = prlim[i][i]; |
gp[i] = prlim[i][i]; |
mgp[theta][i] = prlim[i][i]; |
mgp[theta][i] = prlim[i][i]; |
Line 4394 void cvevsij(double ***eij, double x[],
|
Line 6147 void cvevsij(double ***eij, double x[],
|
for(i=1; i<=npar; i++) /* Computes gradient */ |
for(i=1; i<=npar; i++) /* Computes gradient */ |
xp[i] = x[i] - (i==theta ?delti[theta]:0); |
xp[i] = x[i] - (i==theta ?delti[theta]:0); |
if((int)age==79 ||(int)age== 80 ||(int)age== 81 ) |
if((int)age==79 ||(int)age== 80 ||(int)age== 81 ) |
prevalim(prlim,nlstate,xp,age,oldm,savm,ftolpl,ncvyearp,ij); |
prevalim(prlim,nlstate,xp,age,oldm,savm,ftolpl,ncvyearp,ij,nres); |
else |
else |
prevalim(prlim,nlstate,xp,age,oldm,savm,ftolpl,ncvyearp,ij); |
prevalim(prlim,nlstate,xp,age,oldm,savm,ftolpl,ncvyearp,ij,nres); |
for(i=1;i<=nlstate;i++){ |
for(i=1;i<=nlstate;i++){ |
gm[i] = prlim[i][i]; |
gm[i] = prlim[i][i]; |
mgm[theta][i] = prlim[i][i]; |
mgm[theta][i] = prlim[i][i]; |
Line 4433 void cvevsij(double ***eij, double x[],
|
Line 6186 void cvevsij(double ***eij, double x[],
|
for(i=1;i<=nlstate;i++) |
for(i=1;i<=nlstate;i++) |
varpl[i][(int)age] =0.; |
varpl[i][(int)age] =0.; |
if((int)age==79 ||(int)age== 80 ||(int)age== 81){ |
if((int)age==79 ||(int)age== 80 ||(int)age== 81){ |
matprod2(dnewm,trgradg,1,nlstate,1,npar,1,npar,matcov); |
matprod2(dnewmpar,trgradg,1,nlstate,1,npar,1,npar,matcov); |
matprod2(doldm,dnewm,1,nlstate,1,npar,1,nlstate,gradg); |
matprod2(doldm,dnewmpar,1,nlstate,1,npar,1,nlstate,gradg); |
}else{ |
}else{ |
matprod2(dnewm,trgradg,1,nlstate,1,npar,1,npar,matcov); |
matprod2(dnewmpar,trgradg,1,nlstate,1,npar,1,npar,matcov); |
matprod2(doldm,dnewm,1,nlstate,1,npar,1,nlstate,gradg); |
matprod2(doldm,dnewmpar,1,nlstate,1,npar,1,nlstate,gradg); |
} |
} |
for(i=1;i<=nlstate;i++) |
for(i=1;i<=nlstate;i++) |
varpl[i][(int)age] = doldm[i][i]; /* Covariances are useless */ |
varpl[i][(int)age] = doldm[i][i]; /* Covariances are useless */ |
|
|
fprintf(ficresvpl,"%.0f ",age ); |
fprintf(ficresvpl,"%.0f ",age ); |
|
if(nresult >=1) |
|
fprintf(ficresvpl,"%d ",nres ); |
for(i=1; i<=nlstate;i++) |
for(i=1; i<=nlstate;i++) |
fprintf(ficresvpl," %.5f (%.5f)",prlim[i][i],sqrt(varpl[i][(int)age])); |
fprintf(ficresvpl," %.5f (%.5f)",prlim[i][i],sqrt(varpl[i][(int)age])); |
fprintf(ficresvpl,"\n"); |
fprintf(ficresvpl,"\n"); |
Line 4456 void cvevsij(double ***eij, double x[],
|
Line 6211 void cvevsij(double ***eij, double x[],
|
|
|
free_vector(xp,1,npar); |
free_vector(xp,1,npar); |
free_matrix(doldm,1,nlstate,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; |
/* Variance of backward prevalence limit for each state ij using current parameters x[] and estimates of neighbourhood give by delti*/ |
int k2, l2, j1, z1; |
/* double **prevalim(double **prlim, int nlstate, double *xp, double age, double **oldm, double **savm,double ftolpl);*/ |
int k=0, l; |
|
int first=1, first1, first2; |
double **dnewmpar,**doldm; |
double cv12, mu1, mu2, lc1, lc2, v12, v21, v11, v22,v1,v2, c12, tnalp; |
int i, j, nhstepm, hstepm; |
double **dnewm,**doldm; |
|
double *xp; |
double *xp; |
double *gp, *gm; |
double *gp, *gm; |
double **gradg, **trgradg; |
double **gradg, **trgradg; |
double **mu; |
double **mgm, **mgp; |
double age, cov[NCOVMAX+1]; |
double age,agelim; |
double std=2.0; /* Number of standard deviation wide of confidence ellipsoids */ |
|
int theta; |
int theta; |
char fileresprob[FILENAMELENGTH]; |
|
char fileresprobcov[FILENAMELENGTH]; |
pstamp(ficresvbl); |
char fileresprobcor[FILENAMELENGTH]; |
fprintf(ficresvbl,"# Standard deviation of back (stable) prevalences \n"); |
double ***varpij; |
fprintf(ficresvbl,"# Age "); |
|
if(nresult >=1) |
strcpy(fileresprob,"PROB_"); |
fprintf(ficresvbl," Result# "); |
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(i=1; i<=nlstate;i++) |
for(j=1; j<=(nlstate+ndeath);j++){ |
fprintf(ficresvbl," %1d-%1d",i,i); |
fprintf(ficresprob," p%1d-%1d (SE)",i,j); |
fprintf(ficresvbl,"\n"); |
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); |
xp=vector(1,npar); |
dnewm=matrix(1,(nlstate)*(nlstate+ndeath),1,npar); |
dnewmpar=matrix(1,nlstate,1,npar); |
doldm=matrix(1,(nlstate)*(nlstate+ndeath),1,(nlstate)*(nlstate+ndeath)); |
doldm=matrix(1,nlstate,1,nlstate); |
mu=matrix(1,(nlstate)*(nlstate+ndeath), (int) bage, (int)fage); |
|
varpij=ma3x(1,nlstate*(nlstate+ndeath),1,nlstate*(nlstate+ndeath),(int) bage, (int) fage); |
hstepm=1*YEARM; /* Every year of age */ |
first=1; |
hstepm=hstepm/stepm; /* Typically in stepm units, if j= 2 years, = 2/6 months = 4 */ |
fprintf(ficgp,"\n# Routine varprob"); |
agelim = AGEINF; |
fprintf(fichtm,"\n<li><h4> Computing and drawing one step probabilities with their confidence intervals</h4></li>\n"); |
for (age=fage; age>=bage; age --){ /* If stepm=6 months */ |
fprintf(fichtm,"\n"); |
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); |
|
|
fprintf(fichtm,"\n<li><h4> <a href=\"%s\">Matrix of variance-covariance of one-step probabilities (drawings)</a></h4> this page is important in order to visualize confidence intervals and especially correlation between disability and recovery, or more generally, way in and way back.</li>\n",optionfilehtmcov); |
for(theta=1; theta <=npar; theta++){ |
fprintf(fichtmcov,"Current page is file <a href=\"%s\">%s</a><br>\n\n<h4>Matrix of variance-covariance of pairs of step probabilities</h4>\n",optionfilehtmcov, optionfilehtmcov); |
for(i=1; i<=npar; i++){ /* Computes gradient */ |
fprintf(fichtmcov,"\nEllipsoids of confidence centered on point (p<inf>ij</inf>, p<inf>kl</inf>) are estimated \ |
xp[i] = x[i] + (i==theta ?delti[theta]:0); |
|
} |
|
if(mobilavproj > 0 ) |
|
bprevalim(bprlim, mobaverage,nlstate,xp,age,ftolpl,ncvyearp,ij,nres); |
|
else |
|
bprevalim(bprlim, mobaverage,nlstate,xp,age,ftolpl,ncvyearp,ij,nres); |
|
for(i=1;i<=nlstate;i++){ |
|
gp[i] = bprlim[i][i]; |
|
mgp[theta][i] = bprlim[i][i]; |
|
} |
|
for(i=1; i<=npar; i++) /* Computes gradient */ |
|
xp[i] = x[i] - (i==theta ?delti[theta]:0); |
|
if(mobilavproj > 0 ) |
|
bprevalim(bprlim, mobaverage,nlstate,xp,age,ftolpl,ncvyearp,ij,nres); |
|
else |
|
bprevalim(bprlim, mobaverage,nlstate,xp,age,ftolpl,ncvyearp,ij,nres); |
|
for(i=1;i<=nlstate;i++){ |
|
gm[i] = bprlim[i][i]; |
|
mgm[theta][i] = bprlim[i][i]; |
|
} |
|
for(i=1;i<=nlstate;i++) |
|
gradg[theta][i]= (gp[i]-gm[i])/2./delti[theta]; |
|
/* gradg[theta][2]= -gradg[theta][1]; */ /* For testing if nlstate=2 */ |
|
} /* End theta */ |
|
|
|
trgradg =matrix(1,nlstate,1,npar); |
|
|
|
for(j=1; j<=nlstate;j++) |
|
for(theta=1; theta <=npar; theta++) |
|
trgradg[j][theta]=gradg[theta][j]; |
|
/* if((int)age==79 ||(int)age== 80 ||(int)age== 81 ){ */ |
|
/* printf("\nmgm mgp %d ",(int)age); */ |
|
/* for(j=1; j<=nlstate;j++){ */ |
|
/* printf(" %d ",j); */ |
|
/* for(theta=1; theta <=npar; theta++) */ |
|
/* printf(" %d %lf %lf",theta,mgm[theta][j],mgp[theta][j]); */ |
|
/* printf("\n "); */ |
|
/* } */ |
|
/* } */ |
|
/* if((int)age==79 ||(int)age== 80 ||(int)age== 81 ){ */ |
|
/* printf("\n gradg %d ",(int)age); */ |
|
/* for(j=1; j<=nlstate;j++){ */ |
|
/* printf("%d ",j); */ |
|
/* for(theta=1; theta <=npar; theta++) */ |
|
/* printf("%d %lf ",theta,gradg[theta][j]); */ |
|
/* printf("\n "); */ |
|
/* } */ |
|
/* } */ |
|
|
|
for(i=1;i<=nlstate;i++) |
|
varbpl[i][(int)age] =0.; |
|
if((int)age==79 ||(int)age== 80 ||(int)age== 81){ |
|
matprod2(dnewmpar,trgradg,1,nlstate,1,npar,1,npar,matcov); |
|
matprod2(doldm,dnewmpar,1,nlstate,1,npar,1,nlstate,gradg); |
|
}else{ |
|
matprod2(dnewmpar,trgradg,1,nlstate,1,npar,1,npar,matcov); |
|
matprod2(doldm,dnewmpar,1,nlstate,1,npar,1,nlstate,gradg); |
|
} |
|
for(i=1;i<=nlstate;i++) |
|
varbpl[i][(int)age] = doldm[i][i]; /* Covariances are useless */ |
|
|
|
fprintf(ficresvbl,"%.0f ",age ); |
|
if(nresult >=1) |
|
fprintf(ficresvbl,"%d ",nres ); |
|
for(i=1; i<=nlstate;i++) |
|
fprintf(ficresvbl," %.5f (%.5f)",bprlim[i][i],sqrt(varbpl[i][(int)age])); |
|
fprintf(ficresvbl,"\n"); |
|
free_vector(gp,1,nlstate); |
|
free_vector(gm,1,nlstate); |
|
free_matrix(mgm,1,npar,1,nlstate); |
|
free_matrix(mgp,1,npar,1,nlstate); |
|
free_matrix(gradg,1,npar,1,nlstate); |
|
free_matrix(trgradg,1,nlstate,1,npar); |
|
} /* End age */ |
|
|
|
free_vector(xp,1,npar); |
|
free_matrix(doldm,1,nlstate,1,npar); |
|
free_matrix(dnewmpar,1,nlstate,1,nlstate); |
|
|
|
} |
|
|
|
/************ Variance of one-step probabilities ******************/ |
|
void varprob(char optionfilefiname[], double **matcov, double x[], double delti[], int nlstate, double bage, double fage, int ij, int *Tvar, int **nbcode, int *ncodemax, char strstart[]) |
|
{ |
|
int i, j=0, k1, l1, tj; |
|
int k2, l2, j1, z1; |
|
int k=0, l; |
|
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<li><h4> Computing and drawing one step probabilities with their confidence intervals</h4></li>\n"); |
|
fprintf(fichtm,"\n"); |
|
|
|
fprintf(fichtm,"\n<li><h4> <a href=\"%s\">Matrix of variance-covariance of one-step probabilities (drawings)</a></h4> this page is important in order to visualize confidence intervals and especially correlation between disability and recovery, or more generally, way in and way back. %s</li>\n",optionfilehtmcov,optionfilehtmcov); |
|
fprintf(fichtmcov,"Current page is file <a href=\"%s\">%s</a><br>\n\n<h4>Matrix of variance-covariance of pairs of step probabilities</h4>\n",optionfilehtmcov, optionfilehtmcov); |
|
fprintf(fichtmcov,"\nEllipsoids of confidence centered on point (p<inf>ij</inf>, p<inf>kl</inf>) are estimated \ |
and drawn. It helps understanding how is the covariance between two incidences.\ |
and drawn. It helps understanding how is the covariance between two incidences.\ |
They are expressed in year<sup>-1</sup> in order to be less dependent of stepm.<br>\n"); |
They are expressed in year<sup>-1</sup> in order to be less dependent of stepm.<br>\n"); |
fprintf(fichtmcov,"\n<br> Contour plot corresponding to x'cov<sup>-1</sup>x = 4 (where x is the column vector (pij,pkl)) are drawn. \ |
fprintf(fichtmcov,"\n<br> Contour plot corresponding to x'cov<sup>-1</sup>x = 4 (where x is the column vector (pij,pkl)) are drawn. \ |
It can be understood this way: if pij and pkl where uncorrelated the (2x2) matrix of covariance \ |
It can be understood this way: if pij and pkl where uncorrelated the (2x2) matrix of covariance \ |
would have been (1/(var pij), 0 , 0, 1/(var pkl)), and the confidence interval would be 2 \ |
would have been (1/(var pij), 0 , 0, 1/(var pkl)), and the confidence interval would be 2 \ |
standard deviations wide on each axis. <br>\ |
standard deviations wide on each axis. <br>\ |
Line 4549 standard deviations wide on each axis. <
|
Line 6429 standard deviations wide on each axis. <
|
and made the appropriate rotation to look at the uncorrelated principal directions.<br>\ |
and made the appropriate rotation to look at the uncorrelated principal directions.<br>\ |
To be simple, these graphs help to understand the significativity of each parameter in relation to a second other one.<br> \n"); |
To be simple, these graphs help to understand the significativity of each parameter in relation to a second other one.<br> \n"); |
|
|
cov[1]=1; |
cov[1]=1; |
/* tj=cptcoveff; */ |
/* tj=cptcoveff; */ |
tj = (int) pow(2,cptcoveff); |
tj = (int) pow(2,cptcoveff); |
if (cptcovn<1) {tj=1;ncodemax[1]=1;} |
if (cptcovn<1) {tj=1;ncodemax[1]=1;} |
j1=0; |
j1=0; |
for(j1=1; j1<=tj;j1++){ |
for(j1=1; j1<=tj;j1++){ /* For each valid combination of covariates or only once*/ |
/*for(i1=1; i1<=ncodemax[t];i1++){ */ |
if (cptcovn>0) { |
/*j1++;*/ |
fprintf(ficresprob, "\n#********** Variable "); |
if (cptcovn>0) { |
for (z1=1; z1<=cptcoveff; z1++) fprintf(ficresprob, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); |
fprintf(ficresprob, "\n#********** Variable "); |
fprintf(ficresprob, "**********\n#\n"); |
for (z1=1; z1<=cptcoveff; z1++) fprintf(ficresprob, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); |
fprintf(ficresprobcov, "\n#********** Variable "); |
fprintf(ficresprob, "**********\n#\n"); |
for (z1=1; z1<=cptcoveff; z1++) fprintf(ficresprobcov, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); |
fprintf(ficresprobcov, "\n#********** Variable "); |
fprintf(ficresprobcov, "**********\n#\n"); |
for (z1=1; z1<=cptcoveff; z1++) fprintf(ficresprobcov, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); |
|
fprintf(ficresprobcov, "**********\n#\n"); |
fprintf(ficgp, "\n#********** Variable "); |
|
for (z1=1; z1<=cptcoveff; z1++) fprintf(ficgp, " V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); |
fprintf(ficgp, "\n#********** Variable "); |
fprintf(ficgp, "**********\n#\n"); |
for (z1=1; z1<=cptcoveff; z1++) fprintf(ficgp, " V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); |
|
fprintf(ficgp, "**********\n#\n"); |
|
|
fprintf(fichtmcov, "\n<hr size=\"2\" color=\"#EC5E5E\">********** Variable "); |
|
for (z1=1; z1<=cptcoveff; z1++) fprintf(fichtm, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); |
fprintf(fichtmcov, "\n<hr size=\"2\" color=\"#EC5E5E\">********** Variable "); |
fprintf(fichtmcov, "**********\n<hr size=\"2\" color=\"#EC5E5E\">"); |
for (z1=1; z1<=cptcoveff; z1++) fprintf(fichtm, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); |
|
fprintf(fichtmcov, "**********\n<hr size=\"2\" color=\"#EC5E5E\">"); |
fprintf(ficresprobcor, "\n#********** Variable "); |
|
for (z1=1; z1<=cptcoveff; z1++) fprintf(ficresprobcor, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); |
fprintf(ficresprobcor, "\n#********** Variable "); |
fprintf(ficresprobcor, "**********\n#"); |
for (z1=1; z1<=cptcoveff; z1++) fprintf(ficresprobcor, "V%d=%d ",Tvaraff[z1],nbcode[Tvaraff[z1]][codtabm(j1,z1)]); |
if(invalidvarcomb[j1]){ |
fprintf(ficresprobcor, "**********\n#"); |
fprintf(ficgp,"\n#Combination (%d) ignored because no cases \n",j1); |
} |
fprintf(fichtmcov,"\n<h3>Combination (%d) ignored because no cases </h3>\n",j1); |
|
continue; |
gradg=matrix(1,npar,1,(nlstate)*(nlstate+ndeath)); |
} |
trgradg=matrix(1,(nlstate)*(nlstate+ndeath),1,npar); |
} |
gp=vector(1,(nlstate)*(nlstate+ndeath)); |
gradg=matrix(1,npar,1,(nlstate)*(nlstate+ndeath)); |
gm=vector(1,(nlstate)*(nlstate+ndeath)); |
trgradg=matrix(1,(nlstate)*(nlstate+ndeath),1,npar); |
for (age=bage; age<=fage; age ++){ |
gp=vector(1,(nlstate)*(nlstate+ndeath)); |
cov[2]=age; |
gm=vector(1,(nlstate)*(nlstate+ndeath)); |
if(nagesqr==1) |
for (age=bage; age<=fage; age ++){ |
cov[3]= age*age; |
cov[2]=age; |
for (k=1; k<=cptcovn;k++) { |
if(nagesqr==1) |
cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(j1,k)]; |
cov[3]= age*age; |
/*cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(j1,Tvar[k])];*//* j1 1 2 3 4 |
for (k=1; k<=cptcovn;k++) { |
* 1 1 1 1 1 |
cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(j1,k)]; |
* 2 2 1 1 1 |
/*cov[2+nagesqr+k]=nbcode[Tvar[k]][codtabm(j1,Tvar[k])];*//* j1 1 2 3 4 |
* 3 1 2 1 1 |
* 1 1 1 1 1 |
*/ |
* 2 2 1 1 1 |
/* nbcode[1][1]=0 nbcode[1][2]=1;*/ |
* 3 1 2 1 1 |
} |
*/ |
/* for (k=1; k<=cptcovage;k++) cov[2+Tage[k]]=cov[2+Tage[k]]*cov[2]; */ |
/* nbcode[1][1]=0 nbcode[1][2]=1;*/ |
for (k=1; k<=cptcovage;k++) cov[2+Tage[k]]=nbcode[Tvar[Tage[k]]][codtabm(ij,k)]*cov[2]; |
} |
for (k=1; k<=cptcovprod;k++) |
/* for (k=1; k<=cptcovage;k++) cov[2+Tage[k]]=cov[2+Tage[k]]*cov[2]; */ |
cov[2+nagesqr+Tprod[k]]=nbcode[Tvard[k][1]][codtabm(ij,k)]*nbcode[Tvard[k][2]][codtabm(ij,k)]; |
for (k=1; k<=cptcovage;k++) cov[2+Tage[k]]=nbcode[Tvar[Tage[k]]][codtabm(ij,k)]*cov[2]; |
|
for (k=1; k<=cptcovprod;k++) |
|
cov[2+nagesqr+Tprod[k]]=nbcode[Tvard[k][1]][codtabm(ij,k)]*nbcode[Tvard[k][2]][codtabm(ij,k)]; |
for(theta=1; theta <=npar; theta++){ |
|
for(i=1; i<=npar; i++) |
|
xp[i] = x[i] + (i==theta ?delti[theta]:(double)0); |
for(theta=1; theta <=npar; theta++){ |
|
for(i=1; i<=npar; i++) |
pmij(pmmij,cov,ncovmodel,xp,nlstate); |
xp[i] = x[i] + (i==theta ?delti[theta]:(double)0); |
|
|
k=0; |
pmij(pmmij,cov,ncovmodel,xp,nlstate); |
for(i=1; i<= (nlstate); i++){ |
|
for(j=1; j<=(nlstate+ndeath);j++){ |
k=0; |
k=k+1; |
for(i=1; i<= (nlstate); i++){ |
gp[k]=pmmij[i][j]; |
for(j=1; j<=(nlstate+ndeath);j++){ |
} |
k=k+1; |
} |
gp[k]=pmmij[i][j]; |
|
} |
for(i=1; i<=npar; i++) |
} |
xp[i] = x[i] - (i==theta ?delti[theta]:(double)0); |
|
|
for(i=1; i<=npar; i++) |
pmij(pmmij,cov,ncovmodel,xp,nlstate); |
xp[i] = x[i] - (i==theta ?delti[theta]:(double)0); |
k=0; |
|
for(i=1; i<=(nlstate); i++){ |
pmij(pmmij,cov,ncovmodel,xp,nlstate); |
for(j=1; j<=(nlstate+ndeath);j++){ |
k=0; |
k=k+1; |
for(i=1; i<=(nlstate); i++){ |
gm[k]=pmmij[i][j]; |
for(j=1; j<=(nlstate+ndeath);j++){ |
} |
k=k+1; |
} |
gm[k]=pmmij[i][j]; |
|
} |
for(i=1; i<= (nlstate)*(nlstate+ndeath); i++) |
} |
gradg[theta][i]=(gp[i]-gm[i])/(double)2./delti[theta]; |
|
} |
for(i=1; i<= (nlstate)*(nlstate+ndeath); i++) |
|
gradg[theta][i]=(gp[i]-gm[i])/(double)2./delti[theta]; |
for(j=1; j<=(nlstate)*(nlstate+ndeath);j++) |
} |
for(theta=1; theta <=npar; theta++) |
|
trgradg[j][theta]=gradg[theta][j]; |
|
|
|
matprod2(dnewm,trgradg,1,(nlstate)*(nlstate+ndeath),1,npar,1,npar,matcov); |
|
matprod2(doldm,dnewm,1,(nlstate)*(nlstate+ndeath),1,npar,1,(nlstate)*(nlstate+ndeath),gradg); |
|
|
|
pmij(pmmij,cov,ncovmodel,x,nlstate); |
|
|
|
k=0; |
|
for(i=1; i<=(nlstate); i++){ |
|
for(j=1; j<=(nlstate+ndeath);j++){ |
|
k=k+1; |
|
mu[k][(int) age]=pmmij[i][j]; |
|
} |
|
} |
|
for(i=1;i<=(nlstate)*(nlstate+ndeath);i++) |
|
for(j=1;j<=(nlstate)*(nlstate+ndeath);j++) |
|
varpij[i][j][(int)age] = doldm[i][j]; |
|
|
|
/*printf("\n%d ",(int)age); |
|
for (i=1; i<=(nlstate)*(nlstate+ndeath);i++){ |
|
printf("%e [%e ;%e] ",gm[i],gm[i]-2*sqrt(doldm[i][i]),gm[i]+2*sqrt(doldm[i][i])); |
|
fprintf(ficlog,"%e [%e ;%e] ",gm[i],gm[i]-2*sqrt(doldm[i][i]),gm[i]+2*sqrt(doldm[i][i])); |
|
}*/ |
|
|
|
fprintf(ficresprob,"\n%d ",(int)age); |
|
fprintf(ficresprobcov,"\n%d ",(int)age); |
|
fprintf(ficresprobcor,"\n%d ",(int)age); |
|
|
|
for (i=1; i<=(nlstate)*(nlstate+ndeath);i++) |
|
fprintf(ficresprob,"%11.3e (%11.3e) ",mu[i][(int) age],sqrt(varpij[i][i][(int)age])); |
|
for (i=1; i<=(nlstate)*(nlstate+ndeath);i++){ |
|
fprintf(ficresprobcov,"%11.3e ",mu[i][(int) age]); |
|
fprintf(ficresprobcor,"%11.3e ",mu[i][(int) age]); |
|
} |
|
i=0; |
|
for (k=1; k<=(nlstate);k++){ |
|
for (l=1; l<=(nlstate+ndeath);l++){ |
|
i++; |
|
fprintf(ficresprobcov,"\n%d %d-%d",(int)age,k,l); |
|
fprintf(ficresprobcor,"\n%d %d-%d",(int)age,k,l); |
|
for (j=1; j<=i;j++){ |
|
/* printf(" k=%d l=%d i=%d j=%d\n",k,l,i,j);fflush(stdout); */ |
|
fprintf(ficresprobcov," %11.3e",varpij[i][j][(int)age]); |
|
fprintf(ficresprobcor," %11.3e",varpij[i][j][(int) age]/sqrt(varpij[i][i][(int) age])/sqrt(varpij[j][j][(int)age])); |
|
} |
|
} |
|
}/* end of loop for state */ |
|
} /* end of loop for age */ |
|
free_vector(gp,1,(nlstate+ndeath)*(nlstate+ndeath)); |
|
free_vector(gm,1,(nlstate+ndeath)*(nlstate+ndeath)); |
|
free_matrix(trgradg,1,(nlstate+ndeath)*(nlstate+ndeath),1,npar); |
|
free_matrix(gradg,1,(nlstate+ndeath)*(nlstate+ndeath),1,npar); |
|
|
|
/* Confidence intervalle of pij */ |
|
/* |
|
fprintf(ficgp,"\nunset parametric;unset label"); |
|
fprintf(ficgp,"\nset log y;unset log x; set xlabel \"Age\";set ylabel \"probability (year-1)\""); |
|
fprintf(ficgp,"\nset ter png small\nset size 0.65,0.65"); |
|
fprintf(fichtm,"\n<br>Probability with confidence intervals expressed in year<sup>-1</sup> :<a href=\"pijgr%s.png\">pijgr%s.png</A>, ",optionfilefiname,optionfilefiname); |
|
fprintf(fichtm,"\n<br><img src=\"pijgr%s.png\"> ",optionfilefiname); |
|
fprintf(ficgp,"\nset out \"pijgr%s.png\"",optionfilefiname); |
|
fprintf(ficgp,"\nplot \"%s\" every :::%d::%d u 1:2 \"\%%lf",k1,k2,xfilevarprob); |
|
*/ |
|
|
|
/* Drawing ellipsoids of confidence of two variables p(k1-l1,k2-l2)*/ |
|
first1=1;first2=2; |
|
for (k2=1; k2<=(nlstate);k2++){ |
|
for (l2=1; l2<=(nlstate+ndeath);l2++){ |
|
if(l2==k2) continue; |
|
j=(k2-1)*(nlstate+ndeath)+l2; |
|
for (k1=1; k1<=(nlstate);k1++){ |
|
for (l1=1; l1<=(nlstate+ndeath);l1++){ |
|
if(l1==k1) continue; |
|
i=(k1-1)*(nlstate+ndeath)+l1; |
|
if(i<=j) continue; |
|
for (age=bage; age<=fage; age ++){ |
|
if ((int)age %5==0){ |
|
v1=varpij[i][i][(int)age]/stepm*YEARM/stepm*YEARM; |
|
v2=varpij[j][j][(int)age]/stepm*YEARM/stepm*YEARM; |
|
cv12=varpij[i][j][(int)age]/stepm*YEARM/stepm*YEARM; |
|
mu1=mu[i][(int) age]/stepm*YEARM ; |
|
mu2=mu[j][(int) age]/stepm*YEARM; |
|
c12=cv12/sqrt(v1*v2); |
|
/* Computing eigen value of matrix of covariance */ |
|
lc1=((v1+v2)+sqrt((v1+v2)*(v1+v2) - 4*(v1*v2-cv12*cv12)))/2.; |
|
lc2=((v1+v2)-sqrt((v1+v2)*(v1+v2) - 4*(v1*v2-cv12*cv12)))/2.; |
|
if ((lc2 <0) || (lc1 <0) ){ |
|
if(first2==1){ |
|
first1=0; |
|
printf("Strange: j1=%d One eigen value of 2x2 matrix of covariance is negative, lc1=%11.3e, lc2=%11.3e, v1=%11.3e, v2=%11.3e, cv12=%11.3e.\n It means that the matrix was not well estimated (varpij), for i=%2d, j=%2d, age=%4d .\n See files %s and %s. Probably WRONG RESULTS. See log file for details...\n", j1, lc1, lc2, v1, v2, cv12, i, j, (int)age,fileresprobcov, fileresprobcor); |
|
} |
|
fprintf(ficlog,"Strange: j1=%d One eigen value of 2x2 matrix of covariance is negative, lc1=%11.3e, lc2=%11.3e, v1=%11.3e, v2=%11.3e, cv12=%11.3e.\n It means that the matrix was not well estimated (varpij), for i=%2d, j=%2d, age=%4d .\n See files %s and %s. Probably WRONG RESULTS.\n", j1, lc1, lc2, v1, v2, cv12, i, j, (int)age,fileresprobcov, fileresprobcor);fflush(ficlog); |
|
/* lc1=fabs(lc1); */ /* If we want to have them positive */ |
|
/* lc2=fabs(lc2); */ |
|
} |
|
|
|
/* Eigen vectors */ |
for(j=1; j<=(nlstate)*(nlstate+ndeath);j++) |
v11=(1./sqrt(1+(v1-lc1)*(v1-lc1)/cv12/cv12)); |
for(theta=1; theta <=npar; theta++) |
/*v21=sqrt(1.-v11*v11); *//* error */ |
trgradg[j][theta]=gradg[theta][j]; |
v21=(lc1-v1)/cv12*v11; |
|
v12=-v21; |
matprod2(dnewm,trgradg,1,(nlstate)*(nlstate+ndeath),1,npar,1,npar,matcov); |
v22=v11; |
matprod2(doldm,dnewm,1,(nlstate)*(nlstate+ndeath),1,npar,1,(nlstate)*(nlstate+ndeath),gradg); |
tnalp=v21/v11; |
|
if(first1==1){ |
pmij(pmmij,cov,ncovmodel,x,nlstate); |
first1=0; |
|
printf("%d %d%d-%d%d mu %.4e %.4e Var %.4e %.4e cor %.3f cov %.4e Eig %.3e %.3e 1stv %.3f %.3f tang %.3f\nOthers in log...\n",(int) age,k1,l1,k2,l2,mu1,mu2,v1,v2,c12,cv12,lc1,lc2,v11,v21,tnalp); |
k=0; |
} |
for(i=1; i<=(nlstate); i++){ |
fprintf(ficlog,"%d %d%d-%d%d mu %.4e %.4e Var %.4e %.4e cor %.3f cov %.4e Eig %.3e %.3e 1stv %.3f %.3f tan %.3f\n",(int) age,k1,l1,k2,l2,mu1,mu2,v1,v2,c12,cv12,lc1,lc2,v11,v21,tnalp); |
for(j=1; j<=(nlstate+ndeath);j++){ |
/*printf(fignu*/ |
k=k+1; |
/* mu1+ v11*lc1*cost + v12*lc2*sin(t) */ |
mu[k][(int) age]=pmmij[i][j]; |
/* mu2+ v21*lc1*cost + v22*lc2*sin(t) */ |
} |
if(first==1){ |
} |
first=0; |
for(i=1;i<=(nlstate)*(nlstate+ndeath);i++) |
fprintf(ficgp,"\n# Ellipsoids of confidence\n#\n"); |
for(j=1;j<=(nlstate)*(nlstate+ndeath);j++) |
fprintf(ficgp,"\nset parametric;unset label"); |
varpij[i][j][(int)age] = doldm[i][j]; |
fprintf(ficgp,"\nset log y;set log x; set xlabel \"p%1d%1d (year-1)\";set ylabel \"p%1d%1d (year-1)\"",k1,l1,k2,l2); |
|
fprintf(ficgp,"\nset ter svg size 640, 480"); |
/*printf("\n%d ",(int)age); |
fprintf(fichtmcov,"\n<br>Ellipsoids of confidence cov(p%1d%1d,p%1d%1d) expressed in year<sup>-1</sup>\ |
for (i=1; i<=(nlstate)*(nlstate+ndeath);i++){ |
:<a href=\"%s_%d%1d%1d-%1d%1d.svg\">\ |
printf("%e [%e ;%e] ",gm[i],gm[i]-2*sqrt(doldm[i][i]),gm[i]+2*sqrt(doldm[i][i])); |
|
fprintf(ficlog,"%e [%e ;%e] ",gm[i],gm[i]-2*sqrt(doldm[i][i]),gm[i]+2*sqrt(doldm[i][i])); |
|
}*/ |
|
|
|
fprintf(ficresprob,"\n%d ",(int)age); |
|
fprintf(ficresprobcov,"\n%d ",(int)age); |
|
fprintf(ficresprobcor,"\n%d ",(int)age); |
|
|
|
for (i=1; i<=(nlstate)*(nlstate+ndeath);i++) |
|
fprintf(ficresprob,"%11.3e (%11.3e) ",mu[i][(int) age],sqrt(varpij[i][i][(int)age])); |
|
for (i=1; i<=(nlstate)*(nlstate+ndeath);i++){ |
|
fprintf(ficresprobcov,"%11.3e ",mu[i][(int) age]); |
|
fprintf(ficresprobcor,"%11.3e ",mu[i][(int) age]); |
|
} |
|
i=0; |
|
for (k=1; k<=(nlstate);k++){ |
|
for (l=1; l<=(nlstate+ndeath);l++){ |
|
i++; |
|
fprintf(ficresprobcov,"\n%d %d-%d",(int)age,k,l); |
|
fprintf(ficresprobcor,"\n%d %d-%d",(int)age,k,l); |
|
for (j=1; j<=i;j++){ |
|
/* printf(" k=%d l=%d i=%d j=%d\n",k,l,i,j);fflush(stdout); */ |
|
fprintf(ficresprobcov," %11.3e",varpij[i][j][(int)age]); |
|
fprintf(ficresprobcor," %11.3e",varpij[i][j][(int) age]/sqrt(varpij[i][i][(int) age])/sqrt(varpij[j][j][(int)age])); |
|
} |
|
} |
|
}/* end of loop for state */ |
|
} /* end of loop for age */ |
|
free_vector(gp,1,(nlstate+ndeath)*(nlstate+ndeath)); |
|
free_vector(gm,1,(nlstate+ndeath)*(nlstate+ndeath)); |
|
free_matrix(trgradg,1,(nlstate+ndeath)*(nlstate+ndeath),1,npar); |
|
free_matrix(gradg,1,(nlstate+ndeath)*(nlstate+ndeath),1,npar); |
|
|
|
/* Confidence intervalle of pij */ |
|
/* |
|
fprintf(ficgp,"\nunset parametric;unset label"); |
|
fprintf(ficgp,"\nset log y;unset log x; set xlabel \"Age\";set ylabel \"probability (year-1)\""); |
|
fprintf(ficgp,"\nset ter png small\nset size 0.65,0.65"); |
|
fprintf(fichtm,"\n<br>Probability with confidence intervals expressed in year<sup>-1</sup> :<a href=\"pijgr%s.png\">pijgr%s.png</A>, ",optionfilefiname,optionfilefiname); |
|
fprintf(fichtm,"\n<br><img src=\"pijgr%s.png\"> ",optionfilefiname); |
|
fprintf(ficgp,"\nset out \"pijgr%s.png\"",optionfilefiname); |
|
fprintf(ficgp,"\nplot \"%s\" every :::%d::%d u 1:2 \"\%%lf",k1,k2,xfilevarprob); |
|
*/ |
|
|
|
/* Drawing ellipsoids of confidence of two variables p(k1-l1,k2-l2)*/ |
|
first1=1;first2=2; |
|
for (k2=1; k2<=(nlstate);k2++){ |
|
for (l2=1; l2<=(nlstate+ndeath);l2++){ |
|
if(l2==k2) continue; |
|
j=(k2-1)*(nlstate+ndeath)+l2; |
|
for (k1=1; k1<=(nlstate);k1++){ |
|
for (l1=1; l1<=(nlstate+ndeath);l1++){ |
|
if(l1==k1) continue; |
|
i=(k1-1)*(nlstate+ndeath)+l1; |
|
if(i<=j) continue; |
|
for (age=bage; age<=fage; age ++){ |
|
if ((int)age %5==0){ |
|
v1=varpij[i][i][(int)age]/stepm*YEARM/stepm*YEARM; |
|
v2=varpij[j][j][(int)age]/stepm*YEARM/stepm*YEARM; |
|
cv12=varpij[i][j][(int)age]/stepm*YEARM/stepm*YEARM; |
|
mu1=mu[i][(int) age]/stepm*YEARM ; |
|
mu2=mu[j][(int) age]/stepm*YEARM; |
|
c12=cv12/sqrt(v1*v2); |
|
/* Computing eigen value of matrix of covariance */ |
|
lc1=((v1+v2)+sqrt((v1+v2)*(v1+v2) - 4*(v1*v2-cv12*cv12)))/2.; |
|
lc2=((v1+v2)-sqrt((v1+v2)*(v1+v2) - 4*(v1*v2-cv12*cv12)))/2.; |
|
if ((lc2 <0) || (lc1 <0) ){ |
|
if(first2==1){ |
|
first1=0; |
|
printf("Strange: j1=%d One eigen value of 2x2 matrix of covariance is negative, lc1=%11.3e, lc2=%11.3e, v1=%11.3e, v2=%11.3e, cv12=%11.3e.\n It means that the matrix was not well estimated (varpij), for i=%2d, j=%2d, age=%4d .\n See files %s and %s. Probably WRONG RESULTS. See log file for details...\n", j1, lc1, lc2, v1, v2, cv12, i, j, (int)age,fileresprobcov, fileresprobcor); |
|
} |
|
fprintf(ficlog,"Strange: j1=%d One eigen value of 2x2 matrix of covariance is negative, lc1=%11.3e, lc2=%11.3e, v1=%11.3e, v2=%11.3e, cv12=%11.3e.\n It means that the matrix was not well estimated (varpij), for i=%2d, j=%2d, age=%4d .\n See files %s and %s. Probably WRONG RESULTS.\n", j1, lc1, lc2, v1, v2, cv12, i, j, (int)age,fileresprobcov, fileresprobcor);fflush(ficlog); |
|
/* lc1=fabs(lc1); */ /* If we want to have them positive */ |
|
/* lc2=fabs(lc2); */ |
|
} |
|
|
|
/* Eigen vectors */ |
|
v11=(1./sqrt(1+(v1-lc1)*(v1-lc1)/cv12/cv12)); |
|
/*v21=sqrt(1.-v11*v11); *//* error */ |
|
v21=(lc1-v1)/cv12*v11; |
|
v12=-v21; |
|
v22=v11; |
|
tnalp=v21/v11; |
|
if(first1==1){ |
|
first1=0; |
|
printf("%d %d%d-%d%d mu %.4e %.4e Var %.4e %.4e cor %.3f cov %.4e Eig %.3e %.3e 1stv %.3f %.3f tang %.3f\nOthers in log...\n",(int) age,k1,l1,k2,l2,mu1,mu2,v1,v2,c12,cv12,lc1,lc2,v11,v21,tnalp); |
|
} |
|
fprintf(ficlog,"%d %d%d-%d%d mu %.4e %.4e Var %.4e %.4e cor %.3f cov %.4e Eig %.3e %.3e 1stv %.3f %.3f tan %.3f\n",(int) age,k1,l1,k2,l2,mu1,mu2,v1,v2,c12,cv12,lc1,lc2,v11,v21,tnalp); |
|
/*printf(fignu*/ |
|
/* mu1+ v11*lc1*cost + v12*lc2*sin(t) */ |
|
/* mu2+ v21*lc1*cost + v22*lc2*sin(t) */ |
|
if(first==1){ |
|
first=0; |
|
fprintf(ficgp,"\n# Ellipsoids of confidence\n#\n"); |
|
fprintf(ficgp,"\nset parametric;unset label"); |
|
fprintf(ficgp,"\nset log y;set log x; set xlabel \"p%1d%1d (year-1)\";set ylabel \"p%1d%1d (year-1)\"",k1,l1,k2,l2); |
|
fprintf(ficgp,"\nset ter svg size 640, 480"); |
|
fprintf(fichtmcov,"\n<p><br>Ellipsoids of confidence cov(p%1d%1d,p%1d%1d) expressed in year<sup>-1</sup>\ |
|
:<a href=\"%s_%d%1d%1d-%1d%1d.svg\"> \ |
%s_%d%1d%1d-%1d%1d.svg</A>, ",k1,l1,k2,l2,\ |
%s_%d%1d%1d-%1d%1d.svg</A>, ",k1,l1,k2,l2,\ |
subdirf2(optionfilefiname,"VARPIJGR_"), j1,k1,l1,k2,l2,\ |
subdirf2(optionfilefiname,"VARPIJGR_"), j1,k1,l1,k2,l2, \ |
subdirf2(optionfilefiname,"VARPIJGR_"), j1,k1,l1,k2,l2); |
subdirf2(optionfilefiname,"VARPIJGR_"), j1,k1,l1,k2,l2); |
fprintf(fichtmcov,"\n<br><img src=\"%s_%d%1d%1d-%1d%1d.svg\"> ",subdirf2(optionfilefiname,"VARPIJGR_"), j1,k1,l1,k2,l2); |
fprintf(fichtmcov,"\n<br><img src=\"%s_%d%1d%1d-%1d%1d.svg\"> ",subdirf2(optionfilefiname,"VARPIJGR_"), j1,k1,l1,k2,l2); |
fprintf(fichtmcov,"\n<br> Correlation at age %d (%.3f),",(int) age, c12); |
fprintf(fichtmcov,"\n<br> Correlation at age %d (%.3f),",(int) age, c12); |
fprintf(ficgp,"\nset out \"%s_%d%1d%1d-%1d%1d.svg\"",subdirf2(optionfilefiname,"VARPIJGR_"), j1,k1,l1,k2,l2); |
fprintf(ficgp,"\nset out \"%s_%d%1d%1d-%1d%1d.svg\"",subdirf2(optionfilefiname,"VARPIJGR_"), j1,k1,l1,k2,l2); |
fprintf(ficgp,"\nset label \"%d\" at %11.3e,%11.3e center",(int) age, mu1,mu2); |
fprintf(ficgp,"\nset label \"%d\" at %11.3e,%11.3e center",(int) age, mu1,mu2); |
fprintf(ficgp,"\n# Age %d, p%1d%1d - p%1d%1d",(int) age, k1,l1,k2,l2); |
fprintf(ficgp,"\n# Age %d, p%1d%1d - p%1d%1d",(int) age, k1,l1,k2,l2); |
fprintf(ficgp,"\nplot [-pi:pi] %11.3e+ %.3f*(%11.3e*%11.3e*cos(t)+%11.3e*%11.3e*sin(t)), %11.3e +%.3f*(%11.3e*%11.3e*cos(t)+%11.3e*%11.3e*sin(t)) not",\ |
fprintf(ficgp,"\nplot [-pi:pi] %11.3e+ %.3f*(%11.3e*%11.3e*cos(t)+%11.3e*%11.3e*sin(t)), %11.3e +%.3f*(%11.3e*%11.3e*cos(t)+%11.3e*%11.3e*sin(t)) not", \ |
mu1,std,v11,sqrt(lc1),v12,sqrt(lc2),\ |
mu1,std,v11,sqrt(lc1),v12,sqrt(fabs(lc2)), \ |
mu2,std,v21,sqrt(lc1),v22,sqrt(lc2)); |
mu2,std,v21,sqrt(lc1),v22,sqrt(fabs(lc2))); /* For gnuplot only */ |
}else{ |
}else{ |
first=0; |
first=0; |
fprintf(fichtmcov," %d (%.3f),",(int) age, c12); |
fprintf(fichtmcov," %d (%.3f),",(int) age, c12); |
fprintf(ficgp,"\n# Age %d, p%1d%1d - p%1d%1d",(int) age, k1,l1,k2,l2); |
fprintf(ficgp,"\n# Age %d, p%1d%1d - p%1d%1d",(int) age, k1,l1,k2,l2); |
fprintf(ficgp,"\nset label \"%d\" at %11.3e,%11.3e center",(int) age, mu1,mu2); |
fprintf(ficgp,"\nset label \"%d\" at %11.3e,%11.3e center",(int) age, mu1,mu2); |
fprintf(ficgp,"\nreplot %11.3e+ %.3f*(%11.3e*%11.3e*cos(t)+%11.3e*%11.3e*sin(t)), %11.3e +%.3f*(%11.3e*%11.3e*cos(t)+%11.3e*%11.3e*sin(t)) not",\ |
fprintf(ficgp,"\nreplot %11.3e+ %.3f*(%11.3e*%11.3e*cos(t)+%11.3e*%11.3e*sin(t)), %11.3e +%.3f*(%11.3e*%11.3e*cos(t)+%11.3e*%11.3e*sin(t)) not", \ |
mu1,std,v11,sqrt(lc1),v12,sqrt(lc2),\ |
mu1,std,v11,sqrt(lc1),v12,sqrt(fabs(lc2)), \ |
mu2,std,v21,sqrt(lc1),v22,sqrt(lc2)); |
mu2,std,v21,sqrt(lc1),v22,sqrt(fabs(lc2))); |
}/* if first */ |
}/* if first */ |
} /* age mod 5 */ |
} /* age mod 5 */ |
} /* end loop age */ |
} /* end loop age */ |
fprintf(ficgp,"\nset out;\nset out \"%s_%d%1d%1d-%1d%1d.svg\";replot;set out;",subdirf2(optionfilefiname,"VARPIJGR_"), j1,k1,l1,k2,l2); |
fprintf(ficgp,"\nset out;\nset out \"%s_%d%1d%1d-%1d%1d.svg\";replot;set out;",subdirf2(optionfilefiname,"VARPIJGR_"), j1,k1,l1,k2,l2); |
first=1; |
first=1; |
} /*l12 */ |
} /*l12 */ |
} /* k12 */ |
} /* k12 */ |
} /*l1 */ |
} /*l1 */ |
}/* k1 */ |
}/* k1 */ |
/* } */ /* loop covariates */ |
} /* loop on combination of covariates j1 */ |
} |
free_ma3x(varpij,1,nlstate,1,nlstate+ndeath,(int) bage, (int)fage); |
free_ma3x(varpij,1,nlstate,1,nlstate+ndeath,(int) bage, (int)fage); |
free_matrix(mu,1,(nlstate+ndeath)*(nlstate+ndeath),(int) bage, (int)fage); |
free_matrix(mu,1,(nlstate+ndeath)*(nlstate+ndeath),(int) bage, (int)fage); |
free_matrix(doldm,1,(nlstate)*(nlstate+ndeath),1,(nlstate)*(nlstate+ndeath)); |
free_matrix(doldm,1,(nlstate)*(nlstate+ndeath),1,(nlstate)*(nlstate+ndeath)); |
free_matrix(dnewm,1,(nlstate)*(nlstate+ndeath),1,npar); |
free_matrix(dnewm,1,(nlstate)*(nlstate+ndeath),1,npar); |
free_vector(xp,1,npar); |
free_vector(xp,1,npar); |
fclose(ficresprob); |
fclose(ficresprob); |
fclose(ficresprobcov); |
fclose(ficresprobcov); |
fclose(ficresprobcor); |
fclose(ficresprobcor); |
fflush(ficgp); |
fflush(ficgp); |
fflush(fichtmcov); |
fflush(fichtmcov); |
} |
} |
|
|
|
|
|
/******************* Printing html file ***********/ |
/******************* Printing html file ***********/ |
void printinghtml(char fileresu[], char title[], char datafile[], int firstpass, \ |
void printinghtml(char fileresu[], char title[], char datafile[], int firstpass, \ |
int lastpass, int stepm, int weightopt, char model[],\ |
int lastpass, int stepm, int weightopt, char model[],\ |
int imx,int jmin, int jmax, double jmeanint,char rfileres[],\ |
int imx,int jmin, int jmax, double jmeanint,char rfileres[],\ |
int popforecast, int estepm ,\ |
int popforecast, int mobilav, int prevfcast, int mobilavproj, int backcast, int estepm , \ |
double jprev1, double mprev1,double anprev1, \ |
double jprev1, double mprev1,double anprev1, double dateprev1, double dateproj1, double dateback1, \ |
double jprev2, double mprev2,double anprev2){ |
double jprev2, double mprev2,double anprev2, double dateprev2, double dateproj2, double dateback2){ |
int jj1, k1, i1, cpt; |
int jj1, k1, i1, cpt, k4, nres; |
|
|
fprintf(fichtm,"<ul><li><a href='#firstorder'>Result files (first order: no variance)</a>\n \ |
fprintf(fichtm,"<ul><li><a href='#firstorder'>Result files (first order: no variance)</a>\n \ |
<li><a href='#secondorder'>Result files (second order (variance)</a>\n \ |
<li><a href='#secondorder'>Result files (second order (variance)</a>\n \ |
</ul>"); |
</ul>"); |
fprintf(fichtm,"<ul><li><h4><a name='firstorder'>Result files (first order: no variance)</a></h4>\n \ |
fprintf(fichtm,"<ul><li> model=1+age+%s\n \ |
- Observed prevalence in each state (during the period defined between %.lf/%.lf/%.lf and %.lf/%.lf/%.lf): <a href=\"%s\">%s</a> <br>\n ", |
</ul>", model); |
jprev1, mprev1,anprev1,jprev2, mprev2,anprev2,subdirf2(fileresu,"P_"),subdirf2(fileresu,"P_")); |
fprintf(fichtm,"<ul><li><h4><a name='firstorder'>Result files (first order: no variance)</a></h4>\n"); |
|
fprintf(fichtm,"<li>- Observed frequency between two states (during the period defined between %.lf/%.lf/%.lf and %.lf/%.lf/%.lf): <a href=\"%s\">%s</a> (html file)<br/>\n", |
|
jprev1, mprev1,anprev1,jprev2, mprev2,anprev2,subdirfext3(optionfilefiname,"PHTMFR_",".htm"),subdirfext3(optionfilefiname,"PHTMFR_",".htm")); |
|
fprintf(fichtm,"<li> - Observed prevalence in each state (during the period defined between %.lf/%.lf/%.lf and %.lf/%.lf/%.lf): <a href=\"%s\">%s</a> (html file) ", |
|
jprev1, mprev1,anprev1,jprev2, mprev2,anprev2,subdirfext3(optionfilefiname,"PHTM_",".htm"),subdirfext3(optionfilefiname,"PHTM_",".htm")); |
|
fprintf(fichtm,", <a href=\"%s\">%s</a> (text file) <br>\n",subdirf2(fileresu,"P_"),subdirf2(fileresu,"P_")); |
fprintf(fichtm,"\ |
fprintf(fichtm,"\ |
- Estimated transition probabilities over %d (stepm) months: <a href=\"%s\">%s</a><br>\n ", |
- Estimated transition probabilities over %d (stepm) months: <a href=\"%s\">%s</a><br>\n ", |
stepm,subdirf2(fileresu,"PIJ_"),subdirf2(fileresu,"PIJ_")); |
stepm,subdirf2(fileresu,"PIJ_"),subdirf2(fileresu,"PIJ_")); |
fprintf(fichtm,"\ |
fprintf(fichtm,"\ |
|
- Estimated back transition probabilities over %d (stepm) months: <a href=\"%s\">%s</a><br>\n ", |
|
stepm,subdirf2(fileresu,"PIJB_"),subdirf2(fileresu,"PIJB_")); |
|
fprintf(fichtm,"\ |
- Period (stable) prevalence in each health state: <a href=\"%s\">%s</a> <br>\n", |
- Period (stable) prevalence in each health state: <a href=\"%s\">%s</a> <br>\n", |
subdirf2(fileresu,"PL_"),subdirf2(fileresu,"PL_")); |
subdirf2(fileresu,"PL_"),subdirf2(fileresu,"PL_")); |
fprintf(fichtm,"\ |
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): \ |
- Period (stable) back prevalence in each health state: <a href=\"%s\">%s</a> <br>\n", |
|
subdirf2(fileresu,"PLB_"),subdirf2(fileresu,"PLB_")); |
|
fprintf(fichtm,"\ |
|
- (a) Life expectancies by health status at initial age, e<sub>i.</sub> (b) health expectancies by health status at initial age, e<sub>ij</sub> . 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): \ |
<a href=\"%s\">%s</a> <br>\n", |
<a href=\"%s\">%s</a> <br>\n", |
estepm,subdirf2(fileresu,"E_"),subdirf2(fileresu,"E_")); |
estepm,subdirf2(fileresu,"E_"),subdirf2(fileresu,"E_")); |
fprintf(fichtm,"\ |
if(prevfcast==1){ |
- Population projections by age and states: \ |
fprintf(fichtm,"\ |
|
- Prevalence projections by age and states: \ |
<a href=\"%s\">%s</a> <br>\n</li>", subdirf2(fileresu,"F_"),subdirf2(fileresu,"F_")); |
<a href=\"%s\">%s</a> <br>\n</li>", subdirf2(fileresu,"F_"),subdirf2(fileresu,"F_")); |
|
} |
|
|
|
|
fprintf(fichtm," \n<ul><li><b>Graphs</b></li><p>"); |
m=pow(2,cptcoveff); |
|
if (cptcovn < 1) {m=1;ncodemax[1]=1;} |
|
|
m=pow(2,cptcoveff); |
fprintf(fichtm," \n<ul><li><b>Graphs</b></li><p>"); |
if (cptcovn < 1) {m=1;ncodemax[1]=1;} |
|
|
|
jj1=0; |
jj1=0; |
for(k1=1; k1<=m;k1++){ |
|
/* for(i1=1; i1<=ncodemax[k1];i1++){ */ |
fprintf(fichtm," \n<ul>"); |
|
for(nres=1; nres <= nresult; nres++) /* For each resultline */ |
|
for(k1=1; k1<=m;k1++){ /* For each combination of covariate */ |
|
if(m != 1 && TKresult[nres]!= k1) |
|
continue; |
jj1++; |
jj1++; |
if (cptcovn > 0) { |
if (cptcovn > 0) { |
fprintf(fichtm,"<hr size=\"2\" color=\"#EC5E5E\">************ Results for covariates"); |
fprintf(fichtm,"\n<li><a size=\"1\" color=\"#EC5E5E\" href=\"#rescov"); |
for (cpt=1; cpt<=cptcoveff;cpt++){ |
for (cpt=1; cpt<=cptcoveff;cpt++){ |
fprintf(fichtm," V%d=%d ",Tvaraff[cpt],nbcode[Tvaraff[cpt]][codtabm(jj1,cpt)]); |
fprintf(fichtm,"_V%d=%d_",Tvresult[nres][cpt],(int)Tresult[nres][cpt]); |
printf(" V%d=%d ",Tvaraff[cpt],nbcode[Tvaraff[cpt]][codtabm(jj1,cpt)]);fflush(stdout); |
|
} |
} |
|
for (k4=1; k4<= nsq; k4++){ /* For each selected (single) quantitative value */ |
|
fprintf(fichtm,"_V%d=%f_",Tvqresult[nres][k4],Tqresult[nres][k4]); |
|
} |
|
fprintf(fichtm,"\">"); |
|
|
|
/* if(nqfveff+nqtveff 0) */ /* Test to be done */ |
|
fprintf(fichtm,"************ Results for covariates"); |
|
for (cpt=1; cpt<=cptcoveff;cpt++){ |
|
fprintf(fichtm," V%d=%d ",Tvresult[nres][cpt],(int)Tresult[nres][cpt]); |
|
} |
|
for (k4=1; k4<= nsq; k4++){ /* For each selected (single) quantitative value */ |
|
fprintf(fichtm," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); |
|
} |
|
if(invalidvarcomb[k1]){ |
|
fprintf(fichtm," Warning Combination (%d) ignored because no cases ",k1); |
|
continue; |
|
} |
|
fprintf(fichtm,"</a></li>"); |
|
} /* cptcovn >0 */ |
|
} |
|
fprintf(fichtm," \n</ul>"); |
|
|
|
jj1=0; |
|
|
|
for(nres=1; nres <= nresult; nres++) /* For each resultline */ |
|
for(k1=1; k1<=m;k1++){ /* For each combination of covariate */ |
|
if(m != 1 && TKresult[nres]!= k1) |
|
continue; |
|
|
|
/* for(i1=1; i1<=ncodemax[k1];i1++){ */ |
|
jj1++; |
|
if (cptcovn > 0) { |
|
fprintf(fichtm,"\n<p><a name=\"rescov"); |
|
for (cpt=1; cpt<=cptcoveff;cpt++){ |
|
fprintf(fichtm,"_V%d=%d_",Tvresult[nres][cpt],(int)Tresult[nres][cpt]); |
|
} |
|
for (k4=1; k4<= nsq; k4++){ /* For each selected (single) quantitative value */ |
|
fprintf(fichtm,"_V%d=%f_",Tvqresult[nres][k4],Tqresult[nres][k4]); |
|
} |
|
fprintf(fichtm,"\"</a>"); |
|
|
|
fprintf(fichtm,"<hr size=\"2\" color=\"#EC5E5E\">************ Results for covariates"); |
|
for (cpt=1; cpt<=cptcoveff;cpt++){ |
|
fprintf(fichtm," V%d=%d ",Tvresult[nres][cpt],(int)Tresult[nres][cpt]); |
|
printf(" V%d=%d ",Tvresult[nres][cpt],Tresult[nres][cpt]);fflush(stdout); |
|
/* fprintf(fichtm," V%d=%d ",Tvaraff[cpt],nbcode[Tvaraff[cpt]][codtabm(jj1,cpt)]); */ |
|
/* printf(" V%d=%d ",Tvaraff[cpt],nbcode[Tvaraff[cpt]][codtabm(jj1,cpt)]);fflush(stdout); */ |
|
} |
|
for (k4=1; k4<= nsq; k4++){ /* For each selected (single) quantitative value */ |
|
fprintf(fichtm," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); |
|
printf(" V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]);fflush(stdout); |
|
} |
|
|
|
/* if(nqfveff+nqtveff 0) */ /* Test to be done */ |
fprintf(fichtm," ************\n<hr size=\"2\" color=\"#EC5E5E\">"); |
fprintf(fichtm," ************\n<hr size=\"2\" color=\"#EC5E5E\">"); |
|
if(invalidvarcomb[k1]){ |
|
fprintf(fichtm,"\n<h3>Combination (%d) ignored because no cases </h3>\n",k1); |
|
printf("\nCombination (%d) ignored because no cases \n",k1); |
|
continue; |
|
} |
} |
} |
/* aij, bij */ |
/* aij, bij */ |
fprintf(fichtm,"<br>- Logit model, for example: logit(pij)=log(pij/pii)= aij+ bij age + V1 age + etc. as a function of age: <a href=\"%s_%d-1.svg\">%s_%d-1.svg</a><br> \ |
fprintf(fichtm,"<br>- Logit model (yours is: logit(pij)=log(pij/pii)= aij+ bij age+%s) as a function of age: <a href=\"%s_%d-1-%d.svg\">%s_%d-1-%d.svg</a><br> \ |
<img src=\"%s_%d-1.svg\">",subdirf2(optionfilefiname,"PE_"),jj1,subdirf2(optionfilefiname,"PE_"),jj1,subdirf2(optionfilefiname,"PE_"),jj1); |
<img src=\"%s_%d-1-%d.svg\">",model,subdirf2(optionfilefiname,"PE_"),k1,nres,subdirf2(optionfilefiname,"PE_"),k1,nres,subdirf2(optionfilefiname,"PE_"),k1,nres); |
/* Pij */ |
/* Pij */ |
fprintf(fichtm,"<br>\n- Pij or conditional probabilities to be observed in state j being in state i, %d (stepm) months before: <a href=\"%s_%d-2.svg\">%s_%d-2.svg</a><br> \ |
fprintf(fichtm,"<br>\n- P<sub>ij</sub> or conditional probabilities to be observed in state j being in state i, %d (stepm) months before: <a href=\"%s_%d-2-%d.svg\">%s_%d-2-%d.svg</a><br> \ |
<img src=\"%s_%d-2.svg\">",stepm,subdirf2(optionfilefiname,"PE_"),jj1,subdirf2(optionfilefiname,"PE_"),jj1,subdirf2(optionfilefiname,"PE_"),jj1); |
<img src=\"%s_%d-2-%d.svg\">",stepm,subdirf2(optionfilefiname,"PE_"),k1,nres,subdirf2(optionfilefiname,"PE_"),k1,nres,subdirf2(optionfilefiname,"PE_"),k1,nres); |
/* Quasi-incidences */ |
/* Quasi-incidences */ |
fprintf(fichtm,"<br>\n- Iij or Conditional probabilities to be observed in state j being in state i %d (stepm) months\ |
fprintf(fichtm,"<br>\n- I<sub>ij</sub> or Conditional probabilities to be observed in state j being in state i %d (stepm) months\ |
before but expressed in per year i.e. quasi incidences if stepm is small and probabilities too,\ |
before but expressed in per year i.e. quasi incidences if stepm is small and probabilities too, \ |
incidence (rates) are the limit when h tends to zero of the ratio of the probability hPij \ |
incidence (rates) are the limit when h tends to zero of the ratio of the probability <sub>h</sub>P<sub>ij</sub> \ |
divided by h: hPij/h : <a href=\"%s_%d-3.svg\">%s_%d-3.svg</a><br> \ |
divided by h: <sub>h</sub>P<sub>ij</sub>/h : <a href=\"%s_%d-3-%d.svg\">%s_%d-3-%d.svg</a><br> \ |
<img src=\"%s_%d-3.svg\">",stepm,subdirf2(optionfilefiname,"PE_"),jj1,subdirf2(optionfilefiname,"PE_"),jj1,subdirf2(optionfilefiname,"PE_"),jj1); |
<img src=\"%s_%d-3-%d.svg\">",stepm,subdirf2(optionfilefiname,"PE_"),k1,nres,subdirf2(optionfilefiname,"PE_"),k1,nres,subdirf2(optionfilefiname,"PE_"),k1,nres); |
/* Survival functions (period) in state j */ |
/* Survival functions (period) in state j */ |
for(cpt=1; cpt<=nlstate;cpt++){ |
for(cpt=1; cpt<=nlstate;cpt++){ |
fprintf(fichtm,"<br>\n- Survival functions in state %d. Or probability to survive in state %d being in state (1 to %d) at different ages. <a href=\"%s%d_%d.svg\">%s%d_%d.svg</a><br> \ |
fprintf(fichtm,"<br>\n- Survival functions in state %d. Or probability to survive in state %d being in state (1 to %d) at different ages. <a href=\"%s_%d-%d-%d.svg\">%s_%d-%d-%d.svg</a><br> \ |
<img src=\"%s_%d-%d.svg\">", cpt, cpt, nlstate, subdirf2(optionfilefiname,"LIJ_"),cpt,jj1,subdirf2(optionfilefiname,"LIJ_"),cpt,jj1,subdirf2(optionfilefiname,"LIJ_"),cpt,jj1); |
<img src=\"%s_%d-%d-%d.svg\">", cpt, cpt, nlstate, subdirf2(optionfilefiname,"LIJ_"),cpt,k1,nres,subdirf2(optionfilefiname,"LIJ_"),cpt,k1,nres,subdirf2(optionfilefiname,"LIJ_"),cpt,k1,nres); |
} |
} |
/* State specific survival functions (period) */ |
/* State specific survival functions (period) */ |
for(cpt=1; cpt<=nlstate;cpt++){ |
for(cpt=1; cpt<=nlstate;cpt++){ |
fprintf(fichtm,"<br>\n- Survival functions from state %d in each live state and total.\ |
fprintf(fichtm,"<br>\n- Survival functions from state %d in each live state and total.\ |
Or probability to survive in various states (1 to %d) being in state %d at different ages.\ |
Or probability to survive in various states (1 to %d) being in state %d at different ages. \ |
<a href=\"%s%d_%d.svg\">%s%d_%d.svg</a><br> <img src=\"%s_%d-%d.svg\">", cpt, nlstate, cpt, subdirf2(optionfilefiname,"LIJT_"),cpt,jj1,subdirf2(optionfilefiname,"LIJT_"),cpt,jj1,subdirf2(optionfilefiname,"LIJT_"),cpt,jj1); |
<a href=\"%s_%d-%d-%d.svg\">%s_%d%d-%d.svg</a><br> <img src=\"%s_%d-%d-%d.svg\">", cpt, nlstate, cpt, subdirf2(optionfilefiname,"LIJT_"),cpt,k1,nres,subdirf2(optionfilefiname,"LIJT_"),cpt,k1,nres,subdirf2(optionfilefiname,"LIJT_"),cpt,k1,nres); |
} |
} |
/* Period (stable) prevalence in each health state */ |
/* Period (stable) prevalence in each health state */ |
for(cpt=1; cpt<=nlstate;cpt++){ |
for(cpt=1; cpt<=nlstate;cpt++){ |
fprintf(fichtm,"<br>\n- Convergence to period (stable) prevalence in state %d. Or probability to be in state %d being in state (1 to %d) at different ages. <a href=\"%s%d_%d.svg\">%s%d_%d.svg</a><br> \ |
fprintf(fichtm,"<br>\n- Convergence to period (stable) prevalence in state %d. Or probability for a person being in state (1 to %d) at different ages, to be in state %d some years after. <a href=\"%s_%d-%d-%d.svg\">%s_%d-%d-%d.svg</a><br> \ |
<img src=\"%s_%d-%d.svg\">", cpt, cpt, nlstate, subdirf2(optionfilefiname,"P_"),cpt,jj1,subdirf2(optionfilefiname,"P_"),cpt,jj1,subdirf2(optionfilefiname,"P_"),cpt,jj1); |
<img src=\"%s_%d-%d-%d.svg\">", cpt, nlstate, cpt, subdirf2(optionfilefiname,"P_"),cpt,k1,nres,subdirf2(optionfilefiname,"P_"),cpt,k1,nres,subdirf2(optionfilefiname,"P_"),cpt,k1,nres); |
|
} |
|
if(backcast==1){ |
|
/* Period (stable) back prevalence in each health state */ |
|
for(cpt=1; cpt<=nlstate;cpt++){ |
|
fprintf(fichtm,"<br>\n- Convergence to mixed (stable) back prevalence in state %d. Or probability for a person to be in state %d at a younger age, knowing that she/he was in state (1 to %d) at different older ages. <a href=\"%s_%d-%d-%d.svg\">%s_%d-%d-%d.svg</a><br> \ |
|
<img src=\"%s_%d-%d-%d.svg\">", cpt, cpt, nlstate, subdirf2(optionfilefiname,"PB_"),cpt,k1,nres,subdirf2(optionfilefiname,"PB_"),cpt,k1,nres,subdirf2(optionfilefiname,"PB_"),cpt,k1,nres); |
|
} |
|
} |
|
if(prevfcast==1){ |
|
/* Projection of prevalence up to period (stable) prevalence in each health state */ |
|
for(cpt=1; cpt<=nlstate;cpt++){ |
|
fprintf(fichtm,"<br>\n- Projection of cross-sectional prevalence (estimated with cases observed from %.1f to %.1f and mobil_average=%d), from year %.1f up to year %.1f tending to period (stable) prevalence in state %d. Or probability to be in state %d being in an observed weighted state (from 1 to %d). <a href=\"%s_%d-%d-%d.svg\">%s_%d-%d-%d.svg</a><br> \ |
|
<img src=\"%s_%d-%d-%d.svg\">", dateprev1, dateprev2, mobilavproj, dateproj1, dateproj2, cpt, cpt, nlstate, subdirf2(optionfilefiname,"PROJ_"),cpt,k1,nres,subdirf2(optionfilefiname,"PROJ_"),cpt,k1,nres,subdirf2(optionfilefiname,"PROJ_"),cpt,k1,nres); |
|
} |
} |
} |
|
if(backcast==1){ |
|
/* Back projection of prevalence up to stable (mixed) back-prevalence in each health state */ |
|
for(cpt=1; cpt<=nlstate;cpt++){ |
|
fprintf(fichtm,"<br>\n- Back projection of cross-sectional prevalence (estimated with cases observed from %.1f to %.1f and mobil_average=%d), \ |
|
from year %.1f up to year %.1f (probably close to stable [mixed] back prevalence in state %d (randomness in cross-sectional prevalence is not taken into \ |
|
account but can visually be appreciated). Or probability to have been in an state %d, knowing that the person was in either state (1 or %d) \ |
|
with weights corresponding to observed prevalence at different ages. <a href=\"%s_%d-%d-%d.svg\">%s_%d-%d-%d.svg</a><br> \ |
|
<img src=\"%s_%d-%d-%d.svg\">", dateprev1, dateprev2, mobilavproj, dateback1, dateback2, cpt, cpt, nlstate, subdirf2(optionfilefiname,"PROJB_"),cpt,k1,nres,subdirf2(optionfilefiname,"PROJB_"),cpt,k1,nres,subdirf2(optionfilefiname,"PROJB_"),cpt,k1,nres); |
|
} |
|
} |
|
|
for(cpt=1; cpt<=nlstate;cpt++) { |
for(cpt=1; cpt<=nlstate;cpt++) { |
fprintf(fichtm,"\n<br>- Life expectancy by health state (%d) at initial age and its decomposition into health expectancies in each alive state (1 to %d) (or area under each survival functions): <a href=\"%s_%d%d.svg\">%s_%d%d.svg</a> <br> \ |
fprintf(fichtm,"\n<br>- Life expectancy by health state (%d) at initial age and its decomposition into health expectancies in each alive state (1 to %d) (or area under each survival functions): <a href=\"%s_%d-%d-%d.svg\">%s_%d-%d-%d.svg</a> <br> \ |
<img src=\"%s_%d%d.svg\">",cpt,nlstate,subdirf2(optionfilefiname,"EXP_"),cpt,jj1,subdirf2(optionfilefiname,"EXP_"),cpt,jj1,subdirf2(optionfilefiname,"EXP_"),cpt,jj1); |
<img src=\"%s_%d-%d-%d.svg\">",cpt,nlstate,subdirf2(optionfilefiname,"EXP_"),cpt,k1,nres,subdirf2(optionfilefiname,"EXP_"),cpt,k1,nres,subdirf2(optionfilefiname,"EXP_"),cpt,k1,nres); |
} |
} |
/* } /\* end i1 *\/ */ |
/* } /\* end i1 *\/ */ |
}/* End k1 */ |
}/* End k1 */ |
fprintf(fichtm,"</ul>"); |
fprintf(fichtm,"</ul>"); |
|
|
fprintf(fichtm,"\ |
fprintf(fichtm,"\ |
\n<br><li><h4> <a name='secondorder'>Result files (second order: variances)</a></h4>\n\ |
\n<br><li><h4> <a name='secondorder'>Result files (second order: variances)</a></h4>\n\ |
- Parameter file with estimated parameters and covariance matrix: <a href=\"%s\">%s</a> <br> \ |
- Parameter file with estimated parameters and covariance matrix: <a href=\"%s\">%s</a> <br> \ |
- 95%% confidence intervals and Wald tests of the estimated parameters are in the log file if optimization has been done (mle != 0).<br> \ |
- 95%% confidence intervals and Wald tests of the estimated parameters are in the log file if optimization has been done (mle != 0).<br> \ |
Line 4890 variances but at the covariance matrix.
|
Line 6872 variances but at the covariance matrix.
|
covariance matrix of the one-step probabilities. \ |
covariance matrix of the one-step probabilities. \ |
See page 'Matrix of variance-covariance of one-step probabilities' below. \n", rfileres,rfileres); |
See page 'Matrix of variance-covariance of one-step probabilities' below. \n", rfileres,rfileres); |
|
|
fprintf(fichtm," - Standard deviation of one-step probabilities: <a href=\"%s\">%s</a> <br>\n", |
fprintf(fichtm," - Standard deviation of one-step probabilities: <a href=\"%s\">%s</a> <br>\n", |
subdirf2(fileresu,"PROB_"),subdirf2(fileresu,"PROB_")); |
subdirf2(fileresu,"PROB_"),subdirf2(fileresu,"PROB_")); |
fprintf(fichtm,"\ |
fprintf(fichtm,"\ |
- Variance-covariance of one-step probabilities: <a href=\"%s\">%s</a> <br>\n", |
- Variance-covariance of one-step probabilities: <a href=\"%s\">%s</a> <br>\n", |
subdirf2(fileresu,"PROBCOV_"),subdirf2(fileresu,"PROBCOV_")); |
subdirf2(fileresu,"PROBCOV_"),subdirf2(fileresu,"PROBCOV_")); |
|
|
fprintf(fichtm,"\ |
fprintf(fichtm,"\ |
- Correlation matrix of one-step probabilities: <a href=\"%s\">%s</a> <br>\n", |
- Correlation matrix of one-step probabilities: <a href=\"%s\">%s</a> <br>\n", |
subdirf2(fileresu,"PROBCOR_"),subdirf2(fileresu,"PROBCOR_")); |
subdirf2(fileresu,"PROBCOR_"),subdirf2(fileresu,"PROBCOR_")); |
fprintf(fichtm,"\ |
fprintf(fichtm,"\ |
- Variances and covariances of health expectancies by age and <b>initial health status</b> (cov(e<sup>ij</sup>,e<sup>kl</sup>)(estepm=%2d months): \ |
- Variances and covariances of health expectancies by age and <b>initial health status</b> (cov(e<sup>ij</sup>,e<sup>kl</sup>)(estepm=%2d months): \ |
<a href=\"%s\">%s</a> <br>\n</li>", |
<a href=\"%s\">%s</a> <br>\n</li>", |
estepm,subdirf2(fileresu,"CVE_"),subdirf2(fileresu,"CVE_")); |
estepm,subdirf2(fileresu,"CVE_"),subdirf2(fileresu,"CVE_")); |
fprintf(fichtm,"\ |
fprintf(fichtm,"\ |
- (a) Health expectancies by health status at initial age (e<sup>ij</sup>) and standard errors (in parentheses) (b) life expectancies and standard errors (e<sup>i.</sup>=e<sup>i1</sup>+e<sup>i2</sup>+...)(estepm=%2d months): \ |
- (a) Health expectancies by health status at initial age (e<sup>ij</sup>) and standard errors (in parentheses) (b) life expectancies and standard errors (e<sup>i.</sup>=e<sup>i1</sup>+e<sup>i2</sup>+...)(estepm=%2d months): \ |
<a href=\"%s\">%s</a> <br>\n</li>", |
<a href=\"%s\">%s</a> <br>\n</li>", |
estepm,subdirf2(fileresu,"STDE_"),subdirf2(fileresu,"STDE_")); |
estepm,subdirf2(fileresu,"STDE_"),subdirf2(fileresu,"STDE_")); |
fprintf(fichtm,"\ |
fprintf(fichtm,"\ |
- Variances and covariances of health expectancies by age. Status (i) based health expectancies (in state j), e<sup>ij</sup> are weighted by the period prevalences in each state i (if popbased=1, an additional computation is done using the cross-sectional prevalences, i.e population based) (estepm=%d months): <a href=\"%s\">%s</a><br>\n", |
- Variances and covariances of health expectancies by age. Status (i) based health expectancies (in state j), e<sup>ij</sup> are weighted by the period prevalences in each state i (if popbased=1, an additional computation is done using the cross-sectional prevalences, i.e population based) (estepm=%d months): <a href=\"%s\">%s</a><br>\n", |
estepm, subdirf2(fileresu,"V_"),subdirf2(fileresu,"V_")); |
estepm, subdirf2(fileresu,"V_"),subdirf2(fileresu,"V_")); |
fprintf(fichtm,"\ |
fprintf(fichtm,"\ |
- Total life expectancy and total health expectancies to be spent in each health state e<sup>.j</sup> with their standard errors (if popbased=1, an additional computation is done using the cross-sectional prevalences, i.e population based) (estepm=%d months): <a href=\"%s\">%s</a> <br>\n", |
- Total life expectancy and total health expectancies to be spent in each health state e<sup>.j</sup> with their standard errors (if popbased=1, an additional computation is done using the cross-sectional prevalences, i.e population based) (estepm=%d months): <a href=\"%s\">%s</a> <br>\n", |
estepm, subdirf2(fileresu,"T_"),subdirf2(fileresu,"T_")); |
estepm, subdirf2(fileresu,"T_"),subdirf2(fileresu,"T_")); |
fprintf(fichtm,"\ |
fprintf(fichtm,"\ |
- Standard deviation of period (stable) prevalences: <a href=\"%s\">%s</a> <br>\n",\ |
- Standard deviation of period (stable) prevalences: <a href=\"%s\">%s</a> <br>\n",\ |
subdirf2(fileresu,"VPL_"),subdirf2(fileresu,"VPL_")); |
subdirf2(fileresu,"VPL_"),subdirf2(fileresu,"VPL_")); |
|
|
/* if(popforecast==1) fprintf(fichtm,"\n */ |
/* if(popforecast==1) fprintf(fichtm,"\n */ |
/* - Prevalences forecasting: <a href=\"f%s\">f%s</a> <br>\n */ |
/* - Prevalences forecasting: <a href=\"f%s\">f%s</a> <br>\n */ |
Line 4923 See page 'Matrix of variance-covariance
|
Line 6905 See page 'Matrix of variance-covariance
|
/* <br>",fileres,fileres,fileres,fileres); */ |
/* <br>",fileres,fileres,fileres,fileres); */ |
/* else */ |
/* else */ |
/* fprintf(fichtm,"\n No population forecast: popforecast = %d (instead of 1) or stepm = %d (instead of 1) or model=%s (instead of .)<br><br></li>\n",popforecast, stepm, model); */ |
/* fprintf(fichtm,"\n No population forecast: popforecast = %d (instead of 1) or stepm = %d (instead of 1) or model=%s (instead of .)<br><br></li>\n",popforecast, stepm, model); */ |
fflush(fichtm); |
fflush(fichtm); |
fprintf(fichtm," <ul><li><b>Graphs</b></li><p>"); |
fprintf(fichtm," <ul><li><b>Graphs</b></li><p>"); |
|
|
m=pow(2,cptcoveff); |
m=pow(2,cptcoveff); |
if (cptcovn < 1) {m=1;ncodemax[1]=1;} |
if (cptcovn < 1) {m=1;ncodemax[1]=1;} |
|
|
jj1=0; |
jj1=0; |
for(k1=1; k1<=m;k1++){ |
|
/* for(i1=1; i1<=ncodemax[k1];i1++){ */ |
for(nres=1; nres <= nresult; nres++){ /* For each resultline */ |
|
for(k1=1; k1<=m;k1++){ |
|
if(m != 1 && TKresult[nres]!= k1) |
|
continue; |
|
/* for(i1=1; i1<=ncodemax[k1];i1++){ */ |
jj1++; |
jj1++; |
if (cptcovn > 0) { |
if (cptcovn > 0) { |
fprintf(fichtm,"<hr size=\"2\" color=\"#EC5E5E\">************ Results for covariates"); |
fprintf(fichtm,"<hr size=\"2\" color=\"#EC5E5E\">************ Results for covariates"); |
for (cpt=1; cpt<=cptcoveff;cpt++) |
for (cpt=1; cpt<=cptcoveff;cpt++) /**< cptcoveff number of variables */ |
fprintf(fichtm," V%d=%d ",Tvaraff[cpt],nbcode[Tvaraff[cpt]][codtabm(jj1,cpt)]); |
fprintf(fichtm," V%d=%d ",Tvresult[nres][cpt],Tresult[nres][cpt]); |
|
/* fprintf(fichtm," V%d=%d ",Tvaraff[cpt],nbcode[Tvaraff[cpt]][codtabm(jj1,cpt)]); */ |
|
for (k4=1; k4<= nsq; k4++){ /* For each selected (single) quantitative value */ |
|
fprintf(fichtm," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); |
|
} |
|
|
fprintf(fichtm," ************\n<hr size=\"2\" color=\"#EC5E5E\">"); |
fprintf(fichtm," ************\n<hr size=\"2\" color=\"#EC5E5E\">"); |
|
|
|
if(invalidvarcomb[k1]){ |
|
fprintf(fichtm,"\n<h4>Combination (%d) ignored because no cases </h4>\n",k1); |
|
continue; |
|
} |
} |
} |
for(cpt=1; cpt<=nlstate;cpt++) { |
for(cpt=1; cpt<=nlstate;cpt++) { |
fprintf(fichtm,"<br>- Observed (cross-sectional) and period (incidence based) \ |
fprintf(fichtm,"\n<br>- Observed (cross-sectional with mov_average=%d) and period (incidence based) \ |
prevalence (with 95%% confidence interval) in state (%d): <a href=\"%s_%d%d.svg\"> %s_%d-%d.svg <br>\ |
prevalence (with 95%% confidence interval) in state (%d): <a href=\"%s_%d-%d-%d.svg\"> %s_%d-%d-%d.svg</a>\n <br>\ |
<img src=\"%s_%d-%d.svg\">",cpt,subdirf2(optionfilefiname,"V_"),cpt,jj1,subdirf2(optionfilefiname,"V_"),cpt,jj1,subdirf2(optionfilefiname,"V_"),cpt,jj1); |
<img src=\"%s_%d-%d-%d.svg\">",mobilav,cpt,subdirf2(optionfilefiname,"V_"),cpt,k1,nres,subdirf2(optionfilefiname,"V_"),cpt,k1,nres,subdirf2(optionfilefiname,"V_"),cpt,k1,nres); |
} |
} |
fprintf(fichtm,"\n<br>- Total life expectancy by age and \ |
fprintf(fichtm,"\n<br>- Total life expectancy by age and \ |
health expectancies in states (1) and (2). If popbased=1 the smooth (due to the model) \ |
health expectancies in states (1) and (2). If popbased=1 the smooth (due to the model) \ |
true period expectancies (those weighted with period prevalences are also\ |
true period expectancies (those weighted with period prevalences are also\ |
drawn in addition to the population based expectancies computed using\ |
drawn in addition to the population based expectancies computed using\ |
observed and cahotic prevalences: <a href=\"%s_%d.svg\">%s_%d.svg<br>\ |
observed and cahotic prevalences: <a href=\"%s_%d-%d.svg\">%s_%d-%d.svg</a>\n<br>\ |
<img src=\"%s_%d.svg\">",subdirf2(optionfilefiname,"E_"),jj1,subdirf2(optionfilefiname,"E_"),jj1,subdirf2(optionfilefiname,"E_"),jj1); |
<img src=\"%s_%d-%d.svg\">",subdirf2(optionfilefiname,"E_"),k1,nres,subdirf2(optionfilefiname,"E_"),k1,nres,subdirf2(optionfilefiname,"E_"),k1,nres); |
/* } /\* end i1 *\/ */ |
/* } /\* end i1 *\/ */ |
}/* End k1 */ |
}/* End k1 */ |
fprintf(fichtm,"</ul>"); |
}/* End nres */ |
fflush(fichtm); |
fprintf(fichtm,"</ul>"); |
|
fflush(fichtm); |
} |
} |
|
|
/******************* Gnuplot file **************/ |
/******************* 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 backcast, char pathc[], double p[], int offyear, int offbyear){ |
|
|
char dirfileres[132],optfileres[132]; |
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 ng=0; |
int vpopbased; |
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) { */ |
/* if((ficgp=fopen(optionfilegnuplot,"a"))==NULL) { */ |
/* printf("Problem with file %s",optionfilegnuplot); */ |
/* printf("Problem with file %s",optionfilegnuplot); */ |
/* fprintf(ficlog,"Problem with file %s",optionfilegnuplot); */ |
/* fprintf(ficlog,"Problem with file %s",optionfilegnuplot); */ |
Line 4970 void printinggnuplot(char fileresu[], ch
|
Line 6975 void printinggnuplot(char fileresu[], ch
|
|
|
/*#ifdef windows */ |
/*#ifdef windows */ |
fprintf(ficgp,"cd \"%s\" \n",pathc); |
fprintf(ficgp,"cd \"%s\" \n",pathc); |
/*#endif */ |
/*#endif */ |
m=pow(2,cptcoveff); |
m=pow(2,cptcoveff); |
|
|
|
/* 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 */ |
/* Contribution to likelihood */ |
/* Plot the probability implied in the likelihood */ |
/* Plot the probability implied in the likelihood */ |
fprintf(ficgp,"\n# Contributions to the Likelihood, mle >=1. For mle=4 no interpolation, pure matrix products.\n#\n"); |
fprintf(ficgp,"\n# Contributions to the Likelihood, mle >=1. For mle=4 no interpolation, pure matrix products.\n#\n"); |
fprintf(ficgp,"\n set log y; unset log x;set xlabel \"Age\"; set ylabel \"Likelihood (-2Log(L))\";"); |
fprintf(ficgp,"\n set log y; unset log x;set xlabel \"Age\"; set ylabel \"Likelihood (-2Log(L))\";"); |
/* fprintf(ficgp,"\nset ter svg size 640, 480"); */ /* Too big for svg */ |
/* fprintf(ficgp,"\nset ter svg size 640, 480"); */ /* Too big for svg */ |
fprintf(ficgp,"\nset ter pngcairo size 640, 480"); |
fprintf(ficgp,"\nset ter pngcairo size 640, 480"); |
/* nice for mle=4 plot by number of matrix products. |
/* nice for mle=4 plot by number of matrix products. |
replot "rrtest1/toto.txt" u 2:($4 == 1 && $5==2 ? $9 : 1/0):5 t "p12" with point lc 1 */ |
replot "rrtest1/toto.txt" u 2:($4 == 1 && $5==2 ? $9 : 1/0):5 t "p12" with point lc 1 */ |
/* replot exp(p1+p2*x)/(1+exp(p1+p2*x)+exp(p3+p4*x)+exp(p5+p6*x)) t "p12(x)" */ |
/* replot exp(p1+p2*x)/(1+exp(p1+p2*x)+exp(p3+p4*x)+exp(p5+p6*x)) t "p12(x)" */ |
/* fprintf(ficgp,"\nset out \"%s.svg\";",subdirf2(optionfilefiname,"ILK_")); */ |
/* fprintf(ficgp,"\nset out \"%s.svg\";",subdirf2(optionfilefiname,"ILK_")); */ |
fprintf(ficgp,"\nset out \"%s-dest.png\";",subdirf2(optionfilefiname,"ILK_")); |
fprintf(ficgp,"\nset out \"%s-dest.png\";",subdirf2(optionfilefiname,"ILK_")); |
fprintf(ficgp,"\nset log y;plot \"%s\" u 2:(-$12):5 t \"All sample, transitions colored by destination\" with dots lc variable; set out;\n",subdirf(fileresilk)); |
fprintf(ficgp,"\nset log y;plot \"%s\" u 2:(-$13):6 t \"All sample, transitions colored by destination\" with dots lc variable; set out;\n",subdirf(fileresilk)); |
fprintf(ficgp,"\nset out \"%s-ori.png\";",subdirf2(optionfilefiname,"ILK_")); |
fprintf(ficgp,"\nset out \"%s-ori.png\";",subdirf2(optionfilefiname,"ILK_")); |
fprintf(ficgp,"\nset log y;plot \"%s\" u 2:(-$12):4 t \"All sample, transitions colored by origin\" with dots lc variable; set out;\n\n",subdirf(fileresilk)); |
fprintf(ficgp,"\nset log y;plot \"%s\" u 2:(-$13):5 t \"All sample, transitions colored by origin\" with dots lc variable; set out;\n\n",subdirf(fileresilk)); |
for (i=1; i<= nlstate ; i ++) { |
for (i=1; i<= nlstate ; i ++) { |
fprintf(ficgp,"\nset out \"%s-p%dj.png\";set ylabel \"Probability for each individual/wave\";",subdirf2(optionfilefiname,"ILK_"),i); |
fprintf(ficgp,"\nset out \"%s-p%dj.png\";set ylabel \"Probability for each individual/wave\";",subdirf2(optionfilefiname,"ILK_"),i); |
fprintf(ficgp,"unset log;\n# plot weighted, mean weight should have point size of 0.5\n plot \"%s\"",subdirf(fileresilk)); |
fprintf(ficgp,"unset log;\n# plot weighted, mean weight should have point size of 0.5\n plot \"%s\"",subdirf(fileresilk)); |
fprintf(ficgp," u 2:($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); |
fprintf(ficgp," u 2:($5 == %d && $6==%d ? $10 : 1/0):($12/4.):6 t \"p%d%d\" with points pointtype 7 ps variable lc variable \\\n",i,1,i,1); |
for (j=2; j<= nlstate+ndeath ; j ++) { |
for (j=2; j<= nlstate+ndeath ; j ++) { |
fprintf(ficgp,",\\\n \"\" u 2:($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,",\\\n \"\" u 2:($5 == %d && $6==%d ? $10 : 1/0):($12/4.):6 t \"p%d%d\" with points pointtype 7 ps variable lc variable ",i,j,i,j); |
} |
} |
fprintf(ficgp,";\nset out; unset ylabel;\n"); |
fprintf(ficgp,";\nset out; unset ylabel;\n"); |
} |
} |
/* unset log; plot "rrtest1_sorted_4/ILK_rrtest1_sorted_4.txt" u 2:($4 == 1 && $5==2 ? $9 : 1/0):5 t "p12" with points lc variable */ |
/* unset log; plot "rrtest1_sorted_4/ILK_rrtest1_sorted_4.txt" u 2:($4 == 1 && $5==2 ? $9 : 1/0):5 t "p12" with points lc variable */ |
/* fprintf(ficgp,"\nset log y;plot \"%s\" u 2:(-$11):3 t \"All sample, all transitions\" with dots lc variable",subdirf(fileresilk)); */ |
/* fprintf(ficgp,"\nset log y;plot \"%s\" u 2:(-$11):3 t \"All sample, all transitions\" with dots lc variable",subdirf(fileresilk)); */ |
/* fprintf(ficgp,"\nreplot \"%s\" u 2:($3 <= 3 ? -$11 : 1/0):3 t \"First 3 individuals\" with line lc variable", subdirf(fileresilk)); */ |
/* fprintf(ficgp,"\nreplot \"%s\" u 2:($3 <= 3 ? -$11 : 1/0):3 t \"First 3 individuals\" with line lc variable", subdirf(fileresilk)); */ |
fprintf(ficgp,"\nset out;unset log\n"); |
fprintf(ficgp,"\nset out;unset log\n"); |
/* fprintf(ficgp,"\nset out \"%s.svg\"; replot; set out; # bug gnuplot",subdirf2(optionfilefiname,"ILK_")); */ |
/* fprintf(ficgp,"\nset out \"%s.svg\"; replot; set out; # bug gnuplot",subdirf2(optionfilefiname,"ILK_")); */ |
|
|
strcpy(dirfileres,optionfilefiname); |
strcpy(dirfileres,optionfilefiname); |
strcpy(optfileres,"vpl"); |
strcpy(optfileres,"vpl"); |
/* 1eme*/ |
/* 1eme*/ |
fprintf(ficgp,"\n# 1st: Period (stable) prevalence with CI: 'VPL_' files\n"); |
for (cpt=1; cpt<= nlstate ; cpt ++){ /* For each live state */ |
for (cpt=1; cpt<= nlstate ; cpt ++) { |
for (k1=1; k1<= m ; k1 ++){ /* For each valid combination of covariate */ |
for (k1=1; k1<= m ; k1 ++) { /* plot [100000000000000000000:-100000000000000000000] "mysbiaspar/vplrmysbiaspar.txt to check */ |
for(nres=1; nres <= nresult; nres++){ /* For each resultline */ |
fprintf(ficgp,"\nset out \"%s_%d-%d.svg\" \n",subdirf2(optionfilefiname,"V_"),cpt,k1); |
/* plot [100000000000000000000:-100000000000000000000] "mysbiaspar/vplrmysbiaspar.txt to check */ |
fprintf(ficgp,"\n#set out \"V_%s_%d-%d.svg\" \n",optionfilefiname,cpt,k1); |
if(m != 1 && TKresult[nres]!= k1) |
fprintf(ficgp,"set xlabel \"Age\" \n\ |
continue; |
set ylabel \"Probability\" \n\ |
/* We are interested in selected combination by the resultline */ |
set ter svg size 640, 480\n\ |
/* printf("\n# 1st: Period (stable) prevalence with CI: 'VPL_' files and live state =%d ", cpt); */ |
plot [%.f:%.f] \"%s\" every :::%d::%d u 1:2 \"%%lf",ageminpar,fage,subdirf2(fileresu,"VPL_"),k1-1,k1-1); |
fprintf(ficgp,"\n# 1st: Period (stable) prevalence with CI: 'VPL_' files and live state =%d ", cpt); |
|
strcpy(gplotlabel,"("); |
for (i=1; i<= nlstate ; i ++) { |
for (k=1; k<=cptcoveff; k++){ /* For each covariate k get corresponding value lv for combination k1 */ |
if (i==cpt) fprintf(ficgp," %%lf (%%lf)"); |
lv= decodtabm(k1,k,cptcoveff); /* Should be the value of the covariate corresponding to k1 combination */ |
else fprintf(ficgp," %%*lf (%%*lf)"); |
/* 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 */ |
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); |
/* decodtabm(13,3,4)= 2 because h=13 k= 1 1 (2) 2 */ |
for (i=1; i<= nlstate ; i ++) { |
vlv= nbcode[Tvaraff[k]][lv]; /* vlv is the value of the covariate lv, 0 or 1 */ |
if (i==cpt) fprintf(ficgp," %%lf (%%lf)"); |
/* For each combination of covariate k1 (V1=1, V3=0), we printed the current covariate k and its value vlv */ |
else fprintf(ficgp," %%*lf (%%*lf)"); |
/* printf(" V%d=%d ",Tvaraff[k],vlv); */ |
} |
fprintf(ficgp," V%d=%d ",Tvaraff[k],vlv); |
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); |
sprintf(gplotlabel+strlen(gplotlabel)," V%d=%d ",Tvaraff[k],vlv); |
for (i=1; i<= nlstate ; i ++) { |
} |
if (i==cpt) fprintf(ficgp," %%lf (%%lf)"); |
for (k4=1; k4<= nsq; k4++){ /* For each selected (single) quantitative value */ |
else fprintf(ficgp," %%*lf (%%*lf)"); |
/* printf(" V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); */ |
} |
fprintf(ficgp," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); |
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)); |
sprintf(gplotlabel+strlen(gplotlabel)," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); |
fprintf(ficgp,"\nset out \n"); |
} |
} /* k1 */ |
strcpy(gplotlabel+strlen(gplotlabel),")"); |
} /* cpt */ |
/* printf("\n#\n"); */ |
/*2 eme*/ |
fprintf(ficgp,"\n#\n"); |
fprintf(ficgp,"\n# 2nd: Total life expectancy with CI: 't' files\n"); |
if(invalidvarcomb[k1]){ |
for (k1=1; k1<= m ; k1 ++) { |
/*k1=k1-1;*/ /* To be checked */ |
fprintf(ficgp,"\nset out \"%s_%d.svg\" \n",subdirf2(optionfilefiname,"E_"),k1); |
fprintf(ficgp,"#Combination (%d) ignored because no cases \n",k1); |
for(vpopbased=0; vpopbased <= popbased; vpopbased++){ /* Done for vpopbased=0 and vpopbased=1 if popbased==1*/ |
continue; |
if(vpopbased==0) |
} |
fprintf(ficgp,"set ylabel \"Years\" \nset ter svg size 640, 480\nplot [%.f:%.f] ",ageminpar,fage); |
|
else |
fprintf(ficgp,"\nset out \"%s_%d-%d-%d.svg\" \n",subdirf2(optionfilefiname,"V_"),cpt,k1,nres); |
fprintf(ficgp,"\nreplot "); |
fprintf(ficgp,"\n#set out \"V_%s_%d-%d-%d.svg\" \n",optionfilefiname,cpt,k1,nres); |
for (i=1; i<= nlstate+1 ; i ++) { |
/* fprintf(ficgp,"set label \"Alive state %d %s\" at graph 0.98,0.5 center rotate font \"Helvetica,12\"\n",cpt,gplotlabel); */ |
k=2*i; |
fprintf(ficgp,"set title \"Alive state %d %s\" font \"Helvetica,12\"\n",cpt,gplotlabel); |
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); |
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); |
for (j=1; j<= nlstate+1 ; j ++) { |
/* 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); */ |
if (j==i) fprintf(ficgp," %%lf (%%lf)"); |
/* k1-1 error should be nres-1*/ |
else fprintf(ficgp," %%*lf (%%*lf)"); |
for (i=1; i<= nlstate ; i ++) { |
} |
if (i==cpt) fprintf(ficgp," %%lf (%%lf)"); |
if (i== 1) fprintf(ficgp,"\" t\"TLE\" w l lt %d, \\\n",i); |
else fprintf(ficgp," %%*lf (%%*lf)"); |
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); |
fprintf(ficgp,"\" t\"Period (stable) 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 (j=1; j<= nlstate+1 ; j ++) { |
for (i=1; i<= nlstate ; i ++) { |
if (j==i) fprintf(ficgp," %%lf (%%lf)"); |
if (i==cpt) fprintf(ficgp," %%lf (%%lf)"); |
else fprintf(ficgp," %%*lf (%%*lf)"); |
else fprintf(ficgp," %%*lf (%%*lf)"); |
} |
} |
fprintf(ficgp,"\" t\"\" w l lt 0,"); |
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); |
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 (i=1; i<= nlstate ; i ++) { |
for (j=1; j<= nlstate+1 ; j ++) { |
if (i==cpt) fprintf(ficgp," %%lf (%%lf)"); |
if (j==i) fprintf(ficgp," %%lf (%%lf)"); |
|
else fprintf(ficgp," %%*lf (%%*lf)"); |
else fprintf(ficgp," %%*lf (%%*lf)"); |
} |
} |
if (i== (nlstate+1)) fprintf(ficgp,"\" t\"\" w l lt 0"); |
/* 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)); */ |
else fprintf(ficgp,"\" t\"\" w l lt 0,\\\n"); |
|
} /* state */ |
fprintf(ficgp,"\" t\"\" w l lt 1,\"%s\" u 1:((",subdirf2(fileresu,"P_")); |
} /* vpopbased */ |
if(cptcoveff ==0){ |
fprintf(ficgp,"\nset out;set out \"%s_%d.svg\"; replot; set out; \n",subdirf2(optionfilefiname,"E_"),k1); /* Buggy gnuplot */ |
fprintf(ficgp,"$%d)) t 'Observed prevalence in state %d' with line lt 3", 2+3*(cpt-1), cpt ); |
} /* k1 */ |
}else{ |
/*3eme*/ |
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(backcast==1){ /* We need to get the corresponding values of the covariates involved in this combination k1 */ |
|
/* fprintf(ficgp,",\"%s\" every :::%d::%d u 1:($%d) t\"Backward stable prevalence\" w l lt 3",subdirf2(fileresu,"PLB_"),k1-1,k1-1,1+cpt); */ |
|
fprintf(ficgp,",\"%s\" u 1:((",subdirf2(fileresu,"PLB_")); /* Age is in 1, 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(backcast == 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 backcast */ |
|
/* fprintf(ficgp,"\nset out ;unset label;\n"); */ |
|
fprintf(ficgp,"\nset out ;unset title;\n"); |
|
} /* nres */ |
|
} /* k1 */ |
|
} /* cpt */ |
|
|
|
|
for (k1=1; k1<= m ; k1 ++) { |
/*2 eme*/ |
for (cpt=1; cpt<= nlstate ; cpt ++) { |
for (k1=1; k1<= m ; k1 ++){ |
/* k=2+nlstate*(2*cpt-2); */ |
for(nres=1; nres <= nresult; nres++){ /* For each resultline */ |
k=2+(nlstate+1)*(cpt-1); |
if(m != 1 && TKresult[nres]!= k1) |
fprintf(ficgp,"\nset out \"%s_%d%d.svg\" \n",subdirf2(optionfilefiname,"EXP_"),cpt,k1); |
continue; |
fprintf(ficgp,"set ter svg size 640, 480\n\ |
fprintf(ficgp,"\n# 2nd: Total life expectancy with CI: 't' files "); |
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); |
strcpy(gplotlabel,"("); |
/*fprintf(ficgp,",\"e%s\" every :::%d::%d u 1:($%d-2*$%d) \"\%%lf ",fileres,k1-1,k1-1,k,k+1); |
for (k=1; k<=cptcoveff; k++){ /* For each covariate and each value */ |
for (i=1; i<= nlstate*2 ; i ++) fprintf(ficgp,"\%%lf (\%%lf) "); |
lv= decodtabm(k1,k,cptcoveff); /* Should be the covariate number corresponding to k1 combination */ |
fprintf(ficgp,"\" t \"e%d1\" w l",cpt); |
/* decodtabm(1,1,4) = 1 because h=1 k= (1) 1 1 1 */ |
fprintf(ficgp,",\"e%s\" every :::%d::%d u 1:($%d+2*$%d) \"\%%lf ",fileres,k1-1,k1-1,k,k+1); |
/* decodtabm(1,2,4) = 1 because h=1 k= 1 (1) 1 1 */ |
for (i=1; i<= nlstate*2 ; i ++) fprintf(ficgp,"\%%lf (\%%lf) "); |
/* decodtabm(13,3,4)= 2 because h=13 k= 1 1 (2) 2 */ |
fprintf(ficgp,"\" t \"e%d1\" w l",cpt); |
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);*/ |
|
|
|
} |
/*3eme*/ |
fprintf(ficgp," ,\"%s\" every :::%d::%d u 1:%d t \"e%d.\" w l",subdirf2(fileresu,"E_"),k1-1,k1-1,k+nlstate,cpt); |
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 */ |
/* Survival functions (period) from state i in state j by initial state i */ |
for (k1=1; k1<= m ; k1 ++) { /* For each multivariate if any */ |
for (k1=1; k1<=m; k1++){ /* For each covariate and each value */ |
for (cpt=1; cpt<=nlstate ; cpt ++) { /* For each life state */ |
for(nres=1; nres <= nresult; nres++){ /* For each resultline */ |
k=3; |
if(m != 1 && TKresult[nres]!= k1) |
fprintf(ficgp,"\n#\n#\n# Survival functions in state j : 'lij' files, cov=%d state=%d",k1, cpt); |
continue; |
fprintf(ficgp,"\nset out \"%s_%d-%d.svg\" \n",subdirf2(optionfilefiname,"LIJ_"),cpt,k1); |
for (cpt=1; cpt<=nlstate ; cpt ++) { /* For each life state cpt*/ |
fprintf(ficgp,"set xlabel \"Age\" \nset ylabel \"Probability to be alive\" \n\ |
strcpy(gplotlabel,"("); |
set ter svg size 640, 480\n\ |
fprintf(ficgp,"\n#\n#\n# Survival functions in state j : 'LIJ_' files, cov=%d state=%d",k1, cpt); |
unset log y\n\ |
for (k=1; k<=cptcoveff; k++){ /* For each covariate and each value */ |
plot [%.f:%.f] ", ageminpar, agemaxpar); |
lv= decodtabm(k1,k,cptcoveff); /* Should be the covariate number corresponding to k1 combination */ |
for (i=1; i<= nlstate ; i ++){ |
/* decodtabm(1,1,4) = 1 because h=1 k= (1) 1 1 1 */ |
if(i==1) |
/* decodtabm(1,2,4) = 1 because h=1 k= 1 (1) 1 1 */ |
fprintf(ficgp,"\"%s\"",subdirf2(fileresu,"PIJ_")); |
/* decodtabm(13,3,4)= 2 because h=13 k= 1 1 (2) 2 */ |
else |
vlv= nbcode[Tvaraff[k]][lv]; |
fprintf(ficgp,", '' "); |
fprintf(ficgp," V%d=%d ",Tvaraff[k],vlv); |
l=(nlstate+ndeath)*(i-1)+1; |
sprintf(gplotlabel+strlen(gplotlabel)," V%d=%d ",Tvaraff[k],vlv); |
fprintf(ficgp," u ($1==%d ? ($3):1/0):($%d/($%d",k1,k+l+(cpt-1),k+l); |
} |
for (j=2; j<= nlstate+ndeath ; j ++) |
for (k4=1; k4<= nsq; k4++){ /* For each selected (single) quantitative value */ |
fprintf(ficgp,"+$%d",k+l+j-1); |
fprintf(ficgp," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); |
fprintf(ficgp,")) t \"l(%d,%d)\" w l",i,cpt); |
sprintf(gplotlabel+strlen(gplotlabel)," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); |
} /* nlstate */ |
} |
fprintf(ficgp,"\nset out\n"); |
strcpy(gplotlabel+strlen(gplotlabel),")"); |
} /* end cpt state*/ |
fprintf(ficgp,"\n#\n"); |
} /* end covariate */ |
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 */ |
/* Survival functions (period) from state i in state j by final state j */ |
for (k1=1; k1<= m ; k1 ++) { /* For each covariate if any */ |
for (k1=1; k1<= m ; k1++){ /* For each covariate combination if any */ |
for (cpt=1; cpt<=nlstate ; cpt ++) { /* For each inital state */ |
for(nres=1; nres <= nresult; nres++){ /* For each resultline */ |
k=3; |
if(m != 1 && TKresult[nres]!= k1) |
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); |
continue; |
fprintf(ficgp,"\nset out \"%s_%d-%d.svg\" \n",subdirf2(optionfilefiname,"LIJT_"),cpt,k1); |
for (cpt=1; cpt<=nlstate ; cpt ++) { /* For each inital state */ |
fprintf(ficgp,"set xlabel \"Age\" \nset ylabel \"Probability to be alive\" \n\ |
strcpy(gplotlabel,"("); |
set ter svg size 640, 480\n\ |
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); |
unset log y\n\ |
for (k=1; k<=cptcoveff; k++){ /* For each covariate and each value */ |
plot [%.f:%.f] ", ageminpar, agemaxpar); |
lv= decodtabm(k1,k,cptcoveff); /* Should be the covariate number corresponding to k1 combination */ |
for (j=1; j<= nlstate ; j ++){ /* Lived in state j */ |
/* decodtabm(1,1,4) = 1 because h=1 k= (1) 1 1 1 */ |
if(j==1) |
/* decodtabm(1,2,4) = 1 because h=1 k= 1 (1) 1 1 */ |
fprintf(ficgp,"\"%s\"",subdirf2(fileresu,"PIJ_")); |
/* decodtabm(13,3,4)= 2 because h=13 k= 1 1 (2) 2 */ |
else |
vlv= nbcode[Tvaraff[k]][lv]; |
fprintf(ficgp,", '' "); |
fprintf(ficgp," V%d=%d ",Tvaraff[k],vlv); |
l=(nlstate+ndeath)*(cpt-1) +j; |
sprintf(gplotlabel+strlen(gplotlabel)," V%d=%d ",Tvaraff[k],vlv); |
fprintf(ficgp," u (($1==%d && (floor($2)%%5 == 0)) ? ($3):1/0):($%d",k1,k+l); |
} |
/* for (i=2; i<= nlstate+ndeath ; i ++) */ |
for (k4=1; k4<= nsq; k4++){ /* For each selected (single) quantitative value */ |
/* fprintf(ficgp,"+$%d",k+l+i-1); */ |
fprintf(ficgp," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); |
fprintf(ficgp,") t \"l(%d,%d)\" w l",cpt,j); |
sprintf(gplotlabel+strlen(gplotlabel)," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); |
} /* nlstate */ |
} |
fprintf(ficgp,", '' "); |
strcpy(gplotlabel+strlen(gplotlabel),")"); |
fprintf(ficgp," u (($1==%d && (floor($2)%%5 == 0)) ? ($3):1/0):(",k1); |
fprintf(ficgp,"\n#\n"); |
for (j=1; j<= nlstate ; j ++){ /* Lived in state j */ |
if(invalidvarcomb[k1]){ |
l=(nlstate+ndeath)*(cpt-1) +j; |
fprintf(ficgp,"#Combination (%d) ignored because no cases \n",k1); |
if(j < nlstate) |
continue; |
fprintf(ficgp,"$%d +",k+l); |
} |
else |
|
fprintf(ficgp,"$%d) t\"l(%d,.)\" w l",k+l,cpt); |
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,"\nset out\n"); |
fprintf(ficgp,"set xlabel \"Age\" \nset ylabel \"Probability to be alive\" \n\ |
} /* end cpt state*/ |
set ter svg size 640, 480\nunset log y\nplot [%.f:%.f] ", ageminpar, agemaxpar); |
} /* end covariate */ |
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 */ |
/* CV preval stable (period) for each covariate */ |
for (k1=1; k1<= m ; k1 ++) { /* For each covariate if any */ |
for (k1=1; k1<= m ; k1 ++) /* For each covariate combination if any */ |
for (cpt=1; cpt<=nlstate ; cpt ++) { /* For each life state */ |
for(nres=1; nres <= nresult; nres++){ /* For each resultline */ |
k=3; |
if(m != 1 && TKresult[nres]!= k1) |
fprintf(ficgp,"\n#\n#\n#CV preval stable (period): 'pij' files, cov=%d state=%d",k1, cpt); |
continue; |
fprintf(ficgp,"\nset out \"%s_%d-%d.svg\" \n",subdirf2(optionfilefiname,"P_"),cpt,k1); |
for (cpt=1; cpt<=nlstate ; cpt ++) { /* For each life state of arrival */ |
|
strcpy(gplotlabel,"("); |
|
fprintf(ficgp,"\n#\n#\n#CV preval stable (period): 'pij' files, covariatecombination#=%d state=%d",k1, cpt); |
|
for (k=1; k<=cptcoveff; k++){ /* For each covariate and each value */ |
|
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\ |
fprintf(ficgp,"set xlabel \"Age\" \nset ylabel \"Probability\" \n\ |
set ter svg size 640, 480\n\ |
set ter svg size 640, 480\nunset log y\nplot [%.f:%.f] ", ageminpar, agemaxpar); |
unset log y\n\ |
k=3; /* Offset */ |
plot [%.f:%.f] ", ageminpar, agemaxpar); |
for (i=1; i<= nlstate ; i ++){ /* State of origin */ |
for (i=1; i<= nlstate ; i ++){ |
|
if(i==1) |
if(i==1) |
fprintf(ficgp,"\"%s\"",subdirf2(fileresu,"PIJ_")); |
fprintf(ficgp,"\"%s\"",subdirf2(fileresu,"PIJ_")); |
else |
else |
fprintf(ficgp,", '' "); |
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); |
fprintf(ficgp," u ($1==%d ? ($3):1/0):($%d/($%d",k1,k+l+(cpt-1),k+l); |
for (j=2; j<= nlstate ; j ++) |
for (j=2; j<= nlstate ; j ++) |
fprintf(ficgp,"+$%d",k+l+j-1); |
fprintf(ficgp,"+$%d",k+l+j-1); |
fprintf(ficgp,")) t \"prev(%d,%d)\" w l",i,cpt); |
fprintf(ficgp,")) t \"prev(%d,%d)\" w l",i,cpt); |
} /* nlstate */ |
} /* nlstate */ |
fprintf(ficgp,"\nset out\n"); |
fprintf(ficgp,"\nset out; unset label;\n"); |
} /* end cpt state*/ |
} /* end cpt state*/ |
} /* end covariate */ |
} /* end covariate */ |
|
|
/* proba elementaires */ |
|
fprintf(ficgp,"\n##############\n#MLE estimated parameters\n#############\n"); |
/* 7eme */ |
|
if(backcast == 1){ |
|
/* CV back preval stable (period) 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 Back preval stable (period): '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 backcast */ |
|
|
|
/* 8eme */ |
|
if(prevfcast==1){ |
|
/* Projection from cross-sectional to stable (period) 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 stable (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 <cptcoveff && cptcoveff>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(backcast==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 <cptcoveff && cptcoveff>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 backcast */ |
|
|
|
|
|
/* 9eme writing MLE parameters */ |
|
fprintf(ficgp,"\n##############\n#9eme MLE estimated parameters\n#############\n"); |
for(i=1,jk=1; i <=nlstate; i++){ |
for(i=1,jk=1; i <=nlstate; i++){ |
fprintf(ficgp,"# initial state %d\n",i); |
fprintf(ficgp,"# initial state %d\n",i); |
for(k=1; k <=(nlstate+ndeath); k++){ |
for(k=1; k <=(nlstate+ndeath); k++){ |
Line 5192 plot [%.f:%.f] ", ageminpar, agemaxpar)
|
Line 7740 plot [%.f:%.f] ", ageminpar, agemaxpar)
|
fprintf(ficgp,"\n"); |
fprintf(ficgp,"\n"); |
} |
} |
} |
} |
} |
} |
fprintf(ficgp,"##############\n#\n"); |
fprintf(ficgp,"##############\n#\n"); |
|
|
/*goto avoid;*/ |
/*goto avoid;*/ |
fprintf(ficgp,"\n##############\n#Graphics of probabilities or incidences\n#############\n"); |
/* 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)=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(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"); |
fprintf(ficgp,"# logi(p13/p11)=a13+b13*age+c13age*age+d13*V1+e13*V1*age\n"); |
Line 5210 plot [%.f:%.f] ", ageminpar, agemaxpar)
|
Line 7759 plot [%.f:%.f] ", ageminpar, agemaxpar)
|
fprintf(ficgp,"# +exp(a13+b13*age+c13age*age+d13*V1+e13*V1*age))\n"); |
fprintf(ficgp,"# +exp(a13+b13*age+c13age*age+d13*V1+e13*V1*age))\n"); |
fprintf(ficgp,"# +exp(a14+b14*age+c14age*age+d14*V1+e14*V1*age)+...)\n"); |
fprintf(ficgp,"# +exp(a14+b14*age+c14age*age+d14*V1+e14*V1*age)+...)\n"); |
fprintf(ficgp,"#\n"); |
fprintf(ficgp,"#\n"); |
for(ng=1; ng<=3;ng++){ /* Number of graphics: first is logit, 2nd is probabilities, third is incidences per year*/ |
for(ng=1; ng<=3;ng++){ /* Number of graphics: first is logit, 2nd is probabilities, third is incidences per year*/ |
fprintf(ficgp,"# ng=%d\n",ng); |
fprintf(ficgp,"#Number of graphics: first is logit, 2nd is probabilities, third is incidences per year\n"); |
fprintf(ficgp,"# jk=1 to 2^%d=%d\n",cptcoveff,m); |
fprintf(ficgp,"#model=%s \n",model); |
for(jk=1; jk <=m; jk++) { |
fprintf(ficgp,"# Type of graphic ng=%d\n",ng); |
fprintf(ficgp,"# jk=%d\n",jk); |
fprintf(ficgp,"# k1=1 to 2^%d=%d\n",cptcoveff,m);/* to be checked */ |
fprintf(ficgp,"\nset out \"%s_%d-%d.svg\" ",subdirf2(optionfilefiname,"PE_"),jk,ng); |
for(k1=1; k1 <=m; k1++) /* For each combination of covariate */ |
fprintf(ficgp,"\nset ter svg size 640, 480 "); |
for(nres=1; nres <= nresult; nres++){ /* For each resultline */ |
if (ng==1){ |
if(m != 1 && TKresult[nres]!= k1) |
fprintf(ficgp,"\nset ylabel \"Value of the logit of the model\"\n"); /* exp(a12+b12*x) could be nice */ |
continue; |
fprintf(ficgp,"\nunset log y"); |
fprintf(ficgp,"\n\n# Combination of dummy k1=%d which is ",k1); |
}else if (ng==2){ |
strcpy(gplotlabel,"("); |
fprintf(ficgp,"\nset ylabel \"Probability\"\n"); |
/*sprintf(gplotlabel+strlen(gplotlabel)," Dummy combination %d ",k1);*/ |
fprintf(ficgp,"\nset log y"); |
for (k=1; k<=cptcoveff; k++){ /* For each correspondig covariate value */ |
}else if (ng==3){ |
lv= decodtabm(k1,k,cptcoveff); /* Should be the covariate value corresponding to k1 combination and kth covariate */ |
fprintf(ficgp,"\nset ylabel \"Quasi-incidence per year\"\n"); |
/* decodtabm(1,1,4) = 1 because h=1 k= (1) 1 1 1 */ |
fprintf(ficgp,"\nset log y"); |
/* decodtabm(1,2,4) = 1 because h=1 k= 1 (1) 1 1 */ |
}else |
/* decodtabm(13,3,4)= 2 because h=13 k= 1 1 (2) 2 */ |
fprintf(ficgp,"\nunset title "); |
vlv= nbcode[Tvaraff[k]][lv]; |
fprintf(ficgp,"\nplot [%.f:%.f] ",ageminpar,agemaxpar); |
fprintf(ficgp," V%d=%d ",Tvaraff[k],vlv); |
i=1; |
sprintf(gplotlabel+strlen(gplotlabel)," V%d=%d ",Tvaraff[k],vlv); |
for(k2=1; k2<=nlstate; k2++) { |
} |
k3=i; |
for (k4=1; k4<= nsq; k4++){ /* For each selected (single) quantitative value */ |
for(k=1; k<=(nlstate+ndeath); k++) { |
fprintf(ficgp," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); |
if (k != k2){ |
sprintf(gplotlabel+strlen(gplotlabel)," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); |
switch( ng) { |
} |
case 1: |
strcpy(gplotlabel+strlen(gplotlabel),")"); |
if(nagesqr==0) |
fprintf(ficgp,"\n#\n"); |
fprintf(ficgp," p%d+p%d*x",i,i+1); |
fprintf(ficgp,"\nset out \"%s_%d-%d-%d.svg\" ",subdirf2(optionfilefiname,"PE_"),k1,ng,nres); |
else /* nagesqr =1 */ |
fprintf(ficgp,"\nset key outside "); |
fprintf(ficgp," p%d+p%d*x+p%d*x*x",i,i+1,i+1+nagesqr); |
/* fprintf(ficgp,"\nset label \"%s\" at graph 1.2,0.5 center rotate font \"Helvetica,12\"\n",gplotlabel); */ |
break; |
fprintf(ficgp,"\nset title \"%s\" font \"Helvetica,12\"\n",gplotlabel); |
case 2: /* ng=2 */ |
fprintf(ficgp,"\nset ter svg size 640, 480 "); |
if(nagesqr==0) |
if (ng==1){ |
fprintf(ficgp," exp(p%d+p%d*x",i,i+1); |
fprintf(ficgp,"\nset ylabel \"Value of the logit of the model\"\n"); /* exp(a12+b12*x) could be nice */ |
else /* nagesqr =1 */ |
fprintf(ficgp,"\nunset log y"); |
fprintf(ficgp," exp(p%d+p%d*x+p%d*x*x",i,i+1,i+1+nagesqr); |
}else if (ng==2){ |
break; |
fprintf(ficgp,"\nset ylabel \"Probability\"\n"); |
case 3: |
fprintf(ficgp,"\nset log y"); |
if(nagesqr==0) |
}else if (ng==3){ |
fprintf(ficgp," %f*exp(p%d+p%d*x",YEARM/stepm,i,i+1); |
fprintf(ficgp,"\nset ylabel \"Quasi-incidence per year\"\n"); |
else /* nagesqr =1 */ |
fprintf(ficgp,"\nset log y"); |
fprintf(ficgp," %f*exp(p%d+p%d*x+p%d*x*x",YEARM/stepm,i,i+1,i+1+nagesqr); |
}else |
break; |
fprintf(ficgp,"\nunset title "); |
} |
fprintf(ficgp,"\nplot [%.f:%.f] ",ageminpar,agemaxpar); |
ij=1;/* To be checked else nbcode[0][0] wrong */ |
i=1; |
for(j=3; j <=ncovmodel-nagesqr; j++) { |
for(k2=1; k2<=nlstate; k2++) { |
/* printf("Tage[%d]=%d, j=%d\n", ij, Tage[ij], j); */ |
k3=i; |
if(ij <=cptcovage) { /* Bug valgrind */ |
for(k=1; k<=(nlstate+ndeath); k++) { |
if((j-2)==Tage[ij]) { /* Bug valgrind */ |
if (k != k2){ |
fprintf(ficgp,"+p%d*%d*x",i+j+nagesqr-1,nbcode[Tvar[j-2]][codtabm(jk,j-2)]); |
switch( ng) { |
/* fprintf(ficgp,"+p%d*%d*x",i+j+nagesqr-1,nbcode[Tvar[j-2]][codtabm(jk,Tvar[j-2])]); */ |
case 1: |
ij++; |
if(nagesqr==0) |
} |
fprintf(ficgp," p%d+p%d*x",i,i+1); |
} |
else /* nagesqr =1 */ |
else |
fprintf(ficgp," p%d+p%d*x+p%d*x*x",i,i+1,i+1+nagesqr); |
fprintf(ficgp,"+p%d*%d",i+j+nagesqr-1,nbcode[Tvar[j-2]][codtabm(jk,j-2)]); |
break; |
} |
case 2: /* ng=2 */ |
if(ng != 1){ |
if(nagesqr==0) |
fprintf(ficgp,")/(1"); |
fprintf(ficgp," exp(p%d+p%d*x",i,i+1); |
|
else /* nagesqr =1 */ |
for(k1=1; k1 <=nlstate; k1++){ |
fprintf(ficgp," exp(p%d+p%d*x+p%d*x*x",i,i+1,i+1+nagesqr); |
if(nagesqr==0) |
break; |
fprintf(ficgp,"+exp(p%d+p%d*x",k3+(k1-1)*ncovmodel,k3+(k1-1)*ncovmodel+1); |
case 3: |
else /* nagesqr =1 */ |
if(nagesqr==0) |
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); |
fprintf(ficgp," %f*exp(p%d+p%d*x",YEARM/stepm,i,i+1); |
|
else /* nagesqr =1 */ |
ij=1; |
fprintf(ficgp," %f*exp(p%d+p%d*x+p%d*x*x",YEARM/stepm,i,i+1,i+1+nagesqr); |
for(j=3; j <=ncovmodel-nagesqr; j++){ |
break; |
if(ij <=cptcovage) { /* Bug valgrind */ |
} |
if((j-2)==Tage[ij]) { /* Bug valgrind */ |
ij=1;/* To be checked else nbcode[0][0] wrong */ |
fprintf(ficgp,"+p%d*%d*x",k3+(k1-1)*ncovmodel+1+j-2+nagesqr,nbcode[Tvar[j-2]][codtabm(jk,j-2)]); |
ijp=1; /* product no age */ |
/* fprintf(ficgp,"+p%d*%d*x",k3+(k1-1)*ncovmodel+1+j-2+nagesqr,nbcode[Tvar[j-2]][codtabm(jk,Tvar[j-2])]); */ |
/* 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++; |
ij++; |
} |
} |
} |
} |
else |
}else |
fprintf(ficgp,"+p%d*%d",k3+(k1-1)*ncovmodel+1+j-2+nagesqr,nbcode[Tvar[j-2]][codtabm(jk,j-2)]); |
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,")"); |
} |
} |
fprintf(ficgp,")"); |
fprintf(ficgp,")"); |
if(ng ==2) |
if(ng ==2) |
fprintf(ficgp," t \"p%d%d\" ", k2,k); |
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 */ |
else /* ng= 3 */ |
fprintf(ficgp," t \"i%d%d\" ", k2,k); |
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 */ |
}else{ /* end ng <> 1 */ |
fprintf(ficgp," t \"logit(p%d%d)\" ", k2,k); |
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)) fprintf(ficgp,","); |
} |
i=i+ncovmodel; |
if ((k+k2)!= (nlstate*2+ndeath) && ng != 1) |
} |
fprintf(ficgp,","); |
} /* end k */ |
if (ng == 1 && k!=k2 && (k+k2)!= (nlstate*2+ndeath)) |
} /* end k2 */ |
fprintf(ficgp,","); |
fprintf(ficgp,"\n set out\n"); |
i=i+ncovmodel; |
} /* end jk */ |
} /* end k */ |
} /* end ng */ |
} /* end k2 */ |
/* avoid: */ |
/* fprintf(ficgp,"\n set out; unset label;set key default;\n"); */ |
fflush(ficgp); |
fprintf(ficgp,"\n set out; unset title;set key default;\n"); |
|
} /* end k1 */ |
|
} /* end ng */ |
|
/* avoid: */ |
|
fflush(ficgp); |
} /* end gnuplot */ |
} /* end gnuplot */ |
|
|
|
|
/*************** Moving average **************/ |
/*************** 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; |
|
|
|
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; |
for (cptcod=1;cptcod<=ncovcombmax;cptcod++){ /* for each combination */ |
int modcovmax =1; |
/* for (age=bage+(mob-1)/2; age<=fage-(mob-1)/2; age++){ */ |
int mobilavrange, mob; |
if(invalidvarcomb[cptcod]){ |
double age; |
printf("\nCombination (%d) ignored because no cases \n",cptcod); |
|
continue; |
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 (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 */ |
|
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 */ |
|
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\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 */ |
|
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\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 ******************/ |
/************** 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){ |
void prevforecast(char fileres[], double anproj1, double mproj1, double jproj1, double ageminpar, double agemax, double dateprev1, double dateprev2, int mobilav, double ***prev, double bage, double fage, int firstpass, int lastpass, double anproj2, double p[], int cptcoveff){ |
/* proj1, year, month, day of starting projection |
/* proj1, year, month, day of starting projection |
agemin, agemax range of age |
agemin, agemax range of age |
dateprev1 dateprev2 range of dates during which prevalence is computed |
dateprev1 dateprev2 range of dates during which prevalence is computed |
anproj2 year of en of projection (same day and month as proj1). |
anproj2 year of en of projection (same day and month as proj1). |
*/ |
*/ |
int yearp, stepsize, hstepm, nhstepm, j, k, cptcod, i, h, i1; |
int yearp, stepsize, hstepm, nhstepm, j, k, cptcod, i, h, i1, k4, nres=0; |
double agec; /* generic age */ |
double agec; /* generic age */ |
double agelim, ppij, yp,yp1,yp2,jprojmean,mprojmean,anprojmean; |
double agelim, ppij, yp,yp1,yp2,jprojmean,mprojmean,anprojmean; |
double *popeffectif,*popcount; |
double *popeffectif,*popcount; |
double ***p3mat; |
double ***p3mat; |
double ***mobaverage; |
/* double ***mobaverage; */ |
char fileresf[FILENAMELENGTH]; |
char fileresf[FILENAMELENGTH]; |
|
|
agelim=AGESUP; |
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_"); |
strcpy(fileresf,"F_"); |
strcat(fileresf,fileresu); |
strcat(fileresf,fileresu); |
Line 5377 void prevforecast(char fileres[], double
|
Line 8190 void prevforecast(char fileres[], double
|
printf("Problem with forecast resultfile: %s\n", fileresf); |
printf("Problem with forecast resultfile: %s\n", fileresf); |
fprintf(ficlog,"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); |
printf("\nComputing forecasting: result on file '%s', please wait... \n", fileresf); |
fprintf(ficlog,"Computing forecasting: result on file '%s' \n", fileresf); |
fprintf(ficlog,"\nComputing forecasting: result on file '%s', please wait... \n", fileresf); |
|
|
if (cptcoveff==0) ncodemax[cptcoveff]=1; |
if (cptcoveff==0) ncodemax[cptcoveff]=1; |
|
|
if (mobilav!=0) { |
|
mobaverage= ma3x(1, AGESUP,1,NCOVMAX, 1,NCOVMAX); |
|
if (movingaverage(probs, ageminpar, fage, mobaverage,mobilav)!=0){ |
|
fprintf(ficlog," Error in movingaverage mobilav=%d\n",mobilav); |
|
printf(" Error in movingaverage mobilav=%d\n",mobilav); |
|
} |
|
} |
|
|
|
stepsize=(int) (stepm+YEARM-1)/YEARM; |
stepsize=(int) (stepm+YEARM-1)/YEARM; |
if (stepm<=12) stepsize=1; |
if (stepm<=12) stepsize=1; |
if(estepm < stepm){ |
if(estepm < stepm){ |
printf ("Problem %d lower than %d\n",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; |
hstepm=hstepm/stepm; |
yp1=modf(dateintmean,&yp);/* extracts integral of datemean in yp and |
yp1=modf(dateintmean,&yp);/* extracts integral of datemean in yp and |
Line 5408 void prevforecast(char fileres[], double
|
Line 8219 void prevforecast(char fileres[], double
|
if(jprojmean==0) jprojmean=1; |
if(jprojmean==0) jprojmean=1; |
if(mprojmean==0) jprojmean=1; |
if(mprojmean==0) jprojmean=1; |
|
|
i1=cptcoveff; |
i1=pow(2,cptcoveff); |
if (cptcovn < 1){i1=1;} |
if (cptcovn < 1){i1=1;} |
|
|
fprintf(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",jprojmean,mprojmean,anprojmean,dateintmean,dateprev1,dateprev2); |
|
|
fprintf(ficresf,"#****** Routine prevforecast **\n"); |
fprintf(ficresf,"#****** Routine prevforecast **\n"); |
|
|
/* if (h==(int)(YEARM*yearp)){ */ |
/* if (h==(int)(YEARM*yearp)){ */ |
for(cptcov=1, k=0;cptcov<=i1;cptcov++){ |
for(nres=1; nres <= nresult; nres++) /* For each resultline */ |
for(cptcod=1;cptcod<=ncodemax[cptcoveff];cptcod++){ |
for(k=1; k<=i1;k++){ |
k=k+1; |
if(i1 != 1 && TKresult[nres]!= k) |
fprintf(ficresf,"\n#******"); |
continue; |
for(j=1;j<=cptcoveff;j++) { |
if(invalidvarcomb[k]){ |
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)]); |
printf("\nCombination (%d) projection ignored because no cases \n",k); |
} |
continue; |
fprintf(ficresf,"******\n"); |
} |
fprintf(ficresf,"# Covariate valuofcovar yearproj age"); |
fprintf(ficresf,"\n#****** hpijx=probability over h years, hp.jx is weighted by observed prev \n#"); |
for(j=1; j<=nlstate+ndeath;j++){ |
for(j=1;j<=cptcoveff;j++) { |
for(i=1; i<=nlstate;i++) |
fprintf(ficresf," V%d (=) %d",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); |
fprintf(ficresf," p%d%d",i,j); |
} |
fprintf(ficresf," p.%d",j); |
for (k4=1; k4<= nsq; k4++){ /* For each selected (single) quantitative value */ |
} |
fprintf(ficresf," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); |
for (yearp=0; yearp<=(anproj2-anproj1);yearp +=stepsize) { |
} |
|
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<=(anproj2-anproj1);yearp +=stepsize) { |
|
fprintf(ficresf,"\n"); |
|
fprintf(ficresf,"\n# Forecasting at date %.lf/%.lf/%.lf ",jproj1,mproj1,anproj1+yearp); |
|
/* for (agec=fage; agec>=(ageminpar-1); agec--){ */ |
|
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"); |
fprintf(ficresf,"\n# Forecasting at date %.lf/%.lf/%.lf ",jproj1,mproj1,anproj1+yearp); |
for(j=1;j<=cptcoveff;j++) |
|
fprintf(ficresf,"%d %d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); |
for (agec=fage; agec>=(ageminpar-1); agec--){ |
fprintf(ficresf,"%.f %.f ",anproj1+yearp,agec+h*hstepm/YEARM*stepm); |
nhstepm=(int) rint((agelim-agec)*YEARM/stepm); |
|
nhstepm = nhstepm/hstepm; |
for(j=1; j<=nlstate+ndeath;j++) { |
p3mat=ma3x(1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); |
ppij=0.; |
oldm=oldms;savm=savms; |
for(i=1; i<=nlstate;i++) { |
hpxij(p3mat,nhstepm,agec,hstepm,p,nlstate,stepm,oldm,savm, k); |
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); |
fclose(ficresf); |
|
printf("End of Computing forecasting \n"); |
|
fprintf(ficlog,"End of Computing forecasting\n"); |
|
|
} |
} |
|
|
/************** Forecasting *****not tested NB*************/ |
/************** Back Forecasting ******************/ |
void populforecast(char fileres[], double anpyram,double mpyram,double jpyram,double ageminpar, double agemax,double dateprev1, double dateprev2, int mobilav, double agedeb, double fage, int popforecast, char popfile[], double anpyram1,double p[], int i2){ |
void prevbackforecast(char fileres[], double ***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){ |
|
/* back1, year, month, day of starting backection |
int cpt, stepsize, hstepm, nhstepm, j,k,c, cptcod, i,h; |
agemin, agemax range of age |
int *popage; |
dateprev1 dateprev2 range of dates during which prevalence is computed |
double calagedatem, agelim, kk1, kk2; |
anback2 year of 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,jprojmean,mprojmean,anprojmean; |
double *popeffectif,*popcount; |
double *popeffectif,*popcount; |
double ***p3mat,***tabpop,***tabpopprev; |
double ***p3mat; |
double ***mobaverage; |
/* double ***mobaverage; */ |
char filerespop[FILENAMELENGTH]; |
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); |
/*Do we need to compute prevalence again?*/ |
tabpopprev= ma3x(1, AGESUP,1,NCOVMAX, 1,NCOVMAX); |
|
agelim=AGESUP; |
/* prevalence(probs, ageminpar, agemax, s, agev, nlstate, imx, Tvar, nbcode, ncodemax, mint, anint, dateprev1, dateprev2, firstpass, lastpass); */ |
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_"); |
strcpy(fileresfb,"FB_"); |
strcat(filerespop,fileresu); |
strcat(fileresfb,fileresu); |
if((ficrespop=fopen(filerespop,"w"))==NULL) { |
if((ficresfb=fopen(fileresfb,"w"))==NULL) { |
printf("Problem with forecast resultfile: %s\n", filerespop); |
printf("Problem with back forecast resultfile: %s\n", fileresfb); |
fprintf(ficlog,"Problem with forecast resultfile: %s\n", filerespop); |
fprintf(ficlog,"Problem with back forecast resultfile: %s\n", fileresfb); |
} |
} |
printf("Computing forecasting: result on file '%s' \n", filerespop); |
printf("\nComputing back forecasting: result on file '%s', please wait... \n", fileresfb); |
fprintf(ficlog,"Computing forecasting: result on file '%s' \n", filerespop); |
fprintf(ficlog,"\nComputing back forecasting: result on file '%s', please wait... \n", fileresfb); |
|
|
if (cptcoveff==0) ncodemax[cptcoveff]=1; |
if (cptcoveff==0) ncodemax[cptcoveff]=1; |
|
|
if (mobilav!=0) { |
|
mobaverage= ma3x(1, AGESUP,1,NCOVMAX, 1,NCOVMAX); |
|
if (movingaverage(probs, ageminpar, fage, mobaverage,mobilav)!=0){ |
|
fprintf(ficlog," Error in movingaverage mobilav=%d\n",mobilav); |
|
printf(" Error in movingaverage mobilav=%d\n",mobilav); |
|
} |
|
} |
|
|
|
stepsize=(int) (stepm+YEARM-1)/YEARM; |
stepsize=(int) (stepm+YEARM-1)/YEARM; |
if (stepm<=12) stepsize=1; |
if (stepm<=12) stepsize=1; |
|
if(estepm < stepm){ |
|
printf ("Problem %d lower than %d\n",estepm, stepm); |
|
} |
|
else{ |
|
hstepm=estepm; |
|
} |
|
if(estepm >= stepm){ /* Yes every two year */ |
|
stepsize=2; |
|
} |
|
|
agelim=AGESUP; |
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; |
|
|
hstepm=1; |
i1=pow(2,cptcoveff); |
hstepm=hstepm/stepm; |
if (cptcovn < 1){i1=1;} |
|
|
if (popforecast==1) { |
fprintf(ficresfb,"# Mean day of interviews %.lf/%.lf/%.lf (%.2f) between %.2f and %.2f \n",jprojmean,mprojmean,anprojmean,dateintmean,dateprev1,dateprev2); |
if((ficpop=fopen(popfile,"r"))==NULL) { |
printf("# Mean day of interviews %.lf/%.lf/%.lf (%.2f) between %.2f and %.2f \n",jprojmean,mprojmean,anprojmean,dateintmean,dateprev1,dateprev2); |
printf("Problem with population file : %s\n",popfile);exit(0); |
|
fprintf(ficlog,"Problem with population file : %s\n",popfile);exit(0); |
fprintf(ficresfb,"#****** Routine prevbackforecast **\n"); |
} |
|
popage=ivector(0,AGESUP); |
for(nres=1; nres <= nresult; nres++) /* For each resultline */ |
popeffectif=vector(0,AGESUP); |
for(k=1; k<=i1;k++){ |
popcount=vector(0,AGESUP); |
if(i1 != 1 && TKresult[nres]!= k) |
|
continue; |
i=1; |
if(invalidvarcomb[k]){ |
while ((c=fscanf(ficpop,"%d %lf\n",&popage[i],&popcount[i])) != EOF) i=i+1; |
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>=(anback2-anback1);yearp -=stepsize) { |
|
/* for (yearp=0; yearp<=(anproj2-anproj1);yearp +=stepsize) { */ |
|
fprintf(ficresfb,"\n"); |
|
fprintf(ficresfb,"\n# Back Forecasting at date %.lf/%.lf/%.lf ",jback1,mback1,anback1+yearp); |
|
/* 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 ",anback1+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"); |
|
|
|
} |
|
|
|
/* 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 period (stable) prevalence------*/ |
|
|
|
char fileresvpl[FILENAMELENGTH]; |
|
FILE *ficresvpl; |
|
double **oldm, **savm; |
|
double **varpl; /* Variances of prevalence limits by age */ |
|
int i1, k, nres, j ; |
|
|
imx=i; |
strcpy(fileresvpl,"VPL_"); |
for (i=1; i<imx;i++) popeffectif[popage[i]]=popcount[i]; |
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' ...", fileresvpl);fflush(stdout); |
|
fprintf(ficlog, "Computing Variance-covariance of 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;} |
|
|
for(cptcov=1,k=0;cptcov<=i2;cptcov++){ |
for(nres=1; nres <= nresult; nres++) /* For each resultline */ |
for(cptcod=1;cptcod<=ncodemax[cptcoveff];cptcod++){ |
for(k=1; k<=i1;k++){ |
k=k+1; |
if(i1 != 1 && TKresult[nres]!= k) |
fprintf(ficrespop,"\n#******"); |
continue; |
|
fprintf(ficresvpl,"\n#****** "); |
|
printf("\n#****** "); |
|
fprintf(ficlog,"\n#****** "); |
for(j=1;j<=cptcoveff;j++) { |
for(j=1;j<=cptcoveff;j++) { |
fprintf(ficrespop," V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); |
fprintf(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)]); |
fprintf(ficrespop,"******\n"); |
printf("V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); |
fprintf(ficrespop,"# Age"); |
} |
for(j=1; j<=nlstate+ndeath;j++) fprintf(ficrespop," P.%d",j); |
for (j=1; j<= nsq; j++){ /* For each selected (single) quantitative value */ |
if (popforecast==1) fprintf(ficrespop," [Population]"); |
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 period prevalence\n");fflush(stdout); |
|
fprintf(ficlog,"done variance-covariance of period prevalence\n");fflush(ficlog); |
|
|
|
} |
|
/* 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){ */ |
|
|
|
/* 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; */ |
|
|
|
/* agelim=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<imx;i++) popeffectif[popage[i]]=popcount[i]; */ |
|
/* } */ |
|
|
|
/* for(cptcov=1,k=0;cptcov<=i2;cptcov++){ */ |
|
/* for(cptcod=1;cptcod<=ncodemax[cptcoveff];cptcod++){ */ |
|
/* k=k+1; */ |
|
/* fprintf(ficrespop,"\n#******"); */ |
|
/* for(j=1;j<=cptcoveff;j++) { */ |
|
/* fprintf(ficrespop," V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); */ |
|
/* } */ |
|
/* fprintf(ficrespop,"******\n"); */ |
|
/* fprintf(ficrespop,"# Age"); */ |
|
/* for(j=1; j<=nlstate+ndeath;j++) fprintf(ficrespop," P.%d",j); */ |
|
/* if (popforecast==1) fprintf(ficrespop," [Population]"); */ |
|
|
for (cpt=0; cpt<=0;cpt++) { |
/* for (cpt=0; cpt<=0;cpt++) { */ |
fprintf(ficrespop,"\n\n# Forecasting at date %.lf/%.lf/%.lf ",jpyram,mpyram,anpyram+cpt); |
/* fprintf(ficrespop,"\n\n# Forecasting at date %.lf/%.lf/%.lf ",jpyram,mpyram,anpyram+cpt); */ |
|
|
for (agedeb=(fage-((int)calagedatem %12/12.)); agedeb>=(ageminpar-((int)calagedatem %12)/12.); agedeb--){ |
/* for (agedeb=(fage-((int)calagedatem %12/12.)); agedeb>=(ageminpar-((int)calagedatem %12)/12.); agedeb--){ */ |
nhstepm=(int) rint((agelim-agedeb)*YEARM/stepm); |
/* nhstepm=(int) rint((agelim-agedeb)*YEARM/stepm); */ |
nhstepm = nhstepm/hstepm; |
/* nhstepm = nhstepm/hstepm; */ |
|
|
p3mat=ma3x(1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); |
/* p3mat=ma3x(1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); */ |
oldm=oldms;savm=savms; |
/* oldm=oldms;savm=savms; */ |
hpxij(p3mat,nhstepm,agedeb,hstepm,p,nlstate,stepm,oldm,savm, k); |
/* hpxij(p3mat,nhstepm,agedeb,hstepm,p,nlstate,stepm,oldm,savm, k); */ |
|
|
for (h=0; h<=nhstepm; h++){ |
|
if (h==(int) (calagedatem+YEARM*cpt)) { |
|
fprintf(ficrespop,"\n %3.f ",agedeb+h*hstepm/YEARM*stepm); |
|
} |
|
for(j=1; j<=nlstate+ndeath;j++) { |
|
kk1=0.;kk2=0; |
|
for(i=1; i<=nlstate;i++) { |
|
if (mobilav==1) |
|
kk1=kk1+p3mat[i][j][h]*mobaverage[(int)agedeb+1][i][cptcod]; |
|
else { |
|
kk1=kk1+p3mat[i][j][h]*probs[(int)(agedeb+1)][i][cptcod]; |
|
} |
|
} |
|
if (h==(int)(calagedatem+12*cpt)){ |
|
tabpop[(int)(agedeb)][j][cptcod]=kk1; |
|
/*fprintf(ficrespop," %.3f", kk1); |
|
if (popforecast==1) fprintf(ficrespop," [%.f]", kk1*popeffectif[(int)agedeb+1]);*/ |
|
} |
|
} |
|
for(i=1; i<=nlstate;i++){ |
|
kk1=0.; |
|
for(j=1; j<=nlstate;j++){ |
|
kk1= kk1+tabpop[(int)(agedeb)][j][cptcod]; |
|
} |
|
tabpopprev[(int)(agedeb)][i][cptcod]=tabpop[(int)(agedeb)][i][cptcod]/kk1*popeffectif[(int)(agedeb+(calagedatem+12*cpt)*hstepm/YEARM*stepm-1)]; |
|
} |
|
|
|
if (h==(int)(calagedatem+12*cpt)) for(j=1; j<=nlstate;j++) |
|
fprintf(ficrespop," %15.2f",tabpopprev[(int)(agedeb+1)][j][cptcod]); |
|
} |
|
free_ma3x(p3mat,1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); |
|
} |
|
} |
|
|
|
/******/ |
|
|
|
for (cpt=1; cpt<=(anpyram1-anpyram);cpt++) { |
|
fprintf(ficrespop,"\n\n# Forecasting at date %.lf/%.lf/%.lf ",jpyram,mpyram,anpyram+cpt); |
|
for (agedeb=(fage-((int)calagedatem %12/12.)); agedeb>=(ageminpar-((int)calagedatem %12)/12.); agedeb--){ |
|
nhstepm=(int) rint((agelim-agedeb)*YEARM/stepm); |
|
nhstepm = nhstepm/hstepm; |
|
|
|
p3mat=ma3x(1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); |
/* for (h=0; h<=nhstepm; h++){ */ |
oldm=oldms;savm=savms; |
/* if (h==(int) (calagedatem+YEARM*cpt)) { */ |
hpxij(p3mat,nhstepm,agedeb,hstepm,p,nlstate,stepm,oldm,savm, k); |
/* fprintf(ficrespop,"\n %3.f ",agedeb+h*hstepm/YEARM*stepm); */ |
for (h=0; h<=nhstepm; h++){ |
/* } */ |
if (h==(int) (calagedatem+YEARM*cpt)) { |
/* for(j=1; j<=nlstate+ndeath;j++) { */ |
fprintf(ficresf,"\n %3.f ",agedeb+h*hstepm/YEARM*stepm); |
/* kk1=0.;kk2=0; */ |
} |
/* for(i=1; i<=nlstate;i++) { */ |
for(j=1; j<=nlstate+ndeath;j++) { |
/* if (mobilav==1) */ |
kk1=0.;kk2=0; |
/* kk1=kk1+p3mat[i][j][h]*mobaverage[(int)agedeb+1][i][cptcod]; */ |
for(i=1; i<=nlstate;i++) { |
/* else { */ |
kk1=kk1+p3mat[i][j][h]*tabpopprev[(int)agedeb+1][i][cptcod]; |
/* kk1=kk1+p3mat[i][j][h]*probs[(int)(agedeb+1)][i][cptcod]; */ |
} |
/* } */ |
if (h==(int)(calagedatem+12*cpt)) fprintf(ficresf," %15.2f", kk1); |
/* } */ |
} |
/* if (h==(int)(calagedatem+12*cpt)){ */ |
} |
/* tabpop[(int)(agedeb)][j][cptcod]=kk1; */ |
free_ma3x(p3mat,1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); |
/* /\*fprintf(ficrespop," %.3f", kk1); */ |
} |
/* if (popforecast==1) fprintf(ficrespop," [%.f]", kk1*popeffectif[(int)agedeb+1]);*\/ */ |
} |
/* } */ |
} |
/* } */ |
} |
/* for(i=1; i<=nlstate;i++){ */ |
|
/* kk1=0.; */ |
|
/* for(j=1; j<=nlstate;j++){ */ |
|
/* kk1= kk1+tabpop[(int)(agedeb)][j][cptcod]; */ |
|
/* } */ |
|
/* tabpopprev[(int)(agedeb)][i][cptcod]=tabpop[(int)(agedeb)][i][cptcod]/kk1*popeffectif[(int)(agedeb+(calagedatem+12*cpt)*hstepm/YEARM*stepm-1)]; */ |
|
/* } */ |
|
|
|
/* if (h==(int)(calagedatem+12*cpt)) */ |
|
/* for(j=1; j<=nlstate;j++) */ |
|
/* fprintf(ficrespop," %15.2f",tabpopprev[(int)(agedeb+1)][j][cptcod]); */ |
|
/* } */ |
|
/* free_ma3x(p3mat,1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); */ |
|
/* } */ |
|
/* } */ |
|
|
|
/* /\******\/ */ |
|
|
|
/* for (cpt=1; cpt<=(anpyram1-anpyram);cpt++) { */ |
|
/* fprintf(ficrespop,"\n\n# Forecasting at date %.lf/%.lf/%.lf ",jpyram,mpyram,anpyram+cpt); */ |
|
/* for (agedeb=(fage-((int)calagedatem %12/12.)); agedeb>=(ageminpar-((int)calagedatem %12)/12.); agedeb--){ */ |
|
/* nhstepm=(int) rint((agelim-agedeb)*YEARM/stepm); */ |
|
/* nhstepm = nhstepm/hstepm; */ |
|
|
|
/* p3mat=ma3x(1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); */ |
|
/* oldm=oldms;savm=savms; */ |
|
/* hpxij(p3mat,nhstepm,agedeb,hstepm,p,nlstate,stepm,oldm,savm, k); */ |
|
/* for (h=0; h<=nhstepm; h++){ */ |
|
/* if (h==(int) (calagedatem+YEARM*cpt)) { */ |
|
/* fprintf(ficresf,"\n %3.f ",agedeb+h*hstepm/YEARM*stepm); */ |
|
/* } */ |
|
/* for(j=1; j<=nlstate+ndeath;j++) { */ |
|
/* kk1=0.;kk2=0; */ |
|
/* for(i=1; i<=nlstate;i++) { */ |
|
/* kk1=kk1+p3mat[i][j][h]*tabpopprev[(int)agedeb+1][i][cptcod]; */ |
|
/* } */ |
|
/* if (h==(int)(calagedatem+12*cpt)) fprintf(ficresf," %15.2f", kk1); */ |
|
/* } */ |
|
/* } */ |
|
/* free_ma3x(p3mat,1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); */ |
|
/* } */ |
|
/* } */ |
|
/* } */ |
|
/* } */ |
|
|
|
/* /\* if (mobilav!=0) free_ma3x(mobaverage,1, AGESUP,1,NCOVMAX, 1,NCOVMAX); *\/ */ |
|
|
|
/* if (popforecast==1) { */ |
|
/* free_ivector(popage,0,AGESUP); */ |
|
/* free_vector(popeffectif,0,AGESUP); */ |
|
/* free_vector(popcount,0,AGESUP); */ |
|
/* } */ |
|
/* free_ma3x(tabpop,1, AGESUP,1,NCOVMAX, 1,NCOVMAX); */ |
|
/* free_ma3x(tabpopprev,1, AGESUP,1,NCOVMAX, 1,NCOVMAX); */ |
|
/* fclose(ficrespop); */ |
|
/* } /\* End of popforecast *\/ */ |
|
|
if (mobilav!=0) free_ma3x(mobaverage,1, AGESUP,1,NCOVMAX, 1,NCOVMAX); |
|
|
|
if (popforecast==1) { |
|
free_ivector(popage,0,AGESUP); |
|
free_vector(popeffectif,0,AGESUP); |
|
free_vector(popcount,0,AGESUP); |
|
} |
|
free_ma3x(tabpop,1, AGESUP,1,NCOVMAX, 1,NCOVMAX); |
|
free_ma3x(tabpopprev,1, AGESUP,1,NCOVMAX, 1,NCOVMAX); |
|
fclose(ficrespop); |
|
} /* End of popforecast */ |
|
|
|
int fileappend(FILE *fichier, char *optionfich) |
int fileappend(FILE *fichier, char *optionfich) |
{ |
{ |
if((fichier=fopen(optionfich,"a"))==NULL) { |
if((fichier=fopen(optionfich,"a"))==NULL) { |
Line 5776 double gompertz(double x[])
|
Line 8864 double gompertz(double x[])
|
double A,B,L=0.0,sump=0.,num=0.; |
double A,B,L=0.0,sump=0.,num=0.; |
int i,n=0; /* n is the size of the sample */ |
int i,n=0; /* n is the size of the sample */ |
|
|
for (i=0;i<=imx-1 ; i++) { |
for (i=1;i<=imx ; i++) { |
sump=sump+weight[i]; |
sump=sump+weight[i]; |
/* sump=sump+1;*/ |
/* sump=sump+1;*/ |
num=num+1; |
num=num+1; |
Line 5901 int readdata(char datafile[], int firsto
|
Line 8989 int readdata(char datafile[], int firsto
|
/*-------- data file ----------*/ |
/*-------- data file ----------*/ |
FILE *fic; |
FILE *fic; |
char dummy[]=" "; |
char dummy[]=" "; |
int i=0, j=0, n=0; |
int i=0, j=0, n=0, iv=0, v; |
|
int lstra; |
int linei, month, year,iout; |
int linei, month, year,iout; |
char line[MAXLINE], linetmp[MAXLINE]; |
char line[MAXLINE], linetmp[MAXLINE]; |
char stra[MAXLINE], strb[MAXLINE]; |
char stra[MAXLINE], strb[MAXLINE]; |
char *stratrunc; |
char *stratrunc; |
int lstra; |
|
|
|
|
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) { |
if((fic=fopen(datafile,"r"))==NULL) { |
printf("Problem while opening datafile: %s\n", datafile);fflush(stdout); |
printf("Problem while opening datafile: %s with errno='%s'\n", datafile,strerror(errno));fflush(stdout); |
fprintf(ficlog,"Problem while opening datafile: %s\n", datafile);fflush(ficlog);return 1; |
fprintf(ficlog,"Problem while opening datafile: %s with errno='%s'\n", datafile,strerror(errno));fflush(ficlog);return 1; |
} |
} |
|
|
i=1; |
i=1; |
Line 5933 int readdata(char datafile[], int firsto
|
Line 9044 int readdata(char datafile[], int firsto
|
} |
} |
trimbb(linetmp,line); /* Trims multiple blanks in line */ |
trimbb(linetmp,line); /* Trims multiple blanks in line */ |
strcpy(line, linetmp); |
strcpy(line, linetmp); |
|
|
|
/* Loops on waves */ |
for (j=maxwav;j>=1;j--){ |
for (j=maxwav;j>=1;j--){ |
|
for (iv=nqtv;iv>=1;iv--){ /* Loop on time varying quantitative variables */ |
|
cutv(stra, strb, line, ' '); |
|
if(strb[0]=='.') { /* Missing value */ |
|
lval=-1; |
|
cotqvar[j][iv][i]=-1; /* 0.0/0.0 */ |
|
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, ' '); |
cutv(stra, strb, line, ' '); |
if(strb[0]=='.') { /* Missing status */ |
if(strb[0]=='.') { /* Missing value */ |
lval=-1; |
lval=-1; |
}else{ |
}else{ |
errno=0; |
errno=0; |
lval=strtol(strb,&endptr,10); |
lval=strtol(strb,&endptr,10); |
/* if (errno == ERANGE && (lval == LONG_MAX || lval == LONG_MIN))*/ |
/* if (errno == ERANGE && (lval == LONG_MAX || lval == LONG_MIN))*/ |
if( strb[0]=='\0' || (*endptr != '\0')){ |
if( strb[0]=='\0' || (*endptr != '\0')){ |
printf("Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a status of wave %d. Setting maxwav=%d might be wrong. Exiting.\n", strb, linei,i,line,j,maxwav); |
printf("Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a status of wave %d. Setting maxwav=%d might be wrong. Exiting.\n", strb, linei,i,line,j,maxwav); |
fprintf(ficlog,"Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a status of wave %d. Setting maxwav=%d might be wrong. Exiting.\n", strb, linei,i,line,j,maxwav);fflush(ficlog); |
fprintf(ficlog,"Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a status of wave %d. Setting maxwav=%d might be wrong. Exiting.\n", strb, linei,i,line,j,maxwav);fflush(ficlog); |
return 1; |
return 1; |
} |
} |
} |
} |
|
|
s[j][i]=lval; |
s[j][i]=lval; |
|
|
|
/* Date of Interview */ |
strcpy(line,stra); |
strcpy(line,stra); |
cutv(stra, strb,line,' '); |
cutv(stra, strb,line,' '); |
if( (iout=sscanf(strb,"%d/%d",&month, &year)) != 0){ |
if( (iout=sscanf(strb,"%d/%d",&month, &year)) != 0){ |
Line 5966 int readdata(char datafile[], int firsto
|
Line 9149 int readdata(char datafile[], int firsto
|
anint[j][i]= (double) year; |
anint[j][i]= (double) year; |
mint[j][i]= (double)month; |
mint[j][i]= (double)month; |
strcpy(line,stra); |
strcpy(line,stra); |
} /* ENd Waves */ |
} /* End loop on waves */ |
|
|
|
/* Date of death */ |
cutv(stra, strb,line,' '); |
cutv(stra, strb,line,' '); |
if( (iout=sscanf(strb,"%d/%d",&month, &year)) != 0){ |
if( (iout=sscanf(strb,"%d/%d",&month, &year)) != 0){ |
} |
} |
Line 5976 int readdata(char datafile[], int firsto
|
Line 9160 int readdata(char datafile[], int firsto
|
year=9999; |
year=9999; |
}else{ |
}else{ |
printf("Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a date of death (mm/yyyy or .). Exiting.\n",strb, linei,i,line); |
printf("Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a date of death (mm/yyyy or .). Exiting.\n",strb, linei,i,line); |
fprintf(ficlog,"Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a date of death (mm/yyyy or .). Exiting.\n",strb, linei,i,line);fflush(ficlog); |
fprintf(ficlog,"Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a date of death (mm/yyyy or .). Exiting.\n",strb, linei,i,line);fflush(ficlog); |
return 1; |
return 1; |
} |
} |
andc[i]=(double) year; |
andc[i]=(double) year; |
moisdc[i]=(double) month; |
moisdc[i]=(double) month; |
strcpy(line,stra); |
strcpy(line,stra); |
|
|
|
/* Date of birth */ |
cutv(stra, strb,line,' '); |
cutv(stra, strb,line,' '); |
if( (iout=sscanf(strb,"%d/%d",&month, &year)) != 0){ |
if( (iout=sscanf(strb,"%d/%d",&month, &year)) != 0){ |
} |
} |
Line 5992 int readdata(char datafile[], int firsto
|
Line 9177 int readdata(char datafile[], int firsto
|
}else{ |
}else{ |
printf("Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a date of birth (mm/yyyy or .). Exiting.\n",strb, linei,i,line); |
printf("Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a date of birth (mm/yyyy or .). Exiting.\n",strb, linei,i,line); |
fprintf(ficlog,"Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a date of birth (mm/yyyy or .). Exiting.\n",strb, linei,i,line);fflush(ficlog); |
fprintf(ficlog,"Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a date of birth (mm/yyyy or .). Exiting.\n",strb, linei,i,line);fflush(ficlog); |
return 1; |
return 1; |
} |
} |
if (year==9999) { |
if (year==9999) { |
printf("Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a date of birth (mm/yyyy) but at least the year of birth should be given. Exiting.\n",strb, linei,i,line); |
printf("Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a date of birth (mm/yyyy) but at least the year of birth should be given. Exiting.\n",strb, linei,i,line); |
fprintf(ficlog,"Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a date of birth (mm/yyyy) but at least the year of birth should be given. Exiting.\n",strb, linei,i,line);fflush(ficlog); |
fprintf(ficlog,"Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be a date of birth (mm/yyyy) but at least the year of birth should be given. Exiting.\n",strb, linei,i,line);fflush(ficlog); |
return 1; |
return 1; |
|
|
} |
} |
annais[i]=(double)(year); |
annais[i]=(double)(year); |
moisnais[i]=(double)(month); |
moisnais[i]=(double)(month); |
strcpy(line,stra); |
strcpy(line,stra); |
|
|
|
/* Sample weight */ |
cutv(stra, strb,line,' '); |
cutv(stra, strb,line,' '); |
errno=0; |
errno=0; |
dval=strtod(strb,&endptr); |
dval=strtod(strb,&endptr); |
Line 6016 int readdata(char datafile[], int firsto
|
Line 9202 int readdata(char datafile[], int firsto
|
weight[i]=dval; |
weight[i]=dval; |
strcpy(line,stra); |
strcpy(line,stra); |
|
|
|
for (iv=nqv;iv>=1;iv--){ /* Loop on fixed quantitative variables */ |
|
cutv(stra, strb, line, ' '); |
|
if(strb[0]=='.') { /* Missing value */ |
|
lval=-1; |
|
}else{ |
|
errno=0; |
|
/* what_kind_of_number(strb); */ |
|
dval=strtod(strb,&endptr); |
|
/* if(strb != endptr && *endptr == '\0') */ |
|
/* dval=dlval; */ |
|
/* if (errno == ERANGE && (lval == LONG_MAX || lval == LONG_MIN)) */ |
|
if( strb[0]=='\0' || (*endptr != '\0')){ |
|
printf("Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be the %d th quantitative value (out of %d) constant for all waves. Setting maxwav=%d might be wrong. Exiting.\n", strb, linei,i,line, iv, nqv, maxwav); |
|
fprintf(ficlog,"Error reading data around '%s' at line number %d for individual %d, '%s'\nShould be the %d th quantitative value (out of %d) constant for all waves. Setting maxwav=%d might be wrong. Exiting.\n", strb, linei,i,line, iv, nqv, maxwav);fflush(ficlog); |
|
return 1; |
|
} |
|
coqvar[iv][i]=dval; |
|
covar[ncovcol+iv][i]=dval; /* including qvar in standard covar for performance reasons */ |
|
} |
|
strcpy(line,stra); |
|
}/* end loop nqv */ |
|
|
|
/* Covariate values */ |
for (j=ncovcol;j>=1;j--){ |
for (j=ncovcol;j>=1;j--){ |
cutv(stra, strb,line,' '); |
cutv(stra, strb,line,' '); |
if(strb[0]=='.') { /* Missing status */ |
if(strb[0]=='.') { /* Missing covariate value */ |
lval=-1; |
lval=-1; |
}else{ |
}else{ |
errno=0; |
errno=0; |
Line 6033 int readdata(char datafile[], int firsto
|
Line 9242 int readdata(char datafile[], int firsto
|
printf("Error reading data around '%ld' at line number %d for individual %d, '%s'\n \ |
printf("Error reading data around '%ld' at line number %d for individual %d, '%s'\n \ |
Should be a value of %d(nth) covariate (0 should be the value for the reference and 1\n \ |
Should be a value of %d(nth) covariate (0 should be the value for the reference and 1\n \ |
for the alternative. IMaCh does not build design variables automatically, do it yourself.\n \ |
for the alternative. IMaCh does not build design variables automatically, do it yourself.\n \ |
For example, for multinomial values like 1, 2 and 3,\n \ |
For example, for multinomial values like 1, 2 and 3,\n \ |
build V1=0 V2=0 for the reference value (1),\n \ |
build V1=0 V2=0 for the reference value (1),\n \ |
V1=1 V2=0 for (2) \n \ |
V1=1 V2=0 for (2) \n \ |
and V1=0 V2=1 for (3). V1=1 V2=1 should not exist and the corresponding\n \ |
and V1=0 V2=1 for (3). V1=1 V2=1 should not exist and the corresponding\n \ |
output of IMaCh is often meaningless.\n \ |
output of IMaCh is often meaningless.\n \ |
Exiting.\n",lval,linei, i,line,j); |
Exiting.\n",lval,linei, i,line,j); |
fprintf(ficlog,"Error reading data around '%ld' at line number %d for individual %d, '%s'\n \ |
fprintf(ficlog,"Error reading data around '%ld' at line number %d for individual %d, '%s'\n \ |
Should be a value of %d(nth) covariate (0 should be the value for the reference and 1\n \ |
Should be a value of %d(nth) covariate (0 should be the value for the reference and 1\n \ |
for the alternative. IMaCh does not build design variables automatically, do it yourself.\n \ |
for the alternative. IMaCh does not build design variables automatically, do it yourself.\n \ |
For example, for multinomial values like 1, 2 and 3,\n \ |
For example, for multinomial values like 1, 2 and 3,\n \ |
build V1=0 V2=0 for the reference value (1),\n \ |
build V1=0 V2=0 for the reference value (1),\n \ |
V1=1 V2=0 for (2) \n \ |
V1=1 V2=0 for (2) \n \ |
and V1=0 V2=1 for (3). V1=1 V2=1 should not exist and the corresponding\n \ |
and V1=0 V2=1 for (3). V1=1 V2=1 should not exist and the corresponding\n \ |
output of IMaCh is often meaningless.\n \ |
output of IMaCh is often meaningless.\n \ |
Exiting.\n",lval,linei, i,line,j);fflush(ficlog); |
Exiting.\n",lval,linei, i,line,j);fflush(ficlog); |
return 1; |
return 1; |
} |
} |
Line 6054 int readdata(char datafile[], int firsto
|
Line 9263 int readdata(char datafile[], int firsto
|
strcpy(line,stra); |
strcpy(line,stra); |
} |
} |
lstra=strlen(stra); |
lstra=strlen(stra); |
|
|
if(lstra > 9){ /* More than 2**32 or max of what printf can write with %ld */ |
if(lstra > 9){ /* More than 2**32 or max of what printf can write with %ld */ |
stratrunc = &(stra[lstra-9]); |
stratrunc = &(stra[lstra-9]); |
num[i]=atol(stratrunc); |
num[i]=atol(stratrunc); |
Line 6066 int readdata(char datafile[], int firsto
|
Line 9275 int readdata(char datafile[], int firsto
|
|
|
i=i+1; |
i=i+1; |
} /* End loop reading data */ |
} /* End loop reading data */ |
|
|
*imax=i-1; /* Number of individuals */ |
*imax=i-1; /* Number of individuals */ |
fclose(fic); |
fclose(fic); |
|
|
return (0); |
return (0); |
/* endread: */ |
/* endread: */ |
printf("Exiting readdata: "); |
printf("Exiting readdata: "); |
fclose(fic); |
fclose(fic); |
return (1); |
return (1); |
|
} |
|
|
|
void 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); |
|
printf("decoderesult:%s\n",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; |
int decodemodel( char model[], int lastobs) |
do |
/**< This routine decodes the model and returns: |
while (*p2 == ' ') |
* Model V1+V2+V3+V8+V7*V8+V5*V6+V8*age+V3*age+age*age |
p2++; |
* - nagesqr = 1 if age*age in the model, otherwise 0. |
while (*p1++ == *p2++); |
* - 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 |
int decodemodel ( char model[], int lastobs) /**< This routine decode the model and returns: |
* - cptcovs number of simple covariates |
* Model V1+V2+V3+V8+V7*V8+V5*V6+V8*age+V3*age+age*age |
* - 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 |
* - nagesqr = 1 if age*age in the model, otherwise 0. |
* which is a new column after the 9 (ncovcol) variables. |
* - cptcovt total number of covariates of the model nbocc(+)+1 = 8 excepting constant and age and age*age |
* - if k is a product Vn*Vm covar[k][i] is filled with correct values for each individual |
* - cptcovn or number of covariates k of the models excluding age*products =6 and age*age |
* - Tprod[l] gives the kth covariates of the product Vn*Vm l=1 to cptcovprod-cptcovage |
* - cptcovage number of covariates with age*products =2 |
* Tprod[1]@2 {5, 6}: position of first product V7*V8 is 5, and second V5*V6 is 6. |
* - cptcovs number of simple covariates |
* - Tvard[k] p Tvard[1][1]@4 {7, 8, 5, 6} for V7*V8 and V5*V6 . |
* - 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 i, j, k, ks, v; |
int j1, k1, k2; |
int j1, k1, k2, k3, k4; |
char modelsav[80]; |
char modelsav[80]; |
char stra[80], strb[80], strc[80], strd[80],stre[80]; |
char stra[80], strb[80], strc[80], strd[80],stre[80]; |
char *strpt; |
char *strpt; |
Line 6125 int decodemodel ( char model[], int last
|
Line 9461 int decodemodel ( char model[], int last
|
if ((strpt=strstr(model,"age*age")) !=0){ |
if ((strpt=strstr(model,"age*age")) !=0){ |
printf(" strpt=%s, model=%s\n",strpt, model); |
printf(" strpt=%s, model=%s\n",strpt, model); |
if(strpt != model){ |
if(strpt != model){ |
printf("Error in model: 'model=%s'; 'age*age' should in first place before other covariates\n \ |
printf("Error in model: 'model=%s'; 'age*age' should in first place before other covariates\n \ |
'model=1+age+age*age+V1.' or 'model=1+age+age*age+V1+V1*age.', please swap as well as \n \ |
'model=1+age+age*age+V1.' or 'model=1+age+age*age+V1+V1*age.', please swap as well as \n \ |
corresponding column of parameters.\n",model); |
corresponding column of parameters.\n",model); |
fprintf(ficlog,"Error in model: 'model=%s'; 'age*age' should in first place before other covariates\n \ |
fprintf(ficlog,"Error in model: 'model=%s'; 'age*age' should in first place before other covariates\n \ |
'model=1+age+age*age+V1.' or 'model=1+age+age*age+V1+V1*age.', please swap as well as \n \ |
'model=1+age+age*age+V1.' or 'model=1+age+age*age+V1+V1*age.', please swap as well as \n \ |
corresponding column of parameters.\n",model); fflush(ficlog); |
corresponding column of parameters.\n",model); fflush(ficlog); |
return 1; |
return 1; |
} |
} |
|
|
nagesqr=1; |
nagesqr=1; |
if (strstr(model,"+age*age") !=0) |
if (strstr(model,"+age*age") !=0) |
substrchaine(modelsav, model, "+age*age"); |
substrchaine(modelsav, model, "+age*age"); |
Line 6146 int decodemodel ( char model[], int last
|
Line 9481 int decodemodel ( char model[], int last
|
if (strlen(modelsav) >1){ |
if (strlen(modelsav) >1){ |
j=nbocc(modelsav,'+'); /**< j=Number of '+' */ |
j=nbocc(modelsav,'+'); /**< j=Number of '+' */ |
j1=nbocc(modelsav,'*'); /**< j1=Number of '*' */ |
j1=nbocc(modelsav,'*'); /**< j1=Number of '*' */ |
cptcovs=j+1-j1; /**< Number of simple covariates V1+V1*age+V3 +V3*V4+age*age=> V1 + V3 =2 */ |
cptcovs=j+1-j1; /**< Number of simple covariates V1+V1*age+V3 +V3*V4+age*age=> V1 + V3 =5-3=2 */ |
cptcovt= j+1; /* Number of total covariates in the model, not including |
cptcovt= j+1; /* Number of total covariates in the model, not including |
* cst, age and age*age |
* cst, age and age*age |
* V1+V1*age+ V3 + V3*V4+age*age=> 4*/ |
* V1+V1*age+ V3 + V3*V4+age*age=> 3+1=4*/ |
/* including age products which are counted in cptcovage. |
/* including age products which are counted in cptcovage. |
* but the covariates which are products must be treated |
* but the covariates which are products must be treated |
* separately: ncovn=4- 2=2 (V1+V3). */ |
* separately: ncovn=4- 2=2 (V1+V3). */ |
cptcovprod=j1; /**< Number of products V1*V2 +v3*age = 2 */ |
cptcovprod=j1; /**< Number of products V1*V2 +v3*age = 2 */ |
cptcovprodnoage=0; /**< Number of covariate products without age: V3*V4 =1 */ |
cptcovprodnoage=0; /**< Number of covariate products without age: V3*V4 =1 */ |
|
|
|
|
/* Design |
/* Design |
* V1 V2 V3 V4 V5 V6 V7 V8 V9 Weight |
* V1 V2 V3 V4 V5 V6 V7 V8 V9 Weight |
* < ncovcol=8 > |
* < ncovcol=8 > |
Line 6164 int decodemodel ( char model[], int last
|
Line 9499 int decodemodel ( char model[], int last
|
* k= 1 2 3 4 5 6 7 8 |
* k= 1 2 3 4 5 6 7 8 |
* cptcovn number of covariates (not including constant and age ) = # of + plus 1 = 7+1=8 |
* cptcovn number of covariates (not including constant and age ) = # of + plus 1 = 7+1=8 |
* covar[k,i], value of kth covariate if not including age for individual i: |
* covar[k,i], value of kth covariate if not including age for individual i: |
* covar[1][i]= (V2), covar[4][i]=(V3), covar[8][i]=(V8) |
* covar[1][i]= (V1), covar[4][i]=(V4), covar[8][i]=(V8) |
* Tvar[k] # of the kth covariate: Tvar[1]=2 Tvar[4]=3 Tvar[8]=8 |
* Tvar[k] # of the kth covariate: Tvar[1]=2 Tvar[2]=1 Tvar[4]=3 Tvar[8]=8 |
* if multiplied by age: V3*age Tvar[3=V3*age]=3 (V3) Tvar[7]=8 and |
* if multiplied by age: V3*age Tvar[3=V3*age]=3 (V3) Tvar[7]=8 and |
* Tage[++cptcovage]=k |
* Tage[++cptcovage]=k |
* if products, new covar are created after ncovcol with k1 |
* if products, new covar are created after ncovcol with k1 |
Line 6190 int decodemodel ( char model[], int last
|
Line 9525 int decodemodel ( char model[], int last
|
* {2, 1, 4, 8, 5, 6, 3, 7} |
* {2, 1, 4, 8, 5, 6, 3, 7} |
* Struct [] |
* Struct [] |
*/ |
*/ |
|
|
/* This loop fills the array Tvar from the string 'model'.*/ |
/* This loop fills the array Tvar from the string 'model'.*/ |
/* j is the number of + signs in the model V1+V2+V3 j=2 i=3 to 1 */ |
/* j is the number of + signs in the model V1+V2+V3 j=2 i=3 to 1 */ |
/* modelsav=V2+V1+V4+age*V3 strb=age*V3 stra=V2+V1+V4 */ |
/* modelsav=V2+V1+V4+age*V3 strb=age*V3 stra=V2+V1+V4 */ |
Line 6205 int decodemodel ( char model[], int last
|
Line 9540 int decodemodel ( char model[], int last
|
/* for (k=1; k<=cptcovage;k++) cov[2+Tage[k]]=nbcode[Tvar[Tage[k]]][codtabm(ij,Tvar[Tage[k])]]*cov[2]; */ |
/* for (k=1; k<=cptcovage;k++) cov[2+Tage[k]]=nbcode[Tvar[Tage[k]]][codtabm(ij,Tvar[Tage[k])]]*cov[2]; */ |
/* |
/* |
* Treating invertedly V2+V1+V3*age+V2*V4 is as if written V2*V4 +V3*age + V1 + V2 */ |
* Treating invertedly V2+V1+V3*age+V2*V4 is as if written V2*V4 +V3*age + V1 + V2 */ |
for(k=cptcovt; k>=1;k--) /**< Number of covariates */ |
for(k=cptcovt; k>=1;k--){ /**< Number of covariates not including constant and age, neither age*age*/ |
Tvar[k]=0; |
Tvar[k]=0; Tprod[k]=0; Tposprod[k]=0; |
|
} |
cptcovage=0; |
cptcovage=0; |
for(k=1; k<=cptcovt;k++){ /* Loop on total covariates of the model */ |
for(k=1; k<=cptcovt;k++){ /* Loop on total covariates of the model */ |
cutl(stra,strb,modelsav,'+'); /* keeps in strb after the first '+' |
cutl(stra,strb,modelsav,'+'); /* keeps in strb after the first '+' |
Line 6221 int decodemodel ( char model[], int last
|
Line 9557 int decodemodel ( char model[], int last
|
cptcovprod--; |
cptcovprod--; |
cutl(stre,strb,strd,'V'); /* strd=V3(input): stre="3" */ |
cutl(stre,strb,strd,'V'); /* strd=V3(input): stre="3" */ |
Tvar[k]=atoi(stre); /* V2+V1+V4+V3*age Tvar[4]=3 ; V1+V2*age Tvar[2]=2; V1+V1*age Tvar[2]=1 */ |
Tvar[k]=atoi(stre); /* V2+V1+V4+V3*age Tvar[4]=3 ; V1+V2*age Tvar[2]=2; V1+V1*age Tvar[2]=1 */ |
|
Typevar[k]=1; /* 1 for age product */ |
cptcovage++; /* Sums the number of covariates which include age as a product */ |
cptcovage++; /* Sums the number of covariates which include age as a product */ |
Tage[cptcovage]=k; /* Tvar[4]=3, Tage[1] = 4 or V1+V1*age Tvar[2]=1, Tage[1]=2 */ |
Tage[cptcovage]=k; /* Tvar[4]=3, Tage[1] = 4 or V1+V1*age Tvar[2]=1, Tage[1]=2 */ |
/*printf("stre=%s ", stre);*/ |
/*printf("stre=%s ", stre);*/ |
Line 6228 int decodemodel ( char model[], int last
|
Line 9565 int decodemodel ( char model[], int last
|
cptcovprod--; |
cptcovprod--; |
cutl(stre,strb,strc,'V'); |
cutl(stre,strb,strc,'V'); |
Tvar[k]=atoi(stre); |
Tvar[k]=atoi(stre); |
|
Typevar[k]=1; /* 1 for age product */ |
cptcovage++; |
cptcovage++; |
Tage[cptcovage]=k; |
Tage[cptcovage]=k; |
} else { /* Age is not in the model product V2+V1+V1*V4+V3*age+V3*V2 strb=V3*V2*/ |
} else { /* Age is not in the model product V2+V1+V1*V4+V3*age+V3*V2 strb=V3*V2*/ |
Line 6235 int decodemodel ( char model[], int last
|
Line 9573 int decodemodel ( char model[], int last
|
cptcovn++; |
cptcovn++; |
cptcovprodnoage++;k1++; |
cptcovprodnoage++;k1++; |
cutl(stre,strb,strc,'V'); /* strc= Vn, stre is n; strb=V3*V2 stre=3 strc=*/ |
cutl(stre,strb,strc,'V'); /* strc= Vn, stre is n; strb=V3*V2 stre=3 strc=*/ |
Tvar[k]=ncovcol+k1; /* For model-covariate k tells which data-covariate to use but |
Tvar[k]=ncovcol+nqv+ntv+nqtv+k1; /* For model-covariate k tells which data-covariate to use but |
because this model-covariate is a construction we invent a new column |
because this model-covariate is a construction we invent a new column |
ncovcol + k1 |
which is after existing variables ncovcol+nqv+ntv+nqtv + k1 |
If already ncovcol=4 and model=V2+V1+V1*V4+age*V3+V3*V2 |
If already ncovcol=4 and model=V2+V1+V1*V4+age*V3+V3*V2 |
Tvar[3=V1*V4]=4+1 Tvar[5=V3*V2]=4 + 2= 6, etc */ |
Tvar[3=V1*V4]=4+1 Tvar[5=V3*V2]=4 + 2= 6, etc */ |
|
Typevar[k]=2; /* 2 for double fixed dummy covariates */ |
cutl(strc,strb,strd,'V'); /* strd was Vm, strc is m */ |
cutl(strc,strb,strd,'V'); /* strd was Vm, strc is m */ |
Tprod[k1]=k; /* Tprod[1]=3(=V1*V4) for V2+V1+V1*V4+age*V3+V3*V2 */ |
Tprod[k1]=k; /* Tprod[1]=3(=V1*V4) for V2+V1+V1*V4+age*V3+V3*V2 */ |
|
Tposprod[k]=k1; /* Tpsprod[3]=1, Tposprod[2]=5 */ |
Tvard[k1][1] =atoi(strc); /* m 1 for V1*/ |
Tvard[k1][1] =atoi(strc); /* m 1 for V1*/ |
Tvard[k1][2] =atoi(stre); /* n 4 for V4*/ |
Tvard[k1][2] =atoi(stre); /* n 4 for V4*/ |
k2=k2+2; |
k2=k2+2; /* k2 is initialize to -1, We want to store the n and m in Vn*Vm at the end of Tvar */ |
Tvar[cptcovt+k2]=Tvard[k1][1]; /* Tvar[(cptcovt=4+k2=1)=5]= 1 (V1) */ |
/* Tvar[cptcovt+k2]=Tvard[k1][1]; /\* Tvar[(cptcovt=4+k2=1)=5]= 1 (V1) *\/ */ |
Tvar[cptcovt+k2+1]=Tvard[k1][2]; /* Tvar[(cptcovt=4+(k2=1)+1)=6]= 4 (V4) */ |
/* Tvar[cptcovt+k2+1]=Tvard[k1][2]; /\* Tvar[(cptcovt=4+(k2=1)+1)=6]= 4 (V4) *\/ */ |
|
/*ncovcol=4 and model=V2+V1+V1*V4+age*V3+V3*V2, Tvar[3]=5, Tvar[4]=6, cptcovt=5 */ |
|
/* 1 2 3 4 5 | Tvar[5+1)=1, Tvar[7]=2 */ |
for (i=1; i<=lastobs;i++){ |
for (i=1; i<=lastobs;i++){ |
/* Computes the new covariate which is a product of |
/* Computes the new covariate which is a product of |
covar[n][i]* covar[m][i] and stores it at ncovol+k1 May not be defined */ |
covar[n][i]* covar[m][i] and stores it at ncovol+k1 May not be defined */ |
Line 6258 int decodemodel ( char model[], int last
|
Line 9600 int decodemodel ( char model[], int last
|
/*printf("d=%s c=%s b=%s\n", strd,strc,strb);*/ |
/*printf("d=%s c=%s b=%s\n", strd,strc,strb);*/ |
/* scanf("%d",i);*/ |
/* scanf("%d",i);*/ |
cutl(strd,strc,strb,'V'); |
cutl(strd,strc,strb,'V'); |
ks++; /**< Number of simple covariates */ |
ks++; /**< Number of simple covariates dummy or quantitative, fixe or varying */ |
cptcovn++; |
cptcovn++; /** V4+V3+V5: V4 and V3 timevarying dummy covariates, V5 timevarying quantitative */ |
Tvar[k]=atoi(strd); |
Tvar[k]=atoi(strd); |
|
Typevar[k]=0; /* 0 for simple covariates */ |
} |
} |
strcpy(modelsav,stra); /* modelsav=V2+V1+V4 stra=V2+V1+V4 */ |
strcpy(modelsav,stra); /* modelsav=V2+V1+V4 stra=V2+V1+V4 */ |
/*printf("a=%s b=%s sav=%s\n", stra,strb,modelsav); |
/*printf("a=%s b=%s sav=%s\n", stra,strb,modelsav); |
scanf("%d",i);*/ |
scanf("%d",i);*/ |
} /* end of loop + on total covariates */ |
} /* end of loop + on total covariates */ |
} /* end if strlen(modelsave == 0) age*age might exist */ |
} /* end if strlen(modelsave == 0) age*age might exist */ |
} /* end if strlen(model == 0) */ |
} /* end if strlen(model == 0) */ |
|
|
/*The number n of Vn is stored in Tvar. cptcovage =number of age covariate. Tage gives the position of age. cptcovprod= number of products. |
/*The number n of Vn is stored in Tvar. cptcovage =number of age covariate. Tage gives the position of age. cptcovprod= number of products. |
If model=V1+V1*age then Tvar[1]=1 Tvar[2]=1 cptcovage=1 Tage[1]=2 cptcovprod=0*/ |
If model=V1+V1*age then Tvar[1]=1 Tvar[2]=1 cptcovage=1 Tage[1]=2 cptcovprod=0*/ |
|
|
/* printf("tvar1=%d tvar2=%d tvar3=%d cptcovage=%d Tage=%d",Tvar[1],Tvar[2],Tvar[3],cptcovage,Tage[1]); |
/* printf("tvar1=%d tvar2=%d tvar3=%d cptcovage=%d Tage=%d",Tvar[1],Tvar[2],Tvar[3],cptcovage,Tage[1]); |
printf("cptcovprod=%d ", cptcovprod); |
printf("cptcovprod=%d ", cptcovprod); |
fprintf(ficlog,"cptcovprod=%d ", cptcovprod); |
fprintf(ficlog,"cptcovprod=%d ", cptcovprod); |
|
scanf("%d ",i);*/ |
scanf("%d ",i);*/ |
|
|
|
|
/* 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 <k1;k2++){ |
|
if((Typevar[k1]==Typevar[k2]) && (Fixed[Tvar[k1]]==Fixed[Tvar[k2]]) && (Dummy[Tvar[k1]]==Dummy[Tvar[k2]] )){ |
|
if((Typevar[k1] == 0 || Typevar[k1] == 1)){ /* Simple or age product */ |
|
if(Tvar[k1]==Tvar[k2]){ |
|
printf("Error duplication in the model=%s at positions (+) %d and %d, Tvar[%d]=V%d, Tvar[%d]=V%d, Typevar=%d, Fixed=%d, Dummy=%d\n", model, k1,k2, k1, Tvar[k1], k2, Tvar[k2],Typevar[k1],Fixed[Tvar[k1]],Dummy[Tvar[k1]]); |
|
fprintf(ficlog,"Error duplication in the model=%s at positions (+) %d and %d, Tvar[%d]=V%d, Tvar[%d]=V%d, Typevar=%d, Fixed=%d, Dummy=%d\n", model, k1,k2, k1, Tvar[k1], k2, Tvar[k2],Typevar[k1],Fixed[Tvar[k1]],Dummy[Tvar[k1]]); fflush(ficlog); |
|
return(1); |
|
} |
|
}else if (Typevar[k1] ==2){ |
|
k3=Tposprod[k1]; |
|
k4=Tposprod[k2]; |
|
if( ((Tvard[k3][1]== Tvard[k4][1])&&(Tvard[k3][2]== Tvard[k4][2])) || ((Tvard[k3][1]== Tvard[k4][2])&&(Tvard[k3][2]== Tvard[k4][1])) ){ |
|
printf("Error duplication in the model=%s at positions (+) %d and %d, V%d*V%d, Typevar=%d, Fixed=%d, Dummy=%d\n",model, k1,k2, Tvard[k3][1], Tvard[k3][2],Typevar[k1],Fixed[Tvar[k1]],Dummy[Tvar[k1]]); |
|
fprintf(ficlog,"Error duplication in the model=%s at positions (+) %d and %d, V%d*V%d, Typevar=%d, Fixed=%d, Dummy=%d\n",model, k1,k2, Tvard[k3][1], Tvard[k3][2],Typevar[k1],Fixed[Tvar[k1]],Dummy[Tvar[k1]]); fflush(ficlog); |
|
return(1); |
|
} |
|
} |
|
} |
|
} |
|
} |
|
printf("ncoveff=%d, nqfveff=%d, ntveff=%d, nqtveff=%d, cptcovn=%d\n",ncoveff,nqfveff,ntveff,nqtveff,cptcovn); |
|
fprintf(ficlog,"ncoveff=%d, nqfveff=%d, ntveff=%d, nqtveff=%d, cptcovn=%d\n",ncoveff,nqfveff,ntveff,nqtveff,cptcovn); |
|
printf("ncovf=%d, ncovv=%d, ncova=%d, nsd=%d, nsq=%d\n",ncovf,ncovv,ncova,nsd,nsq); |
|
fprintf(ficlog,"ncovf=%d, ncovv=%d, ncova=%d, nsd=%d, nsq=%d\n",ncovf,ncovv,ncova,nsd, nsq); |
return (0); /* with covar[new additional covariate if product] and Tage if age */ |
return (0); /* with covar[new additional covariate if product] and Tage if age */ |
/*endread:*/ |
/*endread:*/ |
printf("Exiting decodemodel: "); |
printf("Exiting decodemodel: "); |
return (1); |
return (1); |
} |
} |
|
|
int calandcheckages(int imx, int maxwav, double *agemin, double *agemax, int *nberr, int *nbwarn ) |
int calandcheckages(int imx, int maxwav, double *agemin, double *agemax, int *nberr, int *nbwarn ) |
{ |
{/* Check ages at death */ |
int i, m; |
int i, m; |
|
int firstone=0; |
|
|
for (i=1; i<=imx; i++) { |
for (i=1; i<=imx; i++) { |
for(m=2; (m<= maxwav); m++) { |
for(m=2; (m<= maxwav); m++) { |
if (((int)mint[m][i]== 99) && (s[m][i] <= nlstate)){ |
if (((int)mint[m][i]== 99) && (s[m][i] <= nlstate)){ |
anint[m][i]=9999; |
anint[m][i]=9999; |
s[m][i]=-1; |
if (s[m][i] != -2) /* Keeping initial status of unknown vital status */ |
|
s[m][i]=-1; |
} |
} |
if((int)moisdc[i]==99 && (int)andc[i]==9999 && s[m][i]>nlstate){ |
if((int)moisdc[i]==99 && (int)andc[i]==9999 && s[m][i]>nlstate){ |
*nberr = *nberr + 1; |
*nberr = *nberr + 1; |
printf("Error! Date of death (month %2d and year %4d) of individual %ld on line %d was unknown, you must set an arbitrary year of death or he/she is skipped and results are biased (%d)\n",(int)moisdc[i],(int)andc[i],num[i],i, *nberr); |
if(firstone == 0){ |
fprintf(ficlog,"Error! Date of death (month %2d and year %4d) of individual %ld on line %d was unknown, you must set an arbitrary year of death or he/she is skipped and results are biased (%d)\n",(int)moisdc[i],(int)andc[i],num[i],i, *nberr); |
firstone=1; |
s[m][i]=-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){ |
if((int)moisdc[i]==99 && (int)andc[i]!=9999 && s[m][i]>nlstate){ |
(*nberr)++; |
(*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]); |
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! 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]); |
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]=-1; /* We prefer to skip it (and to skip it in version 0.8a1 too */ |
s[m][i]=-2; /* We prefer to skip it (and to skip it in version 0.8a1 too */ |
} |
} |
} |
} |
} |
} |
Line 6313 int calandcheckages(int imx, int maxwav,
|
Line 9956 int calandcheckages(int imx, int maxwav,
|
for (i=1; i<=imx; i++) { |
for (i=1; i<=imx; i++) { |
agedc[i]=(moisdc[i]/12.+andc[i])-(moisnais[i]/12.+annais[i]); |
agedc[i]=(moisdc[i]/12.+andc[i])-(moisnais[i]/12.+annais[i]); |
for(m=firstpass; (m<= lastpass); m++){ |
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 (s[m][i] >= nlstate+1) { |
if(agedc[i]>0){ |
if(agedc[i]>0){ |
if((int)moisdc[i]!=99 && (int)andc[i]!=9999){ |
if((int)moisdc[i]!=99 && (int)andc[i]!=9999){ |
agev[m][i]=agedc[i]; |
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 { |
}else { |
if ((int)andc[i]!=9999){ |
if ((int)andc[i]!=9999){ |
nbwarn++; |
nbwarn++; |
Line 6328 int calandcheckages(int imx, int maxwav,
|
Line 9971 int calandcheckages(int imx, int maxwav,
|
} |
} |
} |
} |
} /* agedc > 0 */ |
} /* agedc > 0 */ |
} |
} /* end if */ |
else if(s[m][i] !=9){ /* Standard case, age in fractional |
else if(s[m][i] !=9){ /* Standard case, age in fractional |
years but with the precision of a month */ |
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]); |
agev[m][i]=(mint[m][i]/12.+1./24.+anint[m][i])-(moisnais[i]/12.+1./24.+annais[i]); |
Line 6344 int calandcheckages(int imx, int maxwav,
|
Line 9987 int calandcheckages(int imx, int maxwav,
|
} |
} |
/*agev[m][i]=anint[m][i]-annais[i];*/ |
/*agev[m][i]=anint[m][i]-annais[i];*/ |
/* agev[m][i] = age[i]+2*m;*/ |
/* agev[m][i] = age[i]+2*m;*/ |
} |
} /* en if 9*/ |
else { /* =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; |
agev[m][i]=1; |
s[m][i]=-1; |
s[m][i]=-1; |
} |
} |
} |
} |
else /*= 0 Unknown */ |
else if(s[m][i]==0) /*= 0 Unknown */ |
agev[m][i]=1; |
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 (i=1; i<=imx; i++) { |
for(m=firstpass; (m<=lastpass); m++){ |
for(m=firstpass; (m<=lastpass); m++){ |
if (s[m][i] > (nlstate+ndeath)) { |
if (s[m][i] > (nlstate+ndeath)) { |
Line 6578 void syscompilerinfo(int logged)
|
Line 10227 void syscompilerinfo(int logged)
|
#endif |
#endif |
|
|
|
|
} |
} |
|
|
int prevalence_limit(double *p, double **prlim, double ageminpar, double agemaxpar, double ftolpl, int *ncvyearp){ |
int prevalence_limit(double *p, double **prlim, double ageminpar, double agemaxpar, double ftolpl, int *ncvyearp){ |
/*--------------- Prevalence limit (period or stable prevalence) --------------*/ |
/*--------------- Prevalence limit (period or stable prevalence) --------------*/ |
int i, j, k, i1 ; |
int i, j, k, i1, k4=0, nres=0 ; |
/* double ftolpl = 1.e-10; */ |
/* double ftolpl = 1.e-10; */ |
double age, agebase, agelim; |
double age, agebase, agelim; |
double tot; |
double tot; |
Line 6593 void syscompilerinfo(int logged)
|
Line 10242 void syscompilerinfo(int logged)
|
printf("Problem with period (stable) prevalence resultfile: %s\n", filerespl);return 1; |
printf("Problem with period (stable) prevalence resultfile: %s\n", filerespl);return 1; |
fprintf(ficlog,"Problem with period (stable) prevalence resultfile: %s\n", filerespl);return 1; |
fprintf(ficlog,"Problem with period (stable) prevalence resultfile: %s\n", filerespl);return 1; |
} |
} |
printf("Computing period (stable) prevalence: result on file '%s' \n", filerespl); |
printf("\nComputing period (stable) prevalence: result on file '%s' \n", filerespl); |
fprintf(ficlog,"Computing period (stable) prevalence: result on file '%s' \n", filerespl); |
fprintf(ficlog,"\nComputing period (stable) prevalence: result on file '%s' \n", filerespl); |
pstamp(ficrespl); |
pstamp(ficrespl); |
fprintf(ficrespl,"# Period (stable) prevalence. Precision given by ftolpl=%g \n", ftolpl); |
fprintf(ficrespl,"# Period (stable) prevalence. Precision given by ftolpl=%g \n", ftolpl); |
fprintf(ficrespl,"#Age "); |
fprintf(ficrespl,"#Age "); |
for(i=1; i<=nlstate;i++) fprintf(ficrespl,"%d-%d ",i,i); |
for(i=1; i<=nlstate;i++) fprintf(ficrespl,"%d-%d ",i,i); |
fprintf(ficrespl,"\n"); |
fprintf(ficrespl,"\n"); |
|
|
/* prlim=matrix(1,nlstate,1,nlstate);*/ /* back in main */ |
/* prlim=matrix(1,nlstate,1,nlstate);*/ /* back in main */ |
|
|
agebase=ageminpar; |
agebase=ageminpar; |
agelim=agemaxpar; |
agelim=agemaxpar; |
|
|
i1=pow(2,cptcoveff); |
/* i1=pow(2,ncoveff); */ |
if (cptcovn < 1){i1=1;} |
i1=pow(2,cptcoveff); /* Number of combination of dummy covariates */ |
|
if (cptcovn < 1){i1=1;} |
|
|
for(cptcov=1,k=0;cptcov<=i1;cptcov++){ |
for(k=1; k<=i1;k++){ /* For each combination k of dummy covariates in the model */ |
/* for(cptcov=1,k=0;cptcov<=1;cptcov++){ */ |
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++){ |
//for(cptcod=1;cptcod<=ncodemax[cptcov];cptcod++){ |
k=k+1; |
/* k=k+1; */ |
/* to clean */ |
/* to clean */ |
//printf("cptcov=%d cptcod=%d codtab=%d\n",cptcov, cptcod,codtabm(cptcod,cptcov)); |
//printf("cptcov=%d cptcod=%d codtab=%d\n",cptcov, cptcod,codtabm(cptcod,cptcov)); |
fprintf(ficrespl,"#******"); |
fprintf(ficrespl,"#******"); |
printf("#******"); |
printf("#******"); |
fprintf(ficlog,"#******"); |
fprintf(ficlog,"#******"); |
for(j=1;j<=cptcoveff;j++) { |
for(j=1;j<=cptcoveff ;j++) {/* all covariates */ |
fprintf(ficrespl," V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); |
fprintf(ficrespl," V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); /* Here problem for varying dummy*/ |
printf(" V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); |
printf(" V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); |
fprintf(ficlog," V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); |
fprintf(ficlog," V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); |
} |
} |
fprintf(ficrespl,"******\n"); |
for (k4=1; k4<= nsq; k4++){ /* For each selected (single) quantitative value */ |
printf("******\n"); |
printf(" V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); |
fprintf(ficlog,"******\n"); |
fprintf(ficrespl," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); |
|
fprintf(ficlog," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); |
fprintf(ficrespl,"#Age "); |
} |
for(j=1;j<=cptcoveff;j++) { |
fprintf(ficrespl,"******\n"); |
fprintf(ficrespl,"V%d %d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); |
printf("******\n"); |
} |
fprintf(ficlog,"******\n"); |
for(i=1; i<=nlstate;i++) fprintf(ficrespl," %d-%d ",i,i); |
if(invalidvarcomb[k]){ |
fprintf(ficrespl,"Total Years_to_converge\n"); |
printf("\nCombination (%d) ignored because no case \n",k); |
|
fprintf(ficrespl,"#Combination (%d) ignored because no case \n",k); |
for (age=agebase; age<=agelim; age++){ |
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++){ */ |
/* for (age=agebase; age<=agebase; age++){ */ |
prevalim(prlim, nlstate, p, age, oldm, savm, ftolpl, ncvyearp, k); |
prevalim(prlim, nlstate, p, age, oldm, savm, ftolpl, ncvyearp, k, nres); |
fprintf(ficrespl,"%.0f ",age ); |
fprintf(ficrespl,"%.0f ",age ); |
for(j=1;j<=cptcoveff;j++) |
for(j=1;j<=cptcoveff;j++) |
fprintf(ficrespl,"%d %d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); |
fprintf(ficrespl,"%d %d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,j)]); |
tot=0.; |
tot=0.; |
for(i=1; i<=nlstate;i++){ |
for(i=1; i<=nlstate;i++){ |
tot += prlim[i][i]; |
tot += prlim[i][i]; |
fprintf(ficrespl," %.5f", prlim[i][i]); |
fprintf(ficrespl," %.5f", prlim[i][i]); |
} |
} |
fprintf(ficrespl," %.3f %d\n", tot, *ncvyearp); |
fprintf(ficrespl," %.3f %d\n", tot, *ncvyearp); |
} /* Age */ |
} /* Age */ |
/* was end of cptcod */ |
/* was end of cptcod */ |
} /* cptcov */ |
} /* 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 (period or stable prevalence) --------------*/ |
|
|
|
/* Computes the back prevalence limit for any combination of covariate values |
|
* at any age between ageminpar and agemaxpar |
|
*/ |
|
int i, j, k, i1, 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 period (stable) back prevalence resultfile: %s\n", fileresplb);return 1; |
|
fprintf(ficlog,"Problem with period (stable) back prevalence resultfile: %s\n", fileresplb);return 1; |
|
} |
|
printf("Computing period (stable) back prevalence: result on file '%s' \n", fileresplb); |
|
fprintf(ficlog,"Computing period (stable) back prevalence: result on file '%s' \n", fileresplb); |
|
pstamp(ficresplb); |
|
fprintf(ficresplb,"# Period (stable) back 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){ |
int hPijx(double *p, int bage, int fage){ |
/*------------- h Pij x at various ages ------------*/ |
/*------------- h Pij x at various ages ------------*/ |
|
|
Line 6659 int hPijx(double *p, int bage, int fage)
|
Line 10435 int hPijx(double *p, int bage, int fage)
|
int agelim; |
int agelim; |
int hstepm; |
int hstepm; |
int nhstepm; |
int nhstepm; |
int h, i, i1, j, k; |
int h, i, i1, j, k, k4, nres=0; |
|
|
double agedeb; |
double agedeb; |
double ***p3mat; |
double ***p3mat; |
Line 6678 int hPijx(double *p, int bage, int fage)
|
Line 10454 int hPijx(double *p, int bage, int fage)
|
agelim=AGESUP; |
agelim=AGESUP; |
hstepm=stepsize*YEARM; /* Every year of age */ |
hstepm=stepsize*YEARM; /* Every year of age */ |
hstepm=hstepm/stepm; /* Typically 2 years, = 2/6 months = 4 */ |
hstepm=hstepm/stepm; /* Typically 2 years, = 2/6 months = 4 */ |
|
|
/* hstepm=1; aff par mois*/ |
/* hstepm=1; aff par mois*/ |
pstamp(ficrespij); |
pstamp(ficrespij); |
fprintf(ficrespij,"#****** h Pij x Probability to be in state j at age x+h being in i at x "); |
fprintf(ficrespij,"#****** h Pij x Probability to be in state j at age x+h being in i at x "); |
i1= pow(2,cptcoveff); |
i1= pow(2,cptcoveff); |
/* for(cptcov=1,k=0;cptcov<=i1;cptcov++){ */ |
/* for(cptcov=1,k=0;cptcov<=i1;cptcov++){ */ |
/* /\*for(cptcod=1;cptcod<=ncodemax[cptcov];cptcod++){*\/ */ |
/* /\*for(cptcod=1;cptcod<=ncodemax[cptcov];cptcod++){*\/ */ |
/* k=k+1; */ |
/* k=k+1; */ |
for (k=1; k <= (int) pow(2,cptcoveff); k++){ |
for(nres=1; nres <= nresult; nres++) /* For each resultline */ |
|
for(k=1; k<=i1;k++){ |
|
if(i1 != 1 && TKresult[nres]!= k) |
|
continue; |
fprintf(ficrespij,"\n#****** "); |
fprintf(ficrespij,"\n#****** "); |
for(j=1;j<=cptcoveff;j++) |
for(j=1;j<=cptcoveff;j++) |
fprintf(ficrespij,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,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"); |
fprintf(ficrespij,"******\n"); |
|
|
for (agedeb=fage; agedeb>=bage; agedeb--){ /* If stepm=6 months */ |
for (agedeb=fage; agedeb>=bage; agedeb--){ /* If stepm=6 months */ |
Line 6700 int hPijx(double *p, int bage, int fage)
|
Line 10483 int hPijx(double *p, int bage, int fage)
|
|
|
p3mat=ma3x(1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); |
p3mat=ma3x(1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); |
oldm=oldms;savm=savms; |
oldm=oldms;savm=savms; |
hpxij(p3mat,nhstepm,agedeb,hstepm,p,nlstate,stepm,oldm,savm, k); |
hpxij(p3mat,nhstepm,agedeb,hstepm,p,nlstate,stepm,oldm,savm, k, nres); |
fprintf(ficrespij,"# Cov Agex agex+h hpijx with i,j="); |
fprintf(ficrespij,"# Cov Agex agex+h hpijx with i,j="); |
for(i=1; i<=nlstate;i++) |
for(i=1; i<=nlstate;i++) |
for(j=1; j<=nlstate+ndeath;j++) |
for(j=1; j<=nlstate+ndeath;j++) |
Line 6719 int hPijx(double *p, int bage, int fage)
|
Line 10502 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=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); /* Typically 20 years = 20*12/6=40 */ |
|
nhstepm = nhstepm/hstepm; /* Typically 40/4=10, because estepm=24 stepm=6 => hstepm=24/6=4 */ |
|
|
|
/* nhstepm=nhstepm*YEARM; aff par mois*/ |
|
|
|
p3mat=ma3x(1,nlstate+ndeath,1, nlstate+ndeath, 0,nhstepm); /* 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 */ |
|
|
|
|
/***********************************************/ |
/***********************************************/ |
Line 6745 int main(int argc, char *argv[])
|
Line 10617 int main(int argc, char *argv[])
|
int itimes; |
int itimes; |
int NDIM=2; |
int NDIM=2; |
int vpopbased=0; |
int vpopbased=0; |
|
int nres=0; |
|
int endishere=0; |
|
int noffset=0; |
|
int ncurrv=0; /* Temporary variable */ |
|
|
char ca[32], cb[32]; |
char ca[32], cb[32]; |
/* FILE *fichtm; *//* Html File */ |
/* FILE *fichtm; *//* Html File */ |
/* FILE *ficgp;*/ /*Gnuplot File */ |
/* FILE *ficgp;*/ /*Gnuplot File */ |
Line 6753 int main(int argc, char *argv[])
|
Line 10629 int main(int argc, char *argv[])
|
double agedeb=0.; |
double agedeb=0.; |
|
|
double ageminpar=AGEOVERFLOW,agemin=AGEOVERFLOW, agemaxpar=-AGEOVERFLOW, agemax=-AGEOVERFLOW; |
double ageminpar=AGEOVERFLOW,agemin=AGEOVERFLOW, agemaxpar=-AGEOVERFLOW, agemax=-AGEOVERFLOW; |
|
double ageminout=-AGEOVERFLOW,agemaxout=AGEOVERFLOW; /* Smaller Age range redefined after movingaverage */ |
|
|
double fret; |
double fret; |
double dum=0.; /* Dummy variable */ |
double dum=0.; /* Dummy variable */ |
double ***p3mat; |
double ***p3mat; |
double ***mobaverage; |
/* double ***mobaverage; */ |
|
|
char line[MAXLINE]; |
char line[MAXLINE]; |
char path[MAXLINE],pathc[MAXLINE],pathcd[MAXLINE],pathtot[MAXLINE]; |
char path[MAXLINE],pathc[MAXLINE],pathcd[MAXLINE],pathtot[MAXLINE]; |
|
|
char model[MAXLINE], modeltemp[MAXLINE]; |
char modeltemp[MAXLINE]; |
|
char resultline[MAXLINE]; |
|
|
char pathr[MAXLINE], pathimach[MAXLINE]; |
char pathr[MAXLINE], pathimach[MAXLINE]; |
char *tok, *val; /* pathtot */ |
char *tok, *val; /* pathtot */ |
int firstobs=1, lastobs=10; |
int firstobs=1, lastobs=10; |
Line 6773 int main(int argc, char *argv[])
|
Line 10652 int main(int argc, char *argv[])
|
|
|
int *tab; |
int *tab; |
int mobilavproj=0 , prevfcast=0 ; /* moving average of prev, If prevfcast=1 prevalence projection */ |
int mobilavproj=0 , prevfcast=0 ; /* moving average of prev, If prevfcast=1 prevalence projection */ |
|
int backcast=0; |
int mobilav=0,popforecast=0; |
int mobilav=0,popforecast=0; |
int hstepm=0, nhstepm=0; |
int hstepm=0, nhstepm=0; |
int agemortsup; |
int agemortsup; |
Line 6783 int main(int argc, char *argv[])
|
Line 10663 int main(int argc, char *argv[])
|
double bage=0, fage=110., age, agelim=0., agebase=0.; |
double bage=0, fage=110., age, agelim=0., agebase=0.; |
double ftolpl=FTOL; |
double ftolpl=FTOL; |
double **prlim; |
double **prlim; |
|
double **bprlim; |
double ***param; /* Matrix of parameters */ |
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 **matcov; /* Matrix of covariance */ |
double **hess; /* Hessian matrix */ |
double **hess; /* Hessian matrix */ |
double ***delti3; /* Scale */ |
double ***delti3; /* Scale */ |
double *delti; /* Scale */ |
double *delti; /* Scale */ |
double ***eij, ***vareij; |
double ***eij, ***vareij; |
double **varpl; /* Variances of prevalence limits by age */ |
double **varpl; /* Variances of prevalence limits by age */ |
|
|
double *epj, vepp; |
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; |
|
double jback1=1,mback1=1,anback1=2000,jback2=1,mback2=1,anback2=2000, dateback1=0, dateback2=0; |
|
|
double **ximort; |
double **ximort; |
char *alph[]={"a","a","b","c","d","e"}, str[4]="1234"; |
char *alph[]={"a","a","b","c","d","e"}, str[4]="1234"; |
int *dcwave; |
int *dcwave; |
Line 6959 int main(int argc, char *argv[])
|
Line 10845 int main(int argc, char *argv[])
|
fflush(ficlog); |
fflush(ficlog); |
goto end; |
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 '#' */ |
/* Reads comments: lines beginning with '#' */ |
numlinepar=0; |
numlinepar=0; |
|
/* Is it a BOM UTF-8 Windows file? */ |
/* First parameter line */ |
/* First parameter line */ |
while(fgets(line, MAXLINE, ficpar)) { |
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) |
|
{ |
|
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 starts with a # it is a comment */ |
if (line[0] == '#') { |
if (line[noffset] == '#') { |
numlinepar++; |
numlinepar++; |
fputs(line,stdout); |
fputs(line,stdout); |
fputs(line,ficparo); |
fputs(line,ficparo); |
|
fputs(line,ficres); |
fputs(line,ficlog); |
fputs(line,ficlog); |
continue; |
continue; |
}else |
}else |
Line 6990 int main(int argc, char *argv[])
|
Line 10911 int main(int argc, char *argv[])
|
numlinepar++; |
numlinepar++; |
fputs(line,stdout); |
fputs(line,stdout); |
fputs(line,ficparo); |
fputs(line,ficparo); |
|
fputs(line,ficres); |
fputs(line,ficlog); |
fputs(line,ficlog); |
continue; |
continue; |
}else |
}else |
break; |
break; |
} |
} |
if((num_filled=sscanf(line,"ftol=%lf stepm=%d ncovcol=%d nlstate=%d ndeath=%d maxwav=%d mle=%d weight=%d\n", \ |
if((num_filled=sscanf(line,"ftol=%lf stepm=%d ncovcol=%d nqv=%d ntv=%d nqtv=%d nlstate=%d ndeath=%d maxwav=%d mle=%d weight=%d\n", \ |
&ftol, &stepm, &ncovcol, &nlstate, &ndeath, &maxwav, &mle, &weightopt)) !=EOF){ |
&ftol, &stepm, &ncovcol, &nqv, &ntv, &nqtv, &nlstate, &ndeath, &maxwav, &mle, &weightopt)) !=EOF){ |
if (num_filled != 8) { |
if (num_filled != 11) { |
printf("Not 8 parameters, for example:ftol=1.e-8 stepm=12 ncovcol=2 nlstate=2 ndeath=1 maxwav=3 mle=1 weight=1\n"); |
printf("Not 11 parameters, for example:ftol=1.e-8 stepm=12 ncovcol=2 nqv=1 ntv=2 nqtv=1 nlstate=2 ndeath=1 maxwav=3 mle=1 weight=1\n"); |
printf("but line=%s\n",line); |
printf("but line=%s\n",line); |
} |
} |
printf("ftol=%e stepm=%d ncovcol=%d nlstate=%d ndeath=%d maxwav=%d mle=%d weight=%d\n",ftol, stepm, ncovcol, nlstate,ndeath, maxwav, mle, weightopt); |
printf("ftol=%e stepm=%d ncovcol=%d nqv=%d ntv=%d nqtv=%d nlstate=%d ndeath=%d maxwav=%d mle=%d weight=%d\n",ftol, stepm, ncovcol, nqv, ntv, nqtv, nlstate, ndeath, maxwav, mle, weightopt); |
} |
} |
/* ftolpl=6*ftol*1.e5; /\* 6.e-3 make convergences in less than 80 loops for the prevalence limit *\/ */ |
/* ftolpl=6*ftol*1.e5; /\* 6.e-3 make convergences in less than 80 loops for the prevalence limit *\/ */ |
/*ftolpl=6.e-4; *//* 6.e-3 make convergences in less than 80 loops for the prevalence limit */ |
/*ftolpl=6.e-4; *//* 6.e-3 make convergences in less than 80 loops for the prevalence limit */ |
Line 7012 int main(int argc, char *argv[])
|
Line 10934 int main(int argc, char *argv[])
|
numlinepar++; |
numlinepar++; |
fputs(line,stdout); |
fputs(line,stdout); |
fputs(line,ficparo); |
fputs(line,ficparo); |
|
fputs(line,ficres); |
fputs(line,ficlog); |
fputs(line,ficlog); |
continue; |
continue; |
}else |
}else |
break; |
break; |
} |
} |
if((num_filled=sscanf(line,"model=1+age%[^.\n]", model)) !=EOF){ |
if((num_filled=sscanf(line,"model=1+age%[^.\n]", model)) !=EOF){ |
if (num_filled == 0) |
if (num_filled == 0){ |
model[0]='\0'; |
printf("ERROR %d: Model should be at minimum 'model=1+age.' WITHOUT space:'%s'\n",num_filled, line); |
else if (num_filled != 1){ |
fprintf(ficlog,"ERROR %d: Model should be at minimum 'model=1+age.' WITHOUT space:'%s'\n",num_filled, line); |
|
model[0]='\0'; |
|
goto end; |
|
} else if (num_filled != 1){ |
printf("ERROR %d: Model should be at minimum 'model=1+age.' %s\n",num_filled, line); |
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); |
fprintf(ficlog,"ERROR %d: Model should be at minimum 'model=1+age.' %s\n",num_filled, line); |
model[0]='\0'; |
model[0]='\0'; |
Line 7039 int main(int argc, char *argv[])
|
Line 10965 int main(int argc, char *argv[])
|
/* fscanf(ficpar,"title=%s datafile=%s lastobs=%d firstpass=%d lastpass=%d\nftol=%lf stepm=%d ncovcol=%d nlstate=%d ndeath=%d maxwav=%d mle=%d weight=%d model=1+age+%s\n",title, datafile, &lastobs, &firstpass,&lastpass,&ftol, &stepm, &ncovcol, &nlstate,&ndeath, &maxwav, &mle, &weightopt,model); */ |
/* fscanf(ficpar,"title=%s datafile=%s lastobs=%d firstpass=%d lastpass=%d\nftol=%lf stepm=%d ncovcol=%d nlstate=%d ndeath=%d maxwav=%d mle=%d weight=%d model=1+age+%s\n",title, datafile, &lastobs, &firstpass,&lastpass,&ftol, &stepm, &ncovcol, &nlstate,&ndeath, &maxwav, &mle, &weightopt,model); */ |
/* numlinepar=numlinepar+3; /\* In general *\/ */ |
/* numlinepar=numlinepar+3; /\* In general *\/ */ |
/* printf("title=%s datafile=%s lastobs=%d firstpass=%d lastpass=%d\nftol=%e stepm=%d ncovcol=%d nlstate=%d ndeath=%d maxwav=%d mle=%d weight=%d\nmodel=1+age+%s\n", title, datafile, lastobs, firstpass,lastpass,ftol, stepm, ncovcol, nlstate,ndeath, maxwav, mle, weightopt,model); */ |
/* printf("title=%s datafile=%s lastobs=%d firstpass=%d lastpass=%d\nftol=%e stepm=%d ncovcol=%d nlstate=%d ndeath=%d maxwav=%d mle=%d weight=%d\nmodel=1+age+%s\n", title, datafile, lastobs, firstpass,lastpass,ftol, stepm, ncovcol, nlstate,ndeath, maxwav, mle, weightopt,model); */ |
fprintf(ficparo,"title=%s datafile=%s lastobs=%d firstpass=%d lastpass=%d\nftol=%e stepm=%d ncovcol=%d nlstate=%d ndeath=%d maxwav=%d mle=%d weight=%d\nmodel=1+age+%s.\n", title, datafile, lastobs, firstpass,lastpass,ftol,stepm,ncovcol,nlstate,ndeath,maxwav, mle, weightopt,model); |
fprintf(ficparo,"title=%s datafile=%s lastobs=%d firstpass=%d lastpass=%d\nftol=%e stepm=%d ncovcol=%d nqv=%d ntv=%d nqtv=%d nlstate=%d ndeath=%d maxwav=%d mle=%d weight=%d\nmodel=1+age+%s.\n", title, datafile, lastobs, firstpass,lastpass,ftol,stepm,ncovcol, nqv, ntv, nqtv, nlstate,ndeath,maxwav, mle, weightopt,model); |
fprintf(ficlog,"title=%s datafile=%s lastobs=%d firstpass=%d lastpass=%d\nftol=%e stepm=%d ncovcol=%d nlstate=%d ndeath=%d maxwav=%d mle=%d weight=%d\nmodel=1+age+%s.\n", title, datafile, lastobs, firstpass,lastpass,ftol,stepm,ncovcol,nlstate,ndeath,maxwav, mle, weightopt,model); |
fprintf(ficlog,"title=%s datafile=%s lastobs=%d firstpass=%d lastpass=%d\nftol=%e stepm=%d ncovcol=%d nqv=%d ntv=%d nqtv=%d nlstate=%d ndeath=%d maxwav=%d mle=%d weight=%d\nmodel=1+age+%s.\n", title, datafile, lastobs, firstpass,lastpass,ftol,stepm,ncovcol, nqv, ntv, nqtv, nlstate,ndeath,maxwav, mle, weightopt,model); |
fflush(ficlog); |
fflush(ficlog); |
/* if(model[0]=='#'|| model[0]== '\0'){ */ |
/* if(model[0]=='#'|| model[0]== '\0'){ */ |
if(model[0]=='#'){ |
if(model[0]=='#'){ |
Line 7069 int main(int argc, char *argv[])
|
Line 10995 int main(int argc, char *argv[])
|
|
|
|
|
covar=matrix(0,NCOVMAX,1,n); /**< used in readdata */ |
covar=matrix(0,NCOVMAX,1,n); /**< used in readdata */ |
|
if(nqv>=1)coqvar=matrix(1,nqv,1,n); /**< Fixed quantitative covariate */ |
|
if(nqtv>=1)cotqvar=ma3x(1,maxwav,1,nqtv,1,n); /**< Time varying quantitative covariate */ |
|
if(ntv+nqtv>=1)cotvar=ma3x(1,maxwav,1,ntv+nqtv,1,n); /**< 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*/ |
cptcovn=0; /*Number of covariates, i.e. number of '+' in model statement plus one, indepently of n in Vn*/ |
/* v1+v2+v3+v2*v4+v5*age makes cptcovn = 5 |
/* v1+v2+v3+v2*v4+v5*age makes cptcovn = 5 |
v1+v2*age+v2*v3 makes cptcovn = 3 |
v1+v2*age+v2*v3 makes cptcovn = 3 |
Line 7090 int main(int argc, char *argv[])
|
Line 11019 int main(int argc, char *argv[])
|
delti=delti3[1][1]; |
delti=delti3[1][1]; |
/*delti=vector(1,npar); *//* Scale of each paramater (output from hesscov)*/ |
/*delti=vector(1,npar); *//* Scale of each paramater (output from hesscov)*/ |
if(mle==-1){ /* Print a wizard for help writing covariance matrix */ |
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;i<nlstate;i++){ */ |
|
/* /\*reducing xi for 1 to npar to 1 to ncovmodel; *\/ */ |
|
/* mlikeli(ficres,p, ncovmodel, ncovmodel, nlstate, ftol, funcnoprod); */ |
|
/* } */ |
prwizard(ncovmodel, nlstate, ndeath, model, ficparo); |
prwizard(ncovmodel, nlstate, ndeath, model, ficparo); |
printf(" You chose mle=-1, look at file %s for a template of covariance matrix \n",filereso); |
printf(" You chose mle=-1, look at file %s for a template of covariance matrix \n",filereso); |
fprintf(ficlog," You chose mle=-1, look at file %s for a template of covariance matrix \n",filereso); |
fprintf(ficlog," You chose mle=-1, look at file %s for a template of covariance matrix \n",filereso); |
Line 7098 int main(int argc, char *argv[])
|
Line 11033 int main(int argc, char *argv[])
|
fclose (ficlog); |
fclose (ficlog); |
goto end; |
goto end; |
exit(0); |
exit(0); |
} |
} else if(mle==-5) { /* Main Wizard */ |
else if(mle==-3) { /* Main Wizard */ |
|
prwizard(ncovmodel, nlstate, ndeath, model, ficparo); |
prwizard(ncovmodel, nlstate, ndeath, model, ficparo); |
printf(" You chose mle=-3, look at file %s for a template of covariance matrix \n",filereso); |
printf(" You chose mle=-3, look at file %s for a template of covariance matrix \n",filereso); |
fprintf(ficlog," You chose mle=-3, look at file %s for a template of covariance matrix \n",filereso); |
fprintf(ficlog," You chose mle=-3, look at file %s for a template of covariance matrix \n",filereso); |
param= ma3x(1,nlstate,1,nlstate+ndeath-1,1,ncovmodel); |
param= ma3x(1,nlstate,1,nlstate+ndeath-1,1,ncovmodel); |
matcov=matrix(1,npar,1,npar); |
matcov=matrix(1,npar,1,npar); |
hess=matrix(1,npar,1,npar); |
hess=matrix(1,npar,1,npar); |
} |
} else{ /* Begin of mle != -1 or -5 */ |
else{ |
|
/* Read guessed parameters */ |
/* Read guessed parameters */ |
/* Reads comments: lines beginning with '#' */ |
/* Reads comments: lines beginning with '#' */ |
while((c=getc(ficpar))=='#' && c!= EOF){ |
while((c=getc(ficpar))=='#' && c!= EOF){ |
Line 7121 int main(int argc, char *argv[])
|
Line 11054 int main(int argc, char *argv[])
|
ungetc(c,ficpar); |
ungetc(c,ficpar); |
|
|
param= ma3x(1,nlstate,1,nlstate+ndeath-1,1,ncovmodel); |
param= ma3x(1,nlstate,1,nlstate+ndeath-1,1,ncovmodel); |
|
paramstart= ma3x(1,nlstate,1,nlstate+ndeath-1,1,ncovmodel); |
for(i=1; i <=nlstate; i++){ |
for(i=1; i <=nlstate; i++){ |
j=0; |
j=0; |
for(jj=1; jj <=nlstate+ndeath; jj++){ |
for(jj=1; jj <=nlstate+ndeath; jj++){ |
Line 7156 run imach with mle=-1 to get a correct t
|
Line 11090 run imach with mle=-1 to get a correct t
|
} |
} |
} |
} |
fflush(ficlog); |
fflush(ficlog); |
|
|
/* Reads scales values */ |
/* Reads parameters values */ |
p=param[1][1]; |
p=param[1][1]; |
|
pstart=paramstart[1][1]; |
|
|
/* Reads comments: lines beginning with '#' */ |
/* Reads comments: lines beginning with '#' */ |
while((c=getc(ficpar))=='#' && c!= EOF){ |
while((c=getc(ficpar))=='#' && c!= EOF){ |
Line 7195 run imach with mle=-1 to get a correct t
|
Line 11130 run imach with mle=-1 to get a correct t
|
} |
} |
} |
} |
fflush(ficlog); |
fflush(ficlog); |
|
|
/* Reads covariance matrix */ |
/* Reads covariance matrix */ |
delti=delti3[1][1]; |
delti=delti3[1][1]; |
|
|
|
|
/* free_ma3x(delti3,1,nlstate,1,nlstate+ndeath-1,1,ncovmodel); */ /* Hasn't to to freed here otherwise delti is no more allocated */ |
/* free_ma3x(delti3,1,nlstate,1,nlstate+ndeath-1,1,ncovmodel); */ /* Hasn't to to freed here otherwise delti is no more allocated */ |
|
|
/* Reads comments: lines beginning with '#' */ |
/* Reads comments: lines beginning with '#' */ |
while((c=getc(ficpar))=='#' && c!= EOF){ |
while((c=getc(ficpar))=='#' && c!= EOF){ |
ungetc(c,ficpar); |
ungetc(c,ficpar); |
Line 7212 run imach with mle=-1 to get a correct t
|
Line 11147 run imach with mle=-1 to get a correct t
|
fputs(line,ficlog); |
fputs(line,ficlog); |
} |
} |
ungetc(c,ficpar); |
ungetc(c,ficpar); |
|
|
matcov=matrix(1,npar,1,npar); |
matcov=matrix(1,npar,1,npar); |
hess=matrix(1,npar,1,npar); |
hess=matrix(1,npar,1,npar); |
for(i=1; i <=npar; i++) |
for(i=1; i <=npar; i++) |
for(j=1; j <=npar; j++) matcov[i][j]=0.; |
for(j=1; j <=npar; j++) matcov[i][j]=0.; |
|
|
/* Scans npar lines */ |
/* Scans npar lines */ |
for(i=1; i <=npar; i++){ |
for(i=1; i <=npar; i++){ |
count=fscanf(ficpar,"%1d%1d%1d",&i1,&j1,&jk); |
count=fscanf(ficpar,"%1d%1d%d",&i1,&j1,&jk); |
if(count != 3){ |
if(count != 3){ |
printf("Error! Error in parameter file %s at line %d after line starting with %1d%1d%1d\n\ |
printf("Error! Error in parameter file %s at line %d after line starting with %1d%1d%1d\n\ |
This is probably because your covariance matrix doesn't \n contain exactly %d lines corresponding to your model line '1+age+%s'.\n\ |
This is probably because your covariance matrix doesn't \n contain exactly %d lines corresponding to your model line '1+age+%s'.\n\ |
Line 7229 Please run with mle=-1 to get a correct
|
Line 11164 Please run with mle=-1 to get a correct
|
This is probably because your covariance matrix doesn't \n contain exactly %d lines corresponding to your model line '1+age+%s'.\n\ |
This is probably because your covariance matrix doesn't \n contain exactly %d lines corresponding to your model line '1+age+%s'.\n\ |
Please run with mle=-1 to get a correct covariance matrix.\n",optionfile,numlinepar, i1,j1,jk, npar, model); |
Please run with mle=-1 to get a correct covariance matrix.\n",optionfile,numlinepar, i1,j1,jk, npar, model); |
exit(1); |
exit(1); |
}else |
}else{ |
if(mle==1) |
if(mle==1) |
printf("%1d%1d%1d",i1,j1,jk); |
printf("%1d%1d%d",i1,j1,jk); |
fprintf(ficlog,"%1d%1d%1d",i1,j1,jk); |
} |
fprintf(ficparo,"%1d%1d%1d",i1,j1,jk); |
fprintf(ficlog,"%1d%1d%d",i1,j1,jk); |
|
fprintf(ficparo,"%1d%1d%d",i1,j1,jk); |
for(j=1; j <=i; j++){ |
for(j=1; j <=i; j++){ |
fscanf(ficpar," %le",&matcov[i][j]); |
fscanf(ficpar," %le",&matcov[i][j]); |
if(mle==1){ |
if(mle==1){ |
Line 7245 Please run with mle=-1 to get a correct
|
Line 11181 Please run with mle=-1 to get a correct
|
fscanf(ficpar,"\n"); |
fscanf(ficpar,"\n"); |
numlinepar++; |
numlinepar++; |
if(mle==1) |
if(mle==1) |
printf("\n"); |
printf("\n"); |
fprintf(ficlog,"\n"); |
fprintf(ficlog,"\n"); |
fprintf(ficparo,"\n"); |
fprintf(ficparo,"\n"); |
} |
} |
Line 7260 Please run with mle=-1 to get a correct
|
Line 11196 Please run with mle=-1 to get a correct
|
|
|
fflush(ficlog); |
fflush(ficlog); |
|
|
/*-------- 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; |
|
} |
|
fprintf(ficres,"#%s\n",version); |
|
} /* End of mle != -3 */ |
} /* End of mle != -3 */ |
|
|
/* Main data |
/* Main data |
*/ |
*/ |
n= lastobs; |
n= lastobs; |
Line 7280 Please run with mle=-1 to get a correct
|
Line 11206 Please run with mle=-1 to get a correct
|
annais=vector(1,n); |
annais=vector(1,n); |
moisdc=vector(1,n); |
moisdc=vector(1,n); |
andc=vector(1,n); |
andc=vector(1,n); |
|
weight=vector(1,n); |
agedc=vector(1,n); |
agedc=vector(1,n); |
cod=ivector(1,n); |
cod=ivector(1,n); |
weight=vector(1,n); |
for(i=1;i<=n;i++){ |
for(i=1;i<=n;i++) weight[i]=1.0; /* Equal weights, 1 by default */ |
num[i]=0; |
|
moisnais[i]=0; |
|
annais[i]=0; |
|
moisdc[i]=0; |
|
andc[i]=0; |
|
agedc[i]=0; |
|
cod[i]=0; |
|
weight[i]=1.0; /* Equal weights, 1 by default */ |
|
} |
mint=matrix(1,maxwav,1,n); |
mint=matrix(1,maxwav,1,n); |
anint=matrix(1,maxwav,1,n); |
anint=matrix(1,maxwav,1,n); |
s=imatrix(1,maxwav+1,1,n); /* s[i][j] health state for wave i and individual j */ |
s=imatrix(1,maxwav+1,1,n); /* s[i][j] health state for wave i and individual j */ |
Line 7296 Please run with mle=-1 to get a correct
|
Line 11231 Please run with mle=-1 to get a correct
|
goto end; |
goto end; |
|
|
/* Calculation of the number of parameters from char model */ |
/* 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=4 (age*V3) Tvar[k=4]= 3 (from V3) Tag[cptcovage=1]=4 |
k=3 V4 Tvar[k=3]= 4 (from V4) |
k=3 V4 Tvar[k=3]= 4 (from V4) |
k=2 V1 Tvar[k=2]= 1 (from V1) |
k=2 V1 Tvar[k=2]= 1 (from V1) |
k=1 Tvar[1]=2 (from V2) |
k=1 Tvar[1]=2 (from V2) |
*/ |
*/ |
|
|
Tvar=ivector(1,NCOVMAX); /* Was 15 changed to NCOVMAX. */ |
Tvar=ivector(1,NCOVMAX); /* Was 15 changed to NCOVMAX. */ |
|
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). |
/* V2+V1+V4+age*V3 is a model with 4 covariates (3 plus signs). |
For each model-covariate stores the data-covariate id. Tvar[1]=2, Tvar[2]=1, Tvar[3]=4, |
For each model-covariate stores the data-covariate id. Tvar[1]=2, Tvar[2]=1, Tvar[3]=4, |
Tvar[4=age*V3] is 3 and 'age' is recorded in Tage. |
Tvar[4=age*V3] is 3 and 'age' is recorded in Tage. |
Line 7312 Please run with mle=-1 to get a correct
|
Line 11272 Please run with mle=-1 to get a correct
|
ncovcol + k1 |
ncovcol + k1 |
If already ncovcol=4 and model=V2+V1+V1*V4+age*V3 |
If already ncovcol=4 and model=V2+V1+V1*V4+age*V3 |
Tvar[3=V1*V4]=4+1 etc */ |
Tvar[3=V1*V4]=4+1 etc */ |
Tprod=ivector(1,NCOVMAX); /* Gives the position of a product */ |
Tprod=ivector(1,NCOVMAX); /* Gives the k position of the k1 product */ |
|
Tposprod=ivector(1,NCOVMAX); /* Gives the k1 product from the k position */ |
/* Tprod[k1=1]=3(=V1*V4) for V2+V1+V1*V4+age*V3 |
/* Tprod[k1=1]=3(=V1*V4) for V2+V1+V1*V4+age*V3 |
if V2+V1+V1*V4+age*V3+V3*V2 TProd[k1=2]=5 (V3*V2) |
if V2+V1+V1*V4+age*V3+V3*V2 TProd[k1=2]=5 (V3*V2) |
|
Tposprod[k]=k1 , Tposprod[3]=1, Tposprod[5]=2 |
*/ |
*/ |
Tvaraff=ivector(1,NCOVMAX); /* Unclear */ |
Tvaraff=ivector(1,NCOVMAX); /* Unclear */ |
Tvard=imatrix(1,NCOVMAX,1,2); /* n=Tvard[k1][1] and m=Tvard[k1][2] gives the couple n,m of the k1 th product Vn*Vm |
Tvard=imatrix(1,NCOVMAX,1,2); /* n=Tvard[k1][1] and m=Tvard[k1][2] gives the couple n,m of the k1 th product Vn*Vm |
Line 7324 Please run with mle=-1 to get a correct
|
Line 11286 Please run with mle=-1 to get a correct
|
4 covariates (3 plus signs) |
4 covariates (3 plus signs) |
Tage[1=V3*age]= 4; Tage[2=age*V4] = 3 |
Tage[1=V3*age]= 4; Tage[2=age*V4] = 3 |
*/ |
*/ |
|
Tmodelind=ivector(1,NCOVMAX);/** 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 */ |
/* Main decodemodel */ |
|
|
|
|
if(decodemodel(model, lastobs) == 1) |
if(decodemodel(model, lastobs) == 1) /* In order to get Tvar[k] V4+V3+V5 p Tvar[1]@3 = {4, 3, 5}*/ |
goto end; |
goto end; |
|
|
if((double)(lastobs-imx)/(double)imx > 1.10){ |
if((double)(lastobs-imx)/(double)imx > 1.10){ |
Line 7353 Please run with mle=-1 to get a correct
|
Line 11327 Please run with mle=-1 to get a correct
|
free_vector(annais,1,n); |
free_vector(annais,1,n); |
/* free_matrix(mint,1,maxwav,1,n); |
/* free_matrix(mint,1,maxwav,1,n); |
free_matrix(anint,1,maxwav,1,n);*/ |
free_matrix(anint,1,maxwav,1,n);*/ |
free_vector(moisdc,1,n); |
/* free_vector(moisdc,1,n); */ |
free_vector(andc,1,n); |
/* free_vector(andc,1,n); */ |
/* */ |
/* */ |
|
|
wav=ivector(1,imx); |
wav=ivector(1,imx); |
dh=imatrix(1,lastpass-firstpass+1,1,imx); |
/* dh=imatrix(1,lastpass-firstpass+1,1,imx); */ |
bh=imatrix(1,lastpass-firstpass+1,1,imx); |
/* bh=imatrix(1,lastpass-firstpass+1,1,imx); */ |
mw=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 */ |
|
/* 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); |
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,1,n); |
|
free_vector(andc,1,n); |
|
|
|
/* Routine tricode is to calculate cptcoveff (real number of unique covariates) and to associate covariable number and modality */ |
nbcode=imatrix(0,NCOVMAX,0,NCOVMAX); |
nbcode=imatrix(0,NCOVMAX,0,NCOVMAX); |
ncodemax[1]=1; |
ncodemax[1]=1; |
Ndum =ivector(-1,NCOVMAX); |
Ndum =ivector(-1,NCOVMAX); |
if (ncovmodel-nagesqr > 2 ) /* That is if covariate other than cst, age and age*age */ |
cptcoveff=0; |
tricode(Tvar,nbcode,imx, Ndum); /**< Fills nbcode[Tvar[j]][l]; */ |
if (ncovmodel-nagesqr > 2 ){ /* That is if covariate other than cst, age and age*age */ |
/* Nbcode gives the value of the lth modality of jth covariate, in |
tricode(&cptcoveff,Tvar,nbcode,imx, Ndum); /**< Fills nbcode[Tvar[j]][l]; */ |
|
} |
|
|
|
ncovcombmax=pow(2,cptcoveff); |
|
invalidvarcomb=ivector(1, ncovcombmax); |
|
for(i=1;i<ncovcombmax;i++) |
|
invalidvarcomb[i]=0; |
|
|
|
/* Nbcode gives the value of the lth modality (currently 1 to 2) of jth covariate, in |
V2+V1*age, there are 3 covariates Tvar[2]=1 (V1).*/ |
V2+V1*age, there are 3 covariates Tvar[2]=1 (V1).*/ |
/* 1 to ncodemax[j] is the maximum value of this jth covariate */ |
/* 1 to ncodemax[j] which is the maximum value of this jth covariate */ |
|
|
/* codtab=imatrix(1,100,1,10);*/ /* codtab[h,k]=( (h-1) - mod(k-1,2**(k-1) )/2**(k-1) */ |
/* codtab=imatrix(1,100,1,10);*/ /* codtab[h,k]=( (h-1) - mod(k-1,2**(k-1) )/2**(k-1) */ |
/*printf(" codtab[1,1],codtab[100,10]=%d,%d\n", codtab[1][1],codtabm(100,10));*/ |
/*printf(" codtab[1,1],codtab[100,10]=%d,%d\n", codtab[1][1],codtabm(100,10));*/ |
/* codtab gives the value 1 or 2 of the hth combination of k covariates (1 or 2).*/ |
/* codtab gives the value 1 or 2 of the hth combination of k covariates (1 or 2).*/ |
h=0; |
/* nbcode[Tvaraff[j]][codtabm(h,j)]) : if there are only 2 modalities for a covariate j, |
|
* codtabm(h,j) gives its value classified at position h and nbcode gives how it is coded |
|
* (currently 0 or 1) in the data. |
|
* In a loop on h=1 to 2**k, and a loop on j (=1 to k), we get the value of |
|
* corresponding modality (h,j). |
|
*/ |
|
|
|
h=0; |
/*if (cptcovn > 0) */ |
/*if (cptcovn > 0) */ |
|
|
|
|
m=pow(2,cptcoveff); |
m=pow(2,cptcoveff); |
|
|
/**< codtab(h,k) k = codtab[h,k]=( (h-1) - mod(k-1,2**(k-1) )/2**(k-1) + 1 |
/**< codtab(h,k) k = codtab[h,k]=( (h-1) - mod(k-1,2**(k-1) )/2**(k-1) + 1 |
* For k=4 covariates, h goes from 1 to 2**k |
* For k=4 covariates, h goes from 1 to m=2**k |
* codtabm(h,k)= 1 & (h-1) >> (k-1) ; |
* 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 |
* h\k 1 2 3 4 |
*______________________________ |
*______________________________ |
* 1 i=1 1 i=1 1 i=1 1 i=1 1 |
* 1 i=1 1 i=1 1 i=1 1 i=1 1 |
Line 7410 Please run with mle=-1 to get a correct
|
Line 11408 Please run with mle=-1 to get a correct
|
* 15 i=8 1 2 2 2 |
* 15 i=8 1 2 2 2 |
* 16 2 2 2 2 |
* 16 2 2 2 2 |
*/ |
*/ |
/* /\* for(h=1; h <=100 ;h++){ *\/ */ |
/* How to do the opposite? From combination h (=1 to 2**k) how to get the value on the covariates? */ |
/* /\* printf("h=%2d ", h); *\/ */ |
/* from h=5 and m, we get then number of covariates k=log(m)/log(2)=4 |
/* /\* for(k=1; k <=10; k++){ *\/ */ |
* and the value of each covariate? |
/* /\* printf("k=%d %d ",k,codtabm(h,k)); *\/ */ |
* V1=1, V2=1, V3=2, V4=1 ? |
/* /\* codtab[h][k]=codtabm(h,k); *\/ */ |
* 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. |
/* /\* printf("\n"); *\/ */ |
* In order to get the real value in the data, we use nbcode |
/* } */ |
* nbcode[Tvar[3][2nd]]=1 and nbcode[Tvar[4][1]]=0 |
/* for(k=1;k<=cptcoveff; k++){ /\* scans any effective covariate *\/ */ |
* We are keeping this crazy system in order to be able (in the future?) |
/* 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 *\/ */ |
* to have more than 2 values (0 or 1) for a covariate. |
/* for(j=1; j <= ncodemax[k]; j++){ /\* For each modality of this covariate ncodemax=2*\/ */ |
* #define codtabm(h,k) (1 & (h-1) >> (k-1))+1 |
/* 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=6, k=2? h-1=5=0101, reverse 1010, +1=2121, k=2nd position: value is 1: codtabm(6,2)=1 |
/* h++; */ |
* bbbbbbbb |
/* if (h>m) */ |
* 76543210 |
/* h=1; */ |
* h-1 00000101 (6-1=5) |
/* codtab[h][k]=j; */ |
*(h-1)>>(k-1)= 00000010 >> (2-1) = 1 right shift |
/* /\* codtab[12][3]=1; *\/ */ |
* & |
/* /\*codtab[h][Tvar[k]]=j;*\/ */ |
* 1 00000001 (1) |
/* /\* 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]]); *\/ */ |
* 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 |
/* printf("codtab[1][2]=%d codtab[2][2]=%d",codtab[1][2],codtab[2][2]); |
* >>k' 11 |
codtab[1][2]=1;codtab[2][2]=2; */ |
* & 00000001 |
/* for(i=1; i <=m ;i++){ */ |
* = 00000001 |
/* for(k=1; k <=cptcovn; k++){ */ |
* +1 = 00000010=2 = codtabm(14,3) |
/* printf("i=%d k=%d %d %d ",i,k,codtab[i][k], cptcoveff); */ |
* 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. |
/* printf("\n"); */ |
* for (j=1 to cptcoveff) Vj=decodtabm(j,h,cptcoveff) |
/* } */ |
* decodtabm(h,j,cptcoveff)= (((h-1) >> (j-1)) & 1) +1 |
/* scanf("%d",i);*/ |
* decodtabm(h,j,cptcoveff)= (h <= (1<<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); |
free_ivector(Ndum,-1,NCOVMAX); |
|
|
Line 7488 Title=%s <br>Datafile=%s Firstpass=%d La
|
Line 11498 Title=%s <br>Datafile=%s Firstpass=%d La
|
optionfilehtmcov,version,fullversion,title,datafile,firstpass,lastpass,stepm, weightopt, model); |
optionfilehtmcov,version,fullversion,title,datafile,firstpass,lastpass,stepm, weightopt, model); |
} |
} |
|
|
fprintf(fichtm,"<html><head>\n<head>\n<meta charset=\"utf-8\"/><meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\" />\n<title>IMaCh %s</title></head>\n <body><font size=\"7\"><a href=http:/euroreves.ined.fr/imach>IMaCh for Interpolated Markov Chain</a> </font><br>\n<font size=\"3\">Sponsored by Copyright (C) 2002-2015 <a href=http://www.ined.fr>INED</a>-EUROREVES-Institut de longévité-Japan Society for the Promotion of Sciences 日本学術振興会 (<a href=https://www.jsps.go.jp/english/e-grants/>Grant-in-Aid for Scientific Research 25293121</a>) - <a href=https://software.intel.com/en-us>Intel Software 2015</a></font><br> \ |
fprintf(fichtm,"<html><head>\n<head>\n<meta charset=\"utf-8\"/><meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\" />\n<title>IMaCh %s</title></head>\n <body><font size=\"7\"><a href=http:/euroreves.ined.fr/imach>IMaCh for Interpolated Markov Chain</a> </font><br>\n<font size=\"3\">Sponsored by Copyright (C) 2002-2015 <a href=http://www.ined.fr>INED</a>-EUROREVES-Institut de longévité-2013-2016-Japan Society for the Promotion of Sciences 日本学術振興会 (<a href=https://www.jsps.go.jp/english/e-grants/>Grant-in-Aid for Scientific Research 25293121</a>) - <a href=https://software.intel.com/en-us>Intel Software 2015-2018</a></font><br> \ |
<hr size=\"2\" color=\"#EC5E5E\"> \n\ |
<hr size=\"2\" color=\"#EC5E5E\"> \n\ |
<font size=\"2\">IMaCh-%s <br> %s</font> \ |
<font size=\"2\">IMaCh-%s <br> %s</font> \ |
<hr size=\"2\" color=\"#EC5E5E\"> \n\ |
<hr size=\"2\" color=\"#EC5E5E\"> \n\ |
Line 7516 Title=%s <br>Datafile=%s Firstpass=%d La
|
Line 11526 Title=%s <br>Datafile=%s Firstpass=%d La
|
#endif |
#endif |
|
|
|
|
/* Calculates basic frequencies. Computes observed prevalence at single age |
/* Calculates basic frequencies. Computes observed prevalence at single age |
|
and for any valid combination of covariates |
and prints on file fileres'p'. */ |
and prints on file fileres'p'. */ |
freqsummary(fileres, agemin, agemax, s, agev, nlstate, imx,Tvaraff,nbcode, ncodemax,mint,anint,strstart); |
freqsummary(fileres, 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,"\n"); |
fprintf(fichtm,"<br>Total number of observations=%d <br>\n\ |
fprintf(fichtm,"<h4>Parameter line 2</h4><ul><li>Tolerance for the convergence of the likelihood: ftol=%f \n<li>Interval for the elementary matrix (in month): stepm=%d",\ |
|
ftol, stepm); |
|
fprintf(fichtm,"\n<li>Number of fixed dummy covariates: ncovcol=%d ", ncovcol); |
|
ncurrv=1; |
|
for(i=ncurrv; i <=ncovcol; i++) fprintf(fichtm,"V%d ", i); |
|
fprintf(fichtm,"\n<li> 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<li> Number of time varying (wave varying) covariates: ntv=%d ", ntv); |
|
ncurrv=i; |
|
for(i=ncurrv; i <=ncurrv-1+ntv; i++) fprintf(fichtm,"V%d ", i); |
|
fprintf(fichtm,"\n<li>Number of quantitative time varying covariates: nqtv=%d ", nqtv); |
|
ncurrv=i; |
|
for(i=ncurrv; i <=ncurrv-1+nqtv; i++) fprintf(fichtm,"V%d ", i); |
|
fprintf(fichtm,"\n<li>Weights column \n<br>Number of alive states: nlstate=%d <br>Number of death states (not really implemented): ndeath=%d \n<li>Number of waves: maxwav=%d \n<li>Parameter for maximization (1), using parameter values (0), for design of parameters and variance-covariance matrix: mle=%d \n<li>Does the weight column be taken into account (1), or not (0): weight=%d</ul>\n", \ |
|
nlstate, ndeath, maxwav, mle, weightopt); |
|
|
|
fprintf(fichtm,"<h4> Diagram of states <a href=\"%s_.svg\">%s_.svg</a></h4> \n\ |
|
<img src=\"%s_.svg\">", subdirf2(optionfilefiname,"D_"),subdirf2(optionfilefiname,"D_"),subdirf2(optionfilefiname,"D_")); |
|
|
|
|
|
fprintf(fichtm,"\n<h4>Some descriptive statistics </h4>\n<br>Total number of observations=%d <br>\n\ |
Youngest age at first (selected) pass %.2f, oldest age %.2f<br>\n\ |
Youngest age at first (selected) pass %.2f, oldest age %.2f<br>\n\ |
Interval (in months) between two waves: Min=%d Max=%d Mean=%.2lf<br>\n",\ |
Interval (in months) between two waves: Min=%d Max=%d Mean=%.2lf<br>\n",\ |
imx,agemin,agemax,jmin,jmax,jmean); |
imx,agemin,agemax,jmin,jmax,jmean); |
pmmij= matrix(1,nlstate+ndeath,1,nlstate+ndeath); /* creation */ |
pmmij= matrix(1,nlstate+ndeath,1,nlstate+ndeath); /* creation */ |
oldms= matrix(1,nlstate+ndeath,1,nlstate+ndeath); /* creation */ |
oldms= matrix(1,nlstate+ndeath,1,nlstate+ndeath); /* creation */ |
newms= matrix(1,nlstate+ndeath,1,nlstate+ndeath); /* creation */ |
newms= matrix(1,nlstate+ndeath,1,nlstate+ndeath); /* creation */ |
savms= matrix(1,nlstate+ndeath,1,nlstate+ndeath); /* creation */ |
savms= matrix(1,nlstate+ndeath,1,nlstate+ndeath); /* creation */ |
oldm=oldms; newm=newms; savm=savms; /* Keeps fixed addresses to free */ |
oldm=oldms; newm=newms; savm=savms; /* Keeps fixed addresses to free */ |
|
|
|
|
/* For Powell, parameters are in a vector p[] starting at p[1] |
/* For Powell, parameters are in a vector p[] starting at p[1] |
so we point p on param[1][1] so that p[1] maps on param[1][1][1] */ |
so we point p on param[1][1] so that p[1] maps on param[1][1][1] */ |
p=param[1][1]; /* *(*(*(param +1)+1)+0) */ |
p=param[1][1]; /* *(*(*(param +1)+1)+0) */ |
Line 7540 Interval (in months) between two waves:
|
Line 11572 Interval (in months) between two waves:
|
/* For mortality only */ |
/* For mortality only */ |
if (mle==-3){ |
if (mle==-3){ |
ximort=matrix(1,NDIM,1,NDIM); |
ximort=matrix(1,NDIM,1,NDIM); |
|
for(i=1;i<=NDIM;i++) |
|
for(j=1;j<=NDIM;j++) |
|
ximort[i][j]=0.; |
/* ximort=gsl_matrix_alloc(1,NDIM,1,NDIM); */ |
/* ximort=gsl_matrix_alloc(1,NDIM,1,NDIM); */ |
cens=ivector(1,n); |
cens=ivector(1,n); |
ageexmed=vector(1,n); |
ageexmed=vector(1,n); |
agecens=vector(1,n); |
agecens=vector(1,n); |
dcwave=ivector(1,n); |
dcwave=ivector(1,n); |
|
|
for (i=1; i<=imx; i++){ |
for (i=1; i<=imx; i++){ |
dcwave[i]=-1; |
dcwave[i]=-1; |
for (m=firstpass; m<=lastpass; m++) |
for (m=firstpass; m<=lastpass; m++) |
Line 7555 Interval (in months) between two waves:
|
Line 11590 Interval (in months) between two waves:
|
break; |
break; |
} |
} |
} |
} |
|
|
for (i=1; i<=imx; i++) { |
for (i=1; i<=imx; i++) { |
if (wav[i]>0){ |
if (wav[i]>0){ |
ageexmed[i]=agev[mw[1][i]][i]; |
ageexmed[i]=agev[mw[1][i]][i]; |
j=wav[i]; |
j=wav[i]; |
agecens[i]=1.; |
agecens[i]=1.; |
|
|
if (ageexmed[i]> 1 && wav[i] > 0){ |
if (ageexmed[i]> 1 && wav[i] > 0){ |
agecens[i]=agev[mw[j][i]][i]; |
agecens[i]=agev[mw[j][i]][i]; |
cens[i]= 1; |
cens[i]= 1; |
Line 7688 Interval (in months) between two waves:
|
Line 11723 Interval (in months) between two waves:
|
|
|
for(i=1; i <=NDIM; i++) |
for(i=1; i <=NDIM; i++) |
for(j=i+1;j<=NDIM;j++) |
for(j=i+1;j<=NDIM;j++) |
matcov[i][j]=matcov[j][i]; |
matcov[i][j]=matcov[j][i]; |
|
|
printf("\nCovariance matrix\n "); |
printf("\nCovariance matrix\n "); |
fprintf(ficlog,"\nCovariance matrix\n "); |
fprintf(ficlog,"\nCovariance matrix\n "); |
for(i=1; i <=NDIM; i++) { |
for(i=1; i <=NDIM; i++) { |
for(j=1;j<=NDIM;j++){ |
for(j=1;j<=NDIM;j++){ |
printf("%f ",matcov[i][j]); |
printf("%f ",matcov[i][j]); |
fprintf(ficlog,"%f ",matcov[i][j]); |
fprintf(ficlog,"%f ",matcov[i][j]); |
} |
} |
printf("\n "); fprintf(ficlog,"\n "); |
printf("\n "); fprintf(ficlog,"\n "); |
} |
} |
Line 7736 Interval (in months) between two waves:
|
Line 11771 Interval (in months) between two waves:
|
|
|
|
|
replace_back_to_slash(pathc,pathcd); /* Even gnuplot wants a / */ |
replace_back_to_slash(pathc,pathcd); /* Even gnuplot wants a / */ |
|
ageminpar=50; |
|
agemaxpar=100; |
if(ageminpar == AGEOVERFLOW ||agemaxpar == AGEOVERFLOW){ |
if(ageminpar == AGEOVERFLOW ||agemaxpar == AGEOVERFLOW){ |
printf("Warning! Error in gnuplot file with ageminpar %f or agemaxpar %f overflow\n\ |
printf("Warning! Error in gnuplot file with ageminpar %f or agemaxpar %f overflow\n\ |
This is probably because your parameter file doesn't \n contain the exact number of lines (or columns) corresponding to your model line.\n\ |
This is probably because your parameter file doesn't \n contain the exact number of lines (or columns) corresponding to your model line.\n\ |
Line 7743 Please run with mle=-1 to get a correct
|
Line 11780 Please run with mle=-1 to get a correct
|
fprintf(ficlog,"Warning! Error in gnuplot file with ageminpar %f or agemaxpar %f overflow\n\ |
fprintf(ficlog,"Warning! Error in gnuplot file with ageminpar %f or agemaxpar %f overflow\n\ |
This is probably because your parameter file doesn't \n contain the exact number of lines (or columns) corresponding to your model line.\n\ |
This is probably because your parameter file doesn't \n contain the exact number of lines (or columns) corresponding to your model line.\n\ |
Please run with mle=-1 to get a correct covariance matrix.\n",ageminpar,agemaxpar); |
Please run with mle=-1 to get a correct covariance matrix.\n",ageminpar,agemaxpar); |
}else |
}else{ |
|
printf("Warning! ageminpar %f and agemaxpar %f have been fixed because for simplification until it is fixed...\n\n",ageminpar,agemaxpar); |
|
fprintf(ficlog,"Warning! ageminpar %f and agemaxpar %f have been fixed because for simplification until it is fixed...\n\n",ageminpar,agemaxpar); |
printinggnuplotmort(fileresu, optionfilefiname,ageminpar,agemaxpar,fage, pathc,p); |
printinggnuplotmort(fileresu, optionfilefiname,ageminpar,agemaxpar,fage, pathc,p); |
|
} |
printinghtmlmort(fileresu,title,datafile, firstpass, lastpass, \ |
printinghtmlmort(fileresu,title,datafile, firstpass, lastpass, \ |
stepm, weightopt,\ |
stepm, weightopt,\ |
model,imx,p,matcov,agemortsup); |
model,imx,p,matcov,agemortsup); |
Line 7752 Please run with mle=-1 to get a correct
|
Line 11792 Please run with mle=-1 to get a correct
|
free_vector(lsurv,1,AGESUP); |
free_vector(lsurv,1,AGESUP); |
free_vector(lpop,1,AGESUP); |
free_vector(lpop,1,AGESUP); |
free_vector(tpop,1,AGESUP); |
free_vector(tpop,1,AGESUP); |
#ifdef GSL |
free_matrix(ximort,1,NDIM,1,NDIM); |
free_ivector(cens,1,n); |
free_ivector(cens,1,n); |
free_vector(agecens,1,n); |
free_vector(agecens,1,n); |
free_ivector(dcwave,1,n); |
free_ivector(dcwave,1,n); |
free_matrix(ximort,1,NDIM,1,NDIM); |
#ifdef GSL |
#endif |
#endif |
} /* Endof if mle==-3 mortality only */ |
} /* Endof if mle==-3 mortality only */ |
/* Standard */ |
/* Standard */ |
Line 7770 Please run with mle=-1 to get a correct
|
Line 11810 Please run with mle=-1 to get a correct
|
printf("\n"); |
printf("\n"); |
if(mle>=1){ /* Could be 1 or 2, Real Maximization */ |
if(mle>=1){ /* Could be 1 or 2, Real Maximization */ |
/* mlikeli uses func not funcone */ |
/* mlikeli uses func not funcone */ |
|
/* for(i=1;i<nlstate;i++){ */ |
|
/* /\*reducing xi for 1 to npar to 1 to ncovmodel; *\/ */ |
|
/* mlikeli(ficres,p, ncovmodel, ncovmodel, nlstate, ftol, funcnoprod); */ |
|
/* } */ |
mlikeli(ficres,p, npar, ncovmodel, nlstate, ftol, func); |
mlikeli(ficres,p, npar, ncovmodel, nlstate, ftol, func); |
} |
} |
if(mle==0) {/* No optimization, will print the likelihoods for the datafile */ |
if(mle==0) {/* No optimization, will print the likelihoods for the datafile */ |
Line 7785 Please run with mle=-1 to get a correct
|
Line 11829 Please run with mle=-1 to get a correct
|
printf("\n"); |
printf("\n"); |
|
|
/*--------- results files --------------*/ |
/*--------- results files --------------*/ |
fprintf(ficres,"title=%s datafile=%s lastobs=%d firstpass=%d lastpass=%d\nftol=%e stepm=%d ncovcol=%d nlstate=%d ndeath=%d maxwav=%d mle= 0 weight=%d\nmodel=1+age+%s.\n", title, datafile, lastobs, firstpass,lastpass,ftol, stepm, ncovcol, nlstate, ndeath, maxwav, weightopt,model); |
fprintf(ficres,"title=%s datafile=%s lastobs=%d firstpass=%d lastpass=%d\nftol=%e stepm=%d ncovcol=%d nqv=%d ntv=%d nqtv=%d nlstate=%d ndeath=%d maxwav=%d mle= 0 weight=%d\nmodel=1+age+%s.\n", title, datafile, lastobs, firstpass,lastpass,ftol, stepm, ncovcol, nqv, ntv, nqtv, nlstate, ndeath, maxwav, weightopt,model); |
|
|
|
|
fprintf(ficres,"# Parameters nlstate*nlstate*ncov a12*1 + b12 * age + ...\n"); |
fprintf(ficres,"# Parameters nlstate*nlstate*ncov a12*1 + b12 * age + ...\n"); |
Line 7831 Please run with mle=-1 to get a correct
|
Line 11875 Please run with mle=-1 to get a correct
|
} |
} |
} |
} |
} /* end of hesscov and Wald tests */ |
} /* end of hesscov and Wald tests */ |
|
|
/* */ |
/* */ |
fprintf(ficres,"# Scales (for hessian or gradient estimation)\n"); |
fprintf(ficres,"# Scales (for hessian or gradient estimation)\n"); |
printf("# Scales (for hessian or gradient estimation)\n"); |
printf("# Scales (for hessian or gradient estimation)\n"); |
Line 7940 Please run with mle=-1 to get a correct
|
Line 11984 Please run with mle=-1 to get a correct
|
|
|
fflush(ficlog); |
fflush(ficlog); |
fflush(ficres); |
fflush(ficres); |
while(fgets(line, MAXLINE, ficpar)) { |
while(fgets(line, MAXLINE, ficpar)) { |
/* If line starts with a # it is a comment */ |
/* If line starts with a # it is a comment */ |
if (line[0] == '#') { |
if (line[0] == '#') { |
numlinepar++; |
numlinepar++; |
fputs(line,stdout); |
fputs(line,stdout); |
fputs(line,ficparo); |
fputs(line,ficparo); |
fputs(line,ficlog); |
fputs(line,ficlog); |
continue; |
continue; |
}else |
}else |
break; |
break; |
} |
} |
|
|
/* while((c=getc(ficpar))=='#' && c!= EOF){ */ |
/* while((c=getc(ficpar))=='#' && c!= EOF){ */ |
/* ungetc(c,ficpar); */ |
/* ungetc(c,ficpar); */ |
/* fgets(line, MAXLINE, ficpar); */ |
/* fgets(line, MAXLINE, ficpar); */ |
Line 7962 Please run with mle=-1 to get a correct
|
Line 12006 Please run with mle=-1 to get a correct
|
|
|
estepm=0; |
estepm=0; |
if((num_filled=sscanf(line,"agemin=%lf agemax=%lf bage=%lf fage=%lf estepm=%d ftolpl=%lf\n",&ageminpar,&agemaxpar, &bage, &fage, &estepm, &ftolpl)) !=EOF){ |
if((num_filled=sscanf(line,"agemin=%lf agemax=%lf bage=%lf fage=%lf estepm=%d ftolpl=%lf\n",&ageminpar,&agemaxpar, &bage, &fage, &estepm, &ftolpl)) !=EOF){ |
|
|
if (num_filled != 6) { |
if (num_filled != 6) { |
printf("Not 6 parameters in line, for example:agemin=60 agemax=95 bage=55 fage=95 estepm=24 ftolpl=6e-4\n"); |
printf("Error: Not 6 parameters in line, for example:agemin=60 agemax=95 bage=55 fage=95 estepm=24 ftolpl=6e-4\n, your line=%s . Probably you are running an older format.\n",line); |
printf("but line=%s\n",line); |
fprintf(ficlog,"Error: Not 6 parameters in line, for example:agemin=60 agemax=95 bage=55 fage=95 estepm=24 ftolpl=6e-4\n, your line=%s . Probably you are running an older format.\n",line); |
goto end; |
goto end; |
|
} |
|
printf("agemin=%lf agemax=%lf bage=%lf fage=%lf estepm=%d ftolpl=%lf\n",ageminpar,agemaxpar, bage, fage, estepm, ftolpl); |
} |
} |
printf("agemin=%lf agemax=%lf bage=%lf fage=%lf estepm=%d ftolpl=%lf\n",ageminpar,agemaxpar, bage, fage, estepm, ftolpl); |
/* ftolpl=6*ftol*1.e5; /\* 6.e-3 make convergences in less than 80 loops for the prevalence limit *\/ */ |
} |
/*ftolpl=6.e-4;*/ /* 6.e-3 make convergences in less than 80 loops for the prevalence limit */ |
/* ftolpl=6*ftol*1.e5; /\* 6.e-3 make convergences in less than 80 loops for the prevalence limit *\/ */ |
|
/*ftolpl=6.e-4;*/ /* 6.e-3 make convergences in less than 80 loops for the prevalence limit */ |
|
|
|
/* fscanf(ficpar,"agemin=%lf agemax=%lf bage=%lf fage=%lf estepm=%d ftolpl=%\n",&ageminpar,&agemaxpar, &bage, &fage, &estepm); */ |
/* fscanf(ficpar,"agemin=%lf agemax=%lf bage=%lf fage=%lf estepm=%d ftolpl=%\n",&ageminpar,&agemaxpar, &bage, &fage, &estepm); */ |
if (estepm==0 || estepm < stepm) estepm=stepm; |
if (estepm==0 || estepm < stepm) estepm=stepm; |
if (fage <= 2) { |
if (fage <= 2) { |
Line 7981 Please run with mle=-1 to get a correct
|
Line 12025 Please run with mle=-1 to get a correct
|
} |
} |
|
|
fprintf(ficres,"# agemin agemax for life expectancy, bage fage (if mle==0 ie no data nor Max likelihood).\n"); |
fprintf(ficres,"# agemin agemax for life expectancy, bage fage (if mle==0 ie no data nor Max likelihood).\n"); |
fprintf(ficres,"agemin=%.0f agemax=%.0f bage=%.0f fage=%.0f estepm=%d\n",ageminpar,agemaxpar,bage,fage, estepm); |
fprintf(ficres,"agemin=%.0f agemax=%.0f bage=%.0f fage=%.0f estepm=%d ftolpl=%e\n",ageminpar,agemaxpar,bage,fage, estepm, ftolpl); |
fprintf(ficparo,"agemin=%.0f agemax=%.0f bage=%.0f fage=%.0f estepm=%d\n",ageminpar,agemaxpar,bage,fage, estepm); |
fprintf(ficparo,"agemin=%.0f agemax=%.0f bage=%.0f fage=%.0f estepm=%d, ftolpl=%e\n",ageminpar,agemaxpar,bage,fage, estepm, ftolpl); |
|
|
/* Other stuffs, more or less useful */ |
/* Other stuffs, more or less useful */ |
while((c=getc(ficpar))=='#' && c!= EOF){ |
while(fgets(line, MAXLINE, ficpar)) { |
ungetc(c,ficpar); |
/* If line starts with a # it is a comment */ |
fgets(line, MAXLINE, ficpar); |
if (line[0] == '#') { |
fputs(line,stdout); |
numlinepar++; |
fputs(line,ficparo); |
fputs(line,stdout); |
|
fputs(line,ficparo); |
|
fputs(line,ficlog); |
|
continue; |
|
}else |
|
break; |
} |
} |
ungetc(c,ficpar); |
|
|
if((num_filled=sscanf(line,"begin-prev-date=%lf/%lf/%lf end-prev-date=%lf/%lf/%lf mov_average=%d\n",&jprev1, &mprev1,&anprev1,&jprev2, &mprev2,&anprev2,&mobilav)) !=EOF){ |
fscanf(ficpar,"begin-prev-date=%lf/%lf/%lf end-prev-date=%lf/%lf/%lf mov_average=%d\n",&jprev1, &mprev1,&anprev1,&jprev2, &mprev2,&anprev2,&mobilav); |
|
fprintf(ficparo,"begin-prev-date=%.lf/%.lf/%.lf end-prev-date=%.lf/%.lf/%.lf mov_average=%d\n",jprev1, mprev1,anprev1,jprev2, mprev2,anprev2,mobilav); |
if (num_filled != 7) { |
fprintf(ficres,"begin-prev-date=%.lf/%.lf/%.lf end-prev-date=%.lf/%.lf/%.lf mov_average=%d\n",jprev1, mprev1,anprev1,jprev2, mprev2,anprev2,mobilav); |
printf("Error: Not 7 (data)parameters in line but %d, for example:begin-prev-date=1/1/1990 end-prev-date=1/6/2004 mov_average=0\n, your line=%s . Probably you are running an older format.\n",num_filled,line); |
printf("begin-prev-date=%.lf/%.lf/%.lf end-prev-date=%.lf/%.lf/%.lf mov_average=%d\n",jprev1, mprev1,anprev1,jprev2, mprev2,anprev2,mobilav); |
fprintf(ficlog,"Error: Not 7 (data)parameters in line but %d, for example:begin-prev-date=1/1/1990 end-prev-date=1/6/2004 mov_average=0\n, your line=%s . Probably you are running an older format.\n",num_filled,line); |
fprintf(ficlog,"begin-prev-date=%.lf/%.lf/%.lf end-prev-date=%.lf/%.lf/%.lf mov_average=%d\n",jprev1, mprev1,anprev1,jprev2, mprev2,anprev2,mobilav); |
goto end; |
|
} |
while((c=getc(ficpar))=='#' && c!= EOF){ |
printf("begin-prev-date=%.lf/%.lf/%.lf end-prev-date=%.lf/%.lf/%.lf mov_average=%d\n",jprev1, mprev1,anprev1,jprev2, mprev2,anprev2,mobilav); |
ungetc(c,ficpar); |
fprintf(ficparo,"begin-prev-date=%.lf/%.lf/%.lf end-prev-date=%.lf/%.lf/%.lf mov_average=%d\n",jprev1, mprev1,anprev1,jprev2, mprev2,anprev2,mobilav); |
fgets(line, MAXLINE, ficpar); |
fprintf(ficres,"begin-prev-date=%.lf/%.lf/%.lf end-prev-date=%.lf/%.lf/%.lf mov_average=%d\n",jprev1, mprev1,anprev1,jprev2, mprev2,anprev2,mobilav); |
fputs(line,stdout); |
fprintf(ficlog,"begin-prev-date=%.lf/%.lf/%.lf end-prev-date=%.lf/%.lf/%.lf mov_average=%d\n",jprev1, mprev1,anprev1,jprev2, mprev2,anprev2,mobilav); |
fputs(line,ficparo); |
} |
|
|
|
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); |
|
continue; |
|
}else |
|
break; |
} |
} |
ungetc(c,ficpar); |
|
|
|
|
|
dateprev1=anprev1+(mprev1-1)/12.+(jprev1-1)/365.; |
dateprev1=anprev1+(mprev1-1)/12.+(jprev1-1)/365.; |
dateprev2=anprev2+(mprev2-1)/12.+(jprev2-1)/365.; |
dateprev2=anprev2+(mprev2-1)/12.+(jprev2-1)/365.; |
|
|
fscanf(ficpar,"pop_based=%d\n",&popbased); |
if((num_filled=sscanf(line,"pop_based=%d\n",&popbased)) !=EOF){ |
fprintf(ficlog,"pop_based=%d\n",popbased); |
if (num_filled != 1) { |
fprintf(ficparo,"pop_based=%d\n",popbased); |
printf("Error: Not 1 (data)parameters in line but %d, for example:pop_based=0\n, your line=%s . Probably you are running an older format.\n",num_filled,line); |
fprintf(ficres,"pop_based=%d\n",popbased); |
fprintf(ficlog,"Error: Not 1 (data)parameters in line but %d, for example: pop_based=1\n, your line=%s . Probably you are running an older format.\n",num_filled,line); |
|
goto end; |
while((c=getc(ficpar))=='#' && c!= EOF){ |
} |
ungetc(c,ficpar); |
printf("pop_based=%d\n",popbased); |
fgets(line, MAXLINE, ficpar); |
fprintf(ficlog,"pop_based=%d\n",popbased); |
fputs(line,stdout); |
fprintf(ficparo,"pop_based=%d\n",popbased); |
fputs(line,ficparo); |
fprintf(ficres,"pop_based=%d\n",popbased); |
} |
} |
ungetc(c,ficpar); |
|
|
/* Results */ |
fscanf(ficpar,"prevforecast=%d starting-proj-date=%lf/%lf/%lf final-proj-date=%lf/%lf/%lf mobil_average=%d\n",&prevfcast,&jproj1,&mproj1,&anproj1,&jproj2,&mproj2,&anproj2,&mobilavproj); |
nresult=0; |
fprintf(ficparo,"prevforecast=%d starting-proj-date=%.lf/%.lf/%.lf final-proj-date=%.lf/%.lf/%.lf mobil_average=%d\n",prevfcast,jproj1,mproj1,anproj1,jproj2,mproj2,anproj2,mobilavproj); |
do{ |
printf("prevforecast=%d starting-proj-date=%.lf/%.lf/%.lf final-proj-date=%.lf/%.lf/%.lf mobil_average=%d\n",prevfcast,jproj1,mproj1,anproj1,jproj2,mproj2,anproj2,mobilavproj); |
if(!fgets(line, MAXLINE, ficpar)){ |
fprintf(ficlog,"prevforecast=%d starting-proj-date=%.lf/%.lf/%.lf final-proj-date=%.lf/%.lf/%.lf mobil_average=%d\n",prevfcast,jproj1,mproj1,anproj1,jproj2,mproj2,anproj2,mobilavproj); |
endishere=1; |
fprintf(ficres,"prevforecast=%d starting-proj-date=%.lf/%.lf/%.lf final-proj-date=%.lf/%.lf/%.lf mobil_average=%d\n",prevfcast,jproj1,mproj1,anproj1,jproj2,mproj2,anproj2,mobilavproj); |
parameterline=14; |
/* day and month of proj2 are not used but only year anproj2.*/ |
}else if (line[0] == '#') { |
|
/* If line starts with a # it is a comment */ |
|
numlinepar++; |
|
fputs(line,stdout); |
|
fputs(line,ficparo); |
|
fputs(line,ficlog); |
|
continue; |
|
}else if(sscanf(line,"prevforecast=%[^\n]\n",modeltemp)) |
|
parameterline=11; |
|
else if(sscanf(line,"backcast=%[^\n]\n",modeltemp)) |
|
parameterline=12; |
|
else if(sscanf(line,"result:%[^\n]\n",modeltemp)) |
|
parameterline=13; |
|
else{ |
|
parameterline=14; |
|
} |
|
switch (parameterline){ |
|
case 11: |
|
if((num_filled=sscanf(line,"prevforecast=%d starting-proj-date=%lf/%lf/%lf final-proj-date=%lf/%lf/%lf mobil_average=%d\n",&prevfcast,&jproj1,&mproj1,&anproj1,&jproj2,&mproj2,&anproj2,&mobilavproj)) !=EOF){ |
|
if (num_filled != 8) { |
|
printf("Error: Not 8 (data)parameters in line but %d, for example:prevforecast=1 starting-proj-date=1/1/1990 final-proj-date=1/1/2000 mobil_average=0\n, your line=%s . Probably you are running an older format.\n",num_filled,line); |
|
fprintf(ficlog,"Error: Not 8 (data)parameters in line but %d, for example:prevforecast=1 starting-proj-date=1/1/1990 final-proj-date=1/1/2000 mov_average=0\n, your line=%s . Probably you are running an older format.\n",num_filled,line); |
|
goto end; |
|
} |
|
fprintf(ficparo,"prevforecast=%d starting-proj-date=%.lf/%.lf/%.lf final-proj-date=%.lf/%.lf/%.lf mobil_average=%d\n",prevfcast,jproj1,mproj1,anproj1,jproj2,mproj2,anproj2,mobilavproj); |
|
printf("prevforecast=%d starting-proj-date=%.lf/%.lf/%.lf final-proj-date=%.lf/%.lf/%.lf mobil_average=%d\n",prevfcast,jproj1,mproj1,anproj1,jproj2,mproj2,anproj2,mobilavproj); |
|
fprintf(ficlog,"prevforecast=%d starting-proj-date=%.lf/%.lf/%.lf final-proj-date=%.lf/%.lf/%.lf mobil_average=%d\n",prevfcast,jproj1,mproj1,anproj1,jproj2,mproj2,anproj2,mobilavproj); |
|
fprintf(ficres,"prevforecast=%d starting-proj-date=%.lf/%.lf/%.lf final-proj-date=%.lf/%.lf/%.lf mobil_average=%d\n",prevfcast,jproj1,mproj1,anproj1,jproj2,mproj2,anproj2,mobilavproj); |
|
/* day and month of proj2 are not used but only year anproj2.*/ |
|
dateproj1=anproj1+(mproj1-1)/12.+(jproj1-1)/365.; |
|
dateproj2=anproj2+(mproj2-1)/12.+(jproj2-1)/365.; |
|
|
|
} |
|
break; |
|
case 12: |
|
/*fscanf(ficpar,"backcast=%d starting-back-date=%lf/%lf/%lf final-back-date=%lf/%lf/%lf mobil_average=%d\n",&backcast,&jback1,&mback1,&anback1,&jback2,&mback2,&anback2,&mobilavproj);*/ |
|
if((num_filled=sscanf(line,"backcast=%d starting-back-date=%lf/%lf/%lf final-back-date=%lf/%lf/%lf mobil_average=%d\n",&backcast,&jback1,&mback1,&anback1,&jback2,&mback2,&anback2,&mobilavproj)) !=EOF){ |
|
if (num_filled != 8) { |
|
printf("Error: Not 8 (data)parameters in line but %d, for example:backcast=1 starting-back-date=1/1/1990 final-back-date=1/1/1970 mobil_average=1\n, your line=%s . Probably you are running an older format.\n",num_filled,line); |
|
fprintf(ficlog,"Error: Not 8 (data)parameters in line but %d, for example:backcast=1 starting-back-date=1/1/1990 final-back-date=1/1/1970 mobil_average=1\n, your line=%s . Probably you are running an older format.\n",num_filled,line); |
|
goto end; |
|
} |
|
printf("backcast=%d starting-back-date=%.lf/%.lf/%.lf final-back-date=%.lf/%.lf/%.lf mobil_average=%d\n",backcast,jback1,mback1,anback1,jback2,mback2,anback2,mobilavproj); |
|
fprintf(ficparo,"backcast=%d starting-back-date=%.lf/%.lf/%.lf final-back-date=%.lf/%.lf/%.lf mobil_average=%d\n",backcast,jback1,mback1,anback1,jback2,mback2,anback2,mobilavproj); |
|
fprintf(ficlog,"backcast=%d starting-back-date=%.lf/%.lf/%.lf final-back-date=%.lf/%.lf/%.lf mobil_average=%d\n",backcast,jback1,mback1,anback1,jback2,mback2,anback2,mobilavproj); |
|
fprintf(ficres,"backcast=%d starting-back-date=%.lf/%.lf/%.lf final-back-date=%.lf/%.lf/%.lf mobil_average=%d\n",backcast,jback1,mback1,anback1,jback2,mback2,anback2,mobilavproj); |
|
/* day and month of proj2 are not used but only year anproj2.*/ |
|
dateback1=anback1+(mback1-1)/12.+(jback1-1)/365.; |
|
dateback2=anback2+(mback2-1)/12.+(jback2-1)/365.; |
|
} |
|
break; |
|
case 13: |
|
if((num_filled=sscanf(line,"result:%[^\n]\n",resultline)) !=EOF){ |
|
if (num_filled == 0){ |
|
resultline[0]='\0'; |
|
printf("Warning %d: no result line! It should be at minimum 'result: V2=0 V1=1 or result:.\n%s\n", num_filled, line); |
|
fprintf(ficlog,"Warning %d: no result line! It should be at minimum 'result: V2=0 V1=1 or result:.\n%s\n", num_filled, line); |
|
break; |
|
} else if (num_filled != 1){ |
|
printf("ERROR %d: result line! It should be at minimum 'result: V2=0 V1=1 or result:.' %s\n",num_filled, line); |
|
fprintf(ficlog,"ERROR %d: result line! It should be at minimum 'result: V2=0 V1=1 or result:.' %s\n",num_filled, line); |
|
} |
|
nresult++; /* Sum of resultlines */ |
|
printf("Result %d: result=%s\n",nresult, resultline); |
|
if(nresult > MAXRESULTLINES){ |
|
printf("ERROR: Current version of IMaCh limits the number of resultlines to %d, you used %d\n",MAXRESULTLINES,nresult); |
|
fprintf(ficlog,"ERROR: Current version of IMaCh limits the number of resultlines to %d, you used %d\n",MAXRESULTLINES,nresult); |
|
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: |
|
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); |
|
goto end; |
|
} |
|
break; |
|
default: |
|
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); */ |
/* ,dateprev1,dateprev2,jprev1, mprev1,anprev1,jprev2, mprev2,anprev2); */ |
|
|
replace_back_to_slash(pathc,pathcd); /* Even gnuplot wants a / */ |
replace_back_to_slash(pathc,pathcd); /* Even gnuplot wants a / */ |
if(ageminpar == AGEOVERFLOW ||agemaxpar == -AGEOVERFLOW){ |
if(ageminpar == AGEOVERFLOW ||agemaxpar == -AGEOVERFLOW){ |
printf("Warning! Error in gnuplot file with ageminpar %f or agemaxpar %f overflow\n\ |
printf("Warning! Error in gnuplot file with ageminpar %f or agemaxpar %f overflow\n\ |
This is probably because your parameter file doesn't \n contain the exact number of lines (or columns) corresponding to your model line.\n\ |
This is probably because your parameter file doesn't \n contain the exact number of lines (or columns) corresponding to your model line.\n\ |
Please run with mle=-1 to get a correct covariance matrix.\n",ageminpar,agemaxpar); |
Please run with mle=-1 to get a correct covariance matrix.\n",ageminpar,agemaxpar); |
fprintf(ficlog,"Warning! Error in gnuplot file with ageminpar %f or agemaxpar %f overflow\n\ |
fprintf(ficlog,"Warning! Error in gnuplot file with ageminpar %f or agemaxpar %f overflow\n\ |
This is probably because your parameter file doesn't \n contain the exact number of lines (or columns) corresponding to your model line.\n\ |
This is probably because your parameter file doesn't \n contain the exact number of lines (or columns) corresponding to your model line.\n\ |
Please run with mle=-1 to get a correct covariance matrix.\n",ageminpar,agemaxpar); |
Please run with mle=-1 to get a correct covariance matrix.\n",ageminpar,agemaxpar); |
}else |
}else{ |
printinggnuplot(fileresu, optionfilefiname,ageminpar,agemaxpar,fage, pathc,p); |
/* printinggnuplot(fileresu, optionfilefiname,ageminpar,agemaxpar,fage, prevfcast, backcast, pathc,p, (int)anproj1-(int)agemin, (int)anback1-(int)agemax+1); */ |
|
printinggnuplot(fileresu, optionfilefiname,ageminpar,agemaxpar,bage, fage, prevfcast, backcast, pathc,p, (int)anproj1-bage, (int)anback1-fage); |
printinghtml(fileresu,title,datafile, firstpass, lastpass, stepm, weightopt,\ |
} |
model,imx,jmin,jmax,jmean,rfileres,popforecast,estepm,\ |
printinghtml(fileresu,title,datafile, firstpass, lastpass, stepm, weightopt, \ |
jprev1,mprev1,anprev1,jprev2,mprev2,anprev2); |
model,imx,jmin,jmax,jmean,rfileres,popforecast,mobilav,prevfcast,mobilavproj,backcast, estepm, \ |
|
jprev1,mprev1,anprev1,dateprev1, dateproj1, dateback1,jprev2,mprev2,anprev2,dateprev2,dateproj2, dateback2); |
/*------------ free_vector -------------*/ |
|
/* chdir(path); */ |
/*------------ free_vector -------------*/ |
|
/* chdir(path); */ |
free_ivector(wav,1,imx); |
|
free_imatrix(dh,1,lastpass-firstpass+1,1,imx); |
/* free_ivector(wav,1,imx); */ /* Moved after last prevalence call */ |
free_imatrix(bh,1,lastpass-firstpass+1,1,imx); |
/* free_imatrix(dh,1,lastpass-firstpass+2,1,imx); */ |
free_imatrix(mw,1,lastpass-firstpass+1,1,imx); |
/* free_imatrix(bh,1,lastpass-firstpass+2,1,imx); */ |
|
/* free_imatrix(mw,1,lastpass-firstpass+2,1,imx); */ |
free_lvector(num,1,n); |
free_lvector(num,1,n); |
free_vector(agedc,1,n); |
free_vector(agedc,1,n); |
/*free_matrix(covar,0,NCOVMAX,1,n);*/ |
/*free_matrix(covar,0,NCOVMAX,1,n);*/ |
/*free_matrix(covar,1,NCOVMAX,1,n);*/ |
/*free_matrix(covar,1,NCOVMAX,1,n);*/ |
fclose(ficparo); |
fclose(ficparo); |
fclose(ficres); |
fclose(ficres); |
|
|
|
|
/* Other results (useful)*/ |
/* Other results (useful)*/ |
|
|
|
|
/*--------------- Prevalence limit (period or stable prevalence) --------------*/ |
/*--------------- Prevalence limit (period or stable prevalence) --------------*/ |
/*#include "prevlim.h"*/ /* Use ficrespl, ficlog */ |
/*#include "prevlim.h"*/ /* Use ficrespl, ficlog */ |
prlim=matrix(1,nlstate,1,nlstate); |
prlim=matrix(1,nlstate,1,nlstate); |
prevalence_limit(p, prlim, ageminpar, agemaxpar, ftolpl, &ncvyear); |
prevalence_limit(p, prlim, ageminpar, agemaxpar, ftolpl, &ncvyear); |
fclose(ficrespl); |
fclose(ficrespl); |
|
|
#ifdef FREEEXIT2 |
|
#include "freeexit2.h" |
|
#endif |
|
|
|
/*------------- h Pij x at various ages ------------*/ |
/*------------- h Pij x at various ages ------------*/ |
/*#include "hpijx.h"*/ |
/*#include "hpijx.h"*/ |
hPijx(p, bage, fage); |
hPijx(p, bage, fage); |
fclose(ficrespij); |
fclose(ficrespij); |
|
|
/*-------------- Variance of one-step probabilities---*/ |
/* ncovcombmax= pow(2,cptcoveff); */ |
|
/*-------------- Variance of one-step probabilities---*/ |
k=1; |
k=1; |
varprob(optionfilefiname, matcov, p, delti, nlstate, bage, fage,k,Tvar,nbcode, ncodemax,strstart); |
varprob(optionfilefiname, matcov, p, delti, nlstate, bage, fage,k,Tvar,nbcode, ncodemax,strstart); |
|
|
|
/* Prevalence for each covariate combination in probs[age][status][cov] */ |
probs= ma3x(1,AGESUP,1,NCOVMAX, 1,NCOVMAX); |
probs= ma3x(AGEINF,AGESUP,1,nlstate+ndeath, 1,ncovcombmax); |
for(i=1;i<=AGESUP;i++) |
for(i=AGEINF;i<=AGESUP;i++) |
for(j=1;j<=NCOVMAX;j++) |
for(j=1;j<=nlstate+ndeath;j++) /* ndeath is useless but a necessity to be compared with mobaverages */ |
for(k=1;k<=NCOVMAX;k++) |
for(k=1;k<=ncovcombmax;k++) |
probs[i][j][k]=0.; |
probs[i][j][k]=0.; |
|
prevalence(probs, ageminpar, agemaxpar, s, agev, nlstate, imx, Tvar, nbcode, |
|
ncodemax, mint, anint, dateprev1, dateprev2, firstpass, lastpass); |
|
if (mobilav!=0 ||mobilavproj !=0 ) { |
|
mobaverages= ma3x(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 ------------------*/ |
/*---------- Forecasting ------------------*/ |
/*if((stepm == 1) && (strcmp(model,".")==0)){*/ |
|
if(prevfcast==1){ |
if(prevfcast==1){ |
/* if(stepm ==1){*/ |
/* if(stepm ==1){*/ |
prevforecast(fileresu, anproj1, mproj1, jproj1, agemin, agemax, dateprev1, dateprev2, mobilavproj, bage, fage, firstpass, lastpass, anproj2, p, cptcoveff); |
prevforecast(fileresu, anproj1, mproj1, jproj1, agemin, agemax, dateprev1, dateprev2, mobilavproj, mobaverage, 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 */ |
/* Backcasting */ |
|
if(backcast==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); |
|
|
prevalence(probs, agemin, agemax, s, agev, nlstate, imx, Tvar, nbcode, ncodemax, mint, anint, dateprev1, dateprev2, firstpass, lastpass); |
/*--------------- Back Prevalence limit (period or stable prevalence) --------------*/ |
/* 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 (mobilav!=0) { |
bprlim=matrix(1,nlstate,1,nlstate); |
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); |
|
} |
|
} |
|
|
|
|
back_prevalence_limit(p, bprlim, ageminpar, agemaxpar, ftolpl, &ncvyear, dateprev1, dateprev2, firstpass, lastpass, mobilavproj); |
|
fclose(ficresplb); |
|
|
/*---------- Health expectancies, no variances ------------*/ |
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); |
|
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 Backcasting */ |
|
|
|
|
|
/* ------ 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_"); |
strcpy(filerese,"E_"); |
strcat(filerese,fileresu); |
strcat(filerese,fileresu); |
if((ficreseij=fopen(filerese,"w"))==NULL) { |
if((ficreseij=fopen(filerese,"w"))==NULL) { |
Line 8137 Please run with mle=-1 to get a correct
|
Line 12316 Please run with mle=-1 to get a correct
|
} |
} |
printf("Computing Health Expectancies: result on file '%s' ...", filerese);fflush(stdout); |
printf("Computing Health Expectancies: result on file '%s' ...", filerese);fflush(stdout); |
fprintf(ficlog,"Computing Health Expectancies: result on file '%s' ...", filerese);fflush(ficlog); |
fprintf(ficlog,"Computing Health Expectancies: result on file '%s' ...", filerese);fflush(ficlog); |
/*for(cptcov=1,k=0;cptcov<=i1;cptcov++){ |
|
for(cptcod=1;cptcod<=ncodemax[cptcov];cptcod++){*/ |
|
|
|
for (k=1; k <= (int) pow(2,cptcoveff); k++){ |
|
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"); |
|
|
|
eij=ma3x(1,nlstate,1,nlstate,(int) bage, (int) fage); |
pstamp(ficreseij); |
oldm=oldms;savm=savms; |
|
evsij(eij, p, nlstate, stepm, (int) bage, (int)fage, oldm, savm, k, estepm, strstart); |
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); |
fclose(ficreseij); |
printf("done evsij\n");fflush(stdout); |
printf("done evsij\n");fflush(stdout); |
fprintf(ficlog,"done evsij\n");fflush(ficlog); |
fprintf(ficlog,"done evsij\n");fflush(ficlog); |
|
|
/*---------- Health expectancies and variances ------------*/ |
|
|
/*---------- State-specific expectancies and variances ------------*/ |
|
|
strcpy(filerest,"T_"); |
strcpy(filerest,"T_"); |
strcat(filerest,fileresu); |
strcat(filerest,fileresu); |
if((ficrest=fopen(filerest,"w"))==NULL) { |
if((ficrest=fopen(filerest,"w"))==NULL) { |
Line 8169 Please run with mle=-1 to get a correct
|
Line 12360 Please run with mle=-1 to get a correct
|
} |
} |
printf("Computing Total Life expectancies with their standard errors: file '%s' ...\n", filerest); fflush(stdout); |
printf("Computing Total Life expectancies with their standard errors: file '%s' ...\n", filerest); fflush(stdout); |
fprintf(ficlog,"Computing Total Life expectancies with their standard errors: file '%s' ...\n", filerest); fflush(ficlog); |
fprintf(ficlog,"Computing Total Life expectancies with their standard errors: file '%s' ...\n", filerest); fflush(ficlog); |
|
|
|
|
strcpy(fileresstde,"STDE_"); |
strcpy(fileresstde,"STDE_"); |
strcat(fileresstde,fileresu); |
strcat(fileresstde,fileresu); |
if((ficresstdeij=fopen(fileresstde,"w"))==NULL) { |
if((ficresstdeij=fopen(fileresstde,"w"))==NULL) { |
printf("Problem with Health Exp. and std errors resultfile: %s\n", fileresstde); exit(0); |
printf("Problem with State specific Exp. and std errors resultfile: %s\n", fileresstde); exit(0); |
fprintf(ficlog,"Problem with Health Exp. and std errors resultfile: %s\n", fileresstde); exit(0); |
fprintf(ficlog,"Problem with State specific Exp. and std errors resultfile: %s\n", fileresstde); exit(0); |
} |
} |
printf(" Computing Health Expectancies and standard errors: result on file '%s' \n", fileresstde); |
printf(" Computing State-specific Expectancies and standard errors: result on file '%s' \n", fileresstde); |
fprintf(ficlog," Computing Health Expectancies and standard errors: result on file '%s' \n", fileresstde); |
fprintf(ficlog," Computing State-specific Expectancies and standard errors: result on file '%s' \n", fileresstde); |
|
|
strcpy(filerescve,"CVE_"); |
strcpy(filerescve,"CVE_"); |
strcat(filerescve,fileresu); |
strcat(filerescve,fileresu); |
if((ficrescveij=fopen(filerescve,"w"))==NULL) { |
if((ficrescveij=fopen(filerescve,"w"))==NULL) { |
printf("Problem with Covar. Health Exp. resultfile: %s\n", filerescve); exit(0); |
printf("Problem with Covar. State-specific Exp. resultfile: %s\n", filerescve); exit(0); |
fprintf(ficlog,"Problem with Covar. Health Exp. resultfile: %s\n", filerescve); exit(0); |
fprintf(ficlog,"Problem with Covar. State-specific Exp. resultfile: %s\n", filerescve); exit(0); |
} |
} |
printf(" Computing Covar. of Health Expectancies: result on file '%s' \n", filerescve); |
printf(" Computing Covar. of State-specific Expectancies: result on file '%s' \n", filerescve); |
fprintf(ficlog," Computing Covar. of Health Expectancies: result on file '%s' \n", filerescve); |
fprintf(ficlog," Computing Covar. of State-specific Expectancies: result on file '%s' \n", filerescve); |
|
|
strcpy(fileresv,"V_"); |
strcpy(fileresv,"V_"); |
strcat(fileresv,fileresu); |
strcat(fileresv,fileresu); |
Line 8195 Please run with mle=-1 to get a correct
|
Line 12384 Please run with mle=-1 to get a correct
|
printf("Problem with variance resultfile: %s\n", fileresv);exit(0); |
printf("Problem with variance resultfile: %s\n", fileresv);exit(0); |
fprintf(ficlog,"Problem with variance resultfile: %s\n", fileresv);exit(0); |
fprintf(ficlog,"Problem with variance resultfile: %s\n", fileresv);exit(0); |
} |
} |
printf(" Computing Variance-covariance of DFLEs: file '%s' ... ", fileresv);fflush(stdout); |
printf(" Computing Variance-covariance of State-specific Expectancies: file '%s' ... ", fileresv);fflush(stdout); |
fprintf(ficlog," Computing Variance-covariance of DFLEs: file '%s' ... ", fileresv);fflush(ficlog); |
fprintf(ficlog," Computing Variance-covariance of State-specific Expectancies: file '%s' ... ", fileresv);fflush(ficlog); |
|
|
/*for(cptcov=1,k=0;cptcov<=i1;cptcov++){ |
i1=pow(2,cptcoveff); /* Number of combination of dummy covariates */ |
for(cptcod=1;cptcod<=ncodemax[cptcov];cptcod++){*/ |
if (cptcovn < 1){i1=1;} |
|
|
for (k=1; k <= (int) pow(2,cptcoveff); k++){ |
for(nres=1; nres <= nresult; nres++) /* For each resultline */ |
fprintf(ficrest,"\n#****** "); |
for(k=1; k<=i1;k++){ /* For any combination of dummy covariates, fixed and varying */ |
for(j=1;j<=cptcoveff;j++) |
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(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(ficrest,"******\n"); |
|
fprintf(ficlog,"******\n"); |
|
printf("******\n"); |
|
|
fprintf(ficresstdeij,"\n#****** "); |
fprintf(ficresstdeij,"\n#****** "); |
fprintf(ficrescveij,"\n#****** "); |
fprintf(ficrescveij,"\n#****** "); |
Line 8213 Please run with mle=-1 to get a correct
|
Line 12417 Please run with mle=-1 to get a correct
|
fprintf(ficresstdeij,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,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(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(ficresstdeij,"******\n"); |
fprintf(ficrescveij,"******\n"); |
fprintf(ficrescveij,"******\n"); |
|
|
fprintf(ficresvij,"\n#****** "); |
fprintf(ficresvij,"\n#****** "); |
|
/* pstamp(ficresvij); */ |
for(j=1;j<=cptcoveff;j++) |
for(j=1;j<=cptcoveff;j++) |
fprintf(ficresvij,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,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"); |
fprintf(ficresvij,"******\n"); |
|
|
eij=ma3x(1,nlstate,1,nlstate,(int) bage, (int) fage); |
eij=ma3x(1,nlstate,1,nlstate,(int) bage, (int) fage); |
oldm=oldms;savm=savms; |
oldm=oldms;savm=savms; |
printf(" cvevsij %d, ",k); |
printf(" cvevsij "); |
fprintf(ficlog, " cvevsij %d, ",k); |
fprintf(ficlog, " cvevsij "); |
cvevsij(eij, p, nlstate, stepm, (int) bage, (int)fage, oldm, savm, k, estepm, delti, matcov, strstart); |
cvevsij(eij, p, nlstate, stepm, (int) bage, (int)fage, oldm, savm, k, estepm, delti, matcov, strstart, nres); |
printf(" end cvevsij \n "); |
printf(" end cvevsij \n "); |
fprintf(ficlog, " end cvevsij \n "); |
fprintf(ficlog, " end cvevsij \n "); |
|
|
Line 8236 Please run with mle=-1 to get a correct
|
Line 12448 Please run with mle=-1 to get a correct
|
vareij=ma3x(1,nlstate,1,nlstate,(int) bage, (int) fage); |
vareij=ma3x(1,nlstate,1,nlstate,(int) bage, (int) fage); |
pstamp(ficrest); |
pstamp(ficrest); |
|
|
|
epj=vector(1,nlstate+1); |
for(vpopbased=0; vpopbased <= popbased; vpopbased++){ /* Done for vpopbased=0 and vpopbased=1 if popbased==1*/ |
for(vpopbased=0; vpopbased <= popbased; vpopbased++){ /* Done for vpopbased=0 and vpopbased=1 if popbased==1*/ |
oldm=oldms;savm=savms; /* ZZ Segmentation fault */ |
oldm=oldms;savm=savms; /* ZZ Segmentation fault */ |
cptcod= 0; /* To be deleted */ |
cptcod= 0; /* To be deleted */ |
printf("varevsij %d \n",vpopbased); |
printf("varevsij vpopbased=%d \n",vpopbased); |
fprintf(ficlog, "varevsij %d \n",vpopbased); |
fprintf(ficlog, "varevsij vpopbased=%d \n",vpopbased); |
varevsij(optionfilefiname, vareij, matcov, p, delti, nlstate, stepm, (int) bage, (int) fage, oldm, savm, prlim, ftolpl, &ncvyear, k, estepm, cptcov,cptcod,vpopbased,mobilav, strstart); /* cptcod not initialized Intel */ |
varevsij(optionfilefiname, vareij, matcov, p, delti, nlstate, stepm, (int) bage, (int) fage, oldm, savm, prlim, ftolpl, &ncvyear, k, estepm, cptcov,cptcod,vpopbased,mobilav, strstart, 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 "); |
fprintf(ficrest,"# Total life expectancy with std error and decomposition into time to be expected in each health state\n# (weighted average of eij where weights are "); |
if(vpopbased==1) |
if(vpopbased==1) |
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); |
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); |
Line 8252 Please run with mle=-1 to get a correct
|
Line 12464 Please run with mle=-1 to get a correct
|
for (i=1;i<=nlstate;i++) fprintf(ficrest,"e.%d (std) ",i); |
for (i=1;i<=nlstate;i++) fprintf(ficrest,"e.%d (std) ",i); |
fprintf(ficrest,"\n"); |
fprintf(ficrest,"\n"); |
/* printf("Which p?\n"); for(i=1;i<=npar;i++)printf("p[i=%d]=%lf,",i,p[i]);printf("\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); |
|
printf("Computing age specific period (stable) prevalences in each health state \n"); |
printf("Computing age specific period (stable) prevalences in each health state \n"); |
fprintf(ficlog,"Computing age specific period (stable) prevalences in each health state \n"); |
fprintf(ficlog,"Computing age specific period (stable) prevalences in each health state \n"); |
for(age=bage; age <=fage ;age++){ |
for(age=bage; age <=fage ;age++){ |
prevalim(prlim, nlstate, p, age, oldm, savm, ftolpl, &ncvyear, k); /*ZZ Is it the correct prevalim */ |
prevalim(prlim, nlstate, p, age, oldm, savm, ftolpl, &ncvyear, k, nres); /*ZZ Is it the correct prevalim */ |
if (vpopbased==1) { |
if (vpopbased==1) { |
if(mobilav ==0){ |
if(mobilav ==0){ |
for(i=1; i<=nlstate;i++) |
for(i=1; i<=nlstate;i++) |
Line 8290 Please run with mle=-1 to get a correct
|
Line 12501 Please run with mle=-1 to get a correct
|
fprintf(ficrest,"\n"); |
fprintf(ficrest,"\n"); |
} |
} |
} /* End vpopbased */ |
} /* End vpopbased */ |
|
free_vector(epj,1,nlstate+1); |
free_ma3x(eij,1,nlstate,1,nlstate,(int) bage, (int)fage); |
free_ma3x(eij,1,nlstate,1,nlstate,(int) bage, (int)fage); |
free_ma3x(vareij,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); |
printf("done selection\n");fflush(stdout); |
printf("done \n");fflush(stdout); |
fprintf(ficlog,"done selection\n");fflush(ficlog); |
fprintf(ficlog,"done\n");fflush(ficlog); |
|
|
|
/*}*/ |
} /* End k selection */ |
} /* End k */ |
|
|
printf("done State-specific expectancies\n");fflush(stdout); |
|
fprintf(ficlog,"done State-specific expectancies\n");fflush(ficlog); |
|
|
|
/* variance-covariance of period prevalence*/ |
|
varprlim(fileresu, nresult, mobaverage, mobilavproj, bage, fage, prlim, &ncvyear, ftolpl, p, matcov, delti, stepm, cptcoveff); |
|
|
|
|
free_vector(weight,1,n); |
free_vector(weight,1,n); |
free_imatrix(Tvard,1,NCOVMAX,1,2); |
free_imatrix(Tvard,1,NCOVMAX,1,2); |
free_imatrix(s,1,maxwav+1,1,n); |
free_imatrix(s,1,maxwav+1,1,n); |
Line 8309 Please run with mle=-1 to get a correct
|
Line 12527 Please run with mle=-1 to get a correct
|
fclose(ficrescveij); |
fclose(ficrescveij); |
fclose(ficresvij); |
fclose(ficresvij); |
fclose(ficrest); |
fclose(ficrest); |
printf("done Health expectancies\n");fflush(stdout); |
|
fprintf(ficlog,"done Health expectancies\n");fflush(ficlog); |
|
fclose(ficpar); |
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' ...", fileresvpl);fflush(stdout); |
|
fprintf(ficlog, "Computing Variance-covariance of period (stable) prevalence: file '%s' ...", fileresvpl);fflush(ficlog); |
|
|
|
/*for(cptcov=1,k=0;cptcov<=i1;cptcov++){ |
|
for(cptcod=1;cptcod<=ncodemax[cptcov];cptcod++){*/ |
|
|
|
for (k=1; k <= (int) pow(2,cptcoveff); k++){ |
|
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); |
|
printf("done variance-covariance of period prevalence\n");fflush(stdout); |
|
fprintf(ficlog,"done variance-covariance of period prevalence\n");fflush(ficlog); |
|
|
|
/*---------- End : free ----------------*/ |
/*---------- End : free ----------------*/ |
if (mobilav!=0) free_ma3x(mobaverage,1, AGESUP,1,NCOVMAX, 1,NCOVMAX); |
if (mobilav!=0 ||mobilavproj !=0) |
free_ma3x(probs,1,AGESUP,1,NCOVMAX, 1,NCOVMAX); |
free_ma3x(mobaverages,AGEINF, AGESUP,1,nlstate+ndeath, 1,ncovcombmax); /* We need to have a squared matrix with prevalence of the dead! */ |
} /* mle==-3 arrives here for freeing */ |
free_ma3x(probs,AGEINF,AGESUP,1,nlstate+ndeath, 1,ncovcombmax); |
/* endfree:*/ |
|
free_matrix(prlim,1,nlstate,1,nlstate); /*here or after loop ? */ |
free_matrix(prlim,1,nlstate,1,nlstate); /*here or after loop ? */ |
free_matrix(pmmij,1,nlstate+ndeath,1,nlstate+ndeath); |
free_matrix(pmmij,1,nlstate+ndeath,1,nlstate+ndeath); |
free_matrix(oldms, 1,nlstate+ndeath,1,nlstate+ndeath); |
} /* mle==-3 arrives here for freeing */ |
free_matrix(newms, 1,nlstate+ndeath,1,nlstate+ndeath); |
/* endfree:*/ |
free_matrix(savms, 1,nlstate+ndeath,1,nlstate+ndeath); |
free_matrix(oldms, 1,nlstate+ndeath,1,nlstate+ndeath); |
free_matrix(covar,0,NCOVMAX,1,n); |
free_matrix(newms, 1,nlstate+ndeath,1,nlstate+ndeath); |
free_matrix(matcov,1,npar,1,npar); |
free_matrix(savms, 1,nlstate+ndeath,1,nlstate+ndeath); |
free_matrix(hess,1,npar,1,npar); |
if(ntv+nqtv>=1)free_ma3x(cotvar,1,maxwav,1,ntv+nqtv,1,n); |
/*free_vector(delti,1,npar);*/ |
if(nqtv>=1)free_ma3x(cotqvar,1,maxwav,1,nqtv,1,n); |
free_ma3x(delti3,1,nlstate,1, nlstate+ndeath-1,1,ncovmodel); |
if(nqv>=1)free_matrix(coqvar,1,nqv,1,n); |
free_matrix(agev,1,maxwav,1,imx); |
free_matrix(covar,0,NCOVMAX,1,n); |
free_ma3x(param,1,nlstate,1, nlstate+ndeath-1,1,ncovmodel); |
free_matrix(matcov,1,npar,1,npar); |
|
free_matrix(hess,1,npar,1,npar); |
free_ivector(ncodemax,1,NCOVMAX); |
/*free_vector(delti,1,npar);*/ |
free_ivector(ncodemaxwundef,1,NCOVMAX); |
free_ma3x(delti3,1,nlstate,1, nlstate+ndeath-1,1,ncovmodel); |
free_ivector(Tvar,1,NCOVMAX); |
free_matrix(agev,1,maxwav,1,imx); |
free_ivector(Tprod,1,NCOVMAX); |
free_ma3x(paramstart,1,nlstate,1, nlstate+ndeath-1,1,ncovmodel); |
free_ivector(Tvaraff,1,NCOVMAX); |
free_ma3x(param,1,nlstate,1, nlstate+ndeath-1,1,ncovmodel); |
free_ivector(Tage,1,NCOVMAX); |
|
|
free_ivector(ncodemax,1,NCOVMAX); |
free_imatrix(nbcode,0,NCOVMAX,0,NCOVMAX); |
free_ivector(ncodemaxwundef,1,NCOVMAX); |
/* free_imatrix(codtab,1,100,1,10); */ |
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(fichtm); |
fflush(ficgp); |
fflush(ficgp); |
|
|
|
|
if((nberr >0) || (nbwarn>0)){ |
if((nberr >0) || (nbwarn>0)){ |
printf("End of Imach with %d errors and/or %d warnings\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\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{ |
}else{ |
printf("End of Imach\n"); |
printf("End of Imach\n"); |
fprintf(ficlog,"End of Imach\n"); |
fprintf(ficlog,"End of Imach\n"); |
Line 8392 Please run with mle=-1 to get a correct
|
Line 12613 Please run with mle=-1 to get a correct
|
printf("Local time at start %s\nLocal time at end %s",strstart, strtend); |
printf("Local time at start %s\nLocal time at end %s",strstart, strtend); |
fprintf(ficlog,"Local time at start %s\nLocal time at end %s\n",strstart, strtend); |
fprintf(ficlog,"Local time at start %s\nLocal time at end %s\n",strstart, strtend); |
printf("Total time used %s\n", asc_diff_time(rend_time -rstart_time,tmpout)); |
printf("Total time used %s\n", asc_diff_time(rend_time -rstart_time,tmpout)); |
|
|
printf("Total time was %.0lf Sec.\n", difftime(rend_time,rstart_time)); |
printf("Total time was %.0lf Sec.\n", difftime(rend_time,rstart_time)); |
fprintf(ficlog,"Total time used %s\n", asc_diff_time(rend_time -rstart_time,tmpout)); |
fprintf(ficlog,"Total time used %s\n", asc_diff_time(rend_time -rstart_time,tmpout)); |
fprintf(ficlog,"Total time was %.0lf Sec.\n", difftime(rend_time,rstart_time)); |
fprintf(ficlog,"Total time was %.0lf Sec.\n", difftime(rend_time,rstart_time)); |
Line 8405 Please run with mle=-1 to get a correct
|
Line 12626 Please run with mle=-1 to get a correct
|
fclose(ficgp); |
fclose(ficgp); |
fclose(ficlog); |
fclose(ficlog); |
/*------ End -----------*/ |
/*------ End -----------*/ |
|
|
|
|
printf("Before Current directory %s!\n",pathcd); |
printf("Before Current directory %s!\n",pathcd); |
#ifdef WIN32 |
#ifdef WIN32 |
if (_chdir(pathcd) != 0) |
if (_chdir(pathcd) != 0) |
printf("Can't move to directory %s!\n",path); |
printf("Can't move to directory %s!\n",path); |
if(_getcwd(pathcd,MAXLINE) > 0) |
if(_getcwd(pathcd,MAXLINE) > 0) |
#else |
#else |
if(chdir(pathcd) != 0) |
if(chdir(pathcd) != 0) |
printf("Can't move to directory %s!\n", path); |
printf("Can't move to directory %s!\n", path); |
if (getcwd(pathcd, MAXLINE) > 0) |
if (getcwd(pathcd, MAXLINE) > 0) |
#endif |
#endif |
printf("Current directory %s!\n",pathcd); |
printf("Current directory %s!\n",pathcd); |
/*strcat(plotcmd,CHARSEPARATOR);*/ |
/*strcat(plotcmd,CHARSEPARATOR);*/ |
Line 8441 Please run with mle=-1 to get a correct
|
Line 12662 Please run with mle=-1 to get a correct
|
|
|
sprintf(plotcmd,"%s %s",pplotcmd, optionfilegnuplot); |
sprintf(plotcmd,"%s %s",pplotcmd, optionfilegnuplot); |
printf("Starting graphs with: '%s'\n",plotcmd);fflush(stdout); |
printf("Starting graphs with: '%s'\n",plotcmd);fflush(stdout); |
|
|
if((outcmd=system(plotcmd)) != 0){ |
if((outcmd=system(plotcmd)) != 0){ |
printf("gnuplot command might not be in your path: '%s', err=%d\n", plotcmd, outcmd); |
printf("gnuplot command might not be in your path: '%s', err=%d\n", plotcmd, outcmd); |
printf("\n Trying if gnuplot resides on the same directory that IMaCh\n"); |
printf("\n Trying if gnuplot resides on the same directory that IMaCh\n"); |
Line 8469 Please run with mle=-1 to get a correct
|
Line 12690 Please run with mle=-1 to get a correct
|
else if (z[0] == 'g') system(plotcmd); |
else if (z[0] == 'g') system(plotcmd); |
else if (z[0] == 'q') exit(0); |
else if (z[0] == 'q') exit(0); |
} |
} |
end: |
end: |
while (z[0] != 'q') { |
while (z[0] != 'q') { |
printf("\nType q for exiting: "); fflush(stdout); |
printf("\nType q for exiting: "); fflush(stdout); |
scanf("%s",z); |
scanf("%s",z); |