version 1.341, 2022/09/11 07:58:42
|
version 1.367, 2024/07/08 14:26:18
|
Line 1
|
Line 1
|
/* $Id$ |
/* $Id$ |
$State$ |
$State$ |
$Log$ |
$Log$ |
|
Revision 1.367 2024/07/08 14:26:18 brouard |
|
Summary: 0.99s7 |
|
|
|
* imach.c (Module): Some bug fixes: in drawings when age*age is |
|
included in the model as well as with quantitative variables. |
|
|
|
Revision 1.366 2024/07/02 09:42:10 brouard |
|
Summary: trying clang on Linux |
|
|
|
Revision 1.365 2024/06/28 13:53:38 brouard |
|
* imach.c (Module): fixing some bugs in gnuplot and quantitative variables, but not completely solved |
|
|
|
Revision 1.364 2024/06/28 12:27:05 brouard |
|
* imach.c (Module): fixing some bugs in gnuplot and quantitative variables, but not completely solved |
|
|
|
Revision 1.363 2024/06/28 09:31:55 brouard |
|
Summary: Adding log lines too |
|
|
|
Revision 1.362 2024/06/28 08:00:31 brouard |
|
Summary: 0.99s6 |
|
|
|
* imach.c (Module): s6 errors with age*age (harmless). |
|
|
|
Revision 1.361 2024/05/12 20:29:32 brouard |
|
Summary: Version 0.99s5 |
|
|
|
* src/imach.c Version 0.99s5 In fact, the covariance of total life |
|
expectancy e.. with a partial life expectancy e.j is high, |
|
therefore the complete matrix of variance covariance has to be |
|
included in the formula of the standard error of the proportion of |
|
total life expectancy spent in a specific state: |
|
var(X/Y)=mu_x^2/mu_y^2*(sigma_x^2/mu_x^2 -2 |
|
sigma_xy/mu_x/mu_y+sigma^2/mu_y^2). Also an error with mle=-3 |
|
made the program core dump. It is fixed in this version. |
|
|
|
Revision 1.360 2024/04/30 10:59:22 brouard |
|
Summary: Version 0.99s4 and estimation of std of e.j/e.. |
|
|
|
Revision 1.359 2024/04/24 21:21:17 brouard |
|
Summary: First IMaCh version using Brent Praxis software based on Buckhardt and Gegenfürtner C codes |
|
|
|
Revision 1.6 2024/04/24 21:10:29 brouard |
|
Summary: First IMaCh version using Brent Praxis software based on Buckhardt and Gegenfürtner C codes |
|
|
|
Revision 1.5 2023/10/09 09:10:01 brouard |
|
Summary: trying to reconsider |
|
|
|
Revision 1.4 2023/06/22 12:50:51 brouard |
|
Summary: stil on going |
|
|
|
Revision 1.3 2023/06/22 11:28:07 brouard |
|
*** empty log message *** |
|
|
|
Revision 1.2 2023/06/22 11:22:40 brouard |
|
Summary: with svd but not working yet |
|
|
|
Revision 1.353 2023/05/08 18:48:22 brouard |
|
*** empty log message *** |
|
|
|
Revision 1.352 2023/04/29 10:46:21 brouard |
|
*** empty log message *** |
|
|
|
Revision 1.351 2023/04/29 10:43:47 brouard |
|
Summary: 099r45 |
|
|
|
Revision 1.350 2023/04/24 11:38:06 brouard |
|
*** empty log message *** |
|
|
|
Revision 1.349 2023/01/31 09:19:37 brouard |
|
Summary: Improvements in models with age*Vn*Vm |
|
|
|
Revision 1.347 2022/09/18 14:36:44 brouard |
|
Summary: version 0.99r42 |
|
|
|
Revision 1.346 2022/09/16 13:52:36 brouard |
|
* src/imach.c (Module): 0.99r41 Was an error when product of timevarying and fixed. Using FixedV[of name] now. Thank you Feinuo |
|
|
|
Revision 1.345 2022/09/16 13:40:11 brouard |
|
Summary: Version 0.99r41 |
|
|
|
* imach.c (Module): 0.99r41 Was an error when product of timevarying and fixed. Using FixedV[of name] now. Thank you Feinuo |
|
|
|
Revision 1.344 2022/09/14 19:33:30 brouard |
|
Summary: version 0.99r40 |
|
|
|
* imach.c (Module): Fixing names of variables in T_ (thanks to Feinuo) |
|
|
|
Revision 1.343 2022/09/14 14:22:16 brouard |
|
Summary: version 0.99r39 |
|
|
|
* imach.c (Module): Version 0.99r39 with colored dummy covariates |
|
(fixed or time varying), using new last columns of |
|
ILK_parameter.txt file. |
|
|
|
Revision 1.342 2022/09/11 19:54:09 brouard |
|
Summary: 0.99r38 |
|
|
|
* imach.c (Module): Adding timevarying products of any kinds, |
|
should work before shifting cotvar from ncovcol+nqv columns in |
|
order to have a correspondance between the column of cotvar and |
|
the id of column. |
|
(Module): Some cleaning and adding covariates in ILK.txt |
|
|
Revision 1.341 2022/09/11 07:58:42 brouard |
Revision 1.341 2022/09/11 07:58:42 brouard |
Summary: Version 0.99r38 |
Summary: Version 0.99r38 |
|
|
Line 1160 Important routines
|
Line 1263 Important routines
|
- Tricode which tests the modality of dummy variables (in order to warn with wrong or empty modalities) |
- 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. |
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 |
- 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 |
o There are 2**cptcoveff combinations of (0,1) for cptcoveff variables. Outputting only combinations with people, eliminating 1 1 if |
race White (0 0), Black vs White (1 0), Hispanic (0 1) and 1 1 being meaningless. |
race White (0 0), Black vs White (1 0), Hispanic (0 1) and 1 1 being meaningless. |
|
|
|
|
Line 1231 Important routines
|
Line 1334 Important routines
|
/* #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 *\/ */ |
/* #define FLATSUP *//* Suppresses directions where likelihood is flat */ |
/* #define FLATSUP *//* Suppresses directions where likelihood is flat */ |
|
/* #define POWELLORIGINCONJUGATE /\* Don't use conjugate but biggest decrease if valuable *\/ */ |
|
/* #define NOTMINFIT */ |
|
|
#include <math.h> |
#include <math.h> |
#include <stdio.h> |
#include <stdio.h> |
Line 1282 typedef struct {
|
Line 1387 typedef struct {
|
/* #include <libintl.h> */ |
/* #include <libintl.h> */ |
/* #define _(String) gettext (String) */ |
/* #define _(String) gettext (String) */ |
|
|
#define MAXLINE 2048 /* Was 256 and 1024. Overflow with 312 with 2 states and 4 covariates. Should be ok */ |
#define MAXLINE 16384 /* Was 256 and 1024 and 2048. Overflow with 312 with 2 states and 4 covariates. Should be ok */ |
|
|
#define GNUPLOTPROGRAM "gnuplot" |
#define GNUPLOTPROGRAM "gnuplot" |
|
#define GNUPLOTVERSION 5.1 |
|
double gnuplotversion=GNUPLOTVERSION; |
/*#define GNUPLOTPROGRAM "..\\gp37mgw\\wgnuplot"*/ |
/*#define GNUPLOTPROGRAM "..\\gp37mgw\\wgnuplot"*/ |
#define FILENAMELENGTH 256 |
#define FILENAMELENGTH 256 |
|
|
#define GLOCK_ERROR_NOPATH -1 /* empty path */ |
#define GLOCK_ERROR_NOPATH -1 /* empty path */ |
#define GLOCK_ERROR_GETCWD -2 /* cannot get cwd */ |
#define GLOCK_ERROR_GETCWD -2 /* cannot get cwd */ |
|
|
#define MAXPARM 128 /**< Maximum number of parameters for the optimization */ |
#define MAXPARM 216 /**< Maximum number of parameters for the optimization was 128 */ |
#define NPARMAX 64 /**< (nlstate+ndeath-1)*nlstate*ncovmodel */ |
#define NPARMAX 64 /**< (nlstate+ndeath-1)*nlstate*ncovmodel */ |
|
|
#define NINTERVMAX 8 |
#define NINTERVMAX 8 |
Line 1325 typedef struct {
|
Line 1432 typedef struct {
|
/* $State$ */ |
/* $State$ */ |
#include "version.h" |
#include "version.h" |
char version[]=__IMACH_VERSION__; |
char version[]=__IMACH_VERSION__; |
char copyright[]="September 2022,INED-EUROREVES-Institut de longevite-Japan Society for the Promotion of Science (Grant-in-Aid for Scientific Research 25293121), Intel Software 2015-2020, Nihon University 2021-202, INED 2000-2022"; |
char copyright[]="April 2024,INED-EUROREVES-Institut de longevite-Japan Society for the Promotion of Science (Grant-in-Aid for Scientific Research 25293121), Intel Software 2015-2020, Nihon University 2021-202, INED 2000-2024"; |
char fullversion[]="$Revision$ $Date$"; |
char fullversion[]="$Revision$ $Date$"; |
char strstart[80]; |
char strstart[80]; |
char optionfilext[10], optionfilefiname[FILENAMELENGTH]; |
char optionfilext[10], optionfilefiname[FILENAMELENGTH]; |
int erreur=0, nberr=0, nbwarn=0; /* Error number, number of errors number of warnings */ |
int erreur=0, nberr=0, nbwarn=0; /* Error number, number of errors number of warnings */ |
|
int debugILK=0; /* debugILK is set by a #d in a comment line */ |
int nagesqr=0, nforce=0; /* nagesqr=1 if model is including age*age, number of forces */ |
int nagesqr=0, nforce=0; /* nagesqr=1 if model is including age*age, number of forces */ |
/* Number of covariates model (1)=V2+V1+ V3*age+V2*V4 */ |
/* Number of covariates model (1)=V2+V1+ V3*age+V2*V4 */ |
/* Model(2) V1 + V2 + V3 + V8 + V7*V8 + V5*V6 + V8*age + V3*age + age*age */ |
/* Model(2) V1 + V2 + V3 + V8 + V7*V8 + V5*V6 + V8*age + V3*age + age*age */ |
Line 1338 int cptcovt=0; /**< cptcovt: total numbe
|
Line 1446 int cptcovt=0; /**< cptcovt: total numbe
|
int cptcovs=0; /**< cptcovs number of SIMPLE covariates in the model V2+V1 =2 (dummy or quantit or time varying) */ |
int cptcovs=0; /**< cptcovs number of SIMPLE covariates in the model V2+V1 =2 (dummy or quantit or time varying) */ |
int cptcovsnq=0; /**< cptcovsnq number of SIMPLE covariates in the model but non quantitative 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 cptcovprodage=0; /**< Number of fixed covariates with age: V3*age or V2*V3*age 1 */ |
|
int cptcovprodvage=0; /**< Number of varying covariates with age: V7*age or V7*V6*age */ |
|
int cptcovdageprod=0; /**< Number of doubleproducts with age, since 0.99r44 only: age*Vn*Vm for gnuplot printing*/ |
int cptcovprodnoage=0; /**< Number of covariate products without age */ |
int cptcovprodnoage=0; /**< Number of covariate products without age */ |
int cptcoveff=0; /* Total number of single dummy covariates (fixed or time varying) to vary for printing results (2**cptcoveff combinations of dummies)(computed in tricode as cptcov) */ |
int cptcoveff=0; /* Total number of single dummy covariates (fixed or time varying) to vary for printing results (2**cptcoveff combinations of dummies)(computed in tricode as cptcov) */ |
int ncovf=0; /* Total number of effective fixed covariates (dummy or quantitative) in the model */ |
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 ncovv=0; /* Total number of effective (wave) varying covariates (dummy or quantitative) in the model */ |
int ncovvt=0; /* Total number of effective (wave) varying covariates (dummy or quantitative or products [without age]) in the model */ |
int ncovvt=0; /* Total number of effective (wave) varying covariates (dummy or quantitative or products [without age]) in the model */ |
int ncova=0; /* Total number of effective (wave and stepm) varying with age covariates (dummy of quantitative) in the model */ |
int ncovvta=0; /* +age*V6 + age*V7+ age*V6*V3 +age*V7*V3 + age*V6*V4 +age*V7*V4 Total number of expandend products [with age]) in the model */ |
|
int ncovta=0; /*age*V3*V2 +age*V2+agev3+ageV4 +age*V6 + age*V7+ age*V6*V3 +age*V7*V3 + age*V6*V4 +age*V7*V4 Total number of expandend products [with age]) in the model */ |
|
int ncova=0; /* Total number of effective (wave and stepm) varying with age covariates (single or product, dummy or quantitative) in the model */ |
|
int ncovva=0; /* +age*V6 + age*V7+ge*V6*V3 +age*V7*V3 + age*V6*V4 +age*V7*V4 Total number of effective (wave and stepm) varying with age covariates (single or product, dummy or quantitative) in the model */ |
int nsd=0; /**< Total number of single dummy variables (output) */ |
int nsd=0; /**< Total number of single dummy variables (output) */ |
int nsq=0; /**< Total number of single quantitative 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 ncoveff=0; /* Total number of effective fixed dummy covariates in the model */ |
Line 1366 int *wav; /* Number of waves for this in
|
Line 1480 int *wav; /* Number of waves for this in
|
int maxwav=0; /* Maxim number of waves */ |
int maxwav=0; /* Maxim number of waves */ |
int jmin=0, jmax=0; /* min, max spacing between 2 waves */ |
int jmin=0, jmax=0; /* min, max spacing between 2 waves */ |
int ijmin=0, ijmax=0; /* Individuals having jmin and jmax */ |
int ijmin=0, ijmax=0; /* Individuals having jmin and jmax */ |
int gipmx=0, gsw=0; /* Global variables on the number of contributions |
int gipmx = 0; |
|
double gsw = 0; /* Global variables on the number of contributions |
to the likelihood and the sum of weights (done by funcone)*/ |
to the likelihood and the sum of weights (done by funcone)*/ |
int mle=1, weightopt=0; |
int mle=1, weightopt=0; |
int **mw; /* mw[mi][i] is number of the mi wave for this individual */ |
int **mw; /* mw[mi][i] is number of the mi wave for this individual */ |
Line 1377 int countcallfunc=0; /* Count the numbe
|
Line 1492 int countcallfunc=0; /* Count the numbe
|
int selected(int kvar); /* Is covariate kvar selected for printing results */ |
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(double **out, double **in,int nrl, int nrh, int ncl, int nch, int ncolol, int ncoloh, double **b); /* 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 */ |
double **ddnewms, **ddoldms, **ddsavms; /* for freeing later */ |
Line 1424 char optionfilegnuplot[FILENAMELENGTH],
|
Line 1540 char optionfilegnuplot[FILENAMELENGTH],
|
/* struct timeval start_time, end_time, curr_time, last_time, forecast_time; */ |
/* struct timeval start_time, end_time, curr_time, last_time, forecast_time; */ |
/* struct timezone tzp; */ |
/* struct timezone tzp; */ |
/* extern int gettimeofday(); */ |
/* extern int gettimeofday(); */ |
struct tm tml, *gmtime(), *localtime(); |
|
|
|
extern time_t time(); |
/* extern time_t time(); */ /* Commented out for clang */ |
|
/* struct tm tml, *gmtime(), *localtime(); */ |
|
|
|
|
struct tm start_time, end_time, curr_time, last_time, forecast_time; |
struct tm start_time, end_time, curr_time, last_time, forecast_time; |
time_t rstart_time, rend_time, rcurr_time, rlast_time, rforecast_time; /* raw time */ |
time_t rstart_time, rend_time, rcurr_time, rlast_time, rforecast_time; /* raw time */ |
struct tm tm; |
time_t rlast_btime; /* raw time */ |
|
/* struct tm tm; */ |
|
struct tm tm, tml; |
|
|
char strcurr[80], strfor[80]; |
char strcurr[80], strfor[80]; |
|
|
Line 1438 char *endptr;
|
Line 1557 char *endptr;
|
long lval; |
long lval; |
double dval; |
double dval; |
|
|
|
/* This for praxis gegen */ |
|
/* int prin=1; */ |
|
double h0=0.25; |
|
double macheps; |
|
double ffmin; |
|
|
#define NR_END 1 |
#define NR_END 1 |
#define FREE_ARG char* |
#define FREE_ARG char* |
#define FTOL 1.0e-10 |
#define FTOL 1.0e-10 |
Line 1533 int **nbcode, *Tvar; /**< model=V2 => Tv
|
Line 1658 int **nbcode, *Tvar; /**< model=V2 => Tv
|
# States 1=Coresidence, 2 Living alone, 3 Institution |
# States 1=Coresidence, 2 Living alone, 3 Institution |
# V1=sex, V2=raedyrs Quant Fixed, State=livarnb4..livarnb11, V3=iadl4..iald11, V4=adlw4..adlw11, V5=r4bmi..r11bmi |
# V1=sex, V2=raedyrs Quant Fixed, State=livarnb4..livarnb11, V3=iadl4..iald11, V4=adlw4..adlw11, V5=r4bmi..r11bmi |
*/ |
*/ |
/* V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ |
/* V5+V4+ V3+V4*V3 +V5*age+V2 +V1*V2+V1*age+V1+V4*V3*age */ |
/* k 1 2 3 4 5 6 7 8 9 */ |
/* kmodel 1 2 3 4 5 6 7 8 9 10 */ |
/*Typevar[k]= 0 0 0 2 1 0 2 1 0 *//*0 for simple covariate (dummy, quantitative,*/ |
/*Typevar[k]= 0 0 0 2 1 0 2 1 0 3 *//*0 for simple covariate (dummy, quantitative,*/ |
/* fixed or varying), 1 for age product, 2 for*/ |
/* fixed or varying), 1 for age product, 2 for*/ |
/* product */ |
/* product without age, 3 for age and double product */ |
/*Dummy[k]= 1 0 0 1 3 1 1 2 0 *//*Dummy[k] 0=dummy (0 1), 1 quantitative */ |
/*Dummy[k]= 1 0 0 1 3 1 1 2 0 3 *//*Dummy[k] 0=dummy (0 1), 1 quantitative */ |
/*(single or product without age), 2 dummy*/ |
/*(single or product without age), 2 dummy*/ |
/* with age product, 3 quant with age product*/ |
/* with age product, 3 quant with age product*/ |
/*Tvar[k]= 5 4 3 6 5 2 7 1 1 */ |
/*Tvar[k]= 5 4 3 6 5 2 7 1 1 6 */ |
/* nsd 1 2 3 */ /* Counting single dummies covar fixed or tv */ |
/* nsd 1 2 3 */ /* Counting single dummies covar fixed or tv */ |
/*TnsdVar[Tvar] 1 2 3 */ |
/*TnsdVar[Tvar] 1 2 3 */ |
/*Tvaraff[nsd] 4 3 1 */ /* ID of single dummy cova fixed or timevary*/ |
/*Tvaraff[nsd] 4 3 1 */ /* ID of single dummy cova fixed or timevary*/ |
/*TvarsD[nsd] 4 3 1 */ /* ID of single dummy cova fixed or timevary*/ |
/*TvarsD[nsd] 4 3 1 */ /* ID of single dummy cova fixed or timevary*/ |
/*TvarsDind[nsd] 2 3 9 */ /* position K of single dummy cova */ |
/*TvarsDind[nsd] 2 3 9 */ /* position K of single dummy cova */ |
/* nsq 1 2 */ /* Counting single quantit tv */ |
/* nsq 1 2 */ /* Counting single quantit tv */ |
/* TvarsQ[k] 5 2 */ /* Number of single quantitative cova */ |
/* TvarsQ[k] 5 2 */ /* Number of single quantitative cova */ |
/* TvarsQind 1 6 */ /* position K of single quantitative cova */ |
/* TvarsQind 1 6 */ /* position K of single quantitative cova */ |
/* Tprod[i]=k 1 2 */ /* Position in model of the ith prod without age */ |
/* Tprod[i]=k 1 2 */ /* Position in model of the ith prod without age */ |
/* cptcovage 1 2 */ /* Counting cov*age in the model equation */ |
/* cptcovage 1 2 3 */ /* Counting cov*age in the model equation */ |
/* Tage[cptcovage]=k 5 8 */ /* Position in the model of ith cov*age */ |
/* Tage[cptcovage]=k 5 8 10 */ /* Position in the model of ith cov*age */ |
/* Tvard[1][1]@4={4,3,1,2} V4*V3 V1*V2 */ /* Position in model of the ith prod without age */ |
/* model="V2+V3+V4+V6+V7+V6*V2+V7*V2+V6*V3+V7*V3+V6*V4+V7*V4+age*V2+age*V3+age*V4+age*V6+age*V7+age*V6*V2+age*V6*V3+age*V7*V3+age*V6*V4+age*V7*V4\r"*/ |
|
/* p Tvard[1][1]@21 = {6, 2, 7, 2, 6, 3, 7, 3, 6, 4, 7, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0}*/ |
|
/* p Tvard[2][1]@21 = {7, 2, 6, 3, 7, 3, 6, 4, 7, 4, 0 <repeats 11 times>} */ |
|
/* p Tvardk[1][1]@24 = {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 6, 2, 7, 2, 6, 3, 7, 3, 6, 4, 7, 4, 0, 0}*/ |
|
/* p Tvardk[1][1]@22 = {0, 0, 0, 0, 0, 0, 0, 0, 6, 2, 7, 2, 6, 3, 7, 3, 6, 4, 7, 4, 0, 0} */ |
|
/* Tvard[1][1]@4={4,3,1,2} V4*V3 V1*V2 */ /* Position in model of the ith prod without age */ |
/* Tvardk[4][1]=4;Tvardk[4][2]=3;Tvardk[7][1]=1;Tvardk[7][2]=2 */ /* Variables of a prod at position in the model equation*/ |
/* Tvardk[4][1]=4;Tvardk[4][2]=3;Tvardk[7][1]=1;Tvardk[7][2]=2 */ /* Variables of a prod at position in the model equation*/ |
/* TvarF TvarF[1]=Tvar[6]=2, TvarF[2]=Tvar[7]=7, TvarF[3]=Tvar[9]=1 ID of fixed covariates or product V2, V1*V2, V1 */ |
/* TvarF TvarF[1]=Tvar[6]=2, TvarF[2]=Tvar[7]=7, TvarF[3]=Tvar[9]=1 ID of fixed covariates or product V2, V1*V2, V1 */ |
/* TvarFind; TvarFind[1]=6, TvarFind[2]=7, TvarFind[3]=9 *//* Inverse V2(6) is first fixed (single or prod) */ |
/* TvarFind; TvarFind[1]=6, TvarFind[2]=7, TvarFind[3]=9 *//* Inverse V2(6) is first fixed (single or prod) */ |
Line 1603 int *TvarVQ; /* TvarVQ[1]=V5 in V5+V4+V3
|
Line 1733 int *TvarVQ; /* TvarVQ[1]=V5 in V5+V4+V3
|
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 *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 *TvarVV; /* We count ncovvt time varying covariates (single or products without age) and put their name into TvarVV */ |
int *TvarVV; /* We count ncovvt time varying covariates (single or products without age) and put their name into TvarVV */ |
int *TvarVVind; /* We count ncovvt time varying covariates (single or products without age) and put their name into TvarVV */ |
int *TvarVVind; /* We count ncovvt time varying covariates (single or products without age) and put their name into TvarVV */ |
|
int *TvarVVA; /* We count ncovvt time varying covariates (single or products with age) and put their name into TvarVVA */ |
|
int *TvarVVAind; /* We count ncovvt time varying covariates (single or products without age) and put their name into TvarVV */ |
|
int *TvarAVVA; /* We count ALL ncovta time varying covariates (single or products with age) and put their name into TvarVVA */ |
|
int *TvarAVVAind; /* We count ALL ncovta time varying covariates (single or products without age) and put their name into TvarVV */ |
/*# ID V1 V2 weight birth death 1st s1 V3 V4 V5 2nd s2 */ |
/*# ID V1 V2 weight birth death 1st s1 V3 V4 V5 2nd s2 */ |
/* model V1+V3+age*V1+age*V3+V1*V3 */ |
/* model V1+V3+age*V1+age*V3+V1*V3 + V1*V3*age */ |
/* Tvar={1, 3, 1, 3, 6}, the 6 comes from the fact that there are already V1, V2, V3, V4, V5 native covariates */ |
/* Tvar={1, 3, 1, 3, 6, 6}, the 6 comes from the fact that there are already V1, V2, V3, V4, V5 native covariates */ |
/* TvarVV={3,1,3}, for V3 and then the product V1*V3 is decomposed into V1 and V3 */ |
/* TvarVV={3,1,3,1,3}, for V3 and then the product V1*V3 is decomposed into V1 and V3 */ |
/* TvarVVind={2,5,5}, for V3 and then the product V1*V3 is decomposed into V1 and V3 */ |
/* TvarVVind={2,5,5,6,6}, for V3 and then the product V1*V3 is decomposed into V1 and V3 and V1*V3*age into 6,6 */ |
int *Tvarsel; /**< Selected covariates for output */ |
int *Tvarsel; /**< Selected covariates for output */ |
double *Tvalsel; /**< Selected modality value of covariate 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 *Typevar; /**< 0 for simple covariate (dummy, quantitative, fixed or varying), 1 for age product, 2 for product, 3 age*Vn*Vm */ |
int *Fixed; /** Fixed[k] 0=fixed, 1 varying, 2 fixed with age product, 3 varying with age 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 *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 *DummyV; /** Dummy[v] 0=dummy (0 1), 1 quantitative */ |
Line 1747 char *trimbb(char *out, char *in)
|
Line 1881 char *trimbb(char *out, char *in)
|
return s; |
return s; |
} |
} |
|
|
|
char *trimbtab(char *out, char *in) |
|
{ /* Trim blanks or tabs in line but keeps first blanks if line starts with blanks */ |
|
char *s; |
|
s=out; |
|
while (*in != '\0'){ |
|
while( (*in == ' ' || *in == '\t')){ /* && *(in+1) != '\0'){*/ |
|
in++; |
|
} |
|
*out++ = *in++; |
|
} |
|
*out='\0'; |
|
return s; |
|
} |
|
|
/* char *substrchaine(char *out, char *in, char *chain) */ |
/* char *substrchaine(char *out, char *in, char *chain) */ |
/* { */ |
/* { */ |
/* /\* Substract chain 'chain' from 'in', return and output 'out' *\/ */ |
/* /\* Substract chain 'chain' from 'in', return and output 'out' *\/ */ |
Line 1773 char *trimbb(char *out, char *in)
|
Line 1921 char *trimbb(char *out, char *in)
|
char *substrchaine(char *out, char *in, char *chain) |
char *substrchaine(char *out, char *in, char *chain) |
{ |
{ |
/* Substract chain 'chain' from 'in', return and output 'out' */ |
/* Substract chain 'chain' from 'in', return and output 'out' */ |
/* in="V1+V1*age+age*age+V2", chain="age*age" */ |
/* in="V1+V1*age+age*age+V2", chain="+age*age" out="V1+V1*age+V2" */ |
|
|
char *strloc; |
char *strloc; |
|
|
strcpy (out, in); |
strcpy (out, in); /* out="V1+V1*age+age*age+V2" */ |
strloc = strstr(out, chain); /* strloc points to out at age*age+V2 */ |
strloc = strstr(out, chain); /* strloc points to out at "+age*age+V2" */ |
printf("Bef strloc=%s chain=%s out=%s \n", strloc, chain, out); |
printf("Bef strloc=%s chain=%s out=%s \n", strloc, chain, out); /* strloc=+age*age+V2 chain="+age*age", out="V1+V1*age+age*age+V2" */ |
if(strloc != NULL){ |
if(strloc != NULL){ |
/* will affect out */ /* strloc+strlenc(chain)=+V2 */ /* Will also work in Unicode */ |
/* will affect out */ /* strloc+strlen(chain)=|+V2 = "V1+V1*age+age*age|+V2" */ /* Will also work in Unicodek */ |
memmove(strloc,strloc+strlen(chain), strlen(strloc+strlen(chain))+1); |
memmove(strloc,strloc+strlen(chain), strlen(strloc+strlen(chain))+1); /* move number of bytes corresponding to the length of "+V2" which is 3, plus one is 4 (including the null)*/ |
/* strcpy (strloc, strloc +strlen(chain));*/ |
/* equivalent to strcpy (strloc, strloc +strlen(chain)) if no overlap; Copies from "+V2" to V1+V1*age+ */ |
} |
} |
printf("Aft strloc=%s chain=%s in=%s out=%s \n", strloc, chain, in, out); |
printf("Aft strloc=%s chain=%s in=%s out=%s \n", strloc, chain, in, out); /* strloc=+V2 chain="+age*age", in="V1+V1*age+age*age+V2", out="V1+V1*age+V2" */ |
return out; |
return out; |
} |
} |
|
|
Line 1793 char *substrchaine(char *out, char *in,
|
Line 1941 char *substrchaine(char *out, char *in,
|
char *cutl(char *blocc, char *alocc, char *in, char occ) |
char *cutl(char *blocc, char *alocc, char *in, char occ) |
{ |
{ |
/* cuts string in into blocc and alocc where blocc ends before FIRST occurence of char 'occ' |
/* cuts string in into blocc and alocc where blocc ends before FIRST occurence of char 'occ' |
and alocc starts after first occurence of char 'occ' : ex cutv(blocc,alocc,"abcdef2ghi2j",'2') |
and alocc starts after first occurence of char 'occ' : ex cutl(blocc,alocc,"abcdef2ghi2j",'2') |
gives alocc="abcdef" and blocc="ghi2j". |
gives alocc="abcdef" and blocc="ghi2j". |
If occ is not found blocc is null and alocc is equal to in. Returns blocc |
If occ is not found blocc is null and alocc is equal to in. Returns blocc |
*/ |
*/ |
Line 1859 int nbocc(char *s, char occ)
|
Line 2007 int nbocc(char *s, char occ)
|
return j; |
return j; |
} |
} |
|
|
|
int nboccstr(char *textin, char *chain) |
|
{ |
|
/* Counts the number of occurence of "chain" in string textin */ |
|
/* in="+V7*V4+age*V2+age*V3+age*V4" chain="age" */ |
|
char *strloc; |
|
|
|
int j=0; |
|
|
|
strloc=textin; /* strloc points to "^+V7*V4+age+..." in textin */ |
|
for(;;) { |
|
strloc= strstr(strloc,chain); /* strloc points to first character of chain in textin if found. Example strloc points^ to "+V7*V4+^age" in textin */ |
|
if(strloc != NULL){ |
|
strloc = strloc+strlen(chain); /* strloc points to "+V7*V4+age^" in textin */ |
|
j++; |
|
}else |
|
break; |
|
} |
|
return j; |
|
|
|
} |
/* void cutv(char *u,char *v, char*t, char occ) */ |
/* void cutv(char *u,char *v, char*t, char occ) */ |
/* { */ |
/* { */ |
/* /\* cuts string t into u and v where u ends before last occurence of char 'occ' */ |
/* /\* cuts string t into u and v where u ends before last occurence of char 'occ' */ |
Line 1979 int **imatrix(long nrl, long nrh, long n
|
Line 2147 int **imatrix(long nrl, long nrh, long n
|
} |
} |
|
|
/****************** free_imatrix *************************/ |
/****************** free_imatrix *************************/ |
void free_imatrix(m,nrl,nrh,ncl,nch) |
/* void free_imatrix(m,nrl,nrh,ncl,nch); */ |
int **m; |
/* int **m; */ |
long nch,ncl,nrh,nrl; |
/* long nch,ncl,nrh,nrl; */ |
/* free an int matrix allocated by imatrix() */ |
void free_imatrix(int **m,long nrl, long nrh, long ncl, long nch) |
{ |
/* free an int matrix allocated by imatrix() */ |
free((FREE_ARG) (m[nrl]+ncl-NR_END)); |
{ |
free((FREE_ARG) (m+nrl-NR_END)); |
free((FREE_ARG) (m[nrl]+ncl-NR_END)); |
} |
free((FREE_ARG) (m+nrl-NR_END)); |
|
} |
|
|
/******************* matrix *******************************/ |
/******************* matrix *******************************/ |
double **matrix(long nrl, long nrh, long ncl, long nch) |
double **matrix(long nrl, long nrh, long ncl, long nch) |
Line 2246 values at the three points, fa, fb , and
|
Line 2415 values at the three points, fa, fb , and
|
double ulim,u,r,q, dum; |
double ulim,u,r,q, dum; |
double fu; |
double fu; |
|
|
double scale=10.; |
/* double scale=10.; */ |
int iterscale=0; |
/* int iterscale=0; */ |
|
|
*fa=(*func)(*ax); /* xta[j]=pcom[j]+(*ax)*xicom[j]; fa=f(xta[j])*/ |
*fa=(*func)(*ax); /* xta[j]=pcom[j]+(*ax)*xicom[j]; fa=f(xta[j])*/ |
*fb=(*func)(*bx); /* xtb[j]=pcom[j]+(*bx)*xicom[j]; fb=f(xtb[j]) */ |
*fb=(*func)(*bx); /* xtb[j]=pcom[j]+(*bx)*xicom[j]; fb=f(xtb[j]) */ |
Line 2507 void linmin(double p[], double xi[], int
|
Line 2676 void linmin(double p[], double xi[], int
|
free_vector(pcom,1,n); |
free_vector(pcom,1,n); |
} |
} |
|
|
|
/**** praxis gegen ****/ |
|
|
|
/* This has been tested by Visual C from Microsoft and works */ |
|
/* meaning tha valgrind could be wrong */ |
|
/*********************************************************************/ |
|
/* f u n c t i o n p r a x i s */ |
|
/* */ |
|
/* praxis is a general purpose routine for the minimization of a */ |
|
/* function in several variables. the algorithm used is a modifi- */ |
|
/* cation of conjugate gradient search method by powell. the changes */ |
|
/* are due to r.p. brent, who gives an algol-w program, which served */ |
|
/* as a basis for this function. */ |
|
/* */ |
|
/* references: */ |
|
/* - powell, m.j.d., 1964. an efficient method for finding */ |
|
/* the minimum of a function in several variables without */ |
|
/* calculating derivatives, computer journal, 7, 155-162 */ |
|
/* - brent, r.p., 1973. algorithms for minimization without */ |
|
/* derivatives, prentice hall, englewood cliffs. */ |
|
/* */ |
|
/* problems, suggestions or improvements are always wellcome */ |
|
/* karl gegenfurtner 07/08/87 */ |
|
/* c - version */ |
|
/*********************************************************************/ |
|
/* */ |
|
/* usage: min = praxis(tol, macheps, h, n, prin, x, func) */ |
|
/* macheps has been suppressed because it is replaced by DBL_EPSILON */ |
|
/* and if it was an argument of praxis (as it is in original brent) */ |
|
/* it should be declared external */ |
|
/* usage: min = praxis(tol, h, n, prin, x, func) */ |
|
/* was min = praxis(fun, x, n); */ |
|
/* */ |
|
/* fun the function to be minimized. fun is called from */ |
|
/* praxis with x and n as arguments */ |
|
/* x a double array containing the initial guesses for */ |
|
/* the minimum, which will contain the solution on */ |
|
/* return */ |
|
/* n an integer specifying the number of unknown */ |
|
/* parameters */ |
|
/* min praxis returns the least calculated value of fun */ |
|
/* */ |
|
/* some additional global variables control some more aspects of */ |
|
/* the inner workings of praxis. setting them is optional, they */ |
|
/* are all set to some reasonable default values given below. */ |
|
/* */ |
|
/* prin controls the printed output from the routine. */ |
|
/* 0 -> no output */ |
|
/* 1 -> print only starting and final values */ |
|
/* 2 -> detailed map of the minimization process */ |
|
/* 3 -> print also eigenvalues and vectors of the */ |
|
/* search directions */ |
|
/* the default value is 1 */ |
|
/* tol is the tolerance allowed for the precision of the */ |
|
/* solution. praxis returns if the criterion */ |
|
/* 2 * ||x[k]-x[k-1]|| <= sqrt(macheps) * ||x[k]|| + tol */ |
|
/* is fulfilled more than ktm times. */ |
|
/* the default value depends on the machine precision */ |
|
/* ktm see just above. default is 1, and a value of 4 leads */ |
|
/* to a very(!) cautious stopping criterion. */ |
|
/* h0 or step is a steplength parameter and should be set equal */ |
|
/* to the expected distance from the solution. */ |
|
/* exceptionally small or large values of step lead to */ |
|
/* slower convergence on the first few iterations */ |
|
/* the default value for step is 1.0 */ |
|
/* scbd is a scaling parameter. 1.0 is the default and */ |
|
/* indicates no scaling. if the scales for the different */ |
|
/* parameters are very different, scbd should be set to */ |
|
/* a value of about 10.0. */ |
|
/* illc should be set to true (1) if the problem is known to */ |
|
/* be ill-conditioned. the default is false (0). this */ |
|
/* variable is automatically set, when praxis finds */ |
|
/* the problem to be ill-conditioned during iterations. */ |
|
/* maxfun is the maximum number of calls to fun allowed. praxis */ |
|
/* will return after maxfun calls to fun even when the */ |
|
/* minimum is not yet found. the default value of 0 */ |
|
/* indicates no limit on the number of calls. */ |
|
/* this return condition is only checked every n */ |
|
/* iterations. */ |
|
/* */ |
|
/*********************************************************************/ |
|
|
|
#include <math.h> |
|
#include <stdio.h> |
|
#include <stdlib.h> |
|
#include <float.h> /* for DBL_EPSILON */ |
|
/* #include "machine.h" */ |
|
|
|
|
|
/* extern void minfit(int n, double eps, double tol, double **ab, double q[]); */ |
|
/* extern void minfit(int n, double eps, double tol, double ab[N][N], double q[]); */ |
|
/* control parameters */ |
|
/* control parameters */ |
|
#define SQREPSILON 1.0e-19 |
|
/* #define EPSILON 1.0e-8 */ /* in main */ |
|
|
|
double tol = SQREPSILON, |
|
scbd = 1.0, |
|
step = 1.0; |
|
int ktm = 1, |
|
/* prin = 2, */ |
|
maxfun = 0, |
|
illc = 0; |
|
|
|
/* some global variables */ |
|
static int i, j, k, k2, nl, nf, kl, kt; |
|
/* static double s; */ |
|
double sl, dn, dmin, |
|
fx, f1, lds, ldt, sf, df, |
|
qf1, qd0, qd1, qa, qb, qc, |
|
m2, m4, small_windows, vsmall, large, |
|
vlarge, ldfac, t2; |
|
/* static double d[N], y[N], z[N], */ |
|
/* q0[N], q1[N], v[N][N]; */ |
|
|
|
static double *d, *y, *z; |
|
static double *q0, *q1, **v; |
|
double *tflin; /* used in flin: return (*fun)(tflin, n); */ |
|
double *e; /* used in minfit, don't konw how to free memory and thus made global */ |
|
/* static double s, sl, dn, dmin, */ |
|
/* fx, f1, lds, ldt, sf, df, */ |
|
/* qf1, qd0, qd1, qa, qb, qc, */ |
|
/* m2, m4, small, vsmall, large, */ |
|
/* vlarge, ldfac, t2; */ |
|
/* static double d[N], y[N], z[N], */ |
|
/* q0[N], q1[N], v[N][N]; */ |
|
|
|
/* these will be set by praxis to point to it's arguments */ |
|
static int prin; /* added */ |
|
static int n; |
|
static double *x; |
|
static double (*fun)(double *x); /* New for clang */ |
|
/* static double (*fun)(); */ |
|
/* static double (*fun)(double *x, int n); */ |
|
|
|
/* these will be set by praxis to the global control parameters */ |
|
/* static double h, macheps, t; */ |
|
extern double macheps; |
|
static double h; |
|
static double t; |
|
|
|
static double |
|
drandom() /* return random no between 0 and 1 */ |
|
{ |
|
return (double)(rand()%(8192*2))/(double)(8192*2); |
|
} |
|
|
|
static void sort() /* d and v in descending order */ |
|
{ |
|
int k, i, j; |
|
double s; |
|
|
|
for (i=1; i<=n-1; i++) { |
|
k = i; s = d[i]; |
|
for (j=i+1; j<=n; j++) { |
|
if (d[j] > s) { |
|
k = j; |
|
s = d[j]; |
|
} |
|
} |
|
if (k > i) { |
|
d[k] = d[i]; |
|
d[i] = s; |
|
for (j=1; j<=n; j++) { |
|
s = v[j][i]; |
|
v[j][i] = v[j][k]; |
|
v[j][k] = s; |
|
} |
|
} |
|
} |
|
} |
|
|
|
double randbrent ( int *naught ) |
|
{ |
|
double ran1, ran3[127], half; |
|
int ran2, q, r, i, j; |
|
int init=0; /* false */ |
|
double rr; |
|
/* REAL*8 RAN1,RAN3(127),HALF */ |
|
|
|
/* INTEGER RAN2,Q,R */ |
|
/* LOGICAL INIT */ |
|
/* DATA INIT/.FALSE./ */ |
|
/* IF (INIT) GO TO 3 */ |
|
if(!init){ |
|
/* R = MOD(NAUGHT,8190) + 1 *//* 1804289383 rand () */ |
|
r = *naught % 8190 + 1;/* printf(" naught r %d %d",*naught,r); */ |
|
ran2=127; |
|
for(i=ran2; i>0; i--){ |
|
/* RAN2 = 128 */ |
|
/* DO 2 I=1,127 */ |
|
ran2 = ran2-1; |
|
/* RAN2 = RAN2 - 1 */ |
|
ran1 = -pow(2.0,55); |
|
/* RAN1 = -2.D0**55 */ |
|
/* DO 1 J=1,7 */ |
|
for(j=1; j<=7;j++){ |
|
/* R = MOD(1756*R,8191) */ |
|
r = (1756*r) % 8191;/* printf(" i=%d (1756*r)%8191=%d",j,r); */ |
|
q=r/32; |
|
/* Q = R/32 */ |
|
/* 1 RAN1 = (RAN1 + Q)*(1.0D0/256) */ |
|
ran1 =(ran1+q)*(1.0/256); |
|
} |
|
/* 2 RAN3(RAN2) = RAN1 */ |
|
ran3[ran2] = ran1; /* printf(" ran2=%d ran1=%.7g \n",ran2,ran1); */ |
|
} |
|
/* INIT = .TRUE. */ |
|
init=1; |
|
/* 3 IF (RAN2.EQ.1) RAN2 = 128 */ |
|
} |
|
if(ran2 == 0) ran2 = 126; |
|
else ran2 = ran2 -1; |
|
/* RAN2 = RAN2 - 1 */ |
|
/* RAN1 = RAN1 + RAN3(RAN2) */ |
|
ran1 = ran1 + ran3[ran2];/* printf("BIS ran2=%d ran1=%.7g \n",ran2,ran1); */ |
|
half= 0.5; |
|
/* HALF = .5D0 */ |
|
/* IF (RAN1.GE.0.D0) HALF = -HALF */ |
|
if(ran1 >= 0.) half =-half; |
|
ran1 = ran1 +half; |
|
ran3[ran2] = ran1; |
|
rr= ran1+0.5; |
|
/* RAN1 = RAN1 + HALF */ |
|
/* RAN3(RAN2) = RAN1 */ |
|
/* RANDOM = RAN1 + .5D0 */ |
|
/* r = ( ( double ) ( *seed ) ) * 4.656612875E-10; */ |
|
return rr; |
|
} |
|
static void matprint(char *s, double **v, int m, int n) |
|
/* char *s; */ |
|
/* double v[N][N]; */ |
|
{ |
|
#define INCX 8 |
|
int i; |
|
|
|
int i2hi; |
|
int ihi; |
|
int ilo; |
|
int i2lo; |
|
int jlo=1; |
|
int j; |
|
int j2hi; |
|
int jhi; |
|
int j2lo; |
|
ilo=1; |
|
ihi=n; |
|
jlo=1; |
|
jhi=n; |
|
|
|
printf ("\n" ); |
|
printf ("%s\n", s ); |
|
for ( j2lo = jlo; j2lo <= jhi; j2lo = j2lo + INCX ) |
|
{ |
|
j2hi = j2lo + INCX - 1; |
|
if ( n < j2hi ) |
|
{ |
|
j2hi = n; |
|
} |
|
if ( jhi < j2hi ) |
|
{ |
|
j2hi = jhi; |
|
} |
|
|
|
/* fprintf ( ficlog, "\n" ); */ |
|
printf ("\n" ); |
|
/* |
|
For each column J in the current range... |
|
|
|
Write the header. |
|
*/ |
|
/* fprintf ( ficlog, " Col: "); */ |
|
printf ("Col:"); |
|
for ( j = j2lo; j <= j2hi; j++ ) |
|
{ |
|
/* fprintf ( ficlog, " %7d ", j - 1 ); */ |
|
/* printf (" %9d ", j - 1 ); */ |
|
printf (" %9d ", j ); |
|
} |
|
/* fprintf ( ficlog, "\n" ); */ |
|
/* fprintf ( ficlog, " Row\n" ); */ |
|
/* fprintf ( ficlog, "\n" ); */ |
|
printf ("\n" ); |
|
printf (" Row\n" ); |
|
printf ("\n" ); |
|
/* |
|
Determine the range of the rows in this strip. |
|
*/ |
|
if ( 1 < ilo ){ |
|
i2lo = ilo; |
|
}else{ |
|
i2lo = 1; |
|
} |
|
if ( m < ihi ){ |
|
i2hi = m; |
|
}else{ |
|
i2hi = ihi; |
|
} |
|
|
|
for ( i = i2lo; i <= i2hi; i++ ){ |
|
/* |
|
Print out (up to) 5 entries in row I, that lie in the current strip. |
|
*/ |
|
/* fprintf ( ficlog, "%5d:", i - 1 ); */ |
|
/* printf ("%5d:", i - 1 ); */ |
|
printf ("%5d:", i ); |
|
for ( j = j2lo; j <= j2hi; j++ ) |
|
{ |
|
/* fprintf ( ficlog, " %14g", a[i-1+(j-1)*m] ); */ |
|
/* printf ("%14.7g ", a[i-1+(j-1)*m] ); */ |
|
/* printf("%14.7f ", v[i-1][j-1]); */ |
|
printf("%14.7f ", v[i][j]); |
|
/* fprintf ( stdout, " %14g", a[i-1+(j-1)*m] ); */ |
|
} |
|
/* fprintf ( ficlog, "\n" ); */ |
|
printf ("\n" ); |
|
} |
|
} |
|
|
|
/* printf("%s\n", s); */ |
|
/* for (k=0; k<n; k++) { */ |
|
/* for (i=0; i<n; i++) { */ |
|
/* /\* printf("%20.10e ", v[k][i]); *\/ */ |
|
/* } */ |
|
/* printf("\n"); */ |
|
/* } */ |
|
#undef INCX |
|
} |
|
|
|
void vecprint(char *s, double *x, int n) |
|
/* char *s; */ |
|
/* double x[N]; */ |
|
{ |
|
int i=0; |
|
|
|
printf(" %s", s); |
|
/* for (i=0; i<n; i++) */ |
|
for (i=1; i<=n; i++) |
|
printf (" %14.7g", x[i] ); |
|
/* printf(" %8d: %14g\n", i, x[i]); */ |
|
printf ("\n" ); |
|
} |
|
|
|
static void print() /* print a line of traces */ |
|
{ |
|
|
|
|
|
printf("\n"); |
|
/* printf("... chi square reduced to ... %20.10e\n", fx); */ |
|
/* printf("... after %u function calls ...\n", nf); */ |
|
/* printf("... including %u linear searches ...\n", nl); */ |
|
printf("%10d %10d%14.7g",nl, nf, fx); |
|
vecprint("... current values of x ...", x, n); |
|
} |
|
/* static void print2(int n, double *x, int prin, double fx, int nf, int nl) */ /* print a line of traces */ |
|
static void print2() /* print a line of traces */ |
|
{ |
|
int i; /* double fmin=0.; */ |
|
|
|
/* printf("\n"); */ |
|
/* printf("... chi square reduced to ... %20.10e\n", fx); */ |
|
/* printf("... after %u function calls ...\n", nf); */ |
|
/* printf("... including %u linear searches ...\n", nl); */ |
|
/* printf("%10d %10d%14.7g",nl, nf, fx); */ |
|
/* printf ( "\n" ); */ |
|
printf ( " Linear searches %d", nl ); |
|
fprintf (ficlog, " Linear searches %d", nl ); |
|
/* printf ( " Linear searches %d\n", nl ); */ |
|
/* printf ( " Function evaluations %d\n", nf ); */ |
|
/* printf ( " Function value FX = %g\n", fx ); */ |
|
printf ( " Function evaluations %d", nf ); |
|
printf ( " Function value FX = %.12lf\n", fx ); |
|
fprintf (ficlog, " Function evaluations %d", nf ); |
|
fprintf (ficlog, " Function value FX = %.12lf\n", fx ); |
|
#ifdef DEBUGPRAX |
|
printf("n=%d prin=%d\n",n,prin); |
|
#endif |
|
/* if(fx <= fmin) printf(" UNDEFINED "); else printf("%14.7g",log(fx-fmin)); */ |
|
if ( n <= 4 || 2 < prin ) |
|
{ |
|
/* for(i=1;i<=n;i++)printf("%14.7g",x[i-1]); */ |
|
for(i=1;i<=n;i++){ |
|
printf(" %14.7g",x[i]); |
|
fprintf(ficlog," %14.7g",x[i]); |
|
} |
|
/* r8vec_print ( n, x, " X:" ); */ |
|
} |
|
printf("\n"); |
|
fprintf(ficlog,"\n"); |
|
} |
|
|
|
|
|
/* #ifdef MSDOS */ |
|
/* static double tflin[N]; */ |
|
/* #endif */ |
|
|
|
static double flin(double l, int j) |
|
/* double l; */ |
|
{ |
|
int i; |
|
/* #ifndef MSDOS */ |
|
/* double tflin[N]; */ |
|
/* #endif */ |
|
/* double *tflin; */ /* Be careful to put tflin on a vector n */ |
|
|
|
/* j is used from 0 to n-1 and can be -1 for parabolic search */ |
|
|
|
/* if (j != -1) { /\* linear search *\/ */ |
|
if (j > 0) { /* linear search */ |
|
/* for (i=0; i<n; i++){ */ |
|
for (i=1; i<=n; i++){ |
|
tflin[i] = x[i] + l *v[i][j]; |
|
#ifdef DEBUGPRAX |
|
/* printf(" flin i=%14d t=%14.7f x=%14.7f l=%14.7f v[%d,%d]=%14.7f nf=%14d\n",i+1, tflin[i],x[i],l,i,j,v[i][j],nf); */ |
|
printf(" flin i=%14d t=%14.7f x=%14.7f l=%14.7f v[%d,%d]=%14.7f nf=%14d\n",i, tflin[i],x[i],l,i,j,v[i][j],nf); |
|
#endif |
|
} |
|
} |
|
else { /* search along parabolic space curve */ |
|
qa = l*(l-qd1)/(qd0*(qd0+qd1)); |
|
qb = (l+qd0)*(qd1-l)/(qd0*qd1); |
|
qc = l*(l+qd0)/(qd1*(qd0+qd1)); |
|
#ifdef DEBUGPRAX |
|
printf(" search along a parabolic space curve. j=%14d nf=%14d l=%14.7f qd0=%14.7f qd1=%14.7f\n",j,nf,l,qd0,qd1); |
|
#endif |
|
/* for (i=0; i<n; i++){ */ |
|
for (i=1; i<=n; i++){ |
|
tflin[i] = qa*q0[i]+qb*x[i]+qc*q1[i]; |
|
#ifdef DEBUGPRAX |
|
/* printf(" parabole i=%14d t(i)=%14.7f q0=%14.7f x=%14.7f q1=%14.7f\n",i+1,tflin[i],q0[i],x[i],q1[i]); */ |
|
printf(" parabole i=%14d t(i)=%14.7e q0=%14.7e x=%14.7e q1=%14.7e\n",i,tflin[i],q0[i],x[i],q1[i]); |
|
#endif |
|
} |
|
} |
|
nf++; |
|
|
|
#ifdef NR_SHIFT |
|
return (*fun)((tflin-1), n); |
|
#else |
|
/* return (*fun)(tflin, n);*/ |
|
return (*fun)(tflin); |
|
#endif |
|
} |
|
|
|
void minny(int j, int nits, double *d2, double *x1, double f1, int fk) |
|
/* double *d2, *x1, f1; */ |
|
{ |
|
/* here j is from 0 to n-1 and can be -1 for parabolic search */ |
|
/* MINIMIZES F FROM X IN THE DIRECTION V(*,J) */ |
|
/* UNLESS J<1, WHEN A QUADRATIC SEARCH IS DONE */ |
|
/* IN THE PLANE DEFINED BY Q0, Q1 AND X. */ |
|
/* D2 AN APPROXIMATION TO HALF F'' (OR ZERO), */ |
|
/* X1 AN ESTIMATE OF DISTANCE TO MINIMUM, */ |
|
/* RETURNED AS THE DISTANCE FOUND. */ |
|
/* IF FK = TRUE THEN F1 IS FLIN(X1), OTHERWISE */ |
|
/* X1 AND F1 ARE IGNORED ON ENTRY UNLESS FINAL */ |
|
/* FX > F1. NITS CONTROLS THE NUMBER OF TIMES */ |
|
/* AN ATTEMPT IS MADE TO HALVE THE INTERVAL. */ |
|
/* SIDE EFFECTS: USES AND ALTERS X, FX, NF, NL. */ |
|
/* IF J < 1 USES VARIABLES Q... . */ |
|
/* USES H, N, T, M2, M4, LDT, DMIN, MACHEPS; */ |
|
int k, i, dz; |
|
double x2, xm, f0, f2, fm, d1, t2, sf1, sx1; |
|
double s; |
|
double macheps; |
|
macheps=pow(16.0,-13.0); |
|
sf1 = f1; sx1 = *x1; |
|
k = 0; xm = 0.0; fm = f0 = fx; dz = *d2 < macheps; |
|
/* h=1.0;*/ /* To be revised */ |
|
#ifdef DEBUGPRAX |
|
/* printf("min macheps=%14g h=%14g step=%14g t=%14g fx=%14g\n",macheps,h, step,t, fx); */ |
|
/* Where is fx coming from */ |
|
printf(" min macheps=%14g h=%14g t=%14g fx=%.9lf dirj=%d\n",macheps, h, t, fx, j); |
|
matprint(" min vectors:",v,n,n); |
|
#endif |
|
/* find step size */ |
|
s = 0.; |
|
/* for (i=0; i<n; i++) s += x[i]*x[i]; */ |
|
for (i=1; i<=n; i++) s += x[i]*x[i]; |
|
s = sqrt(s); |
|
if (dz) |
|
t2 = m4*sqrt(fabs(fx)/dmin + s*ldt) + m2*ldt; |
|
else |
|
t2 = m4*sqrt(fabs(fx)/(*d2) + s*ldt) + m2*ldt; |
|
s = s*m4 + t; |
|
if (dz && t2 > s) t2 = s; |
|
if (t2 < small_windows) t2 = small_windows; |
|
if (t2 > 0.01*h) t2 = 0.01 * h; |
|
if (fk && f1 <= fm) { |
|
xm = *x1; |
|
fm = f1; |
|
} |
|
#ifdef DEBUGPRAX |
|
printf(" additional flin X1=%14.7f t2=%14.7f *f1=%14.7f fm=%14.7f fk=%d\n",*x1,t2,f1,fm,fk); |
|
#endif |
|
if (!fk || fabs(*x1) < t2) { |
|
*x1 = (*x1 >= 0 ? t2 : -t2); |
|
/* *x1 = (*x1 > 0 ? t2 : -t2); */ /* kind of error */ |
|
#ifdef DEBUGPRAX |
|
printf(" additional flin X1=%16.10e dirj=%d fk=%d\n",*x1, j, fk); |
|
#endif |
|
f1 = flin(*x1, j); |
|
#ifdef DEBUGPRAX |
|
printf(" after flin f1=%18.12e dirj=%d fk=%d\n",f1, j,fk); |
|
#endif |
|
} |
|
if (f1 <= fm) { |
|
xm = *x1; |
|
fm = f1; |
|
} |
|
L0: /*L0 loop or next */ |
|
/* |
|
Evaluate FLIN at another point and estimate the second derivative. |
|
*/ |
|
if (dz) { |
|
x2 = (f0 < f1 ? -(*x1) : 2*(*x1)); |
|
#ifdef DEBUGPRAX |
|
printf(" additional second flin x2=%14.8e x1=%14.8e f0=%14.8e f1=%18.12e dirj=%d\n",x2,*x1,f0,f1,j); |
|
#endif |
|
f2 = flin(x2, j); |
|
#ifdef DEBUGPRAX |
|
printf(" additional second flin x2=%16.10e x1=%16.10e f1=%18.12e f0=%18.10e f2=%18.10e fm=%18.10e\n",x2, *x1, f1,f0,f2,fm); |
|
#endif |
|
if (f2 <= fm) { |
|
xm = x2; |
|
fm = f2; |
|
} |
|
/* d2 is the curvature or double difference f1 doesn't seem to be accurately computed */ |
|
*d2 = (x2*(f1-f0) - (*x1)*(f2-f0))/((*x1)*x2*((*x1)-x2)); |
|
#ifdef DEBUGPRAX |
|
double d11,d12; |
|
d11=(f1-f0)/(*x1);d12=(f2-f0)/x2; |
|
printf(" d11=%18.12e d12=%18.12e d11-d12=%18.12e x1-x2=%18.12e (d11-d12)/(x2-(*x1))=%18.12e\n", d11 ,d12, d11-d12, x2-(*x1), (d11-d12)/(x2-(*x1))); |
|
printf(" original computing f1=%18.12e *d2=%16.10e f0=%18.12e f1-f0=%16.10e f2-f0=%16.10e\n",f1,*d2,f0,f1-f0, f2-f0); |
|
double ff1=7.783920622852e+04; |
|
double f1mf0=9.0344736236e-05; |
|
*d2 = (f1mf0)/ (*x1)/((*x1)-x2) - (f2-f0)/x2/((*x1)-x2); |
|
/* *d2 = (ff1-f0)/ (*x1)/((*x1)-x2) - (f2-f0)/x2/((*x1)-x2); */ |
|
printf(" simpliff computing *d2=%16.10e f1mf0=%18.12e,f1=f0+f1mf0=%18.12e\n",*d2,f1mf0,f0+f1mf0); |
|
*d2 = ((f1-f0)/ (*x1) - (f2-f0)/x2)/((*x1)-x2); |
|
printf(" overlifi computing *d2=%16.10e\n",*d2); |
|
#endif |
|
*d2 = ((f1-f0)/ (*x1) - (f2-f0)/x2)/((*x1)-x2); |
|
} |
|
#ifdef DEBUGPRAX |
|
printf(" additional second flin xm=%14.8e fm=%14.8e *d2=%14.8e\n",xm, fm,*d2); |
|
#endif |
|
/* |
|
Estimate the first derivative at 0. |
|
*/ |
|
d1 = (f1-f0)/(*x1) - *x1**d2; dz = 1; |
|
/* |
|
Predict the minimum. |
|
*/ |
|
if (*d2 <= small_windows) { |
|
x2 = (d1 < 0 ? h : -h); |
|
} |
|
else { |
|
x2 = - 0.5*d1/(*d2); |
|
} |
|
#ifdef DEBUGPRAX |
|
printf(" AT d1=%14.8e d2=%14.8e small=%14.8e dz=%d x1=%14.8e x2=%14.8e\n",d1,*d2,small_windows,dz,*x1,x2); |
|
#endif |
|
if (fabs(x2) > h) |
|
x2 = (x2 > 0 ? h : -h); |
|
L1: /* L1 or try loop */ |
|
#ifdef DEBUGPRAX |
|
printf(" AT predicted minimum flin x2=%14.8e x1=%14.8e K=%14d NITS=%14d dirj=%d\n",x2,*x1,k,nits,j); |
|
#endif |
|
f2 = flin(x2, j); /* x[i]+x2*v[i][j] */ |
|
#ifdef DEBUGPRAX |
|
printf(" after flin f0=%14.8e f1=%14.8e f2=%14.8e fm=%14.8e\n",f0,f1,f2, fm); |
|
#endif |
|
if ((k < nits) && (f2 > f0)) { |
|
#ifdef DEBUGPRAX |
|
printf(" NO SUCCESS SO TRY AGAIN;\n"); |
|
#endif |
|
k++; |
|
if ((f0 < f1) && (*x1*x2 > 0.0)) |
|
goto L0; /* or next */ |
|
x2 *= 0.5; |
|
goto L1; |
|
} |
|
nl++; |
|
#ifdef DEBUGPRAX |
|
printf(" bebeBE end of min x1=%14.8e x2=%14.8e f1=%14.8e f2=%14.8e f0=%14.8e fm=%14.8e d2=%14.8e\n",*x1, x2, f1, f2, f0, fm, *d2); |
|
#endif |
|
if (f2 > fm) x2 = xm; else fm = f2; |
|
if (fabs(x2*(x2-*x1)) > small_windows) { |
|
*d2 = (x2*(f1-f0) - *x1*(fm-f0))/(*x1*x2*(*x1-x2)); |
|
} |
|
else { |
|
if (k > 0) *d2 = 0; |
|
} |
|
#ifdef DEBUGPRAX |
|
printf(" bebe end of min x1 might be very wrong x1=%14.8e fx=%14.8e d2=%14.8e\n",*x1, fx, *d2); |
|
#endif |
|
if (*d2 <= small_windows) *d2 = small_windows; |
|
*x1 = x2; fx = fm; |
|
if (sf1 < fx) { |
|
fx = sf1; |
|
*x1 = sx1; |
|
} |
|
/* |
|
Update X for linear search. |
|
*/ |
|
#ifdef DEBUGPRAX |
|
printf(" end of min x1=%14.8e fx=%14.8e d2=%14.8e\n",*x1, fx, *d2); |
|
#endif |
|
|
|
/* if (j != -1) */ |
|
/* for (i=0; i<n; i++) */ |
|
/* x[i] += (*x1)*v[i][j]; */ |
|
if (j > 0) |
|
for (i=1; i<=n; i++) |
|
x[i] += (*x1)*v[i][j]; |
|
} |
|
|
|
void quad() /* look for a minimum along the curve q0, q1, q2 */ |
|
{ |
|
int i; |
|
double l, s; |
|
|
|
s = fx; fx = qf1; qf1 = s; qd1 = 0.0; |
|
/* for (i=0; i<n; i++) { */ |
|
for (i=1; i<=n; i++) { |
|
s = x[i]; l = q1[i]; x[i] = l; q1[i] = s; |
|
qd1 = qd1 + (s-l)*(s-l); |
|
} |
|
s = 0.0; qd1 = sqrt(qd1); l = qd1; |
|
#ifdef DEBUGPRAX |
|
printf(" QUAD after sqrt qd1=%14.8e \n",qd1); |
|
#endif |
|
|
|
if (qd0>0.0 && qd1>0.0 &&nl>=3*n*n) { |
|
#ifdef DEBUGPRAX |
|
printf(" QUAD before min value=%14.8e \n",qf1); |
|
#endif |
|
/* min(-1, 2, &s, &l, qf1, 1); */ |
|
minny(0, 2, &s, &l, qf1, 1); |
|
qa = l*(l-qd1)/(qd0*(qd0+qd1)); |
|
qb = (l+qd0)*(qd1-l)/(qd0*qd1); |
|
qc = l*(l+qd0)/(qd1*(qd0+qd1)); |
|
} |
|
else { |
|
fx = qf1; qa = qb = 0.0; qc = 1.0; |
|
} |
|
#ifdef DEBUGPRAX |
|
printf("after eventual min qd0=%14.8e qd1=%14.8e nl=%d\n",qd0, qd1,nl); |
|
#endif |
|
qd0 = qd1; |
|
/* for (i=0; i<n; i++) { */ |
|
for (i=1; i<=n; i++) { |
|
s = q0[i]; q0[i] = x[i]; |
|
x[i] = qa*s + qb*x[i] + qc*q1[i]; |
|
} |
|
#ifdef DEBUGQUAD |
|
vecprint ( " X after QUAD:" , x, n ); |
|
#endif |
|
} |
|
|
|
/* void minfit(int n, double eps, double tol, double ab[N][N], double q[]) */ |
|
void minfit(int n, double eps, double tol, double **ab, double q[]) |
|
/* int n; */ |
|
/* double eps, tol, ab[N][N], q[N]; */ |
|
{ |
|
int l, kt, l2, i, j, k; |
|
double c, f, g, h, s, x, y, z; |
|
/* double eps; */ |
|
/* #ifndef MSDOS */ |
|
/* double e[N]; /\* plenty of stack on a vax *\/ */ |
|
/* #endif */ |
|
/* double *e; */ |
|
/* e=vector(0,n-1); /\* should be freed somewhere but gotos *\/ */ |
|
|
|
/* householder's reduction to bidiagonal form */ |
|
|
|
if(n==1){ |
|
/* q[1-1]=ab[1-1][1-1]; */ |
|
/* ab[1-1][1-1]=1.0; */ |
|
q[1]=ab[1][1]; |
|
ab[1][1]=1.0; |
|
return; /* added from hardt */ |
|
} |
|
/* eps=macheps; */ /* added */ |
|
x = g = 0.0; |
|
#ifdef DEBUGPRAX |
|
matprint (" HOUSE holder:", ab, n, n); |
|
#endif |
|
|
|
/* for (i=0; i<n; i++) { /\* FOR I := 1 UNTIL N DO *\/ */ |
|
for (i=1; i<=n; i++) { /* FOR I := 1 UNTIL N DO */ |
|
e[i] = g; s = 0.0; l = i+1; |
|
/* for (j=i; j<n; j++) /\* FOR J := I UNTIL N DO S := S*AB(J,I)**2; *\/ /\* not correct *\/ */ |
|
for (j=i; j<=n; j++) /* FOR J := I UNTIL N DO S := S*AB(J,I)**2; */ /* not correct */ |
|
s += ab[j][i] * ab[j][i]; |
|
#ifdef DEBUGPRAXFIN |
|
printf("i=%d s=%d %.7g tol=%.7g",i,s,tol); |
|
#endif |
|
if (s < tol) { |
|
g = 0.0; |
|
} |
|
else { |
|
/* f = ab[i][i]; */ |
|
f = ab[i][i]; |
|
if (f < 0.0) |
|
g = sqrt(s); |
|
else |
|
g = -sqrt(s); |
|
/* h = f*g - s; ab[i][i] = f - g; */ |
|
h = f*g - s; ab[i][i] = f - g; |
|
/* for (j=l; j<n; j++) { */ /* FOR J := L UNTIL N DO */ /* wrong */ |
|
for (j=l; j<=n; j++) { |
|
f = 0.0; |
|
/* for (k=i; k<n; k++) /\* FOR K := I UNTIL N DO *\/ /\* wrong *\/ */ |
|
for (k=i; k<=n; k++) /* FOR K := I UNTIL N DO */ |
|
/* f += ab[k][i] * ab[k][j]; */ |
|
f += ab[k][i] * ab[k][j]; |
|
f /= h; |
|
for (k=i; k<=n; k++) /* FOR K := I UNTIL N DO */ |
|
/* for (k=i; k<n; k++)/\* FOR K := I UNTIL N DO *\/ /\* wrong *\/ */ |
|
ab[k][j] += f * ab[k][i]; |
|
/* ab[k][j] += f * ab[k][i]; */ |
|
#ifdef DEBUGPRAX |
|
printf("Holder J=%d F=%.7g",j,f); |
|
#endif |
|
} |
|
} /* end s */ |
|
/* q[i] = g; s = 0.0; */ |
|
q[i] = g; s = 0.0; |
|
#ifdef DEBUGPRAX |
|
printf(" I Q=%d %.7g",i,q[i]); |
|
#endif |
|
|
|
/* if (i < n) */ |
|
/* if (i <= n) /\* I is always lower or equal to n wasn't in golub reinsch*\/ */ |
|
/* for (j=l; j<n; j++) */ |
|
for (j=l; j<=n; j++) |
|
s += ab[i][j] * ab[i][j]; |
|
/* s += ab[i][j] * ab[i][j]; */ |
|
if (s < tol) { |
|
g = 0.0; |
|
} |
|
else { |
|
if(i<n) |
|
/* f = ab[i][i+1]; */ /* Brent golub overflow */ |
|
f = ab[i][i+1]; |
|
if (f < 0.0) |
|
g = sqrt(s); |
|
else |
|
g = - sqrt(s); |
|
h = f*g - s; |
|
/* h = f*g - s; ab[i][i+1] = f - g; */ /* Overflow for i=n Error in Golub too but not Burkardt*/ |
|
/* for (j=l; j<n; j++) */ |
|
/* e[j] = ab[i][j]/h; */ |
|
if(i<n){ |
|
ab[i][i+1] = f - g; |
|
for (j=l; j<=n; j++) |
|
e[j] = ab[i][j]/h; |
|
/* for (j=l; j<n; j++) { */ |
|
for (j=l; j<=n; j++) { |
|
s = 0.0; |
|
/* for (k=l; k<n; k++) s += ab[j][k]*ab[i][k]; */ |
|
for (k=l; k<=n; k++) s += ab[j][k]*ab[i][k]; |
|
/* for (k=l; k<n; k++) ab[j][k] += s * e[k]; */ |
|
for (k=l; k<=n; k++) ab[j][k] += s * e[k]; |
|
} /* END J */ |
|
} /* END i <n */ |
|
} /* end s */ |
|
/* y = fabs(q[i]) + fabs(e[i]); */ |
|
y = fabs(q[i]) + fabs(e[i]); |
|
if (y > x) x = y; |
|
#ifdef DEBUGPRAX |
|
printf(" I Y=%d %.7g",i,y); |
|
#endif |
|
#ifdef DEBUGPRAX |
|
printf(" i=%d e(i) %.7g",i,e[i]); |
|
#endif |
|
} /* end i */ |
|
/* |
|
Accumulation of right hand transformations */ |
|
/* for (i=n-1; i >= 0; i--) { */ /* FOR I := N STEP -1 UNTIL 1 DO */ |
|
/* We should avoid the overflow in Golub */ |
|
/* ab[n-1][n-1] = 1.0; */ |
|
/* g = e[n-1]; */ |
|
ab[n][n] = 1.0; |
|
g = e[n]; |
|
l = n; |
|
|
|
/* for (i=n; i >= 1; i--) { */ |
|
for (i=n-1; i >= 1; i--) { /* n-1 loops, different from brent and golub*/ |
|
if (g != 0.0) { |
|
/* h = ab[i-1][i]*g; */ |
|
h = ab[i][i+1]*g; |
|
for (j=l; j<=n; j++) ab[j][i] = ab[i][j] / h; |
|
for (j=l; j<=n; j++) { |
|
/* h = ab[i][i+1]*g; */ |
|
/* for (j=l; j<n; j++) ab[j][i] = ab[i][j] / h; */ |
|
/* for (j=l; j<n; j++) { */ |
|
s = 0.0; |
|
/* for (k=l; k<n; k++) s += ab[i][k] * ab[k][j]; */ |
|
/* for (k=l; k<n; k++) ab[k][j] += s * ab[k][i]; */ |
|
for (k=l; k<=n; k++) s += ab[i][k] * ab[k][j]; |
|
for (k=l; k<=n; k++) ab[k][j] += s * ab[k][i]; |
|
}/* END J */ |
|
}/* END G */ |
|
/* for (j=l; j<n; j++) */ |
|
/* ab[i][j] = ab[j][i] = 0.0; */ |
|
/* ab[i][i] = 1.0; g = e[i]; l = i; */ |
|
for (j=l; j<=n; j++) |
|
ab[i][j] = ab[j][i] = 0.0; |
|
ab[i][i] = 1.0; g = e[i]; l = i; |
|
}/* END I */ |
|
#ifdef DEBUGPRAX |
|
matprint (" HOUSE accumulation:",ab,n, n ); |
|
#endif |
|
|
|
/* diagonalization to bidiagonal form */ |
|
eps *= x; |
|
/* for (k=n-1; k>= 0; k--) { */ |
|
for (k=n; k>= 1; k--) { |
|
kt = 0; |
|
TestFsplitting: |
|
#ifdef DEBUGPRAX |
|
printf(" TestFsplitting: k=%d kt=%d\n",k,kt); |
|
/* for(i=1;i<=n;i++)printf(" e(%d)=%.14f",i,e[i]);printf("\n"); */ |
|
#endif |
|
kt = kt+1; |
|
/* TestFsplitting: */ |
|
/* if (++kt > 30) { */ |
|
if (kt > 30) { |
|
e[k] = 0.0; |
|
fprintf(stderr, "\n+++ MINFIT - Fatal error\n"); |
|
fprintf ( stderr, " The QR algorithm failed to converge.\n" ); |
|
} |
|
/* for (l2=k; l2>=0; l2--) { */ |
|
for (l2=k; l2>=1; l2--) { |
|
l = l2; |
|
#ifdef DEBUGPRAX |
|
printf(" l e(l)< eps %d %.7g %.7g ",l,e[l], eps); |
|
#endif |
|
/* if (fabs(e[l]) <= eps) */ |
|
if (fabs(e[l]) <= eps) |
|
goto TestFconvergence; |
|
/* if (fabs(q[l-1]) <= eps)*/ /* missing if ( 1 < l ){ *//* printf(" q(l-1)< eps %d %.7g %.7g ",l-1,q[l-2], eps); */ |
|
if (fabs(q[l-1]) <= eps) |
|
break; /* goto Cancellation; */ |
|
} |
|
Cancellation: |
|
#ifdef DEBUGPRAX |
|
printf(" Cancellation:\n"); |
|
#endif |
|
c = 0.0; s = 1.0; |
|
for (i=l; i<=k; i++) { |
|
f = s * e[i]; e[i] *= c; |
|
/* f = s * e[i]; e[i] *= c; */ |
|
if (fabs(f) <= eps) |
|
goto TestFconvergence; |
|
/* g = q[i]; */ |
|
g = q[i]; |
|
if (fabs(f) < fabs(g)) { |
|
double fg = f/g; |
|
h = fabs(g)*sqrt(1.0+fg*fg); |
|
} |
|
else { |
|
double gf = g/f; |
|
h = (f!=0.0 ? fabs(f)*sqrt(1.0+gf*gf) : 0.0); |
|
} |
|
/* COMMENT: THE ABOVE REPLACES Q(I):=H:=LONGSQRT(G*G+F*F) */ |
|
/* WHICH MAY GIVE INCORRECT RESULTS IF THE */ |
|
/* SQUARES UNDERFLOW OR IF F = G = 0; */ |
|
|
|
/* q[i] = h; */ |
|
q[i] = h; |
|
if (h == 0.0) { h = 1.0; g = 1.0; } |
|
c = g/h; s = -f/h; |
|
} |
|
TestFconvergence: |
|
#ifdef DEBUGPRAX |
|
printf(" TestFconvergence: l=%d k=%d\n",l,k); |
|
#endif |
|
/* z = q[k]; */ |
|
z = q[k]; |
|
if (l == k) |
|
goto Convergence; |
|
/* shift from bottom 2x2 minor */ |
|
/* x = q[l]; y = q[k-l]; g = e[k-1]; h = e[k]; */ /* Error */ |
|
x = q[l]; y = q[k-1]; g = e[k-1]; h = e[k]; |
|
f = ((y-z)*(y+z) + (g-h)*(g+h)) / (2.0*h*y); |
|
g = sqrt(f*f+1.0); |
|
if (f <= 0.0) |
|
f = ((x-z)*(x+z) + h*(y/(f-g)-h))/x; |
|
else |
|
f = ((x-z)*(x+z) + h*(y/(f+g)-h))/x; |
|
/* next qr transformation */ |
|
s = c = 1.0; |
|
for (i=l+1; i<=k; i++) { |
|
#ifdef DEBUGPRAXQR |
|
printf(" Before Mid TestFconvergence: l+1=%d i=%d k=%d h=%.6e e(i)=%14.8f e(i-1)=%14.8f\n",l+1,i,k, h, e[i],e[i-1]); |
|
#endif |
|
/* g = e[i]; y = q[i]; h = s*g; g *= c; */ |
|
g = e[i]; y = q[i]; h = s*g; g *= c; |
|
if (fabs(f) < fabs(h)) { |
|
double fh = f/h; |
|
z = fabs(h) * sqrt(1.0 + fh*fh); |
|
} |
|
else { |
|
double hf = h/f; |
|
z = (f!=0.0 ? fabs(f)*sqrt(1.0+hf*hf) : 0.0); |
|
} |
|
/* e[i-1] = z; */ |
|
e[i-1] = z; |
|
#ifdef DEBUGPRAXQR |
|
printf(" Mid TestFconvergence: l+1=%d i=%d k=%d h=%.6e e(i)=%14.8f e(i-1)=%14.8f\n",l+1,i,k, h, e[i],e[i-1]); |
|
#endif |
|
if (z == 0.0) |
|
f = z = 1.0; |
|
c = f/z; s = h/z; |
|
f = x*c + g*s; g = - x*s + g*c; h = y*s; |
|
y *= c; |
|
/* for (j=0; j<n; j++) { */ |
|
/* x = ab[j][i-1]; z = ab[j][i]; */ |
|
/* ab[j][i-1] = x*c + z*s; */ |
|
/* ab[j][i] = - x*s + z*c; */ |
|
/* } */ |
|
for (j=1; j<=n; j++) { |
|
x = ab[j][i-1]; z = ab[j][i]; |
|
ab[j][i-1] = x*c + z*s; |
|
ab[j][i] = - x*s + z*c; |
|
} |
|
if (fabs(f) < fabs(h)) { |
|
double fh = f/h; |
|
z = fabs(h) * sqrt(1.0 + fh*fh); |
|
} |
|
else { |
|
double hf = h/f; |
|
z = (f!=0.0 ? fabs(f)*sqrt(1.0+hf*hf) : 0.0); |
|
} |
|
#ifdef DEBUGPRAXQR |
|
printf(" qr transformation z f h=%.7g %.7g %.7g i=%d k=%d\n",z,f,h, i, k); |
|
#endif |
|
q[i-1] = z; |
|
if (z == 0.0) |
|
z = f = 1.0; |
|
c = f/z; s = h/z; |
|
f = c*g + s*y; /* f can be very small */ |
|
x = - s*g + c*y; |
|
} |
|
/* e[l] = 0.0; e[k] = f; q[k] = x; */ |
|
e[l] = 0.0; e[k] = f; q[k] = x; |
|
#ifdef DEBUGPRAXQR |
|
printf(" aftermid loop l=%d k=%d e(l)=%7g e(k)=%.7g q(k)=%.7g x=%.7g\n",l,k,e[l],e[k],q[k],x); |
|
#endif |
|
goto TestFsplitting; |
|
Convergence: |
|
#ifdef DEBUGPRAX |
|
printf(" Convergence:\n"); |
|
#endif |
|
if (z < 0.0) { |
|
/* q[k] = - z; */ |
|
/* for (j=0; j<n; j++) ab[j][k] = - ab[j][k]; */ |
|
q[k] = - z; |
|
for (j=1; j<=n; j++) ab[j][k] = - ab[j][k]; |
|
}/* END Z */ |
|
}/* END K */ |
|
} /* END MINFIT */ |
|
|
|
|
|
double praxis(double tol, double macheps, double h0, int _n, int _prin, double *_x, double (*_fun)(double *_x)) |
|
/* double praxis(double tol, double macheps, double h0, int _n, int _prin, double *_x, double (*_fun)(double *_x, int _n)) */ |
|
/* double praxis(double (*_fun)(), double _x[], int _n) */ |
|
/* double (*_fun)(); */ |
|
/* double _x[N]; */ |
|
/* double (*_fun)(); */ |
|
/* double _x[N]; */ |
|
{ |
|
/* init global extern variables and parameters */ |
|
/* double *d, *y, *z, */ |
|
/* *q0, *q1, **v; */ |
|
/* double *tflin; /\* used in flin: return (*fun)(tflin, n); *\/ */ |
|
/* double *e; /\* used in minfit, don't konw how to free memory and thus made global *\/ */ |
|
|
|
|
|
int seed; /* added */ |
|
int biter=0; |
|
double r; |
|
double randbrent( int (*)); |
|
double s, sf; |
|
|
|
h = h0; /* step; */ |
|
t = tol; |
|
scbd = 1.0; |
|
illc = 0; |
|
ktm = 1; |
|
|
|
macheps = DBL_EPSILON; |
|
/* prin=4; */ |
|
#ifdef DEBUGPRAX |
|
printf("Praxis macheps=%14g h=%14g step=%14g tol=%14g\n",macheps,h, h0,tol); |
|
#endif |
|
n = _n; |
|
x = _x; |
|
prin = _prin; |
|
fun = _fun; |
|
d=vector(1, n); |
|
y=vector(1, n); |
|
z=vector(1, n); |
|
q0=vector(1, n); |
|
q1=vector(1, n); |
|
e=vector(1, n); |
|
tflin=vector(1, n); |
|
v=matrix(1, n, 1, n); |
|
for(i=1;i<=n;i++){d[i]=y[i]=z[i]=q0[0]=e[i]=tflin[i]=0.;} |
|
small_windows = (macheps) * (macheps); vsmall = small_windows*small_windows; |
|
large = 1.0/small_windows; vlarge = 1.0/vsmall; |
|
m2 = sqrt(macheps); m4 = sqrt(m2); |
|
seed = 123456789; /* added */ |
|
ldfac = (illc ? 0.1 : 0.01); |
|
for(i=1;i<=n;i++) z[i]=0.; /* Was missing in Gegenfurtner as well as Brent's algol or fortran */ |
|
nl = kt = 0; nf = 1; |
|
#ifdef NR_SHIFT |
|
fx = (*fun)((x-1), n); |
|
#else |
|
fx = (*fun)(x); |
|
#endif |
|
qf1 = fx; |
|
t2 = small_windows + fabs(t); t = t2; dmin = small_windows; |
|
#ifdef DEBUGPRAX |
|
printf("praxis2 macheps=%14g h=%14g step=%14g small=%14g t=%14g\n",macheps,h, h0,small_windows, t); |
|
#endif |
|
if (h < 100.0*t) h = 100.0*t; |
|
#ifdef DEBUGPRAX |
|
printf("praxis3 macheps=%14g h=%14g step=%14g small=%14g t=%14g\n",macheps,h, h0,small_windows, t); |
|
#endif |
|
ldt = h; |
|
/* for (i=0; i<n; i++) for (j=0; j<n; j++) */ |
|
for (i=1; i<=n; i++) for (j=1; j<=n; j++) |
|
v[i][j] = (i == j ? 1.0 : 0.0); |
|
d[1] = 0.0; qd0 = 0.0; |
|
/* for (i=0; i<n; i++) q1[i] = x[i]; */ |
|
for (i=1; i<=n; i++) q1[i] = x[i]; |
|
if (prin > 1) { |
|
printf("\n------------- enter function praxis -----------\n"); |
|
printf("... current parameter settings ...\n"); |
|
printf("... scaling ... %20.10e\n", scbd); |
|
printf("... tol ... %20.10e\n", t); |
|
printf("... maxstep ... %20.10e\n", h); |
|
printf("... illc ... %20u\n", illc); |
|
printf("... ktm ... %20u\n", ktm); |
|
printf("... maxfun ... %20u\n", maxfun); |
|
} |
|
if (prin) print2(); |
|
|
|
mloop: |
|
biter++; /* Added to count the loops */ |
|
/* sf = d[0]; */ |
|
/* s = d[0] = 0.0; */ |
|
printf("\n Big iteration %d \n",biter); |
|
fprintf(ficlog,"\n Big iteration %d \n",biter); |
|
sf = d[1]; |
|
s = d[1] = 0.0; |
|
|
|
/* minimize along first direction V(*,1) */ |
|
#ifdef DEBUGPRAX |
|
printf(" Minimize along the first direction V(*,1). illc=%d\n",illc); |
|
/* fprintf(ficlog," Minimize along the first direction V(*,1).\n"); */ |
|
#endif |
|
#ifdef DEBUGPRAX2 |
|
printf("praxis4 macheps=%14g h=%14g step=%14g small=%14g t=%14g\n",macheps,h, h0,small_windows, t); |
|
#endif |
|
/* min(0, 2, &d[0], &s, fx, 0); /\* mac heps not global *\/ */ |
|
minny(1, 2, &d[1], &s, fx, 0); /* mac heps not global it seems that fx doesn't correspond to f(s=*x1) */ |
|
#ifdef DEBUGPRAX |
|
printf("praxis5 macheps=%14g h=%14g looks at sign of s=%14g fx=%14g\n",macheps,h, s,fx); |
|
#endif |
|
if (s <= 0.0) |
|
/* for (i=0; i < n; i++) */ |
|
for (i=1; i <= n; i++) |
|
v[i][1] = -v[i][1]; |
|
/* if ((sf <= (0.9 * d[0])) || ((0.9 * sf) >= d[0])) */ |
|
if ((sf <= (0.9 * d[1])) || ((0.9 * sf) >= d[1])) |
|
/* for (i=1; i<n; i++) */ |
|
for (i=2; i<=n; i++) |
|
d[i] = 0.0; |
|
/* for (k=1; k<n; k++) { */ |
|
for (k=2; k<=n; k++) { |
|
/* |
|
The inner loop starts here. |
|
*/ |
|
#ifdef DEBUGPRAX |
|
printf(" The inner loop here from k=%d to n=%d.\n",k,n); |
|
/* fprintf(ficlog," The inner loop here from k=%d to n=%d.\n",k,n); */ |
|
#endif |
|
/* for (i=0; i<n; i++) */ |
|
for (i=1; i<=n; i++) |
|
y[i] = x[i]; |
|
sf = fx; |
|
#ifdef DEBUGPRAX |
|
printf(" illc=%d and kt=%d and ktm=%d\n", illc, kt, ktm); |
|
#endif |
|
illc = illc || (kt > 0); |
|
next: |
|
kl = k; |
|
df = 0.0; |
|
if (illc) { /* random step to get off resolution valley */ |
|
#ifdef DEBUGPRAX |
|
printf(" A random step follows, to avoid resolution valleys.\n"); |
|
matprint(" before rand, vectors:",v,n,n); |
|
#endif |
|
for (i=1; i<=n; i++) { |
|
#ifdef NOBRENTRAND |
|
r = drandom(); |
|
#else |
|
seed=i; |
|
/* seed=i+1; */ |
|
#ifdef DEBUGRAND |
|
printf(" Random seed=%d, brent i=%d",seed,i); /* YYYY i=5 j=1 vji= -0.0001170073 */ |
|
#endif |
|
r = randbrent ( &seed ); |
|
#endif |
|
#ifdef DEBUGRAND |
|
printf(" Random r=%.7g \n",r); |
|
#endif |
|
z[i] = (0.1 * ldt + t2 * pow(10.0,(double)kt)) * (r - 0.5); |
|
/* z[i] = (0.1 * ldt + t2 * pow(10.0,(double)kt)) * (drandom() - 0.5); */ |
|
|
|
s = z[i]; |
|
for (j=1; j <= n; j++) |
|
x[j] += s * v[j][i]; |
|
} |
|
#ifdef DEBUGRAND |
|
matprint(" after rand, vectors:",v,n,n); |
|
#endif |
|
#ifdef NR_SHIFT |
|
fx = (*fun)((x-1), n); |
|
#else |
|
fx = (*fun)(x); |
|
#endif |
|
/* fx = (*func) ( (x-1) ); *//* This for func which is computed from x[1] and not from x[0] xm1=(x-1)*/ |
|
nf++; |
|
} |
|
/* minimize along non-conjugate directions */ |
|
#ifdef DEBUGPRAX |
|
printf(" Minimize along the 'non-conjugate' directions (dots printed) V(*,%d),...,V(*,%d).\n",k,n); |
|
/* fprintf(ficlog," Minimize along the 'non-conjugate' directions (dots printed) V(*,%d),...,V(*,%d).\n",k,n); */ |
|
#endif |
|
/* for (k2=k; k2<n; k2++) { /\* Be careful here k2 <=n ? *\/ */ |
|
for (k2=k; k2<=n; k2++) { /* Be careful here k2 <=n ? */ |
|
sl = fx; |
|
s = 0.0; |
|
#ifdef DEBUGPRAX |
|
printf(" Minimize along the 'NON-CONJUGATE' true direction k2=%14d fx=%14.7f\n",k2, fx); |
|
matprint(" before min vectors:",v,n,n); |
|
#endif |
|
/* min(k2, 2, &d[k2], &s, fx, 0); */ |
|
/* jsearch=k2-1; */ |
|
/* min(jsearch, 2, &d[jsearch], &s, fx, 0); */ |
|
minny(k2, 2, &d[k2], &s, fx, 0); |
|
#ifdef DEBUGPRAX |
|
printf(" . D(%d)=%14.7f d[k2]=%14.7f z[k2]=%14.7f illc=%14d fx=%14.7f\n",k2,d[k2],d[k2],z[k2],illc,fx); |
|
#endif |
|
if (illc) { |
|
/* double szk = s + z[k2]; */ |
|
/* s = d[k2] * szk*szk; */ |
|
double szk = s + z[k2]; |
|
s = d[k2] * szk*szk; |
|
} |
|
else |
|
s = sl - fx; |
|
/* if (df < s) { */ |
|
if (df <= s) { |
|
df = s; |
|
kl = k2; |
|
#ifdef DEBUGPRAX |
|
printf(" df=%.7g and choose kl=%d \n",df,kl); /* UUUU */ |
|
#endif |
|
} |
|
} /* end loop k2 */ |
|
/* |
|
If there was not much improvement on the first try, set |
|
ILLC = true and start the inner loop again. |
|
*/ |
|
#ifdef DEBUGPRAX |
|
printf(" If there was not much improvement on the first try, set ILLC = true and start the inner loop again. illc=%d\n",illc); |
|
/* fprintf(ficlog," If there was not much improvement on the first try, set ILLC = true and start the inner loop again.\n"); */ |
|
#endif |
|
if (!illc && (df < fabs(100.0 * (macheps) * fx))) { |
|
#ifdef DEBUGPRAX |
|
printf("\n NO SUCCESS because DF is small, starts inner loop with same K(=%d), fabs( 100.0 * machep(=%.10e) * fx(=%.9e) )=%.9e > df(=%.9e) break illc=%d\n", k, macheps, fx, fabs ( 100.0 * macheps * fx ), df, illc); |
|
#endif |
|
illc = 1; |
|
goto next; |
|
} |
|
#ifdef DEBUGPRAX |
|
printf("\n SUCCESS, BREAKS inner loop K(=%d) because DF is big, fabs( 100.0 * machep(=%.10e) * fx(=%.9e) )=%.9e <= df(=%.9e) break illc=%d\n", k, macheps, fx, fabs ( 100.0 * macheps * fx ), df, illc); |
|
#endif |
|
|
|
/* if ((k == 1) && (prin > 1)){ /\* be careful k=2 *\/ */ |
|
if ((k == 2) && (prin > 1)){ /* be careful k=2 */ |
|
#ifdef DEBUGPRAX |
|
printf(" NEW D The second difference array d:\n" ); |
|
/* fprintf(ficlog, " NEW D The second difference array d:\n" ); */ |
|
#endif |
|
vecprint(" NEW D The second difference array d:",d,n); |
|
} |
|
/* minimize along conjugate directions */ |
|
/* |
|
Minimize along the "conjugate" directions V(*,1),...,V(*,K-1). |
|
*/ |
|
#ifdef DEBUGPRAX |
|
printf("Minimize along the 'conjugate' directions V(*,1),...,V(*,K-1=%d).\n",k-1); |
|
/* fprintf(ficlog,"Minimize along the 'conjugate' directions V(*,1),...,V(*,K-1=%d).\n",k-1); */ |
|
#endif |
|
/* for (k2=0; k2<=k-1; k2++) { */ |
|
for (k2=1; k2<=k-1; k2++) { |
|
s = 0.0; |
|
/* min(k2-1, 2, &d[k2-1], &s, fx, 0); */ |
|
minny(k2, 2, &d[k2], &s, fx, 0); |
|
} |
|
f1 = fx; |
|
fx = sf; |
|
lds = 0.0; |
|
/* for (i=0; i<n; i++) { */ |
|
for (i=1; i<=n; i++) { |
|
sl = x[i]; |
|
x[i] = y[i]; |
|
y[i] = sl - y[i]; |
|
sl = y[i]; |
|
lds = lds + sl*sl; |
|
} |
|
lds = sqrt(lds); |
|
#ifdef DEBUGPRAX |
|
printf("Minimization done 'conjugate', shifted all points, computed lds=%.8f\n",lds); |
|
#endif |
|
/* |
|
Discard direction V(*,kl). |
|
|
|
If no random step was taken, V(*,KL) is the "non-conjugate" |
|
direction along which the greatest improvement was made. |
|
*/ |
|
if (lds > small_windows) { |
|
#ifdef DEBUGPRAX |
|
printf("lds big enough to throw direction V(*,kl=%d). If no random step was taken, V(*,KL) is the 'non-conjugate' direction along which the greatest improvement was made.\n",kl); |
|
matprint(" before shift new conjugate vectors:",v,n,n); |
|
#endif |
|
for (i=kl-1; i>=k; i--) { |
|
/* for (j=0; j < n; j++) */ |
|
for (j=1; j <= n; j++) |
|
/* v[j][i+1] = v[j][i]; */ /* This is v[j][i+1]=v[j][i] i=kl-1 to k */ |
|
v[j][i+1] = v[j][i]; /* This is v[j][i+1]=v[j][i] i=kl-1 to k */ |
|
/* v[j][i+1] = v[j][i]; */ |
|
/* d[i+1] = d[i];*/ /* last is d[k+1]= d[k] */ |
|
d[i+1] = d[i]; /* last is d[k]= d[k-1] */ |
|
} |
|
#ifdef DEBUGPRAX |
|
matprint(" after shift new conjugate vectors:",v,n,n); |
|
#endif /* d[k] = 0.0; */ |
|
d[k] = 0.0; |
|
for (i=1; i <= n; i++) |
|
v[i][k] = y[i] / lds; |
|
/* v[i][k] = y[i] / lds; */ |
|
#ifdef DEBUGPRAX |
|
printf("Minimize along the new 'conjugate' direction V(*,k=%d), which is the normalized vector: (new x) - (old x). d2=%14.7g lds=%.10f\n",k,d[k],lds); |
|
/* fprintf(ficlog,"Minimize along the new 'conjugate' direction V(*,k=%d), which is the normalized vector: (new x) - (old x).\n",k); */ |
|
matprint(" before min new conjugate vectors:",v,n,n); |
|
#endif |
|
/* min(k-1, 4, &d[k-1], &lds, f1, 1); */ |
|
minny(k, 4, &d[k], &lds, f1, 1); |
|
#ifdef DEBUGPRAX |
|
printf(" after min d(k)=%d %.7g lds=%14f\n",k,d[k],lds); |
|
matprint(" after min vectors:",v,n,n); |
|
#endif |
|
if (lds <= 0.0) { |
|
lds = -lds; |
|
#ifdef DEBUGPRAX |
|
printf(" lds changed sign lds=%.14f k=%d\n",lds,k); |
|
#endif |
|
/* for (i=0; i<n; i++) */ |
|
/* v[i][k] = -v[i][k]; */ |
|
for (i=1; i<=n; i++) |
|
v[i][k] = -v[i][k]; |
|
} |
|
} |
|
ldt = ldfac * ldt; |
|
if (ldt < lds) |
|
ldt = lds; |
|
if (prin > 0){ |
|
#ifdef DEBUGPRAX |
|
printf(" k=%d",k); |
|
/* fprintf(ficlog," k=%d",k); */ |
|
#endif |
|
print2();/* n, x, prin, fx, nf, nl ); */ |
|
} |
|
t2 = 0.0; |
|
/* for (i=0; i<n; i++) */ |
|
for (i=1; i<=n; i++) |
|
t2 += x[i]*x[i]; |
|
t2 = m2 * sqrt(t2) + t; |
|
/* |
|
See whether the length of the step taken since starting the |
|
inner loop exceeds half the tolerance. |
|
*/ |
|
#ifdef DEBUGPRAX |
|
printf("See if step length exceeds half the tolerance.\n"); /* ZZZZZ */ |
|
/* fprintf(ficlog,"See if step length exceeds half the tolerance.\n"); */ |
|
#endif |
|
if (ldt > (0.5 * t2)) |
|
kt = 0; |
|
else |
|
kt++; |
|
#ifdef DEBUGPRAX |
|
printf("if kt=%d >? ktm=%d gotoL2 loop\n",kt,ktm); |
|
#endif |
|
if (kt > ktm){ |
|
if ( 0 < prin ){ |
|
/* printf("\nr8vec_print\n X:\n"); */ |
|
/* fprintf(ficlog,"\nr8vec_print\n X:\n"); */ |
|
vecprint ("END X:", x, n ); |
|
} |
|
goto fret; |
|
} |
|
#ifdef DEBUGPRAX |
|
matprint(" end of L2 loop vectors:",v,n,n); |
|
#endif |
|
|
|
} |
|
/* printf("The inner loop ends here.\n"); */ |
|
/* fprintf(ficlog,"The inner loop ends here.\n"); */ |
|
/* |
|
The inner loop ends here. |
|
|
|
Try quadratic extrapolation in case we are in a curved valley. |
|
*/ |
|
#ifdef DEBUGPRAX |
|
printf("Try QUAD ratic extrapolation in case we are in a curved valley.\n"); |
|
#endif |
|
/* try quadratic extrapolation in case */ |
|
/* we are stuck in a curved valley */ |
|
quad(); |
|
dn = 0.0; |
|
/* for (i=0; i<n; i++) { */ |
|
for (i=1; i<=n; i++) { |
|
d[i] = 1.0 / sqrt(d[i]); |
|
if (dn < d[i]) |
|
dn = d[i]; |
|
} |
|
if (prin > 2) |
|
matprint(" NEW DIRECTIONS vectors:",v,n,n); |
|
/* for (j=0; j<n; j++) { */ |
|
for (j=1; j<=n; j++) { |
|
s = d[j] / dn; |
|
/* for (i=0; i < n; i++) */ |
|
for (i=1; i <= n; i++) |
|
v[i][j] *= s; |
|
} |
|
|
|
if (scbd > 1.0) { /* scale axis to reduce condition number */ |
|
#ifdef DEBUGPRAX |
|
printf("Scale the axes to try to reduce the condition number.\n"); |
|
#endif |
|
/* fprintf(ficlog,"Scale the axes to try to reduce the condition number.\n"); */ |
|
s = vlarge; |
|
/* for (i=0; i<n; i++) { */ |
|
for (i=1; i<=n; i++) { |
|
sl = 0.0; |
|
/* for (j=0; j < n; j++) */ |
|
for (j=1; j <= n; j++) |
|
sl += v[i][j]*v[i][j]; |
|
z[i] = sqrt(sl); |
|
if (z[i] < m4) |
|
z[i] = m4; |
|
if (s > z[i]) |
|
s = z[i]; |
|
} |
|
/* for (i=0; i<n; i++) { */ |
|
for (i=1; i<=n; i++) { |
|
sl = s / z[i]; |
|
z[i] = 1.0 / sl; |
|
if (z[i] > scbd) { |
|
sl = 1.0 / scbd; |
|
z[i] = scbd; |
|
} |
|
} |
|
} |
|
for (i=1; i<=n; i++) |
|
/* for (j=0; j<=i-1; j++) { */ |
|
/* for (j=1; j<=i; j++) { */ |
|
for (j=1; j<=i-1; j++) { |
|
s = v[i][j]; |
|
v[i][j] = v[j][i]; |
|
v[j][i] = s; |
|
} |
|
#ifdef DEBUGPRAX |
|
printf(" Calculate a new set of orthogonal directions before repeating the main loop.\n Transpose V for MINFIT:...\n"); |
|
#endif |
|
/* |
|
MINFIT finds the singular value decomposition of V. |
|
|
|
This gives the principal values and principal directions of the |
|
approximating quadratic form without squaring the condition number. |
|
*/ |
|
#ifdef DEBUGPRAX |
|
printf(" MINFIT finds the singular value decomposition of V. \n This gives the principal values and principal directions of the\n approximating quadratic form without squaring the condition number...\n"); |
|
#endif |
|
|
|
minfit(n, macheps, vsmall, v, d); |
|
/* for(i=0; i<n;i++)printf(" %14.7g",d[i]); */ |
|
/* v is overwritten with R. */ |
|
/* |
|
Unscale the axes. |
|
*/ |
|
if (scbd > 1.0) { |
|
#ifdef DEBUGPRAX |
|
printf(" Unscale the axes.\n"); |
|
#endif |
|
/* for (i=0; i<n; i++) { */ |
|
for (i=1; i<=n; i++) { |
|
s = z[i]; |
|
/* for (j=0; j<n; j++) */ |
|
for (j=1; j<=n; j++) |
|
v[i][j] *= s; |
|
} |
|
/* for (i=0; i<n; i++) { */ |
|
for (i=1; i<=n; i++) { |
|
s = 0.0; |
|
/* for (j=0; j<n; j++) */ |
|
for (j=1; j<=n; j++) |
|
s += v[j][i]*v[j][i]; |
|
s = sqrt(s); |
|
d[i] *= s; |
|
s = 1.0 / s; |
|
/* for (j=0; j<n; j++) */ |
|
for (j=1; j<=n; j++) |
|
v[j][i] *= s; |
|
} |
|
} |
|
/* for (i=0; i<n; i++) { */ |
|
double dni; /* added for compatibility with buckhardt but not brent */ |
|
for (i=1; i<=n; i++) { |
|
dni=dn*d[i]; /* added for compatibility with buckhardt but not brent */ |
|
if ((dn * d[i]) > large) |
|
d[i] = vsmall; |
|
else if ((dn * d[i]) < small_windows) |
|
d[i] = vlarge; |
|
else |
|
d[i] = 1.0 / dni / dni; /* added for compatibility with buckhardt but not brent */ |
|
/* d[i] = pow(dn * d[i],-2.0); */ |
|
} |
|
#ifdef DEBUGPRAX |
|
vecprint ("\n Before sort Eigenvalues of a:",d,n ); |
|
#endif |
|
|
|
sort(); /* the new eigenvalues and eigenvectors */ |
|
#ifdef DEBUGPRAX |
|
vecprint( " After sort the eigenvalues ....\n", d, n); |
|
matprint( " After sort the eigenvectors....\n", v, n,n); |
|
#endif |
|
#ifdef DEBUGPRAX |
|
printf(" Determine the smallest eigenvalue.\n"); |
|
#endif |
|
/* dmin = d[n-1]; */ |
|
dmin = d[n]; |
|
if (dmin < small_windows) |
|
dmin = small_windows; |
|
/* |
|
The ratio of the smallest to largest eigenvalue determines whether |
|
the system is ill conditioned. |
|
*/ |
|
|
|
/* illc = (m2 * d[0]) > dmin; */ |
|
illc = (m2 * d[1]) > dmin; |
|
#ifdef DEBUGPRAX |
|
printf(" The ratio of the smallest to largest eigenvalue determines whether\n the system is ill conditioned=%d . dmin=%.10lf < m2=%.10lf * d[1]=%.10lf \n",illc, dmin,m2, d[1]); |
|
#endif |
|
|
|
if ((prin > 2) && (scbd > 1.0)) |
|
vecprint("\n The scale factors:",z,n); |
|
if (prin > 2) |
|
vecprint(" Principal values (EIGEN VALUES OF A) of the quadratic form:",d,n); |
|
if (prin > 2) |
|
matprint(" The principal axes (EIGEN VECTORS OF A:",v,n, n); |
|
|
|
if ((maxfun > 0) && (nf > maxfun)) { |
|
if (prin) |
|
printf("\n... maximum number of function calls reached ...\n"); |
|
goto fret; |
|
} |
|
#ifdef DEBUGPRAX |
|
printf("Goto main loop\n"); |
|
#endif |
|
goto mloop; /* back to main loop */ |
|
|
|
fret: |
|
if (prin > 0) { |
|
vecprint("\n X:", x, n); |
|
/* printf("\n... ChiSq reduced to %20.10e ...\n", fx); */ |
|
/* printf("... after %20u function calls.\n", nf); */ |
|
} |
|
free_vector(d, 1, n); |
|
free_vector(y, 1, n); |
|
free_vector(z, 1, n); |
|
free_vector(q0, 1, n); |
|
free_vector(q1, 1, n); |
|
free_matrix(v, 1, n, 1, n); |
|
/* double *d, *y, *z, */ |
|
/* *q0, *q1, **v; */ |
|
free_vector(tflin, 1, n); |
|
/* double *tflin; /\* used in flin: return (*fun)(tflin, n); *\/ */ |
|
free_vector(e, 1, n); |
|
/* double *e; /\* used in minfit, don't konw how to free memory and thus made global *\/ */ |
|
|
|
return(fx); |
|
} |
|
|
|
/* end praxis gegen */ |
|
|
/*************** powell ************************/ |
/*************** powell ************************/ |
/* |
/* |
Line 2538 void powell(double p[], double **xi, int
|
Line 4221 void powell(double p[], double **xi, int
|
double fp,fptt; |
double fp,fptt; |
double *xits; |
double *xits; |
int niterf, itmp; |
int niterf, itmp; |
|
int Bigter=0, nBigterf=1; |
|
|
pt=vector(1,n); |
pt=vector(1,n); |
ptt=vector(1,n); |
ptt=vector(1,n); |
xit=vector(1,n); |
xit=vector(1,n); |
Line 2551 void powell(double p[], double **xi, int
|
Line 4235 void powell(double p[], double **xi, int
|
ibig=0; |
ibig=0; |
del=0.0; |
del=0.0; |
rlast_time=rcurr_time; |
rlast_time=rcurr_time; |
|
rlast_btime=rcurr_time; |
/* (void) gettimeofday(&curr_time,&tzp); */ |
/* (void) gettimeofday(&curr_time,&tzp); */ |
rcurr_time = time(NULL); |
rcurr_time = time(NULL); |
curr_time = *localtime(&rcurr_time); |
curr_time = *localtime(&rcurr_time); |
/* printf("\nPowell iter=%d -2*LL=%.12f gain=%.12f=%.3g %ld sec. %ld sec.",*iter,*fret, fp-*fret,fp-*fret, rcurr_time-rlast_time, rcurr_time-rstart_time);fflush(stdout); */ |
/* printf("\nPowell iter=%d -2*LL=%.12f gain=%.12f=%.3g %ld sec. %ld sec.",*iter,*fret, fp-*fret,fp-*fret, rcurr_time-rlast_time, rcurr_time-rstart_time);fflush(stdout); */ |
/* fprintf(ficlog,"\nPowell iter=%d -2*LL=%.12f gain=%.12f=%.3g %ld sec. %ld sec.",*iter,*fret, fp-*fret,fp-*fret,rcurr_time-rlast_time, rcurr_time-rstart_time); fflush(ficlog); */ |
/* fprintf(ficlog,"\nPowell iter=%d -2*LL=%.12f gain=%.12f=%.3g %ld sec. %ld sec.",*iter,*fret, fp-*fret,fp-*fret,rcurr_time-rlast_time, rcurr_time-rstart_time); fflush(ficlog); */ |
printf("\nPowell iter=%d -2*LL=%.12f gain=%.3lg %ld sec. %ld sec.",*iter,*fret,fp-*fret, rcurr_time-rlast_time, rcurr_time-rstart_time);fflush(stdout); |
/* Bigter=(*iter - *iter % ncovmodel)/ncovmodel +1; /\* Big iteration, i.e on ncovmodel cycle *\/ */ |
fprintf(ficlog,"\nPowell iter=%d -2*LL=%.12f gain=%.3lg %ld sec. %ld sec.",*iter,*fret,fp-*fret,rcurr_time-rlast_time, rcurr_time-rstart_time); fflush(ficlog); |
Bigter=(*iter - (*iter-1) % n)/n +1; /* Big iteration, i.e on ncovmodel cycle */ |
/* fprintf(ficrespow,"%d %.12f %ld",*iter,*fret,curr_time.tm_sec-start_time.tm_sec); */ |
printf("\nPowell iter=%d Big Iter=%d -2*LL=%.12f gain=%.3lg %ld sec. %ld sec.",*iter,Bigter,*fret,fp-*fret, rcurr_time-rlast_time, rcurr_time-rstart_time);fflush(stdout); |
|
fprintf(ficlog,"\nPowell iter=%d Big Iter=%d -2*LL=%.12f gain=%.3lg %ld sec. %ld sec.",*iter,Bigter,*fret,fp-*fret,rcurr_time-rlast_time, rcurr_time-rstart_time); fflush(ficlog); |
|
fprintf(ficrespow,"%d %d %.12f %d",*iter,Bigter, *fret,curr_time.tm_sec-start_time.tm_sec); |
fp=(*fret); /* From former iteration or initial value */ |
fp=(*fret); /* From former iteration or initial value */ |
for (i=1;i<=n;i++) { |
for (i=1;i<=n;i++) { |
fprintf(ficrespow," %.12lf", p[i]); |
fprintf(ficrespow," %.12lf", p[i]); |
Line 2570 void powell(double p[], double **xi, int
|
Line 4257 void powell(double p[], double **xi, int
|
printf(" + age*age "); |
printf(" + age*age "); |
fprintf(ficlog," + age*age "); |
fprintf(ficlog," + age*age "); |
} |
} |
for(j=1;j <=ncovmodel-2;j++){ |
for(j=1;j <=ncovmodel-2-nagesqr;j++){ |
if(Typevar[j]==0) { |
if(Typevar[j]==0) { |
printf(" + V%d ",Tvar[j]); |
printf(" + V%d ",Tvar[j]); |
fprintf(ficlog," + V%d ",Tvar[j]); |
fprintf(ficlog," + V%d ",Tvar[j]); |
Line 2580 void powell(double p[], double **xi, int
|
Line 4267 void powell(double p[], double **xi, int
|
}else if(Typevar[j]==2) { |
}else if(Typevar[j]==2) { |
printf(" + V%d*V%d ",Tvard[Tposprod[j]][1],Tvard[Tposprod[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]); |
fprintf(ficlog," + V%d*V%d ",Tvard[Tposprod[j]][1],Tvard[Tposprod[j]][2]); |
|
}else if(Typevar[j]==3) { |
|
printf(" + V%d*V%d*age ",Tvard[Tposprod[j]][1],Tvard[Tposprod[j]][2]); |
|
fprintf(ficlog," + V%d*V%d*age ",Tvard[Tposprod[j]][1],Tvard[Tposprod[j]][2]); |
} |
} |
} |
} |
printf("\n"); |
printf("\n"); |
Line 2610 void powell(double p[], double **xi, int
|
Line 4300 void powell(double p[], double **xi, int
|
strcurr[itmp-1]='\0'; |
strcurr[itmp-1]='\0'; |
printf("\nConsidering the time needed for the last iteration #%d: %ld seconds,\n",*iter,rcurr_time-rlast_time); |
printf("\nConsidering the time needed for the last iteration #%d: %ld seconds,\n",*iter,rcurr_time-rlast_time); |
fprintf(ficlog,"\nConsidering the time needed for this last iteration #%d: %ld seconds,\n",*iter,rcurr_time-rlast_time); |
fprintf(ficlog,"\nConsidering the time needed for this last iteration #%d: %ld seconds,\n",*iter,rcurr_time-rlast_time); |
for(niterf=10;niterf<=30;niterf+=10){ |
for(nBigterf=1;nBigterf<=31;nBigterf+=10){ |
|
niterf=nBigterf*ncovmodel; |
|
/* rforecast_time=rcurr_time+(niterf-*iter)*(rcurr_time-rlast_time); */ |
rforecast_time=rcurr_time+(niterf-*iter)*(rcurr_time-rlast_time); |
rforecast_time=rcurr_time+(niterf-*iter)*(rcurr_time-rlast_time); |
forecast_time = *localtime(&rforecast_time); |
forecast_time = *localtime(&rforecast_time); |
strcpy(strfor,asctime(&forecast_time)); |
strcpy(strfor,asctime(&forecast_time)); |
itmp = strlen(strfor); |
itmp = strlen(strfor); |
if(strfor[itmp-1]=='\n') |
if(strfor[itmp-1]=='\n') |
strfor[itmp-1]='\0'; |
strfor[itmp-1]='\0'; |
printf(" - if your program needs %d iterations to converge, convergence will be \n reached in %s i.e.\n on %s (current time is %s);\n",niterf, asc_diff_time(rforecast_time-rcurr_time,tmpout),strfor,strcurr); |
printf(" - if your program needs %d BIG iterations (%d iterations) to converge, convergence will be \n reached in %s i.e.\n on %s (current time is %s);\n",nBigterf, 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 BIG iterations (%d iterations) to converge, convergence will be \n reached in %s i.e.\n on %s (current time is %s);\n",nBigterf, niterf, asc_diff_time(rforecast_time-rcurr_time,tmpout),strfor,strcurr); |
} |
} |
} |
} |
for (i=1;i<=n;i++) { /* For each direction i */ |
for (i=1;i<=n;i++) { /* For each direction i, maximisation after loading directions */ |
for (j=1;j<=n;j++) xit[j]=xi[j][i]; /* Directions stored from previous iteration with previous scales */ |
for (j=1;j<=n;j++) xit[j]=xi[j][i]; /* Directions stored from previous iteration with previous scales. xi is not changed but one dim xit */ |
fptt=(*fret); |
|
|
fptt=(*fret); /* Computes likelihood for parameters xit */ |
#ifdef DEBUG |
#ifdef DEBUG |
printf("fret=%lf, %lf, %lf \n", *fret, *fret, *fret); |
printf("fret=%lf, %lf, %lf \n", *fret, *fret, *fret); |
fprintf(ficlog, "fret=%lf, %lf, %lf \n", *fret, *fret, *fret); |
fprintf(ficlog, "fret=%lf, %lf, %lf \n", *fret, *fret, *fret); |
Line 2631 void powell(double p[], double **xi, int
|
Line 4324 void powell(double p[], double **xi, int
|
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 |
#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); /* New point i minimizing in direction xit, i has coordinates p[j].*/ |
|
/* xit[j] gives the n coordinates of direction i as input.*/ |
|
/* *fret gives the maximum value on direction xit */ |
#else |
#else |
linmin(p,xit,n,fret,func,&flat); /* Point p[n]. xit[n] has been loaded for direction i as input.*/ |
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 */ |
flatdir[i]=flat; /* Function is vanishing in that direction i */ |
#endif |
#endif |
/* Outputs are fret(new point p) p is updated and xit rescaled */ |
/* 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"); |
#endif |
#endif |
} /* end loop on each direction i */ |
} /* end loop on each direction i */ |
/* Convergence test will use last linmin estimation (fret) and compare former iteration (fp) */ |
/* Convergence test will use last linmin estimation (fret) and compare to former iteration (fp) */ |
/* But p and xit have been updated at the end of linmin, *fret corresponds to new p, xit */ |
/* But p and xit have been updated at the end of linmin, *fret corresponds to new p, xit */ |
/* New value of last point Pn is not computed, P(n-1) */ |
/* New value of last point Pn is not computed, P(n-1) */ |
for(j=1;j<=n;j++) { |
for(j=1;j<=n;j++) { |
Line 2716 void powell(double p[], double **xi, int
|
Line 4411 void powell(double p[], double **xi, int
|
return; |
return; |
} /* enough precision */ |
} /* enough precision */ |
if (*iter == ITMAX*n) 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 and value f3, P_0 + 2 (P_n-P_0)=2Pn-P0 and xit is direction Pn-P0 */ |
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]; /* Coordinate j of last direction xi_n=P_n-P_0 */ |
pt[j]=p[j]; |
#ifdef DEBUG |
} |
printf("\n %d xit=%12.7g p=%12.7g pt=%12.7g ",j,xit[j],p[j],pt[j]); |
|
#endif |
|
pt[j]=p[j]; /* New P0 is Pn */ |
|
} |
|
#ifdef DEBUG |
|
printf("\n"); |
|
#endif |
fptt=(*func)(ptt); /* f_3 */ |
fptt=(*func)(ptt); /* f_3 */ |
#ifdef NODIRECTIONCHANGEDUNTILNITER /* No change in drections until some iterations are done */ |
#ifdef NODIRECTIONCHANGEDUNTILNITER /* No change in directions until some iterations are done */ |
if (*iter <=4) { |
if (*iter <=4) { |
#else |
#else |
#endif |
#endif |
Line 2741 void powell(double p[], double **xi, int
|
Line 4442 void powell(double p[], double **xi, int
|
/* 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 */ |
/* Even if f3 <f1, directest can be negative and t >0 */ |
/* mu² and del² are equal when f3=f1 */ |
/* mu² and del² are equal when f3=f1 */ |
/* f3 < f1 : mu² < del <= lambda^2 both test are equivalent */ |
/* 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 : 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² < mu^2 < del then t is negative and directest >0 */ |
/* f3 > f1 : lambda² < del < mu^2 then t is positive 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 2764 void powell(double p[], double **xi, int
|
Line 4465 void powell(double p[], double **xi, int
|
#endif |
#endif |
#ifdef POWELLORIGINAL |
#ifdef POWELLORIGINAL |
if (t < 0.0) { /* Then we use it for new direction */ |
if (t < 0.0) { /* Then we use it for new direction */ |
#else |
#else /* Not POWELLOriginal but Brouard's */ |
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 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,"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 (P0, Pn) for new direction Xi_n or Xi_iBig */ |
#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); |
Line 2805 void powell(double p[], double **xi, int
|
Line 4506 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 */ |
} |
} |
|
|
|
/* #else */ |
|
/* for (i=1;i<=n-1;i++) { */ |
|
/* for (j=1;j<=n;j++) { */ |
|
/* xi[j][i]=xi[j][i+1]; /\* Standard method of conjugate directions, not Powell who changes the nth direction by p0 pn . *\/ */ |
|
/* } */ |
|
/* } */ |
|
/* for (j=1;j<=n;j++) { */ |
|
/* xi[j][n]=xit[j]; /\* and this nth direction by the by the average p_0 p_n *\/ */ |
|
/* } */ |
|
/* /\* for (j=1;j<=n-1;j++) { *\/ */ |
|
/* /\* xi[j][1]=xi[j][j+1]; /\\* Standard method of conjugate directions *\\/ *\/ */ |
|
/* /\* xi[j][n]=xit[j]; /\\* and this nth direction by the by the average p_0 p_n *\\/ *\/ */ |
|
/* /\* } *\/ */ |
|
/* #endif */ |
#ifdef LINMINORIGINAL |
#ifdef LINMINORIGINAL |
#else |
#else |
for (j=1, flatd=0;j<=n;j++) { |
for (j=1, flatd=0;j<=n;j++) { |
Line 2829 void powell(double p[], double **xi, int
|
Line 4545 void powell(double p[], double **xi, int
|
free_vector(pt,1,n); |
free_vector(pt,1,n); |
return; |
return; |
#endif |
#endif |
} |
} /* endif(flatd >0) */ |
#endif |
#endif /* LINMINORIGINAL */ |
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); |
|
|
Line 2845 void powell(double p[], double **xi, int
|
Line 4561 void powell(double p[], double **xi, int
|
fprintf(ficlog,"\n"); |
fprintf(ficlog,"\n"); |
#endif |
#endif |
} /* end of t or directest negative */ |
} /* end of t or directest negative */ |
|
printf(" Directest is positive, P_n-P_0 does not increase the conjugacy. n=%d\n",n); |
|
fprintf(ficlog," Directest is positive, P_n-P_0 does not increase the conjugacy. n=%d\n",n); |
#ifdef POWELLNOF3INFF1TEST |
#ifdef POWELLNOF3INFF1TEST |
#else |
#else |
} /* end if (fptt < fp) */ |
} /* end if (fptt < fp) */ |
Line 2887 void powell(double p[], double **xi, int
|
Line 4605 void powell(double p[], double **xi, int
|
|
|
int i, ii,j,k, k1; |
int i, ii,j,k, k1; |
double *min, *max, *meandiff, maxmax,sumnew=0.; |
double *min, *max, *meandiff, maxmax,sumnew=0.; |
/* double **matprod2(); */ /* test */ |
double **matprod2(double **out, double **in,int nrl, int nrh, int ncl, int nch, int ncolol, int ncoloh, double **b); /* test */ /* for clang */ |
double **out, cov[NCOVMAX+1], **pmij(); /* **pmmij is a global variable feeded with oldms etc */ |
/* double **matprod2(); */ /* test */ |
|
/* double **out, cov[NCOVMAX+1], **pmij(); */ /* **pmmij is a global variable feeded with oldms etc */ |
|
double **out, cov[NCOVMAX+1], **pmij(double **ps, double *cov, int ncovmodel, double *x, int nlstate); /* **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 2919 void powell(double p[], double **xi, int
|
Line 4639 void powell(double p[], double **xi, int
|
/* Model(2) V1 + V2 + V3 + V8 + V7*V8 + V5*V6 + V8*age + V3*age + age*age */ |
/* Model(2) V1 + V2 + V3 + V8 + V7*V8 + V5*V6 + V8*age + V3*age + age*age */ |
/* total number of covariates of the model nbocc(+)+1 = 8 excepting constant and age and age*age */ |
/* total number of covariates of the model nbocc(+)+1 = 8 excepting constant and age and age*age */ |
for(k1=1;k1<=cptcovt;k1++){ /* loop on model equation (including products) */ |
for(k1=1;k1<=cptcovt;k1++){ /* loop on model equation (including products) */ |
if(Typevar[k1]==1){ /* A product with age */ |
if(Typevar[k1]==1 || Typevar[k1]==3){ /* A product with age */ |
cov[2+nagesqr+k1]=precov[nres][k1]*cov[2]; |
cov[2+nagesqr+k1]=precov[nres][k1]*cov[2]; |
}else{ |
}else{ |
cov[2+nagesqr+k1]=precov[nres][k1]; |
cov[2+nagesqr+k1]=precov[nres][k1]; |
Line 3053 void powell(double p[], double **xi, int
|
Line 4773 void powell(double p[], double **xi, int
|
first++; |
first++; |
} |
} |
|
|
/* 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); */ |
/* 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(min,1,nlstate); |
free_vector(max,1,nlstate); |
free_vector(max,1,nlstate); |
free_vector(meandiff,1,nlstate); |
free_vector(meandiff,1,nlstate); |
Line 3088 void powell(double p[], double **xi, int
|
Line 4810 void powell(double p[], double **xi, int
|
/* 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, k1; |
int i, ii,j, k1; |
int first=0; |
int first=0; |
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], **bmij(); |
double **out, cov[NCOVMAX+1], **bmij(double **ps, double *cov, int ncovmodel, double *x, int nlstate, double ***prevacurrent, int ij); |
|
/* double **out, cov[NCOVMAX+1], **bmij(); */ /* Deprecated in clang */ |
double **newm; |
double **newm; |
double **dnewm, **doldm, **dsavm; /* for use */ |
double **dnewm, **doldm, **dsavm; /* for use */ |
double **oldm, **savm; /* for use */ |
double **oldm, **savm; /* for use */ |
Line 3129 void powell(double p[], double **xi, int
|
Line 4852 void powell(double p[], double **xi, int
|
cov[3]= agefin*agefin;; |
cov[3]= agefin*agefin;; |
} |
} |
for(k1=1;k1<=cptcovt;k1++){ /* loop on model equation (including products) */ |
for(k1=1;k1<=cptcovt;k1++){ /* loop on model equation (including products) */ |
if(Typevar[k1]==1){ /* A product with age */ |
if(Typevar[k1]==1 || Typevar[k1]==3){ /* A product with age */ |
cov[2+nagesqr+k1]=precov[nres][k1]*cov[2]; |
cov[2+nagesqr+k1]=precov[nres][k1]*cov[2]; |
}else{ |
}else{ |
cov[2+nagesqr+k1]=precov[nres][k1]; |
cov[2+nagesqr+k1]=precov[nres][k1]; |
Line 3355 double **pmij(double **ps, double *cov,
|
Line 5078 double **pmij(double **ps, double *cov,
|
/* Computes the backward probability at age agefin, cov[2], and covariate combination 'ij'. In fact cov is already filled and x too. |
/* Computes the backward probability at age agefin, cov[2], 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. |
* 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; |
int ii, j; |
|
|
double **out, **pmij(); |
double **pmij(double **ps, double *cov, int ncovmodel, double *x, int nlstate); |
|
/* double **pmij(); */ /* No more for clang */ |
double sumnew=0.; |
double sumnew=0.; |
double agefin; |
double agefin; |
double k3=0.; /* constant of the w_x diagonal matrix (in order for B to sum to 1 even for death state) */ |
double k3=0.; /* constant of the w_x diagonal matrix (in order for B to sum to 1 even for death state) */ |
Line 3570 double ***hpxij(double ***po, int nhstep
|
Line 5294 double ***hpxij(double ***po, int nhstep
|
|
|
*/ |
*/ |
|
|
int i, j, d, h, k, k1; |
int i, j, d, h, k1; |
double **out, cov[NCOVMAX+1]; |
double **out, cov[NCOVMAX+1]; |
double **newm; |
double **newm; |
double agexact; |
double agexact; |
double agebegin, ageend; |
/*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 3596 double ***hpxij(double ***po, int nhstep
|
Line 5320 double ***hpxij(double ***po, int nhstep
|
/* Model(2) V1 + V2 + V3 + V8 + V7*V8 + V5*V6 + V8*age + V3*age + age*age */ |
/* Model(2) V1 + V2 + V3 + V8 + V7*V8 + V5*V6 + V8*age + V3*age + age*age */ |
/* total number of covariates of the model nbocc(+)+1 = 8 excepting constant and age and age*age */ |
/* total number of covariates of the model nbocc(+)+1 = 8 excepting constant and age and age*age */ |
for(k1=1;k1<=cptcovt;k1++){ /* loop on model equation (including products) */ |
for(k1=1;k1<=cptcovt;k1++){ /* loop on model equation (including products) */ |
if(Typevar[k1]==1){ /* A product with age */ |
if(Typevar[k1]==1 || Typevar[k1]==3){ /* A product with age */ |
cov[2+nagesqr+k1]=precov[nres][k1]*cov[2]; |
cov[2+nagesqr+k1]=precov[nres][k1]*cov[2]; |
}else{ |
}else{ |
cov[2+nagesqr+k1]=precov[nres][k1]; |
cov[2+nagesqr+k1]=precov[nres][k1]; |
Line 3751 double ***hbxij(double ***po, int nhstep
|
Line 5475 double ***hbxij(double ***po, int nhstep
|
The addresss of po (p3mat allocated to the dimension of nhstepm) should be stored for output |
The addresss of po (p3mat allocated to the dimension of nhstepm) should be stored for output |
*/ |
*/ |
|
|
int i, j, d, h, k, k1; |
int i, j, d, h, k1; |
double **out, cov[NCOVMAX+1], **bmij(); |
double **out, cov[NCOVMAX+1], **bmij(double **ps, double *cov, int ncovmodel, double *x, int nlstate, double ***prevacurrent, int ij); |
|
/* double **out, cov[NCOVMAX+1], **bmij(); */ /* No more for clang */ |
double **newm, ***newmm; |
double **newm, ***newmm; |
double agexact; |
double agexact; |
double agebegin, ageend; |
/*double agebegin, ageend;*/ |
double **oldm, **savm; |
double **oldm, **savm; |
|
|
newmm=po; /* To be saved */ |
newmm=po; /* To be saved */ |
Line 3782 double ***hbxij(double ***po, int nhstep
|
Line 5507 double ***hbxij(double ***po, int nhstep
|
} |
} |
/** New code */ |
/** New code */ |
for(k1=1;k1<=cptcovt;k1++){ /* loop on model equation (including products) */ |
for(k1=1;k1<=cptcovt;k1++){ /* loop on model equation (including products) */ |
if(Typevar[k1]==1){ /* A product with age */ |
if(Typevar[k1]==1 || Typevar[k1]==3){ /* A product with age */ |
cov[2+nagesqr+k1]=precov[nres][k1]*cov[2]; |
cov[2+nagesqr+k1]=precov[nres][k1]*cov[2]; |
}else{ |
}else{ |
cov[2+nagesqr+k1]=precov[nres][k1]; |
cov[2+nagesqr+k1]=precov[nres][k1]; |
Line 3925 double func( double *x)
|
Line 5650 double func( double *x)
|
*/ |
*/ |
ioffset=2+nagesqr ; |
ioffset=2+nagesqr ; |
/* Fixed */ |
/* Fixed */ |
for (kf=1; kf<=ncovf;kf++){ /* For each fixed covariate dummu or quant or prod */ |
for (kf=1; kf<=ncovf;kf++){ /* For each fixed covariate dummy or quant or prod */ |
/* # V1=sex, V2=raedyrs Quant Fixed, State=livarnb4..livarnb11, V3=iadl4..iald11, V4=adlw4..adlw11, V5=r4bmi..r11bmi */ |
/* # V1=sex, V2=raedyrs Quant Fixed, State=livarnb4..livarnb11, V3=iadl4..iald11, V4=adlw4..adlw11, V5=r4bmi..r11bmi */ |
/* V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ |
/* V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ |
/* TvarF[1]=Tvar[6]=2, TvarF[2]=Tvar[7]=7, TvarF[3]=Tvar[9]=1 ID of fixed covariates or product V2, V1*V2, V1 */ |
/* TvarF[1]=Tvar[6]=2, TvarF[2]=Tvar[7]=7, TvarF[3]=Tvar[9]=1 ID of fixed covariates or product V2, V1*V2, V1 */ |
Line 3954 double func( double *x)
|
Line 5679 double func( double *x)
|
for(ncovv=1, iposold=0; ncovv <= ncovvt ; ncovv++){ /* Varying covariates (single and product but no age )*/ |
for(ncovv=1, iposold=0; ncovv <= ncovvt ; ncovv++){ /* Varying covariates (single and product but no age )*/ |
itv=TvarVV[ncovv]; /* TvarVV={3, 1, 3} gives the name of each varying covariate */ |
itv=TvarVV[ncovv]; /* TvarVV={3, 1, 3} gives the name of each varying covariate */ |
ipos=TvarVVind[ncovv]; /* TvarVVind={2, 5, 5] gives the position in the model of the ncovv th varying covariate*/ |
ipos=TvarVVind[ncovv]; /* TvarVVind={2, 5, 5] gives the position in the model of the ncovv th varying covariate*/ |
if(TvarFind[itv]==0){ /* Not a fixed covariate */ |
if(FixedV[itv]!=0){ /* Not a fixed covariate */ |
cotvarv=cotvar[mw[mi][i]][TvarVV[ncovv]][i]; /* cotvar[wav][ncovcol+nqv+iv][i] */ |
cotvarv=cotvar[mw[mi][i]][TvarVV[ncovv]][i]; /* cotvar[wav][ncovcol+nqv+iv][i] */ |
}else{ /* fixed covariate */ |
}else{ /* fixed covariate */ |
cotvarv=covar[Tvar[TvarFind[itv]]][i]; |
cotvarv=covar[itv][i]; /* Error: TvarFind gives the name, that is the true column of fixed covariates, but Tvar of the model */ |
} |
} |
if(ipos!=iposold){ /* Not a product or first of a product */ |
if(ipos!=iposold){ /* Not a product or first of a product */ |
cotvarvold=cotvarv; |
cotvarvold=cotvarv; |
Line 3967 double func( double *x)
|
Line 5692 double func( double *x)
|
iposold=ipos; |
iposold=ipos; |
cov[ioffset+ipos]=cotvarv; |
cov[ioffset+ipos]=cotvarv; |
} |
} |
/* 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 products of time varying to be done */ |
/* for products of time varying to be done */ |
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++){ |
Line 3994 double func( double *x)
|
Line 5707 double func( double *x)
|
cov[2]=agexact; |
cov[2]=agexact; |
if(nagesqr==1) |
if(nagesqr==1) |
cov[3]= agexact*agexact; /* Should be changed here */ |
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]]]) |
/* 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 |
/* else */ |
cov[Tage[kk]+2+nagesqr]=cotvar[mw[mi][i]][Tvar[Tage[kk]]][i]*agexact; /* because cotvar starts now at first ncovcol+nqv+ (1 to nqtv) */ |
/* cov[Tage[kk]+2+nagesqr]=cotvar[mw[mi][i]][Tvar[Tage[kk]]][i]*agexact; /\* because cotvar starts now at first ncovcol+nqv+ (1 to nqtv) *\/ */ |
|
/* } */ |
|
for(ncovva=1, iposold=0; ncovva <= ncovta ; ncovva++){ /* Time varying covariates with age including individual from products, product is computed dynamically */ |
|
itv=TvarAVVA[ncovva]; /* TvarVV={3, 1, 3} gives the name of each varying covariate, exploding product Vn*Vm into Vn and then Vm */ |
|
ipos=TvarAVVAind[ncovva]; /* TvarVVind={2, 5, 5] gives the position in the model of the ncovv th varying covariate*/ |
|
if(FixedV[itv]!=0){ /* Not a fixed covariate? Could be a fixed covariate of a product with a higher than ncovcol+nqv, itv */ |
|
cotvarv=cotvar[mw[mi][i]][TvarAVVA[ncovva]][i]; /* because cotvar starts now at first ncovcol+nqv+ntv+nqtv (1 to nqtv) */ |
|
}else{ /* fixed covariate */ |
|
cotvarv=covar[itv][i]; /* Error: TvarFind gives the name, that is the true column of fixed covariates, but Tvar of the model */ |
|
} |
|
if(ipos!=iposold){ /* Not a product or first of a product */ |
|
cotvarvold=cotvarv; |
|
}else{ /* A second product */ |
|
cotvarv=cotvarv*cotvarvold; |
|
} |
|
iposold=ipos; |
|
cov[ioffset+ipos]=cotvarv*agexact; |
|
/* For products */ |
} |
} |
|
|
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; |
Line 4217 double func( double *x)
|
Line 5948 double func( double *x)
|
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; |
/* 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("num[i]=%09ld, 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",num[i],i,s1,s2,mi,mw[mi][i],dh[mi][i],exp(lli),weight[i],(s2==-1? -1: out[s1][s2]),(s2==-1? -1: savm[s1][s2])); */ |
} /* end of wave */ |
} /* end of wave */ |
} /* end of individual */ |
} /* end of individual */ |
}else{ /* ml=5 no inter-extrapolation no jackson =0.8a */ |
}else{ /* ml=5 no inter-extrapolation no jackson =0.8a */ |
Line 4268 double func( double *x)
|
Line 5999 double func( double *x)
|
double funcone( double *x) |
double funcone( double *x) |
{ |
{ |
/* Same as func 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, kf=0; |
int i, ii, j, k, mi, d, kv=0, kf=0; |
int ioffset=0; |
int ioffset=0; |
int ipos=0,iposold=0,ncovv=0; |
int ipos=0,iposold=0,ncovv=0; |
|
|
Line 4304 double funcone( double *x)
|
Line 6035 double funcone( double *x)
|
/* Fixed */ |
/* Fixed */ |
/* for (k=1; k<=cptcovn;k++) cov[2+nagesqr+k]=covar[Tvar[k]][i]; */ |
/* 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<=ncoveff;k++){ /\* Simple and product fixed Dummy covariates without age* products *\/ */ |
for (kf=1; kf<=ncovf;kf++){ /* Simple and product fixed covariates without age* products *//* Missing values are set to -1 but should be dropped */ |
for (kf=1; kf<=ncovf;kf++){ /* V2 + V3 + V4 Simple and product fixed covariates without age* products *//* Missing values are set to -1 but should be dropped */ |
/* printf("Debug3 TvarFind[%d]=%d",kf, TvarFind[kf]); */ |
/* printf("Debug3 TvarFind[%d]=%d",kf, TvarFind[kf]); */ |
/* printf(" Tvar[TvarFind[kf]]=%d", Tvar[TvarFind[kf]]); */ |
/* printf(" Tvar[TvarFind[kf]]=%d", Tvar[TvarFind[kf]]); */ |
/* printf(" i=%d covar[Tvar[TvarFind[kf]]][i]=%f\n",i,covar[Tvar[TvarFind[kf]]][i]); */ |
/* printf(" i=%d covar[Tvar[TvarFind[kf]]][i]=%f\n",i,covar[Tvar[TvarFind[kf]]][i]); */ |
Line 4356 double funcone( double *x)
|
Line 6087 double funcone( double *x)
|
* k= 1 2 3 4 5 6 7 8 9 |
* k= 1 2 3 4 5 6 7 8 9 |
* varying 1 2 3 4 5 |
* varying 1 2 3 4 5 |
* ncovv 1 2 3 4 5 6 7 8 |
* ncovv 1 2 3 4 5 6 7 8 |
* TvarVV V3 5 1 3 3 5 1 5 |
* TvarVV[ncovv] V3 5 1 3 3 5 1 5 |
* TvarVVind 2 3 7 7 8 8 9 9 |
* TvarVVind 2 3 7 7 8 8 9 9 |
* TvarFind[k] 1 0 0 0 0 0 0 0 0 |
* TvarFind[k] 1 0 0 0 0 0 0 0 0 |
* cotvar starts at ntv=2 (because of V3 V4) |
|
*/ |
*/ |
for(ncovv=1, iposold=0; ncovv <= ncovvt ; ncovv++){ /* Varying covariates (single and product but no age) including individual from products */ |
/* Other model ncovcol=5 nqv=0 ntv=3 nqtv=0 nlstate=3 |
itv=TvarVV[ncovv]; /* TvarVV={3, 1, 3} gives the name of each varying covariate */ |
* V2 V3 V4 are fixed V6 V7 are timevarying so V8 and V5 are not in the model and product column will start at 9 Tvar[(v6*V2)6]=9 |
|
* FixedV[ncovcol+qv+ntv+nqtv] V5 |
|
* 3 V1 V2 V3 V4 V5 V6 V7 V8 V3*V2 V7*V2 V6*V3 V7*V3 V6*V4 V7*V4 |
|
* 0 0 0 0 0 1 1 1 0, 0, 1,1, 1, 0, 1, 0, 1, 0, 1, 0} |
|
* 3 0 0 0 0 0 1 1 1 0, 1 1 1 1 1} |
|
* model= V2 + V3 + V4 + V6 + V7 + V6*V2 + V7*V2 + V6*V3 + V7*V3 + V6*V4 + V7*V4 |
|
* +age*V2 +age*V3 +age*V4 +age*V6 + age*V7 |
|
* +age*V6*V2 + age*V6*V3 +age*V7*V3 + age*V6*V4 +age*V7*V4 |
|
* model2= V2 + V3 + V4 + V6 + V7 + V3*V2 + V7*V2 + V6*V3 + V7*V3 + V6*V4 + V7*V4 |
|
* +age*V2 +age*V3 +age*V4 +age*V6 + age*V7 |
|
* +age*V3*V2 + age*V6*V3 +age*V7*V3 + age*V6*V4 +age*V7*V4 |
|
* model3= V2 + V3 + V4 + V6 + V7 + age*V3*V2 + V7*V2 + V6*V3 + V7*V3 + V6*V4 + V7*V4 |
|
* +age*V2 +age*V3 +age*V4 +age*V6 + age*V7 |
|
* +V3*V2 + age*V6*V3 +age*V7*V3 + age*V6*V4 +age*V7*V4 |
|
* kmodel 1 2 3 4 5 6 7 8 9 10 11 |
|
* 12 13 14 15 16 |
|
* 17 18 19 20 21 |
|
* Tvar[kmodel] 2 3 4 6 7 9 10 11 12 13 14 |
|
* 2 3 4 6 7 |
|
* 9 11 12 13 14 |
|
* cptcovage=5+5 total of covariates with age |
|
* Tage[cptcovage] age*V2=12 13 14 15 16 |
|
*1 17 18 19 20 21 gives the position in model of covariates associated with age |
|
*3 Tage[cptcovage] age*V3*V2=6 |
|
*3 age*V2=12 13 14 15 16 |
|
*3 age*V6*V3=18 19 20 21 |
|
* Tvar[Tage[cptcovage]] Tvar[12]=2 3 4 6 Tvar[16]=7(age*V7) |
|
* Tvar[17]age*V6*V2=9 Tvar[18]age*V6*V3=11 age*V7*V3=12 age*V6*V4=13 Tvar[21]age*V7*V4=14 |
|
* 2 Tvar[17]age*V3*V2=9 Tvar[18]age*V6*V3=11 age*V7*V3=12 age*V6*V4=13 Tvar[21]age*V7*V4=14 |
|
* 3 Tvar[Tage[cptcovage]] Tvar[6]=9 Tvar[12]=2 3 4 6 Tvar[16]=7(age*V7) |
|
* 3 Tvar[18]age*V6*V3=11 age*V7*V3=12 age*V6*V4=13 Tvar[21]age*V7*V4=14 |
|
* 3 Tage[cptcovage] age*V3*V2=6 age*V2=12 age*V3 13 14 15 16 |
|
* age*V6*V3=18 19 20 21 gives the position in model of covariates associated with age |
|
* 3 Tvar[17]age*V3*V2=9 Tvar[18]age*V6*V3=11 age*V7*V3=12 age*V6*V4=13 Tvar[21]age*V7*V4=14 |
|
* Tvar= {2, 3, 4, 6, 7, |
|
* 9, 10, 11, 12, 13, 14, |
|
* Tvar[12]=2, 3, 4, 6, 7, |
|
* Tvar[17]=9, 11, 12, 13, 14} |
|
* Typevar[1]@21 = {0, 0, 0, 0, 0, |
|
* 2, 2, 2, 2, 2, 2, |
|
* 3 3, 2, 2, 2, 2, 2, |
|
* 1, 1, 1, 1, 1, |
|
* 3, 3, 3, 3, 3} |
|
* 3 2, 3, 3, 3, 3} |
|
* p Tposprod[1]@21 {0, 0, 0, 0, 0, 1, 2, 3, 4, 5, 6, 0, 0, 0, 0, 0, 1, 3, 4, 5, 6} Id of the prod at position k in the model |
|
* p Tprod[1]@21 {6, 7, 8, 9, 10, 11, 0 <repeats 15 times>} |
|
* 3 Tposprod[1]@21 {0, 0, 0, 0, 0, 1, 2, 3, 4, 5, 6, 0, 0, 0, 0, 0, 1, 3, 4, 5, 6} |
|
* 3 Tprod[1]@21 {17, 7, 8, 9, 10, 11, 0 <repeats 15 times>} |
|
* cptcovprod=11 (6+5) |
|
* FixedV[Tvar[Tage[cptcovage]]]] FixedV[2]=0 FixedV[3]=0 0 1 (age*V7)Tvar[16]=1 FixedV[absolute] not [kmodel] |
|
* FixedV[Tvar[17]=FixedV[age*V6*V2]=FixedV[9]=1 1 1 1 1 |
|
* 3 FixedV[Tvar[17]=FixedV[age*V3*V2]=FixedV[9]=0 [11]=1 1 1 1 |
|
* FixedV[] V1=0 V2=0 V3=0 v4=0 V5=0 V6=1 V7=1 v8=1 OK then model dependent |
|
* 9=1 [V7*V2]=[10]=1 11=1 12=1 13=1 14=1 |
|
* 3 9=0 [V7*V2]=[10]=1 11=1 12=1 13=1 14=1 |
|
* cptcovdageprod=5 for gnuplot printing |
|
* cptcovprodvage=6 |
|
* ncova=15 1 2 3 4 5 |
|
* 6 7 8 9 10 11 12 13 14 15 |
|
* TvarA 2 3 4 6 7 |
|
* 6 2 6 7 7 3 6 4 7 4 |
|
* TvaAind 12 12 13 13 14 14 15 15 16 16 |
|
* ncovf 1 2 3 |
|
* V6 V7 V6*V2 V7*V2 V6*V3 V7*V3 V6*V4 V7*V4 |
|
* ncovvt=14 1 2 3 4 5 6 7 8 9 10 11 12 13 14 |
|
* TvarVV[1]@14 = itv {V6=6, 7, V6*V2=6, 2, 7, 2, 6, 3, 7, 3, 6, 4, 7, 4} |
|
* TvarVVind[1]@14= {4, 5, 6, 6, 7, 7, 8, 8, 9, 9, 10, 10, 11, 11} |
|
* 3 ncovvt=12 V6 V7 V7*V2 V6*V3 V7*V3 V6*V4 V7*V4 |
|
* 3 TvarVV[1]@12 = itv {6, 7, V7*V2=7, 2, 6, 3, 7, 3, 6, 4, 7, 4} |
|
* 3 1 2 3 4 5 6 7 8 9 10 11 12 |
|
* TvarVVind[1]@12= {V6 is in k=4, 5, 7,(4isV2)=7, 8, 8, 9, 9, 10,10, 11,11}TvarVVind[12]=k=11 |
|
* TvarV 6, 7, 9, 10, 11, 12, 13, 14 |
|
* 3 cptcovprodvage=6 |
|
* 3 ncovta=15 +age*V3*V2+age*V2+agev3+ageV4 +age*V6 + age*V7 + age*V6*V3 +age*V7*V3 + age*V6*V4 +age*V7*V4 |
|
* 3 TvarAVVA[1]@15= itva 3 2 2 3 4 6 7 6 3 7 3 6 4 7 4 |
|
* 3 ncovta 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 |
|
*?TvarAVVAind[1]@15= V3 is in k=2 1 1 2 3 4 5 4,2 5,2, 4,3 5 3}TvarVVAind[] |
|
* TvarAVVAind[1]@15= V3 is in k=6 6 12 13 14 15 16 18 18 19,19, 20,20 21,21}TvarVVAind[] |
|
* 3 ncovvta=10 +age*V6 + age*V7 + age*V6*V3 +age*V7*V3 + age*V6*V4 +age*V7*V4 |
|
* 3 we want to compute =cotvar[mw[mi][i]][TvarVVA[ncovva]][i] at position TvarVVAind[ncovva] |
|
* 3 TvarVVA[1]@10= itva 6 7 6 3 7 3 6 4 7 4 |
|
* 3 ncovva 1 2 3 4 5 6 7 8 9 10 |
|
* TvarVVAind[1]@10= V6 is in k=4 5 8,8 9, 9, 10,10 11 11}TvarVVAind[] |
|
* TvarVVAind[1]@10= 15 16 18,18 19,19, 20,20 21 21}TvarVVAind[] |
|
* TvarVA V3*V2=6 6 , 1, 2, 11, 12, 13, 14 |
|
* TvarFind[1]@14= {1, 2, 3, 0 <repeats 12 times>} |
|
* Tvar[1]@21= {2, 3, 4, 6, 7, 9, 10, 11, 12, 13, 14, |
|
* 2, 3, 4, 6, 7, |
|
* 6, 8, 9, 10, 11} |
|
* TvarFind[itv] 0 0 0 |
|
* FixedV[itv] 1 1 1 0 1 0 1 0 1 0 0 |
|
*? FixedV[itv] 1 1 1 0 1 0 1 0 1 0 1 0 1 0 |
|
* Tvar[TvarFind[ncovf]]=[1]=2 [2]=3 [4]=4 |
|
* Tvar[TvarFind[itv]] [0]=? ?ncovv 1 à ncovvt] |
|
* Not a fixed cotvar[mw][itv][i] 6 7 6 2 7, 2, 6, 3, 7, 3, 6, 4, 7, 4} |
|
* fixed covar[itv] [6] [7] [6][2] |
|
*/ |
|
|
|
for(ncovv=1, iposold=0; ncovv <= ncovvt ; ncovv++){ /* V6 V7 V7*V2 V6*V3 V7*V3 V6*V4 V7*V4 Time varying covariates (single and extended product but no age) including individual from products, product is computed dynamically */ |
|
itv=TvarVV[ncovv]; /* TvarVV={3, 1, 3} gives the name of each varying covariate, or fixed covariate of a varying product after exploding product Vn*Vm into Vn and then Vm */ |
ipos=TvarVVind[ncovv]; /* TvarVVind={2, 5, 5] gives the position in the model of the ncovv th varying covariate*/ |
ipos=TvarVVind[ncovv]; /* TvarVVind={2, 5, 5] gives the position in the model of the ncovv th varying covariate*/ |
if(TvarFind[itv]==0){ /* Not a fixed covariate */ |
/* if(TvarFind[itv]==0){ /\* Not a fixed covariate? Could be a fixed covariate of a product with a higher than ncovcol+nqv, itv *\/ */ |
cotvarv=cotvar[mw[mi][i]][TvarVV[ncovv]][i]; /* because cotvar starts now at first ncovcol+nqv+ (1 to nqtv) */ |
if(FixedV[itv]!=0){ /* Not a fixed covariate? Could be a fixed covariate of a product with a higher than ncovcol+nqv, itv */ |
|
/* printf("DEBUG ncovv=%d, Varying TvarVV[ncovv]=%d\n",ncovv, TvarVV[ncovv]); */ |
|
cotvarv=cotvar[mw[mi][i]][TvarVV[ncovv]][i]; /* because cotvar starts now at first ncovcol+nqv+ntv+nqtv (1 to nqtv) */ |
|
/* printf("DEBUG Varying cov[ioffset+ipos=%d]=%g \n",ioffset+ipos,cotvarv); */ |
}else{ /* fixed covariate */ |
}else{ /* fixed covariate */ |
cotvarv=covar[Tvar[TvarFind[itv]]][i]; |
/* cotvarv=covar[Tvar[TvarFind[itv]]][i]; /\* Error: TvarFind gives the name, that is the true column of fixed covariates, but Tvar of the model *\/ */ |
|
/* printf("DEBUG ncovv=%d, Fixed TvarVV[ncovv]=%d\n",ncovv, TvarVV[ncovv]); */ |
|
cotvarv=covar[itv][i]; /* Good: In V6*V3, 3 is fixed at position of the data */ |
|
/* printf("DEBUG Fixed cov[ioffset+ipos=%d]=%g \n",ioffset+ipos,cotvarv); */ |
} |
} |
if(ipos!=iposold){ /* Not a product or first of a product */ |
if(ipos!=iposold){ /* Not a product or first of a product */ |
cotvarvold=cotvarv; |
cotvarvold=cotvarv; |
Line 4376 double funcone( double *x)
|
Line 6211 double funcone( double *x)
|
} |
} |
iposold=ipos; |
iposold=ipos; |
cov[ioffset+ipos]=cotvarv; |
cov[ioffset+ipos]=cotvarv; |
|
/* printf("DEBUG Product cov[ioffset+ipos=%d] \n",ioffset+ipos); */ |
/* For products */ |
/* For products */ |
} |
} |
/* for(itv=1; itv <= ntveff; itv++){ /\* Varying dummy covariates single *\/ */ |
/* for(itv=1; itv <= ntveff; itv++){ /\* Varying dummy covariates single *\/ */ |
Line 4414 double funcone( double *x)
|
Line 6250 double funcone( double *x)
|
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(ncovva=1, iposold=0; ncovva <= ncovta ; ncovva++){ /* Time varying covariates with age including individual from products, product is computed dynamically */ |
if(!FixedV[Tvar[Tage[kk]]]) |
itv=TvarAVVA[ncovva]; /* TvarVV={3, 1, 3} gives the name of each varying covariate, exploding product Vn*Vm into Vn and then Vm */ |
cov[Tage[kk]+2+nagesqr]=covar[Tvar[Tage[kk]]][i]*agexact; |
ipos=TvarAVVAind[ncovva]; /* TvarVVind={2, 5, 5] gives the position in the model of the ncovv th varying covariate*/ |
else |
/* if(TvarFind[itv]==0){ /\* Not a fixed covariate? Could be a fixed covariate of a product with a higher than ncovcol+nqv, itv *\/ */ |
cov[Tage[kk]+2+nagesqr]=cotvar[mw[mi][i]][Tvar[Tage[kk]]][i]*agexact; /* because cotvar starts now at first ncovcol+nqv+ (1 to nqtv) */ |
if(FixedV[itv]!=0){ /* Not a fixed covariate? Could be a fixed covariate of a product with a higher than ncovcol+nqv, itv */ |
|
/* printf("DEBUG ncovva=%d, Varying TvarAVVA[ncovva]=%d\n", ncovva, TvarAVVA[ncovva]); */ |
|
cotvarv=cotvar[mw[mi][i]][TvarAVVA[ncovva]][i]; /* because cotvar starts now at first ncovcol+nqv+ntv+nqtv (1 to nqtv) */ |
|
}else{ /* fixed covariate */ |
|
/* cotvarv=covar[Tvar[TvarFind[itv]]][i]; /\* Error: TvarFind gives the name, that is the true column of fixed covariates, but Tvar of the model *\/ */ |
|
/* printf("DEBUG ncovva=%d, Fixed TvarAVVA[ncovva]=%d\n", ncovva, TvarAVVA[ncovva]); */ |
|
cotvarv=covar[itv][i]; /* Error: TvarFind gives the name, that is the true column of fixed covariates, but Tvar of the model */ |
|
} |
|
if(ipos!=iposold){ /* Not a product or first of a product */ |
|
cotvarvold=cotvarv; |
|
}else{ /* A second product */ |
|
/* printf("DEBUG * \n"); */ |
|
cotvarv=cotvarv*cotvarvold; |
|
} |
|
iposold=ipos; |
|
/* printf("DEBUG Product cov[ioffset+ipos=%d] \n",ioffset+ipos); */ |
|
cov[ioffset+ipos]=cotvarv*agexact; |
|
/* For products */ |
} |
} |
|
|
/* printf("i=%d,mi=%d,d=%d,mw[mi][i]=%d\n",i, mi,d,mw[mi][i]); */ |
/* 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, |
Line 4473 double funcone( double *x)
|
Line 6327 double funcone( double *x)
|
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; |
printf("Funcone num[i]=%ld i=%6d V= ", num[i], i); |
/* Printing covariates values for each contribution for checking */ |
for (kf=1; kf<=ncovf;kf++){ /* Simple and product fixed covariates without age* products *//* Missing values are set to -1 but should be dropped */ |
/* printf("num[i]=%09ld, 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",num[i],i,s1,s2,mi,mw[mi][i],dh[mi][i],exp(lli),weight[i],(s2==-1? -1: out[s1][s2]),(s2==-1? -1: savm[s1][s2])); */ |
printf("%g",covar[Tvar[TvarFind[kf]]][i]); |
|
} |
|
for(ncovv=1, iposold=0; ncovv <= ncovvt ; ncovv++){ /* Varying covariates (single and product but no age) including individual from products */ |
|
ipos=TvarVVind[ncovv]; /* TvarVVind={2, 5, 5] gives the position in the model of the ncovv th varying covariate*/ |
|
if(ipos!=iposold){ /* Not a product or first of a product */ |
|
printf(" %g",cov[ioffset+ipos]); |
|
}else{ |
|
printf("*"); |
|
} |
|
iposold=ipos; |
|
} |
|
for (kk=1; kk<=cptcovage;kk++) { |
|
if(!FixedV[Tvar[Tage[kk]]]) |
|
printf(" %g*age",covar[Tvar[Tage[kk]]][i]); |
|
else |
|
printf(" %g*age",cotvar[mw[mi][i]][Tvar[Tage[kk]]][i]);/* because cotvar starts now at first ncovcol+nqv+ (1 to nqtv) */ |
|
} |
|
printf(" s1=%1d s2=%1d mi=%1d mw=%1d dh=%3d prob=%10.6f w=%6.4f out=%10.6f sav=%10.6f\n",s1,s2,mi,mw[mi][i],dh[mi][i],exp(lli),weight[i],(s2==-1? -1: out[s1][s2]),(s2==-1? -1: savm[s1][s2])); |
|
if(globpr){ |
if(globpr){ |
fprintf(ficresilk,"%09ld %6.1f %6.1f %6d %2d %2d %2d %2d %3d %15.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], agebegin, ageend, i,s1,s2,mi,mw[mi][i],dh[mi][i],exp(lli),weight[i],weight[i]*gipmx/gsw, |
num[i], agebegin, ageend, i,s1,s2,mi,mw[mi][i],dh[mi][i],exp(lli),weight[i],weight[i]*gipmx/gsw, |
2*weight[i]*lli,(s2==-1? -1: out[s1][s2]),(s2==-1? -1: savm[s1][s2])); |
2*weight[i]*lli,(s2==-1? -1: out[s1][s2]),(s2==-1? -1: savm[s1][s2])); |
/* printf("%09ld %6.1f %6.1f %6d %2d %2d %2d %2d %3d %15.6f %8.4f %8.3f\ */ |
/* printf("%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], agebegin, ageend, i,s1,s2,mi,mw[mi][i],dh[mi][i],exp(lli),weight[i],weight[i]*gipmx/gsw, */ |
/* num[i], agebegin, ageend, i,s1,s2,mi,mw[mi][i],dh[mi][i],exp(lli),weight[i],weight[i]*gipmx/gsw, */ |
/* 2*weight[i]*lli,(s2==-1? -1: out[s1][s2]),(s2==-1? -1: 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); |
/* printf(" %10.6f",-ll[k]*gipmx/gsw); */ |
/* printf(" %10.6f",-ll[k]*gipmx/gsw); */ |
} |
} |
fprintf(ficresilk," %10.6f\n", -llt); |
fprintf(ficresilk," %10.6f ", -llt); |
/* printf(" %10.6f\n", -llt); */ |
/* printf(" %10.6f\n", -llt); */ |
} |
/* if(debugILK){ /\* debugILK is set by a #d in a comment line *\/ */ |
|
/* fprintf(ficresilk,"%09ld ", num[i]); */ /* not necessary */ |
|
for (kf=1; kf<=ncovf;kf++){ /* Simple and product fixed covariates without age* products *//* Missing values are set to -1 but should be dropped */ |
|
fprintf(ficresilk," %g",covar[Tvar[TvarFind[kf]]][i]); |
|
} |
|
for(ncovv=1, iposold=0; ncovv <= ncovvt ; ncovv++){ /* Varying covariates (single and product but no age) including individual from products */ |
|
ipos=TvarVVind[ncovv]; /* TvarVVind={2, 5, 5] gives the position in the model of the ncovv th varying covariate*/ |
|
if(ipos!=iposold){ /* Not a product or first of a product */ |
|
fprintf(ficresilk," %g",cov[ioffset+ipos]); |
|
/* printf(" %g",cov[ioffset+ipos]); */ |
|
}else{ |
|
fprintf(ficresilk,"*"); |
|
/* printf("*"); */ |
|
} |
|
iposold=ipos; |
|
} |
|
/* for (kk=1; kk<=cptcovage;kk++) { */ |
|
/* if(!FixedV[Tvar[Tage[kk]]]){ */ |
|
/* fprintf(ficresilk," %g*age",covar[Tvar[Tage[kk]]][i]); */ |
|
/* /\* printf(" %g*age",covar[Tvar[Tage[kk]]][i]); *\/ */ |
|
/* }else{ */ |
|
/* fprintf(ficresilk," %g*age",cotvar[mw[mi][i]][Tvar[Tage[kk]]][i]);/\* because cotvar starts now at first ncovcol+nqv+ (1 to nqtv) *\/ */ |
|
/* /\* printf(" %g*age",cotvar[mw[mi][i]][Tvar[Tage[kk]]][i]);/\\* because cotvar starts now at first ncovcol+nqv+ (1 to nqtv) *\\/ *\/ */ |
|
/* } */ |
|
/* } */ |
|
for(ncovva=1, iposold=0; ncovva <= ncovta ; ncovva++){ /* Time varying covariates with age including individual from products, product is computed dynamically */ |
|
itv=TvarAVVA[ncovva]; /* TvarVV={3, 1, 3} gives the name of each varying covariate, exploding product Vn*Vm into Vn and then Vm */ |
|
ipos=TvarAVVAind[ncovva]; /* TvarVVind={2, 5, 5] gives the position in the model of the ncovv th varying covariate*/ |
|
/* if(TvarFind[itv]==0){ /\* Not a fixed covariate? Could be a fixed covariate of a product with a higher than ncovcol+nqv, itv *\/ */ |
|
if(FixedV[itv]!=0){ /* Not a fixed covariate? Could be a fixed covariate of a product with a higher than ncovcol+nqv, itv */ |
|
/* printf("DEBUG ncovva=%d, Varying TvarAVVA[ncovva]=%d\n", ncovva, TvarAVVA[ncovva]); */ |
|
cotvarv=cotvar[mw[mi][i]][TvarAVVA[ncovva]][i]; /* because cotvar starts now at first ncovcol+nqv+ntv+nqtv (1 to nqtv) */ |
|
}else{ /* fixed covariate */ |
|
/* cotvarv=covar[Tvar[TvarFind[itv]]][i]; /\* Error: TvarFind gives the name, that is the true column of fixed covariates, but Tvar of the model *\/ */ |
|
/* printf("DEBUG ncovva=%d, Fixed TvarAVVA[ncovva]=%d\n", ncovva, TvarAVVA[ncovva]); */ |
|
cotvarv=covar[itv][i]; /* Error: TvarFind gives the name, that is the true column of fixed covariates, but Tvar of the model */ |
|
} |
|
if(ipos!=iposold){ /* Not a product or first of a product */ |
|
cotvarvold=cotvarv; |
|
}else{ /* A second product */ |
|
/* printf("DEBUG * \n"); */ |
|
cotvarv=cotvarv*cotvarvold; |
|
} |
|
cotvarv=cotvarv*agexact; |
|
fprintf(ficresilk," %g*age",cotvarv); |
|
iposold=ipos; |
|
/* printf("DEBUG Product cov[ioffset+ipos=%d] \n",ioffset+ipos); */ |
|
cov[ioffset+ipos]=cotvarv; |
|
/* For products */ |
|
} |
|
/* printf("\n"); */ |
|
/* } /\* End debugILK *\/ */ |
|
fprintf(ficresilk,"\n"); |
|
} /* End if globpr */ |
} /* 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]; |
Line 4519 double funcone( double *x)
|
Line 6408 double funcone( double *x)
|
gipmx=ipmx; |
gipmx=ipmx; |
gsw=sw; |
gsw=sw; |
} |
} |
return -l; |
return -l; |
} |
} |
|
|
|
|
Line 4530 void likelione(FILE *ficres,double p[],
|
Line 6419 void likelione(FILE *ficres,double p[],
|
the selection of individuals/waves and |
the selection of individuals/waves and |
to check the exact contribution to the likelihood. |
to check the exact contribution to the likelihood. |
Plotting could be done. |
Plotting could be done. |
*/ |
*/ |
int k; |
void pstamp(FILE *ficres); |
|
int k, kf, kk, kvar, ncovv, iposold, ipos; |
|
|
if(*globpri !=0){ /* Just counts and sums, no printings */ |
if(*globpri !=0){ /* Just counts and sums, no printings */ |
strcpy(fileresilk,"ILK_"); |
strcpy(fileresilk,"ILK_"); |
Line 4540 void likelione(FILE *ficres,double p[],
|
Line 6430 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); |
} |
} |
|
pstamp(ficresilk);fprintf(ficresilk,"# model=1+age+%s\n",model); |
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, "#individual(line's_record) count ageb ageend s1 s2 wave# effective_wave# number_of_matrices_product pij weight weight/gpw -2ln(pij)*weight 0pij_x 0pij_(x-stepm) cumulating_loglikeli_by_health_state(reweighted=-2ll*weightXnumber_of_contribs/sum_of_weights) and_total\n"); |
fprintf(ficresilk, "#num_i ageb agend i s1 s2 mi mw dh likeli weight %%weight 2wlli out sav "); |
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); |
fprintf(ficresilk," -2*gipw/gsw*weight*ll(total)\n"); |
fprintf(ficresilk," -2*gipw/gsw*weight*ll(total) "); |
} |
|
|
/* if(debugILK){ /\* debugILK is set by a #d in a comment line *\/ */ |
|
for(kf=1;kf <= ncovf; kf++){ |
|
fprintf(ficresilk,"V%d",Tvar[TvarFind[kf]]); |
|
/* printf("V%d",Tvar[TvarFind[kf]]); */ |
|
} |
|
for(ncovv=1, iposold=0; ncovv <= ncovvt ; ncovv++){ |
|
ipos=TvarVVind[ncovv]; /* TvarVVind={2, 5, 5] gives the position in the model of the ncovv th varying covariate */ |
|
if(ipos!=iposold){ /* Not a product or first of a product */ |
|
/* printf(" %d",ipos); */ |
|
fprintf(ficresilk," V%d",TvarVV[ncovv]); |
|
}else{ |
|
/* printf("*"); */ |
|
fprintf(ficresilk,"*"); |
|
} |
|
iposold=ipos; |
|
} |
|
for (kk=1; kk<=cptcovage;kk++) { |
|
if(!FixedV[Tvar[Tage[kk]]]){ |
|
/* printf(" %d*age(Fixed)",Tvar[Tage[kk]]); */ |
|
fprintf(ficresilk," %d*age(Fixed)",Tvar[Tage[kk]]); |
|
}else{ |
|
fprintf(ficresilk," %d*age(Varying)",Tvar[Tage[kk]]);/* because cotvar starts now at first ncovcol+nqv+ (1 to nqtv) */ |
|
/* printf(" %d*age(Varying)",Tvar[Tage[kk]]);/\* because cotvar starts now at first ncovcol+nqv+ (1 to nqtv) *\/ */ |
|
} |
|
} |
|
/* } /\* End if debugILK *\/ */ |
|
/* printf("\n"); */ |
|
fprintf(ficresilk,"\n"); |
|
} /* End glogpri */ |
|
|
*fretone=(*func)(p); |
*fretone=(*func)(p); |
if(*globpri !=0){ |
if(*globpri !=0){ |
Line 4558 void likelione(FILE *ficres,double p[],
|
Line 6478 void likelione(FILE *ficres,double p[],
|
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); |
fprintf(fichtm,"\n<br>Equation of the model: <b>model=1+age+%s</b><br>\n",model); |
|
|
for (k=1; k<= nlstate ; k++) { |
|
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); |
|
} |
|
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> \ |
<img src=\"%s-ori.png\">",subdirf2(optionfilefiname,"ILK_"),subdirf2(optionfilefiname,"ILK_"),subdirf2(optionfilefiname,"ILK_")); |
<img src=\"%s-ori.png\">\n",subdirf2(optionfilefiname,"ILK_"),subdirf2(optionfilefiname,"ILK_"),subdirf2(optionfilefiname,"ILK_")); |
fprintf(fichtm,"<br>- and by state of destination <a href=\"%s-dest.png\">%s-dest.png</a><br> \ |
fprintf(fichtm,"<br>- and by state of destination <a href=\"%s-dest.png\">%s-dest.png</a><br> \ |
<img src=\"%s-dest.png\">",subdirf2(optionfilefiname,"ILK_"),subdirf2(optionfilefiname,"ILK_"),subdirf2(optionfilefiname,"ILK_")); |
<img src=\"%s-dest.png\">\n",subdirf2(optionfilefiname,"ILK_"),subdirf2(optionfilefiname,"ILK_"),subdirf2(optionfilefiname,"ILK_")); |
|
|
|
for (k=1; k<= nlstate ; k++) { |
|
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>\n \ |
|
<img src=\"%s-p%dj.png\">\n",k,k,subdirf2(optionfilefiname,"ILK_"),k,subdirf2(optionfilefiname,"ILK_"),k,subdirf2(optionfilefiname,"ILK_"),k); |
|
for(kf=1; kf <= ncovf; kf++){ /* For each simple dummy covariate of the model */ |
|
kvar=Tvar[TvarFind[kf]]; /* variable */ |
|
fprintf(fichtm,"<br>- Probability p<sub>%dj</sub> by origin %d and destination j with colored covariate V%d. Same dot size of all points but with a different color for transitions with dummy variable V%d=1 at beginning of transition (keeping former color for V%d=0): ",k,k,Tvar[TvarFind[kf]],Tvar[TvarFind[kf]],Tvar[TvarFind[kf]]); |
|
fprintf(fichtm,"<a href=\"%s-p%dj-%d.png\">%s-p%dj-%d.png</a><br>",subdirf2(optionfilefiname,"ILK_"),k,kvar,subdirf2(optionfilefiname,"ILK_"),k,kvar); |
|
fprintf(fichtm,"<img src=\"%s-p%dj-%d.png\">",subdirf2(optionfilefiname,"ILK_"),k,Tvar[TvarFind[kf]]); |
|
} |
|
for(ncovv=1, iposold=0; ncovv <= ncovvt ; ncovv++){ /* Loop on the time varying extended covariates (with extension of Vn*Vm */ |
|
ipos=TvarVVind[ncovv]; /* TvarVVind={2, 5, 5] gives the position in the model of the ncovv th varying covariate */ |
|
kvar=TvarVV[ncovv]; /* TvarVV={3, 1, 3} gives the name of each varying covariate */ |
|
/* printf("DebugILK fichtm ncovv=%d, kvar=TvarVV[ncovv]=V%d, ipos=TvarVVind[ncovv]=%d, Dummy[ipos]=%d, Typevar[ipos]=%d\n", ncovv,kvar,ipos,Dummy[ipos],Typevar[ipos]); */ |
|
if(ipos!=iposold){ /* Not a product or first of a product */ |
|
/* fprintf(ficresilk," V%d",TvarVV[ncovv]); */ |
|
/* printf(" DebugILK fichtm ipos=%d != iposold=%d\n", ipos, iposold); */ |
|
if(Dummy[ipos]==0 && Typevar[ipos]==0){ /* Only if dummy time varying: Dummy(0, 1=quant singor prod without age,2 dummy*age, 3quant*age) Typevar (0 single, 1=*age,2=Vn*vm) */ |
|
fprintf(fichtm,"<br>- Probability p<sub>%dj</sub> by origin %d and destination j with colored time varying dummy covariate V%d. Same dot size of all points but with a different color for transitions with dummy variable V%d=1 at beginning of transition (keeping former color for V%d=0): <a href=\"%s-p%dj.png\">%s-p%dj.png</a><br> \ |
|
<img src=\"%s-p%dj-%d.png\">",k,k,kvar,kvar,kvar,subdirf2(optionfilefiname,"ILK_"),k,subdirf2(optionfilefiname,"ILK_"),k,subdirf2(optionfilefiname,"ILK_"),k,kvar); |
|
} /* End only for dummies time varying (single?) */ |
|
}else{ /* Useless product */ |
|
/* printf("*"); */ |
|
/* fprintf(ficresilk,"*"); */ |
|
} |
|
iposold=ipos; |
|
} /* For each time varying covariate */ |
|
} /* End loop on states */ |
|
|
|
/* if(debugILK){ */ |
|
/* for(kf=1; kf <= ncovf; kf++){ /\* For each simple dummy covariate of the model *\/ */ |
|
/* /\* kvar=Tvar[TvarFind[kf]]; *\/ /\* variable *\/ */ |
|
/* for (k=1; k<= nlstate ; k++) { */ |
|
/* fprintf(fichtm,"<br>- Probability p<sub>%dj</sub> by origin %d and destination j with colored covariate V%. Same dot size of all points but with a different color for transitions with dummy variable V%d=1 at beginning of transition (keeping former color for V%d=0): <a href=\"%s-p%dj.png\">%s-p%dj.png</a><br> \ */ |
|
/* <img src=\"%s-p%dj-%d.png\">",k,k,Tvar[TvarFind[kf]],Tvar[TvarFind[kf]],Tvar[TvarFind[kf]],subdirf2(optionfilefiname,"ILK_"),k,subdirf2(optionfilefiname,"ILK_"),k,subdirf2(optionfilefiname,"ILK_"),k,Tvar[TvarFind[kf]]); */ |
|
/* } */ |
|
/* } */ |
|
/* for(ncovv=1, iposold=0; ncovv <= ncovvt ; ncovv++){ /\* Loop on the time varying extended covariates (with extension of Vn*Vm *\/ */ |
|
/* ipos=TvarVVind[ncovv]; /\* TvarVVind={2, 5, 5] gives the position in the model of the ncovv th varying covariate *\/ */ |
|
/* kvar=TvarVV[ncovv]; /\* TvarVV={3, 1, 3} gives the name of each varying covariate *\/ */ |
|
/* /\* printf("DebugILK fichtm ncovv=%d, kvar=TvarVV[ncovv]=V%d, ipos=TvarVVind[ncovv]=%d, Dummy[ipos]=%d, Typevar[ipos]=%d\n", ncovv,kvar,ipos,Dummy[ipos],Typevar[ipos]); *\/ */ |
|
/* if(ipos!=iposold){ /\* Not a product or first of a product *\/ */ |
|
/* /\* fprintf(ficresilk," V%d",TvarVV[ncovv]); *\/ */ |
|
/* /\* printf(" DebugILK fichtm ipos=%d != iposold=%d\n", ipos, iposold); *\/ */ |
|
/* if(Dummy[ipos]==0 && Typevar[ipos]==0){ /\* Only if dummy time varying: Dummy(0, 1=quant singor prod without age,2 dummy*age, 3quant*age) Typevar (0 single, 1=*age,2=Vn*vm) *\/ */ |
|
/* for (k=1; k<= nlstate ; k++) { */ |
|
/* fprintf(fichtm,"<br>- Probability p<sub>%dj</sub> by origin %d and destination j. Same dot size of all points but with a different color for transitions with dummy variable V%d=1 at beginning of transition (keeping former color for V%d=0): <a href=\"%s-p%dj.png\">%s-p%dj.png</a><br> \ */ |
|
/* <img src=\"%s-p%dj-%d.png\">",k,k,kvar,kvar,subdirf2(optionfilefiname,"ILK_"),k,subdirf2(optionfilefiname,"ILK_"),k,subdirf2(optionfilefiname,"ILK_"),k,kvar); */ |
|
/* } /\* End state *\/ */ |
|
/* } /\* End only for dummies time varying (single?) *\/ */ |
|
/* }else{ /\* Useless product *\/ */ |
|
/* /\* printf("*"); *\/ */ |
|
/* /\* fprintf(ficresilk,"*"); *\/ */ |
|
/* } */ |
|
/* iposold=ipos; */ |
|
/* } /\* For each time varying covariate *\/ */ |
|
/* }/\* End debugILK *\/ */ |
fflush(fichtm); |
fflush(fichtm); |
} |
}/* End globpri */ |
return; |
return; |
} |
} |
|
|
Line 4576 void likelione(FILE *ficres,double p[],
|
Line 6549 void likelione(FILE *ficres,double p[],
|
|
|
void mlikeli(FILE *ficres,double p[], int npar, int ncovmodel, int nlstate, double ftol, double (*func)(double [])) |
void mlikeli(FILE *ficres,double p[], int npar, int ncovmodel, int nlstate, double ftol, double (*func)(double [])) |
{ |
{ |
int i,j,k, jk, jkk=0, iter=0; |
int i,j, jkk=0, iter=0; |
double **xi; |
double **xi; |
double fret; |
/*double fret;*/ |
double fretone; /* Only one call to likelihood */ |
/*double fretone;*/ /* Only one call to likelihood */ |
/* char filerespow[FILENAMELENGTH];*/ |
/* char filerespow[FILENAMELENGTH];*/ |
|
|
|
/*double * p1;*/ /* Shifted parameters from 0 instead of 1 */ |
#ifdef NLOPT |
#ifdef NLOPT |
int creturn; |
int creturn; |
nlopt_opt opt; |
nlopt_opt opt; |
/* double lb[9] = { -HUGE_VAL, -HUGE_VAL, -HUGE_VAL, -HUGE_VAL, -HUGE_VAL, -HUGE_VAL, -HUGE_VAL, -HUGE_VAL, -HUGE_VAL }; /\* lower bounds *\/ */ |
/* double lb[9] = { -HUGE_VAL, -HUGE_VAL, -HUGE_VAL, -HUGE_VAL, -HUGE_VAL, -HUGE_VAL, -HUGE_VAL, -HUGE_VAL, -HUGE_VAL }; /\* lower bounds *\/ */ |
double *lb; |
double *lb; |
double minf; /* the minimum objective value, upon return */ |
double minf; /* the minimum objective value, upon return */ |
double * p1; /* Shifted parameters from 0 instead of 1 */ |
|
myfunc_data dinst, *d = &dinst; |
myfunc_data dinst, *d = &dinst; |
#endif |
#endif |
|
|
|
|
xi=matrix(1,npar,1,npar); |
xi=matrix(1,npar,1,npar); |
for (i=1;i<=npar;i++) |
for (i=1;i<=npar;i++) /* Starting with canonical directions j=1,n xi[i=1,n][j] */ |
for (j=1;j<=npar;j++) |
for (j=1;j<=npar;j++) |
xi[i][j]=(i==j ? 1.0 : 0.0); |
xi[i][j]=(i==j ? 1.0 : 0.0); |
printf("Powell\n"); fprintf(ficlog,"Powell\n"); |
printf("Powell-prax\n"); fprintf(ficlog,"Powell-prax\n"); |
strcpy(filerespow,"POW_"); |
strcpy(filerespow,"POW_"); |
strcat(filerespow,fileres); |
strcat(filerespow,fileres); |
if((ficrespow=fopen(filerespow,"w"))==NULL) { |
if((ficrespow=fopen(filerespow,"w"))==NULL) { |
Line 4661 void mlikeli(FILE *ficres,double p[], in
|
Line 6635 void mlikeli(FILE *ficres,double p[], in
|
} |
} |
powell(p,xi,npar,ftol,&iter,&fret,flatdir,func); |
powell(p,xi,npar,ftol,&iter,&fret,flatdir,func); |
#else /* FLATSUP */ |
#else /* FLATSUP */ |
powell(p,xi,npar,ftol,&iter,&fret,func); |
/* powell(p,xi,npar,ftol,&iter,&fret,func);*/ |
|
/* praxis ( t0, h0, n, prin, x, beale_f ); */ |
|
int prin=4; |
|
/* double h0=0.25; */ |
|
/* double macheps; */ |
|
/* double fmin; */ |
|
macheps=pow(16.0,-13.0); |
|
/* #include "praxis.h" */ |
|
/* Be careful that praxis start at x[0] and powell start at p[1] */ |
|
/* praxis ( ftol, h0, npar, prin, p, func ); */ |
|
/* p1= (p+1); */ /* p *(p+1)@8 and p *(p1)@8 are equal p1[0]=p[1] */ |
|
printf("Praxis Gegenfurtner \n"); |
|
fprintf(ficlog, "Praxis Gegenfurtner\n");fflush(ficlog); |
|
/* praxis ( ftol, h0, npar, prin, p1, func ); */ |
|
/* fmin = praxis(1.e-5,macheps, h, n, prin, x, func); */ |
|
ffmin = praxis(ftol,macheps, h0, npar, prin, p, func); |
|
printf("End Praxis\n"); |
#endif /* FLATSUP */ |
#endif /* FLATSUP */ |
|
|
#ifdef LINMINORIGINAL |
#ifdef LINMINORIGINAL |
Line 4923 double hessij( double x[], double **hess
|
Line 6913 double hessij( double x[], double **hess
|
kmax=kmax+10; |
kmax=kmax+10; |
} |
} |
if(kmax >=10 || firstime ==1){ |
if(kmax >=10 || firstime ==1){ |
|
/* What are the thetai and thetaj? thetai/ncovmodel thetai=(thetai-thetai%ncovmodel)/ncovmodel +thetai%ncovmodel=(line,pos) */ |
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); |
printf("Warning: directions %d-%d, you are not estimating the Hessian at the exact maximum likelihood; you could increase ftol=%.2e\n",thetai,thetaj, ftol); |
fprintf(ficlog,"Warning: directions %d-%d, you are not estimating the Hessian at the exact maximum likelihood; you could increase ftol=%.2e\n",thetai,thetaj, ftol); |
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); |
Line 5791 void prevalence(double ***probs, double
|
Line 7782 void prevalence(double ***probs, double
|
int i, m, jk, j1, bool, z1,j, iv; |
int i, m, jk, j1, bool, z1,j, iv; |
int mi; /* Effective wave */ |
int mi; /* Effective wave */ |
int iage; |
int iage; |
double agebegin, ageend; |
double agebegin; /*, ageend;*/ |
|
|
double **prop; |
double **prop; |
double posprop; |
double posprop; |
Line 6030 void concatwav(int wav[], int **dh, int
|
Line 8021 void concatwav(int wav[], int **dh, int
|
if(j==0) j=1; /* Survives at least one month after exam */ |
if(j==0) j=1; /* Survives at least one month after exam */ |
else if(j<0){ |
else if(j<0){ |
nberr++; |
nberr++; |
printf("Error! Negative delay (%d to death) between waves %d and %d of individual %ld at line %d who is aged %.1f with statuses from %d to %d\n ",j,mw[mi][i],mw[mi+1][i],num[i], i,agev[mw[mi][i]][i],s[mw[mi][i]][i] ,s[mw[mi+1][i]][i]); |
printf("Error! Negative delay (%d to death) between waves %d and %d of individual %ld (around line %d) who is aged %.1f with statuses from %d to %d\n ",j,mw[mi][i],mw[mi+1][i],num[i], i,agev[mw[mi][i]][i],s[mw[mi][i]][i] ,s[mw[mi+1][i]][i]); |
j=1; /* Temporary Dangerous patch */ |
j=1; /* Temporary Dangerous patch */ |
printf(" We assumed that the date of interview was correct (and not the date of death) and postponed the death %d month(s) (one stepm) after the interview. You MUST fix the contradiction between dates.\n",stepm); |
printf(" We assumed that the date of interview was correct (and not the date of death) and postponed the death %d month(s) (one stepm) after the interview. You MUST fix the contradiction between dates.\n",stepm); |
fprintf(ficlog,"Error! Negative delay (%d to death) between waves %d and %d of individual %ld at line %d who is aged %.1f with statuses from %d to %d\n ",j,mw[mi][i],mw[mi+1][i],num[i], i,agev[mw[mi][i]][i],s[mw[mi][i]][i] ,s[mw[mi+1][i]][i]); |
fprintf(ficlog,"Error! Negative delay (%d to death) between waves %d and %d of individual %ld (around line %d) who is aged %.1f with statuses from %d to %d\n ",j,mw[mi][i],mw[mi+1][i],num[i], i,agev[mw[mi][i]][i],s[mw[mi][i]][i] ,s[mw[mi+1][i]][i]); |
fprintf(ficlog," We assumed that the date of interview was correct (and not the date of death) and postponed the death %d month(s) (one stepm) after the interview. You MUST fix the contradiction between dates.\n",stepm); |
fprintf(ficlog," We assumed that the date of interview was correct (and not the date of death) and postponed the death %d month(s) (one stepm) after the interview. You MUST fix the contradiction between dates.\n",stepm); |
} |
} |
k=k+1; |
k=k+1; |
Line 6067 void concatwav(int wav[], int **dh, int
|
Line 8058 void concatwav(int wav[], int **dh, int
|
/*printf("%d %lf %d %d %d\n", i,agev[mw[mi][i]][i],j,s[mw[mi][i]][i] ,s[mw[mi+1][i]][i]);*/ |
/*printf("%d %lf %d %d %d\n", i,agev[mw[mi][i]][i],j,s[mw[mi][i]][i] ,s[mw[mi+1][i]][i]);*/ |
if(j<0){ |
if(j<0){ |
nberr++; |
nberr++; |
printf("Error! Negative delay (%d) between waves %d and %d of individual %ld at line %d who is aged %.1f with statuses from %d to %d\n ",j,mw[mi][i],mw[mi+1][i],num[i], i,agev[mw[mi][i]][i],s[mw[mi][i]][i] ,s[mw[mi+1][i]][i]); |
printf("Error! Negative delay (%d) between waves %d and %d of individual %ld (around line %d) who is aged %.1f with statuses from %d to %d\n ",j,mw[mi][i],mw[mi+1][i],num[i], i,agev[mw[mi][i]][i],s[mw[mi][i]][i] ,s[mw[mi+1][i]][i]); |
fprintf(ficlog,"Error! Negative delay (%d) between waves %d and %d of individual %ld at line %d who is aged %.1f with statuses from %d to %d\n ",j,mw[mi][i],mw[mi+1][i],num[i], i,agev[mw[mi][i]][i],s[mw[mi][i]][i] ,s[mw[mi+1][i]][i]); |
fprintf(ficlog,"Error! Negative delay (%d) between waves %d and %d of individual %ld (around line %d) who is aged %.1f with statuses from %d to %d\n ",j,mw[mi][i],mw[mi+1][i],num[i], i,agev[mw[mi][i]][i],s[mw[mi][i]][i] ,s[mw[mi+1][i]][i]); |
} |
} |
sum=sum+j; |
sum=sum+j; |
} |
} |
Line 6136 void concatwav(int wav[], int **dh, int
|
Line 8127 void concatwav(int wav[], int **dh, int
|
/* Loop on covariates without age and products and no quantitative variable */ |
/* Loop on covariates without age and products and no quantitative variable */ |
for (k=1; k<=cptcovt; k++) { /* cptcovt: total number of covariates of the model (2) nbocc(+)+1 = 8 excepting constant and age and age*age */ |
for (k=1; k<=cptcovt; k++) { /* cptcovt: total number of covariates of the model (2) nbocc(+)+1 = 8 excepting constant and age and age*age */ |
for (j=-1; (j < maxncov); j++) Ndum[j]=0; |
for (j=-1; (j < maxncov); j++) Ndum[j]=0; |
printf("Testing k=%d, cptcovt=%d\n",k, cptcovt); |
/* printf("Testing k=%d, cptcovt=%d\n",k, cptcovt); */ |
if(Dummy[k]==0 && Typevar[k] !=1 && Typevar[k] != 2){ /* Dummy covariate and not age product nor fixed product */ |
if(Dummy[k]==0 && Typevar[k] !=1 && Typevar[k] != 3 && Typevar[k] != 2){ /* Dummy covariate and not age product nor fixed product */ |
switch(Fixed[k]) { |
switch(Fixed[k]) { |
case 0: /* Testing on fixed dummy covariate, simple or product of fixed */ |
case 0: /* Testing on fixed dummy covariate, simple or product of fixed */ |
modmaxcovj=0; |
modmaxcovj=0; |
Line 6234 void concatwav(int wav[], int **dh, int
|
Line 8225 void concatwav(int wav[], int **dh, int
|
break; |
break; |
} /* end switch */ |
} /* end switch */ |
} /* end dummy test */ |
} /* end dummy test */ |
if(Dummy[k]==1 && Typevar[k] !=1){ /* Quantitative covariate and not age product */ |
if(Dummy[k]==1 && Typevar[k] !=1 && Typevar[k] !=3 && Fixed ==0){ /* Fixed Quantitative covariate and not age product */ |
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*/ |
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*/ |
if(Tvar[k]<=0 || Tvar[k]>=NCOVMAX){ |
if(Tvar[k]<=0 || Tvar[k]>=NCOVMAX){ |
printf("Error k=%d \n",k); |
printf("Error k=%d \n",k); |
Line 6636 void concatwav(int wav[], int **dh, int
|
Line 8627 void concatwav(int wav[], int **dh, int
|
/************ 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[], int nres) |
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 |
/** Computes the matrix of variance covariance of health expectancies e.j= sum_i w_i e_ij where w_i depends of popbased, |
|
* either cross-sectional or implied. |
|
* return vareij[i][j][(int)age]=cov(e.i,e.j)=sum_h sum_k trgrad(h_p.i) V(theta) grad(k_p.k) Equation 20 |
* 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) |
Line 6653 void concatwav(int wav[], int **dh, int
|
Line 8646 void concatwav(int wav[], int **dh, int
|
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.3 p.death nlstate+1 to nlstate+ndeath */ |
double ***p3mat; |
double ***p3mat; |
double age,agelim, hf; |
double age,agelim, hf; |
/* double ***mobaverage; */ |
/* double ***mobaverage; */ |
Line 6700 void concatwav(int wav[], int **dh, int
|
Line 8693 void concatwav(int wav[], int **dh, int
|
/* fprintf(ficresprobmorprev," V%d=%f ",Tvqresult[nres][j],Tqresult[nres][resultmodel[nres][j]]); */ |
/* fprintf(ficresprobmorprev," V%d=%f ",Tvqresult[nres][j],Tqresult[nres][resultmodel[nres][j]]); */ |
/* } */ |
/* } */ |
for (j=1; j<= cptcovs; j++){ /* For each selected (single) quantitative value */ /* To be done*/ |
for (j=1; j<= cptcovs; j++){ /* For each selected (single) quantitative value */ /* To be done*/ |
|
/* fprintf(ficresprobmorprev," V%d=%lg ",Tvresult[nres][j],TinvDoQresult[nres][Tvresult[nres][j]]); */ |
fprintf(ficresprobmorprev," V%d=%lg ",Tvresult[nres][j],TinvDoQresult[nres][Tvresult[nres][j]]); |
fprintf(ficresprobmorprev," V%d=%lg ",Tvresult[nres][j],TinvDoQresult[nres][Tvresult[nres][j]]); |
} |
} |
/* for(j=1;j<=cptcoveff;j++) */ |
/* for(j=1;j<=cptcoveff;j++) */ |
Line 6720 void concatwav(int wav[], int **dh, int
|
Line 8714 void concatwav(int wav[], int **dh, int
|
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<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); |
fprintf(fichtm,"\n<br>%s <br>\n",digitp); |
|
|
varppt = matrix(nlstate+1,nlstate+ndeath,nlstate+1,nlstate+ndeath); |
varppt = matrix(nlstate+1,nlstate+ndeath,nlstate+1,nlstate+ndeath); /* In fact, currently a double */ |
pstamp(ficresvij); |
pstamp(ficresvij); |
fprintf(ficresvij,"# Variance and covariance of health expectancies e.j \n# (weighted average of eij where weights are "); |
fprintf(ficresvij,"# Variance and covariance of health expectancies e.j \n# (weighted average of eij where weights are "); |
if(popbased==1) |
if(popbased==1) |
Line 6789 void concatwav(int wav[], int **dh, int
|
Line 8783 void concatwav(int wav[], int **dh, int
|
prlim[i][i]=mobaverage[(int)age][i][ij]; |
prlim[i][i]=mobaverage[(int)age][i][ij]; |
} |
} |
} |
} |
/**< Computes the shifted transition matrix \f$ {}{h}_p^{ij}x\f$ at horizon h. |
/**< Computes the shifted plus (gp) transition matrix \f$ {}{h}_p^{ij}x\f$ at horizon h. |
*/ |
*/ |
hpxij(p3mat,nhstepm,age,hstepm,xp,nlstate,stepm,oldm,savm, ij,nres); /* Returns p3mat[i][j][h] for h=0 to nhstepm */ |
hpxij(p3mat,nhstepm,age,hstepm,xp,nlstate,stepm,oldm,savm, ij,nres); /* Returns p3mat[i][j][h] for h=0 to nhstepm */ |
/**< And for each alive state j, sums over i \f$ w^i_x {}{h}_p^{ij}x\f$, which are the probability |
/**< And for each alive state j, sums over i \f$ w^i_x {}{h}_p^{ij}x\f$, which are the probability |
Line 6798 void concatwav(int wav[], int **dh, int
|
Line 8792 void concatwav(int wav[], int **dh, int
|
for(j=1; j<= nlstate; j++){ |
for(j=1; j<= nlstate; j++){ |
for(h=0; h<=nhstepm; h++){ |
for(h=0; h<=nhstepm; h++){ |
for(i=1, gp[h][j]=0.;i<=nlstate;i++) |
for(i=1, gp[h][j]=0.;i<=nlstate;i++) |
gp[h][j] += prlim[i][i]*p3mat[i][j][h]; |
gp[h][j] += prlim[i][i]*p3mat[i][j][h]; /* gp[h][j]= w_i h_pij */ |
} |
} |
} |
} |
/* Next for computing shifted+ probability of death (h=1 means |
/* Next for computing shifted+ probability of death (h=1 means |
computed over hstepm matrices product = hstepm*stepm months) |
computed over hstepm matrices product = hstepm*stepm months) |
as a weighted average of prlim(i) * p(i,j) p.3=w1*p13 + w2*p23 . |
as a weighted average of prlim(i) * p(i,j) p.3=w1*p13 + w2*p23 . |
*/ |
*/ |
for(j=nlstate+1;j<=nlstate+ndeath;j++){ |
for(j=nlstate+1;j<=nlstate+ndeath;j++){ /* Currently only once for theta plus p.3(age) Sum_i wi pi3*/ |
for(i=1,gpp[j]=0.; i<= nlstate; i++) |
for(i=1,gpp[j]=0.; i<= nlstate; i++) |
gpp[j] += prlim[i][i]*p3mat[i][j][1]; |
gpp[j] += prlim[i][i]*p3mat[i][j][1]; |
} |
} |
Line 6827 void concatwav(int wav[], int **dh, int
|
Line 8821 void concatwav(int wav[], int **dh, int
|
} |
} |
} |
} |
|
|
hpxij(p3mat,nhstepm,age,hstepm,xp,nlstate,stepm,oldm,savm, ij,nres); |
hpxij(p3mat,nhstepm,age,hstepm,xp,nlstate,stepm,oldm,savm, ij,nres); /* Still minus */ |
|
|
for(j=1; j<= nlstate; j++){ /* Sum of wi * eij = e.j */ |
for(j=1; j<= nlstate; j++){ /* gm[h][j]= Sum_i of wi * pij = h_p.j */ |
for(h=0; h<=nhstepm; h++){ |
for(h=0; h<=nhstepm; h++){ |
for(i=1, gm[h][j]=0.;i<=nlstate;i++) |
for(i=1, gm[h][j]=0.;i<=nlstate;i++) |
gm[h][j] += prlim[i][i]*p3mat[i][j][h]; |
gm[h][j] += prlim[i][i]*p3mat[i][j][h]; |
Line 6837 void concatwav(int wav[], int **dh, int
|
Line 8831 void concatwav(int wav[], int **dh, int
|
} |
} |
/* This for computing probability of death (h=1 means |
/* This for computing probability of death (h=1 means |
computed over hstepm matrices product = hstepm*stepm months) |
computed over hstepm matrices product = hstepm*stepm months) |
as a weighted average of prlim. |
as a weighted average of prlim. j is death. gmp[3]=sum_i w_i*p_i3=p.3 minus theta |
*/ |
*/ |
for(j=nlstate+1;j<=nlstate+ndeath;j++){ |
for(j=nlstate+1;j<=nlstate+ndeath;j++){ /* Currently only once theta_minus p.3=Sum_i wi pi3*/ |
for(i=1,gmp[j]=0.; i<= nlstate; i++) |
for(i=1,gmp[j]=0.; i<= nlstate; i++) |
gmp[j] += prlim[i][i]*p3mat[i][j][1]; |
gmp[j] += prlim[i][i]*p3mat[i][j][1]; |
} |
} |
/* end shifting computations */ |
/* end shifting computations */ |
|
|
/**< Computing gradient matrix at horizon h |
/**< Computing gradient of p.j matrix at horizon h and still for one parameter of vector theta |
|
* equation 31 and 32 |
*/ |
*/ |
for(j=1; j<= nlstate; j++) /* vareij */ |
for(j=1; j<= nlstate; j++) /* computes grad p.j(x, over each h) where p.j is Sum_i w_i*pij(x over h) |
|
* equation 24 */ |
for(h=0; h<=nhstepm; h++){ |
for(h=0; h<=nhstepm; h++){ |
gradg[h][theta][j]= (gp[h][j]-gm[h][j])/2./delti[theta]; |
gradg[h][theta][j]= (gp[h][j]-gm[h][j])/2./delti[theta]; |
} |
} |
/**< Gradient of overall mortality p.3 (or p.j) |
/**< Gradient of overall mortality p.3 (or p.death) |
*/ |
*/ |
for(j=nlstate+1; j<= nlstate+ndeath; j++){ /* var mu mortality from j */ |
for(j=nlstate+1; j<= nlstate+ndeath; j++){ /* computes grad of p.3 from wi+pi3 grad p.3 (theta) */ |
gradgp[theta][j]= (gpp[j]-gmp[j])/2./delti[theta]; |
gradgp[theta][j]= (gpp[j]-gmp[j])/2./delti[theta]; |
} |
} |
|
|
} /* End theta */ |
} /* End theta */ |
|
|
/* We got the gradient matrix for each theta and state j */ |
/* We got the gradient matrix for each theta and each state j of gradg(h]theta][j)=grad(_hp.j(theta) */ |
trgradg =ma3x(0,nhstepm,1,nlstate,1,npar); /* veij */ |
trgradg =ma3x(0,nhstepm,1,nlstate,1,npar); |
|
|
for(h=0; h<=nhstepm; h++) /* veij */ |
for(h=0; h<=nhstepm; h++) /* veij */ /* computes the transposed of grad (_hp.j(theta)*/ |
for(j=1; j<=nlstate;j++) |
for(j=1; j<=nlstate;j++) |
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(j=nlstate+1; j<=nlstate+ndeath;j++) /* mu */ |
for(j=nlstate+1; j<=nlstate+ndeath;j++) /* computes transposed of grad p.3 (theta)*/ |
for(theta=1; theta <=npar; theta++) |
for(theta=1; theta <=npar; theta++) |
trgradgp[j][theta]=gradgp[theta][j]; |
trgradgp[j][theta]=gradgp[theta][j]; |
/**< as well as its transposed matrix |
/**< as well as its transposed matrix |
Line 6879 void concatwav(int wav[], int **dh, int
|
Line 8875 void concatwav(int wav[], int **dh, int
|
vareij[i][j][(int)age] =0.; |
vareij[i][j][(int)age] =0.; |
|
|
/* Computing trgradg by matcov by gradg at age and summing over h |
/* Computing trgradg by matcov by gradg at age and summing over h |
* and k (nhstepm) formula 15 of article |
* and k (nhstepm) formula 32 of article |
* Lievre-Brouard-Heathcote |
* Lievre-Brouard-Heathcote so that for each j, computes the cov(e.j,e.k) (formula 31). |
|
* for given h and k computes trgradg[h](i,j) matcov (theta) gradg(k)(i,j) into vareij[i][j] which is |
|
cov(e.i,e.j) and sums on h and k |
|
* including the covariances. |
*/ |
*/ |
|
|
for(h=0;h<=nhstepm;h++){ |
for(h=0;h<=nhstepm;h++){ |
Line 6889 void concatwav(int wav[], int **dh, int
|
Line 8888 void concatwav(int wav[], int **dh, int
|
matprod2(doldm,dnewm,1,nlstate,1,npar,1,nlstate,gradg[k]); |
matprod2(doldm,dnewm,1,nlstate,1,npar,1,nlstate,gradg[k]); |
for(i=1;i<=nlstate;i++) |
for(i=1;i<=nlstate;i++) |
for(j=1;j<=nlstate;j++) |
for(j=1;j<=nlstate;j++) |
vareij[i][j][(int)age] += doldm[i][j]*hf*hf; |
vareij[i][j][(int)age] += doldm[i][j]*hf*hf; /* This is vareij=sum_h sum_k trgrad(h_pij) V(theta) grad(k_pij) |
|
including the covariances of e.j */ |
} |
} |
} |
} |
|
|
/* pptj is p.3 or p.j = trgradgp by cov by gradgp, variance of |
/* Mortality: pptj is p.3 or p.death = trgradgp by cov by gradgp, variance of |
* p.j overall mortality formula 49 but computed directly because |
* p.3=1-p..=1-sum i p.i overall mortality computed directly because |
* we compute the grad (wix pijx) instead of grad (pijx),even if |
* we compute the grad (wix pijx) instead of grad (pijx),even if |
* wix is independent of theta. |
* wix is independent of theta. |
*/ |
*/ |
matprod2(dnewmp,trgradgp,nlstate+1,nlstate+ndeath,1,npar,1,npar,matcov); |
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); |
matprod2(doldmp,dnewmp,nlstate+1,nlstate+ndeath,1,npar,nlstate+1,nlstate+ndeath,gradgp); |
for(j=nlstate+1;j<=nlstate+ndeath;j++) |
for(j=nlstate+1;j<=nlstate+ndeath;j++) |
for(i=nlstate+1;i<=nlstate+ndeath;i++) |
for(i=nlstate+1;i<=nlstate+ndeath;i++) |
varppt[j][i]=doldmp[j][i]; |
varppt[j][i]=doldmp[j][i]; /* This is the variance of p.3 */ |
/* end ppptj */ |
/* end ppptj */ |
/* x centered again */ |
/* x centered again */ |
|
|
Line 6925 void concatwav(int wav[], int **dh, int
|
Line 8925 void concatwav(int wav[], int **dh, int
|
hpxij(p3mat,nhstepm,age,hstepm,x,nlstate,stepm,oldm,savm, ij, nres); |
hpxij(p3mat,nhstepm,age,hstepm,x,nlstate,stepm,oldm,savm, ij, nres); |
for(j=nlstate+1;j<=nlstate+ndeath;j++){ |
for(j=nlstate+1;j<=nlstate+ndeath;j++){ |
for(i=1,gmp[j]=0.;i<= nlstate; i++) |
for(i=1,gmp[j]=0.;i<= nlstate; i++) |
gmp[j] += prlim[i][i]*p3mat[i][j][1]; |
gmp[j] += prlim[i][i]*p3mat[i][j][1]; /* gmp[j] is p.3 */ |
} |
} |
/* end probability of death */ |
/* end probability of death */ |
|
|
fprintf(ficresprobmorprev,"%3d %d ",(int) age, ij); |
fprintf(ficresprobmorprev,"%3d %d ",(int) age, ij); |
for(j=nlstate+1; j<=(nlstate+ndeath);j++){ |
for(j=nlstate+1; j<=(nlstate+ndeath);j++){ |
fprintf(ficresprobmorprev," %11.3e %11.3e",gmp[j], sqrt(varppt[j][j])); |
fprintf(ficresprobmorprev," %11.3e %11.3e",gmp[j], sqrt(varppt[j][j]));/* p.3 (STD p.3) */ |
for(i=1; i<=nlstate;i++){ |
for(i=1; i<=nlstate;i++){ |
fprintf(ficresprobmorprev," %11.3e %11.3e ",prlim[i][i],p3mat[i][j][1]); |
fprintf(ficresprobmorprev," %11.3e %11.3e ",prlim[i][i],p3mat[i][j][1]); /* wi, pi3 */ |
} |
} |
} |
} |
fprintf(ficresprobmorprev,"\n"); |
fprintf(ficresprobmorprev,"\n"); |
Line 7259 void varprob(char optionfilefiname[], do
|
Line 9259 void varprob(char optionfilefiname[], do
|
double ***varpij; |
double ***varpij; |
|
|
strcpy(fileresprob,"PROB_"); |
strcpy(fileresprob,"PROB_"); |
strcat(fileresprob,fileres); |
strcat(fileresprob,fileresu); |
if((ficresprob=fopen(fileresprob,"w"))==NULL) { |
if((ficresprob=fopen(fileresprob,"w"))==NULL) { |
printf("Problem with resultfile: %s\n", fileresprob); |
printf("Problem with resultfile: %s\n", fileresprob); |
fprintf(ficlog,"Problem with resultfile: %s\n", fileresprob); |
fprintf(ficlog,"Problem with resultfile: %s\n", fileresprob); |
Line 7334 To be simple, these graphs help to under
|
Line 9334 To be simple, these graphs help to under
|
|
|
for(nres=1;nres <=nresult; nres++){ /* For each resultline */ |
for(nres=1;nres <=nresult; nres++){ /* For each resultline */ |
for(j1=1; j1<=tj;j1++){ /* For any combination of dummy covariates, fixed and varying */ |
for(j1=1; j1<=tj;j1++){ /* For any combination of dummy covariates, fixed and varying */ |
printf("Varprob TKresult[nres]=%d j1=%d, nres=%d, cptcovn=%d, cptcoveff=%d tj=%d cptcovs=%d\n", TKresult[nres], j1, nres, cptcovn, cptcoveff, tj, cptcovs); |
/* printf("Varprob TKresult[nres]=%d j1=%d, nres=%d, cptcovn=%d, cptcoveff=%d tj=%d cptcovs=%d\n", TKresult[nres], j1, nres, cptcovn, cptcoveff, tj, cptcovs); */ |
if(tj != 1 && TKresult[nres]!= j1) |
if(tj != 1 && TKresult[nres]!= j1) |
continue; |
continue; |
|
|
Line 7350 To be simple, these graphs help to under
|
Line 9350 To be simple, these graphs help to under
|
|
|
/* Including quantitative variables of the resultline to be done */ |
/* Including quantitative variables of the resultline to be done */ |
for (z1=1; z1<=cptcovs; z1++){ /* Loop on each variable of this resultline */ |
for (z1=1; z1<=cptcovs; z1++){ /* Loop on each variable of this resultline */ |
printf("Varprob modelresult[%d][%d]=%d model=1+age+%s \n",nres, z1, modelresult[nres][z1], model); |
/* printf("Varprob modelresult[%d][%d]=%d model=1+age+%s \n",nres, z1, modelresult[nres][z1], model); */ |
fprintf(ficlog,"Varprob modelresult[%d][%d]=%d model=1+age+%s \n",nres, z1, modelresult[nres][z1], model); |
fprintf(ficlog,"Varprob modelresult[%d][%d]=%d model=1+age+%s \n",nres, z1, modelresult[nres][z1], model); |
/* fprintf(ficlog,"Varprob modelresult[%d][%d]=%d model=1+age+%s resultline[%d]=%s \n",nres, z1, modelresult[nres][z1], model, nres, resultline[nres]); */ |
/* fprintf(ficlog,"Varprob modelresult[%d][%d]=%d model=1+age+%s resultline[%d]=%s \n",nres, z1, modelresult[nres][z1], model, nres, resultline[nres]); */ |
if(Dummy[modelresult[nres][z1]]==0){/* Dummy variable of the variable in position modelresult in the model corresponding to z1 in resultline */ |
if(Dummy[modelresult[nres][z1]]==0){/* Dummy variable of the variable in position modelresult in the model corresponding to z1 in resultline */ |
Line 7416 To be simple, these graphs help to under
|
Line 9416 To be simple, these graphs help to under
|
cov[3]= age*age; |
cov[3]= age*age; |
/* New code end of combination but for each resultline */ |
/* New code end of combination but for each resultline */ |
for(k1=1;k1<=cptcovt;k1++){ /* loop on model equation (including products) */ |
for(k1=1;k1<=cptcovt;k1++){ /* loop on model equation (including products) */ |
if(Typevar[k1]==1){ /* A product with age */ |
if(Typevar[k1]==1 || Typevar[k1] ==3){ /* A product with age */ |
cov[2+nagesqr+k1]=precov[nres][k1]*cov[2]; |
cov[2+nagesqr+k1]=precov[nres][k1]*cov[2]; |
}else{ |
}else{ |
cov[2+nagesqr+k1]=precov[nres][k1]; |
cov[2+nagesqr+k1]=precov[nres][k1]; |
Line 7677 void printinghtml(char fileresu[], char
|
Line 9677 void printinghtml(char fileresu[], char
|
int popforecast, int mobilav, int prevfcast, int mobilavproj, int prevbcast, int estepm , \ |
int popforecast, int mobilav, int prevfcast, int mobilavproj, int prevbcast, int estepm , \ |
double jprev1, double mprev1,double anprev1, double dateprev1, double dateprojd, double dateback1, \ |
double jprev1, double mprev1,double anprev1, double dateprev1, double dateprojd, double dateback1, \ |
double jprev2, double mprev2,double anprev2, double dateprev2, double dateprojf, double dateback2){ |
double jprev2, double mprev2,double anprev2, double dateprev2, double dateprojf, double dateback2){ |
int jj1, k1, i1, cpt, k4, nres; |
int jj1, k1, cpt, nres; |
/* In fact some results are already printed in fichtm which is open */ |
/* In fact some results are already printed in fichtm which is open */ |
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 \ |
Line 7814 divided by h: <sub>h</sub>P<sub>ij</sub>
|
Line 9814 divided by h: <sub>h</sub>P<sub>ij</sub>
|
<img src=\"%s_%d-3-%d.svg\">",stepm,subdirf2(optionfilefiname,"PE_"),k1,nres,subdirf2(optionfilefiname,"PE_"),k1,nres,subdirf2(optionfilefiname,"PE_"),k1,nres); |
<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. And probability to be observed 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>", cpt, cpt, nlstate, subdirf2(optionfilefiname,"LIJ_"),cpt,k1,nres,subdirf2(optionfilefiname,"LIJ_"),cpt,k1,nres); |
fprintf(fichtm,"<br>\n- Survival functions in state %d. And probability to be observed in state %d being in state (1 to %d) at different ages. Mean times spent in state (or Life Expectancy or Health Expectancy etc.) are the areas under each curve. <a href=\"%s_%d-%d-%d.svg\">%s_%d-%d-%d.svg</a><br>", cpt, cpt, nlstate, subdirf2(optionfilefiname,"LIJ_"),cpt,k1,nres,subdirf2(optionfilefiname,"LIJ_"),cpt,k1,nres); |
fprintf(fichtm," (data from text file <a href=\"%s.txt\">%s.txt</a>)\n<br>",subdirf2(optionfilefiname,"PIJ_"),subdirf2(optionfilefiname,"PIJ_")); |
fprintf(fichtm," (data from text file <a href=\"%s.txt\">%s.txt</a>)\n<br>",subdirf2(optionfilefiname,"PIJ_"),subdirf2(optionfilefiname,"PIJ_")); |
fprintf(fichtm,"<img src=\"%s_%d-%d-%d.svg\">",subdirf2(optionfilefiname,"LIJ_"),cpt,k1,nres); |
fprintf(fichtm,"<img src=\"%s_%d-%d-%d.svg\">",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 in state %d and in any other live state (total).\ |
fprintf(fichtm,"<br>\n- Survival functions in state %d and in any other live state (total).\ |
And probability to be observed in various states (up to %d) being in state %d at different ages. \ |
And probability to be observed in various states (up to %d) being in state %d at different ages. Mean times spent in state (or Life Expectancy or Health Expectancy etc.) are the areas under each curve. \ |
<a href=\"%s_%d-%d-%d.svg\">%s_%d-%d-%d.svg</a><br> ", cpt, nlstate, cpt, subdirf2(optionfilefiname,"LIJT_"),cpt,k1,nres,subdirf2(optionfilefiname,"LIJT_"),cpt,k1,nres); |
<a href=\"%s_%d-%d-%d.svg\">%s_%d-%d-%d.svg</a><br> ", cpt, nlstate, cpt, subdirf2(optionfilefiname,"LIJT_"),cpt,k1,nres,subdirf2(optionfilefiname,"LIJT_"),cpt,k1,nres); |
fprintf(fichtm," (data from text file <a href=\"%s.txt\">%s.txt</a>)\n<br>",subdirf2(optionfilefiname,"PIJ_"),subdirf2(optionfilefiname,"PIJ_")); |
fprintf(fichtm," (data from text file <a href=\"%s.txt\">%s.txt</a>)\n<br>",subdirf2(optionfilefiname,"PIJ_"),subdirf2(optionfilefiname,"PIJ_")); |
fprintf(fichtm,"<img src=\"%s_%d-%d-%d.svg\">",subdirf2(optionfilefiname,"LIJT_"),cpt,k1,nres); |
fprintf(fichtm,"<img src=\"%s_%d-%d-%d.svg\">",subdirf2(optionfilefiname,"LIJT_"),cpt,k1,nres); |
} |
} |
/* Period (forward stable) prevalence in each health state */ |
/* Period (forward 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 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>", cpt, nlstate, cpt, subdirf2(optionfilefiname,"P_"),cpt,k1,nres,subdirf2(optionfilefiname,"P_"),cpt,k1,nres); |
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 alive in state %d some years after. <a href=\"%s_%d-%d-%d.svg\">%s_%d-%d-%d.svg</a><br>", cpt, nlstate, cpt, subdirf2(optionfilefiname,"P_"),cpt,k1,nres,subdirf2(optionfilefiname,"P_"),cpt,k1,nres); |
fprintf(fichtm," (data from text file <a href=\"%s.txt\">%s.txt</a>)\n<br>",subdirf2(optionfilefiname,"PIJ_"),subdirf2(optionfilefiname,"PIJ_")); |
fprintf(fichtm," (data from text file <a href=\"%s.txt\">%s.txt</a>)\n<br>",subdirf2(optionfilefiname,"PIJ_"),subdirf2(optionfilefiname,"PIJ_")); |
fprintf(fichtm,"<img src=\"%s_%d-%d-%d.svg\">" ,subdirf2(optionfilefiname,"P_"),cpt,k1,nres); |
fprintf(fichtm,"<img src=\"%s_%d-%d-%d.svg\">" ,subdirf2(optionfilefiname,"P_"),cpt,k1,nres); |
} |
} |
Line 7853 divided by h: <sub>h</sub>P<sub>ij</sub>
|
Line 9853 divided by h: <sub>h</sub>P<sub>ij</sub>
|
/* Back projection of prevalence up to stable (mixed) back-prevalence in each health state */ |
/* Back projection of prevalence up to stable (mixed) back-prevalence in each health state */ |
for(cpt=1; cpt<=nlstate;cpt++){ |
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), \ |
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 \ |
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) \ |
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>", dateprev1, dateprev2, mobilavproj, dateback1, dateback2, cpt, cpt, nlstate, subdirf2(optionfilefiname,"PROJB_"),cpt,k1,nres,subdirf2(optionfilefiname,"PROJB_"),cpt,k1,nres); |
with weights corresponding to observed prevalence at different ages. <a href=\"%s_%d-%d-%d.svg\">%s_%d-%d-%d.svg</a>", dateprev1, dateprev2, mobilavproj, dateback1, dateback2, cpt, cpt, nlstate, subdirf2(optionfilefiname,"PROJB_"),cpt,k1,nres,subdirf2(optionfilefiname,"PROJB_"),cpt,k1,nres); |
fprintf(fichtm," (data from text file <a href=\"%s.txt\">%s.txt</a>)\n<br>",subdirf2(optionfilefiname,"FB_"),subdirf2(optionfilefiname,"FB_")); |
fprintf(fichtm," (data from text file <a href=\"%s.txt\">%s.txt</a>)\n<br>",subdirf2(optionfilefiname,"FB_"),subdirf2(optionfilefiname,"FB_")); |
fprintf(fichtm," <img src=\"%s_%d-%d-%d.svg\">", subdirf2(optionfilefiname,"PROJB_"),cpt,k1,nres); |
fprintf(fichtm," <img src=\"%s_%d-%d-%d.svg\">", subdirf2(optionfilefiname,"PROJB_"),cpt,k1,nres); |
Line 7992 prevalence (with 95%% confidence interva
|
Line 9992 prevalence (with 95%% confidence interva
|
fprintf(fichtm,"<img src=\"%s_%d-%d-%d.svg\">",subdirf2(optionfilefiname,"V_"), cpt,k1,nres); |
fprintf(fichtm,"<img src=\"%s_%d-%d-%d.svg\">",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 each live states (1 to %d). If popbased=1 the smooth (due to the model) \ |
health expectancies in each live state (1 to %d) with confidence intervals \ |
|
on left y-scale as well as proportions of time spent in each live state \ |
|
(with confidence intervals) on right y-scale 0 to 100%%.\ |
|
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-%d.svg\">%s_%d-%d.svg</a>",nlstate, subdirf2(optionfilefiname,"E_"),k1,nres,subdirf2(optionfilefiname,"E_"),k1,nres); |
observed and cahotic prevalences: <a href=\"%s_%d-%d.svg\">%s_%d-%d.svg</a>",nlstate, subdirf2(optionfilefiname,"E_"),k1,nres,subdirf2(optionfilefiname,"E_"),k1,nres); |
Line 8007 true period expectancies (those weighted
|
Line 10010 true period expectancies (those weighted
|
/******************* Gnuplot file **************/ |
/******************* Gnuplot file **************/ |
void printinggnuplot(char fileresu[], char optionfilefiname[], double ageminpar, double agemaxpar, double bage, double fage , int prevfcast, int prevbcast, char pathc[], double p[], int offyear, int offbyear){ |
void printinggnuplot(char fileresu[], char optionfilefiname[], double ageminpar, double agemaxpar, double bage, double fage , int prevfcast, int prevbcast, char pathc[], double p[], int offyear, int offbyear){ |
|
|
char dirfileres[132],optfileres[132]; |
char dirfileres[256],optfileres[256]; |
char gplotcondition[132], gplotlabel[132]; |
char gplotcondition[256], gplotlabel[256]; |
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 cpt=0,k1=0,i=0,k=0,j=0,jk=0,k2=0,k3=0,k4=0,kf=0,kvar=0,kk=0,ipos=0,iposold=0,ij=0, ijp=0, l=0; |
int lv=0, vlv=0, kl=0; |
/* int lv=0, vlv=0, kl=0; */ |
|
int lv=0, kl=0; |
|
double vlv=0; |
int ng=0; |
int ng=0; |
int vpopbased; |
int vpopbased; |
int ioffset; /* variable offset for columns */ |
int ioffset; /* variable offset for columns */ |
Line 8035 void printinggnuplot(char fileresu[], ch
|
Line 10040 void printinggnuplot(char fileresu[], ch
|
fprintf(ficgp,"yoff=(%d > 2? 0:1);\n",nlstate); |
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#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#Centripete arrows (turning in other direction (1-i) instead of (i-1)) \nset for [i=1:%d] for [j=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,nlstate); |
fprintf(ficgp,"\n#show arrow\nunset label\n"); |
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,"\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,"\nset label %d+1 sprintf(\"State %%d\",%d+1) center at 0.,0. font \"helvetica, 16\" tc rgbcolor \"red\"\n",nlstate,nlstate); |
Line 8072 void printinggnuplot(char fileresu[], ch
|
Line 10077 void printinggnuplot(char fileresu[], ch
|
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_")); */ |
|
|
|
/* Plot the probability implied in the likelihood by covariate value */ |
|
fprintf(ficgp,"\nset ter pngcairo size 640, 480"); |
|
/* if(debugILK==1){ */ |
|
for(kf=1; kf <= ncovf; kf++){ /* For each simple dummy covariate of the model */ |
|
kvar=Tvar[TvarFind[kf]]; /* variable name */ |
|
/* k=18+Tvar[TvarFind[kf]];/\*offset because there are 18 columns in the ILK_ file but could be placed else where *\/ */ |
|
/* k=18+kf;/\*offset because there are 18 columns in the ILK_ file *\/ */ |
|
/* k=19+kf;/\*offset because there are 19 columns in the ILK_ file *\/ */ |
|
k=16+nlstate+kf;/*offset because there are 19 columns in the ILK_ file, first cov Vn on col 21 with 4 living states */ |
|
for (i=1; i<= nlstate ; i ++) { |
|
fprintf(ficgp,"\nset out \"%s-p%dj-%d.png\";set ylabel \"Probability for each individual/wave\";",subdirf2(optionfilefiname,"ILK_"),i,kvar); |
|
fprintf(ficgp,"unset log;\n# For each simple dummy covariate of the model \n plot \"%s\"",subdirf(fileresilk)); |
|
if(gnuplotversion >=5.2){ /* Former gnuplot versions do not have variable pointsize!! */ |
|
fprintf(ficgp," u 2:($5 == %d && $6==%d ? $10 : 1/0):($%d==0 ? 7 : 9):($%d==0 ? $6 : $6+4) t \"p%d%d V%d\" with points pt variable ps 0.4 lc variable \\\n",i,1,k,k,i,1,kvar); |
|
for (j=2; j<= nlstate+ndeath ; j ++) { |
|
fprintf(ficgp,",\\\n \"\" u 2:($5 == %d && $6==%d ? $10 : 1/0):($%d==0 ? 7 : 9):($%d==0 ? $6 : $6+4) t \"p%d%d V%d\" with points pt variable ps 0.4 lc variable ",i,j,k,k,i,j,kvar); |
|
} |
|
}else{ |
|
fprintf(ficgp," u 2:($5 == %d && $6==%d ? $10 : 1/0):($%d==0 ? $6 : $6+4) t \"p%d%d V%d\" with points pt 7 ps 0.4 lc variable \\\n",i,1,k,i,1,kvar); |
|
for (j=2; j<= nlstate+ndeath ; j ++) { |
|
fprintf(ficgp,",\\\n \"\" u 2:($5 == %d && $6==%d ? $10 : 1/0):($%d==0 ? $6 : $6+4) t \"p%d%d V%d\" with points pt 7 ps 0.4 lc variable ",i,j,k,i,j,kvar); |
|
} |
|
} |
|
fprintf(ficgp,";\nset out; unset ylabel;\n"); |
|
} |
|
} /* End of each covariate dummy */ |
|
for(ncovv=1, iposold=0, kk=0; ncovv <= ncovvt ; ncovv++){ |
|
/* Other example V1 + V3 + V5 + age*V1 + age*V3 + age*V5 + V1*V3 + V3*V5 + V1*V5 |
|
* kmodel = 1 2 3 4 5 6 7 8 9 |
|
* varying 1 2 3 4 5 |
|
* ncovv 1 2 3 4 5 6 7 8 |
|
* TvarVV[ncovv] V3 5 1 3 3 5 1 5 |
|
* TvarVVind[ncovv]=kmodel 2 3 7 7 8 8 9 9 |
|
* TvarFind[kmodel] 1 0 0 0 0 0 0 0 0 |
|
* kdata ncovcol=[V1 V2] nqv=0 ntv=[V3 V4] nqtv=V5 |
|
* Dummy[kmodel] 0 0 1 2 2 3 1 1 1 |
|
*/ |
|
ipos=TvarVVind[ncovv]; /* TvarVVind={2, 5, 5] gives the position in the model of the ncovv th varying covariate */ |
|
kvar=TvarVV[ncovv]; /* TvarVV={3, 1, 3} gives the name of each varying covariate */ |
|
/* printf("DebugILK ficgp ncovv=%d, kvar=TvarVV[ncovv]=%d, ipos=TvarVVind[ncovv]=%d, Dummy[ipos]=%d, Typevar[ipos]=%d\n", ncovv,kvar,ipos,Dummy[ipos],Typevar[ipos]); */ |
|
if(ipos!=iposold){ /* Not a product or first of a product */ |
|
/* printf(" %d",ipos); */ |
|
/* fprintf(ficresilk," V%d",TvarVV[ncovv]); */ |
|
/* printf(" DebugILK ficgp suite ipos=%d != iposold=%d\n", ipos, iposold); */ |
|
kk++; /* Position of the ncovv column in ILK_ */ |
|
k=18+ncovf+kk; /*offset because there are 18 columns in the ILK_ file plus ncovf fixed covariate */ |
|
if(Dummy[ipos]==0 && Typevar[ipos]==0){ /* Only if dummy time varying: Dummy(0, 1=quant singor prod without age,2 dummy*age, 3quant*age) Typevar (0 single, 1=*age,2=Vn*vm) */ |
|
for (i=1; i<= nlstate ; i ++) { |
|
fprintf(ficgp,"\nset out \"%s-p%dj-%d.png\";set ylabel \"Probability for each individual/wave\";",subdirf2(optionfilefiname,"ILK_"),i,kvar); |
|
fprintf(ficgp,"unset log;\n# For each simple dummy covariate of the model \n plot \"%s\"",subdirf(fileresilk)); |
|
|
|
/* printf("Before DebugILK gnuplotversion=%g >=5.2\n",gnuplotversion); */ |
|
if(gnuplotversion >=5.2){ /* Former gnuplot versions do not have variable pointsize!! */ |
|
/* printf("DebugILK gnuplotversion=%g >=5.2\n",gnuplotversion); */ |
|
fprintf(ficgp," u 2:($5 == %d && $6==%d ? $10 : 1/0):($%d==0 ? 7 : 9):($%d==0 ? $6 : $6+4) t \"p%d%d V%d\" with points pt variable ps 0.4 lc variable \\\n",i,1,k,k,i,1,kvar); |
|
for (j=2; j<= nlstate+ndeath ; j ++) { |
|
fprintf(ficgp,",\\\n \"\" u 2:($5 == %d && $6==%d ? $10 : 1/0):($%d==0 ? 7 : 9):($%d==0 ? $6 : $6+4) t \"p%d%d V%d\" with points pt variable ps 0.4 lc variable ",i,j,k,k,i,j,kvar); |
|
} |
|
}else{ |
|
/* printf("DebugILK gnuplotversion=%g <5.2\n",gnuplotversion); */ |
|
fprintf(ficgp," u 2:($5 == %d && $6==%d ? $10 : 1/0):($%d==0 ? $6 : $6+4) t \"p%d%d V%d\" with points pt 7 ps 0.4 lc variable \\\n",i,1,k,i,1,kvar); |
|
for (j=2; j<= nlstate+ndeath ; j ++) { |
|
fprintf(ficgp,",\\\n \"\" u 2:($5 == %d && $6==%d ? $10 : 1/0):($%d==0 ? $6 : $6+4) t \"p%d%d V%d\" with points pt 7 ps 0.4 lc variable ",i,j,k,i,j,kvar); |
|
} |
|
} |
|
fprintf(ficgp,";\nset out; unset ylabel;\n"); |
|
} |
|
}/* End if dummy varying */ |
|
}else{ /*Product */ |
|
/* printf("*"); */ |
|
/* fprintf(ficresilk,"*"); */ |
|
} |
|
iposold=ipos; |
|
} /* For each time varying covariate */ |
|
/* } /\* debugILK==1 *\/ */ |
|
/* unset log; plot "rrtest1_sorted_4/ILK_rrtest1_sorted_4.txt" u 2:($4 == 1 && $5==2 ? $9 : 1/0):5 t "p12" with points lc variable */ |
|
/* fprintf(ficgp,"\nset log y;plot \"%s\" u 2:(-$11):3 t \"All sample, all transitions\" with dots lc variable",subdirf(fileresilk)); */ |
|
/* fprintf(ficgp,"\nreplot \"%s\" u 2:($3 <= 3 ? -$11 : 1/0):3 t \"First 3 individuals\" with line lc variable", subdirf(fileresilk)); */ |
|
fprintf(ficgp,"\nset out;unset log\n"); |
|
/* fprintf(ficgp,"\nset out \"%s.svg\"; replot; set out; # bug gnuplot",subdirf2(optionfilefiname,"ILK_")); */ |
|
|
|
|
|
|
strcpy(dirfileres,optionfilefiname); |
strcpy(dirfileres,optionfilefiname); |
strcpy(optfileres,"vpl"); |
strcpy(optfileres,"vpl"); |
/* 1eme*/ |
/* 1eme*/ |
Line 8121 void printinggnuplot(char fileresu[], ch
|
Line 10209 void printinggnuplot(char fileresu[], ch
|
fprintf(ficgp,"\n#set out \"V_%s_%d-%d-%d.svg\" \n",optionfilefiname,cpt,k1,nres); |
fprintf(ficgp,"\n#set out \"V_%s_%d-%d-%d.svg\" \n",optionfilefiname,cpt,k1,nres); |
/* fprintf(ficgp,"set label \"Alive state %d %s\" at graph 0.98,0.5 center rotate font \"Helvetica,12\"\n",cpt,gplotlabel); */ |
/* fprintf(ficgp,"set label \"Alive state %d %s\" at graph 0.98,0.5 center rotate font \"Helvetica,12\"\n",cpt,gplotlabel); */ |
fprintf(ficgp,"set title \"Alive state %d %s model=1+age+%s\" font \"Helvetica,12\"\n",cpt,gplotlabel,model); |
fprintf(ficgp,"set title \"Alive state %d %s model=1+age+%s\" font \"Helvetica,12\"\n",cpt,gplotlabel,model); |
fprintf(ficgp,"set xlabel \"Age\" \nset ylabel \"Probability\" \nset ter svg size 640, 480\nplot [%.f:%.f] \"%s\" every :::%d::%d u 1:($2==%d ? $3:1/0) \"%%lf %%lf",ageminpar,fage,subdirf2(fileresu,"VPL_"),nres-1,nres-1,nres); |
fprintf(ficgp,"set xlabel \"Age\" \nset ylabel \"Probability\" \nset ter svg size 640, 480\nplot [%.f:%.f] [0:1] \"%s\" every :::%d::%d u 1:($2==%d ? $3:1/0) \"%%lf %%lf",ageminpar,fage,subdirf2(fileresu,"VPL_"),nres-1,nres-1,nres); |
/* fprintf(ficgp,"set xlabel \"Age\" \nset ylabel \"Probability\" \nset ter svg size 640, 480\nplot [%.f:%.f] \"%s\" every :::%d::%d u 1:($2==%d ? $3:1/0) \"%%lf %%lf",ageminpar,fage,subdirf2(fileresu,"VPL_"),k1-1,k1-1,nres); */ |
/* fprintf(ficgp,"set xlabel \"Age\" \nset ylabel \"Probability\" \nset ter svg size 640, 480\nplot [%.f:%.f] \"%s\" every :::%d::%d u 1:($2==%d ? $3:1/0) \"%%lf %%lf",ageminpar,fage,subdirf2(fileresu,"VPL_"),k1-1,k1-1,nres); */ |
/* k1-1 error should be nres-1*/ |
/* k1-1 error should be nres-1*/ |
for (i=1; i<= nlstate ; i ++) { |
for (i=1; i<= nlstate ; i ++) { |
Line 8263 void printinggnuplot(char fileresu[], ch
|
Line 10351 void printinggnuplot(char fileresu[], ch
|
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*/ |
fprintf(ficgp,"\nset label \"popbased %d %s\" at graph 0.98,0.5 center rotate font \"Helvetica,12\"\n",vpopbased,gplotlabel); |
fprintf(ficgp,"\nset label \"popbased %d %s\" at graph 0.98,0.5 center rotate font \"Helvetica,12\"\n",vpopbased,gplotlabel); |
if(vpopbased==0){ |
if(vpopbased==0){ |
fprintf(ficgp,"set ylabel \"Years\" \nset ter svg size 640, 480\nplot [%.f:%.f] ",ageminpar,fage); |
fprintf(ficgp,"set ylabel \"Years\" \nset ter svg size 640, 480\nunset ytics; unset y2tics; set ytics nomirror; set y2tics 0,10,100;set y2range [0:100];\nplot [%.f:%.f] ",ageminpar,fage); |
}else |
}else |
fprintf(ficgp,"\nreplot "); |
fprintf(ficgp,"\nreplot "); |
for (i=1; i<= nlstate+1 ; i ++) { |
for (i=1; i<= nlstate+1 ; i ++) { /* For state i-1=0 is LE, while i-1=1 to nlstate are origin state */ |
k=2*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); |
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 fixed variables age, popbased, mobilav */ |
for (j=1; j<= nlstate+1 ; j ++) { |
for (j=1; j<= nlstate+1 ; j ++) { /* e.. e.1 e.2 again j-1 is the state of end, wlim_i eij*/ |
if (j==i) fprintf(ficgp," %%lf (%%lf)"); |
if (j==i) fprintf(ficgp," %%lf (%%lf)"); /* We want to read e.. i=1,j=1, e.1 i=2,j=2, e.2 i=3,j=3 */ |
else fprintf(ficgp," %%*lf (%%*lf)"); |
else fprintf(ficgp," %%*lf (%%*lf)"); /* skipping that field with a star */ |
} |
} |
if (i== 1) fprintf(ficgp,"\" t\"TLE\" w l lt %d, \\\n",i); |
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); |
else fprintf(ficgp,"\" t\"LE in state (%d)\" w l lt %d, \\\n",i-1,i+1); /* state=i-1=1 to nlstate */ |
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); |
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 ++) { |
for (j=1; j<= nlstate+1 ; j ++) { |
if (j==i) fprintf(ficgp," %%lf (%%lf)"); |
if (j==i) fprintf(ficgp," %%lf (%%lf)"); |
Line 8286 void printinggnuplot(char fileresu[], ch
|
Line 10374 void printinggnuplot(char fileresu[], ch
|
if (j==i) 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"); |
if (i== (nlstate+1)) fprintf(ficgp,"\" t\"\" w l lt 0,\\\n"); /* ,\\\n added for th percentage graphs */ |
else fprintf(ficgp,"\" t\"\" w l lt 0,\\\n"); |
else fprintf(ficgp,"\" t\"\" w l lt 0,\\\n"); |
} /* state */ |
} /* state */ |
|
/* again for the percentag spent in state i-1=1 to i-1=nlstate */ |
|
for (i=2; i<= nlstate+1 ; i ++) { /* For state i-1=0 is LE, while i-1=1 to nlstate are origin state */ |
|
k=2*i; |
|
fprintf(ficgp,"\"%s\" every :::%d::%d u 1:($2==%d && ($4)<=1 && ($4)>=0 ?($4)*100. : 1/0) \"%%lf %%lf %%lf",subdirf2(fileresu,"T_"),nres-1,nres-1, vpopbased); /* for fixed variables age, popbased, mobilav */ |
|
for (j=1; j<= nlstate ; j ++) |
|
fprintf(ficgp," %%*lf (%%*lf)"); /* Skipping TLE and LE to read %LE only */ |
|
for (j=1; j<= nlstate+1 ; j ++) { /* e.. e.1 e.2 again j-1 is the state of end, wlim_i eij*/ |
|
if (j==i) fprintf(ficgp," %%lf (%%lf)"); /* We want to read e.. i=1,j=1, e.1 i=2,j=2, e.2 i=3,j=3 */ |
|
else fprintf(ficgp," %%*lf (%%*lf)"); /* skipping that field with a star */ |
|
} |
|
if (i== 1) fprintf(ficgp,"\" t\"%%TLE\" w l lt %d axis x1y2, \\\n",i); /* Not used */ |
|
else fprintf(ficgp,"\" t\"%%LE in state (%d)\" w l lw 2 lt %d axis x1y2, \\\n",i-1,i+1); /* state=i-1=1 to nlstate */ |
|
fprintf(ficgp,"\"%s\" every :::%d::%d u 1:($2==%d && ($4-$5*2)<=1 && ($4-$5*2)>=0? ($4-$5*2)*100. : 1/0) \"%%lf %%lf %%lf",subdirf2(fileresu,"T_"),nres-1,nres-1,vpopbased); |
|
for (j=1; j<= nlstate ; j ++) |
|
fprintf(ficgp," %%*lf (%%*lf)"); /* Skipping TLE and LE to read %LE only */ |
|
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 axis x1y2,"); |
|
fprintf(ficgp,"\"%s\" every :::%d::%d u 1:($2==%d && ($4+$5*2)<=1 && ($4+$5*2)>=0 ? ($4+$5*2)*100. : 1/0) \"%%lf %%lf %%lf",subdirf2(fileresu,"T_"),nres-1,nres-1,vpopbased); |
|
for (j=1; j<= nlstate ; j ++) |
|
fprintf(ficgp," %%*lf (%%*lf)"); /* Skipping TLE and LE to read %LE only */ |
|
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 axis x1y2"); |
|
else fprintf(ficgp,"\" t\"\" w l lt 0 axis x1y2,\\\n"); |
|
} /* state for percent */ |
} /* vpopbased */ |
} /* vpopbased */ |
fprintf(ficgp,"\nset out;set out \"%s_%d-%d.svg\"; replot; set out; unset label;\n",subdirf2(optionfilefiname,"E_"),k1,nres); /* Buggy gnuplot */ |
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 */ |
} /* end nres */ |
Line 8656 set ter svg size 640, 480\nunset log y\n
|
Line 10774 set ter svg size 640, 480\nunset log y\n
|
}else{ |
}else{ |
fprintf(ficgp,",\\\n '' "); |
fprintf(ficgp,",\\\n '' "); |
} |
} |
if(cptcoveff ==0){ /* No covariate */ |
/* if(cptcoveff ==0){ /\* No covariate *\/ */ |
|
if(cptcovs ==0){ /* No covariate */ |
ioffset=2; /* Age is in 2 */ |
ioffset=2; /* Age is in 2 */ |
/*# yearproj age p11 p21 p31 p.1 p12 p22 p32 p.2 p13 p23 p33 p.3 p14 p24 p34 p.4*/ |
/*# yearproj age p11 p21 p31 p.1 p12 p22 p32 p.2 p13 p23 p33 p.3 p14 p24 p34 p.4*/ |
/*# 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 */ |
/*# 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 */ |
/*# V1 = 1 yearproj age p11 p21 p31 p.1 p12 p22 p32 p.2 p13 p23 p33 p.3 p14 p24 p34 p.4*/ |
/*# 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 */ |
/*# 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 */ |
|
/*# V1 = 1 yearproj age 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); |
fprintf(ficgp," u %d:(", ioffset); |
if(i==nlstate+1){ |
if(i==nlstate+1){ |
fprintf(ficgp," $%d/(1.-$%d)):1 t 'pw.%d' with line lc variable ", \ |
fprintf(ficgp," $%d/(1.-$%d)):1 t 'pw.%d' with line lc variable ", \ |
Line 8675 set ter svg size 640, 480\nunset log y\n
|
Line 10796 set ter svg size 640, 480\nunset log y\n
|
fprintf(ficgp," $%d/(1.-$%d)) t 'p%d%d' with line ", \ |
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 ); |
ioffset+(cpt-1)*(nlstate+1)+1+(i-1), ioffset+1+(i-1)+(nlstate+1)*nlstate,i,cpt ); |
}else{ /* more than 2 covariates */ |
}else{ /* more than 2 covariates */ |
ioffset=2*cptcoveff+2; /* Age is in 4 or 6 or etc.*/ |
/* ioffset=2*cptcoveff+2; */ /* Age is in 4 or 6 or etc.*/ |
|
ioffset=2*cptcovs+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*/ |
/*# 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 */ |
/*# 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 */ |
|
/* # Forecasting at date 3/1/2003 */ |
|
/* V1=0 V2=1 V3=0 V6=2.47 yearproj age */ |
|
/* # 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 */ |
|
/* # p11 p21 p31 wp.1 p12 p22 p32 wp.2 p13 p23 p33 wp.3 p14 p24 p34 wp.4 */ |
|
/* 1 0 2 1 3 0 6 2.47 2003 100 1.000 0.000 0.000 0.297 0.000 1.000 0.000 0.207 0.000 0.000 1.000 0.497 0.000 0.000 0.000 0.000 */ |
iyearc=ioffset-1; |
iyearc=ioffset-1; |
iagec=ioffset; |
iagec=ioffset; |
fprintf(ficgp," u %d:(",ioffset); |
fprintf(ficgp," u %d:(",ioffset); |
kl=0; |
kl=0; |
strcpy(gplotcondition,"("); |
strcpy(gplotcondition,"("); |
for (k=1; k<=cptcoveff; k++){ /* For each covariate writing the chain of conditions */ |
/* 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 *\/ */ |
/* lv= decodtabm(k1,k,cptcoveff); /\* Should be the covariate value corresponding to combination k1 and covariate k *\/ */ |
lv=codtabm(k1,TnsdVar[Tvaraff[k]]); |
for (k=1; k<=cptcovs; k++){ /* For each covariate k get corresponding value lv for combination k1 */ |
|
/* lv=codtabm(k1,TnsdVar[Tvaraff[k]]); */ |
|
lv=Tvresult[nres][k]; |
|
vlv=TinvDoQresult[nres][Tvresult[nres][k]]; |
/* decodtabm(1,1,4) = 1 because h=1 k= (1) 1 1 1 */ |
/* decodtabm(1,1,4) = 1 because h=1 k= (1) 1 1 1 */ |
/* decodtabm(1,2,4) = 1 because h=1 k= 1 (1) 1 1 */ |
/* decodtabm(1,2,4) = 1 because h=1 k= 1 (1) 1 1 */ |
/* decodtabm(13,3,4)= 2 because h=13 k= 1 1 (2) 2 */ |
/* decodtabm(13,3,4)= 2 because h=13 k= 1 1 (2) 2 */ |
/* vlv= nbcode[Tvaraff[k]][lv]; /\* Value of the modality of Tvaraff[k] *\/ */ |
/* vlv= nbcode[Tvaraff[k]][lv]; /\* Value of the modality of Tvaraff[k] *\/ */ |
vlv= nbcode[Tvaraff[k]][codtabm(k1,TnsdVar[Tvaraff[k]])]; |
/* vlv= nbcode[Tvaraff[k]][codtabm(k1,TnsdVar[Tvaraff[k]])]; */ |
kl++; |
kl++; |
sprintf(gplotcondition+strlen(gplotcondition),"$%d==%d && $%d==%d " ,kl,Tvaraff[k], kl+1, nbcode[Tvaraff[k]][lv]); |
/* Problem with quantitative variables TinvDoQresult[nres] */ |
|
/* sprintf(gplotcondition+strlen(gplotcondition),"$%d==%d && $%d==%d " ,kl,Tvaraff[k], kl+1, nbcode[Tvaraff[k]][lv]); */ |
|
sprintf(gplotcondition+strlen(gplotcondition),"$%d==%d && $%d==%lg " ,kl,lv, kl+1, vlv );/* Solved but quantitative must be shifted */ |
kl++; |
kl++; |
if(k <cptcoveff && cptcoveff>1) |
if(k <cptcovs && cptcovs>1) |
sprintf(gplotcondition+strlen(gplotcondition)," && "); |
sprintf(gplotcondition+strlen(gplotcondition)," && "); |
} |
} |
strcpy(gplotcondition+strlen(gplotcondition),")"); |
strcpy(gplotcondition+strlen(gplotcondition),")"); |
Line 8706 set ter svg size 640, 480\nunset log y\n
|
Line 10838 set ter svg size 640, 480\nunset log y\n
|
fprintf(ficgp,"%s ? $%d/(1.-$%d) : 1/0):%d t 'p.%d' with line lc variable", gplotcondition, \ |
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 ); |
ioffset+(cpt-1)*(nlstate+1)+1+(i-1), ioffset+1+(i-1)+(nlstate+1)*nlstate,iyearc, cpt ); |
fprintf(ficgp,",\\\n '' "); |
fprintf(ficgp,",\\\n '' "); |
fprintf(ficgp," u %d:(",iagec); |
fprintf(ficgp," u %d:(",iagec); /* Below iyearc should be increades if quantitative variable in the reult line */ |
|
/* $7==6 && $8==2.47 ) && (($9-$10) == 1953 ) ? $12/(1.-$24) : 1/0):7 with labels center not */ |
|
/* but was && $7==6 && $8==2 ) && (($7-$8) == 1953 ) ? $12/(1.-$24) : 1/0):7 with labels center not */ |
fprintf(ficgp,"%s && (($%d-$%d) == %d ) ? $%d/(1.-$%d) : 1/0):%d with labels center not ", gplotcondition, \ |
fprintf(ficgp,"%s && (($%d-$%d) == %d ) ? $%d/(1.-$%d) : 1/0):%d with labels center not ", gplotcondition, \ |
iyearc, iagec, offyear, \ |
iyearc, iagec, offyear, \ |
ioffset+(cpt-1)*(nlstate+1)+1+(i-1), ioffset+1+(i-1)+(nlstate+1)*nlstate, iyearc ); |
ioffset+(cpt-1)*(nlstate+1)+1+(i-1), ioffset+1+(i-1)+(nlstate+1)*nlstate, iyearc ); |
Line 8778 set ter svg size 640, 480\nunset log y\n
|
Line 10912 set ter svg size 640, 480\nunset log y\n
|
}else{ |
}else{ |
fprintf(ficgp,",\\\n '' "); |
fprintf(ficgp,",\\\n '' "); |
} |
} |
if(cptcoveff ==0){ /* No covariate */ |
/* if(cptcoveff ==0){ /\* No covariate *\/ */ |
|
if(cptcovs ==0){ /* No covariate */ |
ioffset=2; /* Age is in 2 */ |
ioffset=2; /* Age is in 2 */ |
/*# yearproj age p11 p21 p31 p.1 p12 p22 p32 p.2 p13 p23 p33 p.3 p14 p24 p34 p.4*/ |
/*# yearproj age p11 p21 p31 p.1 p12 p22 p32 p.2 p13 p23 p33 p.3 p14 p24 p34 p.4*/ |
/*# 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 */ |
/*# 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 */ |
Line 8786 set ter svg size 640, 480\nunset log y\n
|
Line 10921 set ter svg size 640, 480\nunset log y\n
|
/*# 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 */ |
/*# 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 */ |
fprintf(ficgp," u %d:(", ioffset); |
fprintf(ficgp," u %d:(", ioffset); |
if(i==nlstate+1){ |
if(i==nlstate+1){ |
fprintf(ficgp," $%d/(1.-$%d)):1 t 'bw%d' with line lc variable ", \ |
fprintf(ficgp," $%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 ); |
ioffset+(cpt-1)*(nlstate+1)+1+(i-1),cpt ); |
|
/* 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,",\\\n '' "); |
fprintf(ficgp," u %d:(",ioffset); |
fprintf(ficgp," u %d:(",ioffset); |
fprintf(ficgp," (($1-$2) == %d ) ? $%d : 1/0):1 with labels center not ", \ |
fprintf(ficgp," (($1-$2) == %d ) ? $%d : 1/0):1 with labels center not ", \ |
offbyear, \ |
offbyear, \ |
ioffset+(cpt-1)*(nlstate+1)+1+(i-1) ); |
ioffset+(cpt-1)*(nlstate+1)+1+(i-1) ); |
}else |
}else /* not sure divided by 1- to be checked */ |
fprintf(ficgp," $%d/(1.-$%d)) t 'b%d%d' with line ", \ |
fprintf(ficgp," $%d) t 'b%d%d' with line ", \ |
ioffset+(cpt-1)*(nlstate+1)+1+(i-1), ioffset+1+(i-1)+(nlstate+1)*nlstate,cpt,i ); |
ioffset+(cpt-1)*(nlstate+1)+1+(i-1),cpt,i ); |
|
/* 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 */ |
}else{ /* more than 2 covariates */ |
ioffset=2*cptcoveff+2; /* Age is in 4 or 6 or etc.*/ |
/* ioffset=2*cptcoveff+2; /\* Age is in 4 or 6 or etc.*\/ */ |
|
ioffset=2*cptcovs+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*/ |
/*# 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 */ |
/*# 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 */ |
|
/* #****** hbijx=probability over h years, hb.jx is weighted by observed prev */ |
|
/* # V1=0 V2=1 V3=0 V6=2.47 */ |
|
/* yearbproj age b11 b21 b31 b.1 b12 b22 b32 b.2 b13 b23 b33 b.3 b14 b24 b34 b.4 */ |
|
/* # Back Forecasting at date 3/1/2003 */ |
|
/* 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 */ |
|
/* 1 0 2 1 3 0 6 2.47 2003 50 1.000 0.000 0.000 0.714 0.000 1.000 0.000 0.286 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.000 */ |
iyearc=ioffset-1; |
iyearc=ioffset-1; |
iagec=ioffset; |
iagec=ioffset; |
fprintf(ficgp," u %d:(",ioffset); |
fprintf(ficgp," u %d:(",ioffset); |
kl=0; |
kl=0; |
strcpy(gplotcondition,"("); |
strcpy(gplotcondition,"("); |
for (k=1; k<=cptcovs; k++){ /* For each covariate k of the resultline, get corresponding value lv for combination k1 */ |
for (k=1; k<=cptcovs; k++){ /* For each covariate k of the resultline, get corresponding value lv for combination k1 */ |
if(Dummy[modelresult[nres][k]]==0){ /* To be verified */ |
/* if(Dummy[modelresult[nres][k]]==0){ /\* To be verified *\/ */ |
/* for (k=1; k<=cptcoveff; k++){ /\* For each covariate writing the chain of conditions *\/ */ |
/* 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 *\/ */ |
/* lv= decodtabm(k1,k,cptcoveff); /\* Should be the covariate value corresponding to combination k1 and covariate k *\/ */ |
/* lv= codtabm(k1,TnsdVar[Tvaraff[k]]); /\* Should be the covariate value corresponding to combination k1 and covariate k *\/ */ |
/* lv= codtabm(k1,TnsdVar[Tvaraff[k]]); /\* Should be the covariate value corresponding to combination k1 and covariate k *\/ */ |
Line 8823 set ter svg size 640, 480\nunset log y\n
|
Line 10969 set ter svg size 640, 480\nunset log y\n
|
kl++; |
kl++; |
if(k <cptcovs && cptcovs>1) |
if(k <cptcovs && cptcovs>1) |
sprintf(gplotcondition+strlen(gplotcondition)," && "); |
sprintf(gplotcondition+strlen(gplotcondition)," && "); |
} |
/* } */ /* end dummy */ |
} |
} |
strcpy(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 *\/ */ |
/* 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 *\/ */ |
Line 8890 set ter svg size 640, 480\nunset log y\n
|
Line 11036 set ter svg size 640, 480\nunset log y\n
|
fprintf(ficgp,"#Number of graphics: first is logit, 2nd is probabilities, third is incidences per year\n"); |
fprintf(ficgp,"#Number of graphics: first is logit, 2nd is probabilities, third is incidences per year\n"); |
fprintf(ficgp,"#model=1+age+%s \n",model); |
fprintf(ficgp,"#model=1+age+%s \n",model); |
fprintf(ficgp,"# Type of graphic ng=%d\n",ng); |
fprintf(ficgp,"# Type of graphic ng=%d\n",ng); |
fprintf(ficgp,"# k1=1 to 2^%d=%d\n",cptcoveff,m);/* to be checked */ |
/* fprintf(ficgp,"# k1=1 to 2^%d=%d\n",cptcoveff,m);/\* to be checked *\/ */ |
|
fprintf(ficgp,"# k1=1 to 2^%d=%d\n",cptcovs,m);/* to be checked */ |
/* for(k1=1; k1 <=m; k1++) /\* For each combination of covariate *\/ */ |
/* for(k1=1; k1 <=m; k1++) /\* For each combination of covariate *\/ */ |
for(nres=1; nres <= nresult; nres++){ /* For each resultline */ |
for(nres=1; nres <= nresult; nres++){ /* For each resultline */ |
/* k1=nres; */ |
/* k1=nres; */ |
Line 9015 set ter svg size 640, 480\nunset log y\n
|
Line 11162 set ter svg size 640, 480\nunset log y\n
|
} /* end Tprod */ |
} /* end Tprod */ |
} |
} |
break; |
break; |
|
case 3: |
|
if(cptcovdageprod >0){ |
|
/* if(j==Tprod[ijp]) { */ /* not necessary */ |
|
/* printf("Tprod[%d]=%d, j=%d\n", ij, Tprod[ijp], j); */ |
|
if(ijp <=cptcovprod) { /* Product Vn*Vm and age*VN*Vm*/ |
|
if(DummyV[Tvardk[ijp][1]]==0){/* Vn is dummy */ |
|
if(DummyV[Tvardk[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*x",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*x",i+j+2+nagesqr-1,Tinvresult[nres][Tvardk[ijp][1]],Tqinvresult[nres][Tvardk[ijp][2]]); |
|
} |
|
}else{ /* age* Vn*Vm Vn is quanti HERE */ |
|
if(DummyV[Tvard[ijp][2]]==0){ |
|
fprintf(ficgp,"+p%d*%d*%f*x",i+j+2+nagesqr-1,Tinvresult[nres][Tvardk[ijp][2]],Tqinvresult[nres][Tvardk[ijp][1]]); |
|
}else{ /* Both quanti */ |
|
fprintf(ficgp,"+p%d*%f*%f*x",i+j+2+nagesqr-1,Tqinvresult[nres][Tvardk[ijp][1]],Tqinvresult[nres][Tvardk[ijp][2]]); |
|
} |
|
} |
|
ijp++; |
|
} |
|
/* } */ /* end Tprod */ |
|
} |
|
break; |
case 0: |
case 0: |
/* simple covariate */ |
/* simple covariate */ |
/* fprintf(ficgp,"+p%d*%d",i+j+2+nagesqr-1,nbcode[Tvar[j]][codtabm(k1,j)]); /\* Valgrind bug nbcode *\/ */ |
/* fprintf(ficgp,"+p%d*%d",i+j+2+nagesqr-1,nbcode[Tvar[j]][codtabm(k1,j)]); /\* Valgrind bug nbcode *\/ */ |
Line 9101 set ter svg size 640, 480\nunset log y\n
|
Line 11273 set ter svg size 640, 480\nunset log y\n
|
} /* end Tprod */ |
} /* end Tprod */ |
} /* end if */ |
} /* end if */ |
break; |
break; |
|
case 3: |
|
if(cptcovdageprod >0){ |
|
/* if(j==Tprod[ijp]) { /\* *\/ */ |
|
/* printf("Tprod[%d]=%d, j=%d\n", ij, Tprod[ijp], j); */ |
|
if(ijp <=cptcovprod) { /* Product */ |
|
if(DummyV[Tvardk[ijp][1]]==0){/* Vn is dummy */ |
|
if(DummyV[Tvardk[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*x",k3+(cpt-1)*ncovmodel+1+j+nagesqr,Tinvresult[nres][Tvardk[ijp][1]],Tinvresult[nres][Tvardk[ijp][2]]); |
|
/* 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*x",k3+(cpt-1)*ncovmodel+1+j+nagesqr,Tinvresult[nres][Tvardk[ijp][1]],Tqinvresult[nres][Tvardk[ijp][2]]); |
|
/* fprintf(ficgp,"+p%d*%d*%f*x",i+j+2+nagesqr-1,Tinvresult[nres][Tvard[ijp][1]],Tqinvresult[nres][Tvard[ijp][2]]); */ |
|
} |
|
}else{ /* Vn*Vm Vn is quanti */ |
|
if(DummyV[Tvardk[ijp][2]]==0){ |
|
fprintf(ficgp,"+p%d*%d*%f",k3+(cpt-1)*ncovmodel+1+j+nagesqr,Tinvresult[nres][Tvardk[ijp][2]],Tqinvresult[nres][Tvardk[ijp][1]]); |
|
/* fprintf(ficgp,"+p%d*%d*%f*x",i+j+2+nagesqr-1,Tinvresult[nres][Tvard[ijp][2]],Tqinvresult[nres][Tvard[ijp][1]]); */ |
|
}else{ /* Both quanti */ |
|
fprintf(ficgp,"+p%d*%f*%f",k3+(cpt-1)*ncovmodel+1+j+nagesqr,Tqinvresult[nres][Tvardk[ijp][1]],Tqinvresult[nres][Tvardk[ijp][2]]); |
|
/* fprintf(ficgp,"+p%d*%f*%f*x",i+j+2+nagesqr-1,Tqinvresult[nres][Tvard[ijp][1]],Tqinvresult[nres][Tvard[ijp][2]]); */ |
|
} |
|
} |
|
ijp++; |
|
} |
|
/* } /\* end Tprod *\/ */ |
|
} /* end if */ |
|
break; |
case 0: |
case 0: |
/* simple covariate */ |
/* simple covariate */ |
/* fprintf(ficgp,"+p%d*%d",i+j+2+nagesqr-1,nbcode[Tvar[j]][codtabm(k1,j)]); /\* Valgrind bug nbcode *\/ */ |
/* fprintf(ficgp,"+p%d*%d",i+j+2+nagesqr-1,nbcode[Tvar[j]][codtabm(k1,j)]); /\* Valgrind bug nbcode *\/ */ |
Line 9398 void prevforecast(char fileres[], double
|
Line 11599 void prevforecast(char fileres[], double
|
*/ |
*/ |
/* double anprojd, mprojd, jprojd; */ |
/* double anprojd, mprojd, jprojd; */ |
/* double anprojf, mprojf, jprojf; */ |
/* double anprojf, mprojf, jprojf; */ |
int yearp, stepsize, hstepm, nhstepm, j, k, cptcod, i, h, i1, k4, nres=0; |
int yearp, stepsize, hstepm, nhstepm, j, k, i, h, nres=0; |
double agec; /* generic age */ |
double agec; /* generic age */ |
double agelim, ppij, yp,yp1,yp2; |
double agelim, ppij; |
double *popeffectif,*popcount; |
/*double *popcount;*/ |
double ***p3mat; |
double ***p3mat; |
/* double ***mobaverage; */ |
/* double ***mobaverage; */ |
char fileresf[FILENAMELENGTH]; |
char fileresf[FILENAMELENGTH]; |
Line 9454 void prevforecast(char fileres[], double
|
Line 11655 void prevforecast(char fileres[], double
|
/* date2dmy(dateintmean,&jintmean,&mintmean,&aintmean); */ |
/* date2dmy(dateintmean,&jintmean,&mintmean,&aintmean); */ |
/* date2dmy(dateprojd,&jprojd, &mprojd, &anprojd); */ |
/* date2dmy(dateprojd,&jprojd, &mprojd, &anprojd); */ |
/* date2dmy(dateprojf,&jprojf, &mprojf, &anprojf); */ |
/* date2dmy(dateprojf,&jprojf, &mprojf, &anprojf); */ |
i1=pow(2,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",jintmean,mintmean,aintmean,dateintmean,dateprev1,dateprev2); |
fprintf(ficresf,"# Mean day of interviews %.lf/%.lf/%.lf (%.2f) between %.2f and %.2f \n",jintmean,mintmean,aintmean,dateintmean,dateprev1,dateprev2); |
|
|
fprintf(ficresf,"#****** Routine prevforecast **\n"); |
fprintf(ficresf,"#****** Routine prevforecast **\n"); |
|
|
/* if (h==(int)(YEARM*yearp)){ */ |
/* if (h==(int)(YEARM*yearp)){ */ |
for(nres=1; nres <= nresult; nres++) /* For each resultline */ |
for(nres=1; nres <= nresult; nres++){ /* For each resultline */ |
for(k=1; k<=i1;k++){ /* We want to find the combination k corresponding to the values of the dummies given in this resut line (to be cleaned one day) */ |
k=TKresult[nres]; |
if(i1 != 1 && TKresult[nres]!= k) |
if(TKresult[nres]==0) k=1; /* To be checked for noresult */ |
continue; |
/* for(k=1; k<=i1;k++){ /\* We want to find the combination k corresponding to the values of the dummies given in this resut line (to be cleaned one day) *\/ */ |
if(invalidvarcomb[k]){ |
/* if(i1 != 1 && TKresult[nres]!= k) */ |
printf("\nCombination (%d) projection ignored because no cases \n",k); |
/* continue; */ |
continue; |
/* if(invalidvarcomb[k]){ */ |
} |
/* printf("\nCombination (%d) projection ignored because no cases \n",k); */ |
|
/* continue; */ |
|
/* } */ |
fprintf(ficresf,"\n#****** hpijx=probability over h years, hp.jx is weighted by observed prev \n#"); |
fprintf(ficresf,"\n#****** hpijx=probability over h years, hp.jx is weighted by observed prev \n#"); |
for(j=1;j<=cptcoveff;j++) { |
for(j=1;j<=cptcovs;j++){ |
/* fprintf(ficresf," V%d (=) %d",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,Tvaraff[j])]); */ |
/* for(j=1;j<=cptcoveff;j++) { */ |
fprintf(ficresf," V%d (=) %d",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,TnsdVar[Tvaraff[j]])]); |
/* /\* fprintf(ficresf," V%d (=) %d",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,Tvaraff[j])]); *\/ */ |
} |
/* fprintf(ficresf," V%d (=) %d",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,TnsdVar[Tvaraff[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 (k4=1; k4<= nsq; k4++){ /\* For each selected (single) quantitative value *\/ */ |
|
/* fprintf(ficresf," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); */ |
|
/* } */ |
|
fprintf(ficresf," V%d=%lg ",Tvresult[nres][j],TinvDoQresult[nres][Tvresult[nres][j]]); |
} |
} |
|
|
fprintf(ficresf," yearproj age"); |
fprintf(ficresf," yearproj age"); |
for(j=1; j<=nlstate+ndeath;j++){ |
for(j=1; j<=nlstate+ndeath;j++){ |
for(i=1; i<=nlstate;i++) |
for(i=1; i<=nlstate;i++) |
Line 9502 void prevforecast(char fileres[], double
|
Line 11709 void prevforecast(char fileres[], double
|
} |
} |
} |
} |
fprintf(ficresf,"\n"); |
fprintf(ficresf,"\n"); |
for(j=1;j<=cptcoveff;j++) |
/* for(j=1;j<=cptcoveff;j++) */ |
|
for(j=1;j<=cptcovs;j++) |
|
fprintf(ficresf,"%d %lg ",Tvresult[nres][j],TinvDoQresult[nres][Tvresult[nres][j]]); |
/* fprintf(ficresf,"%d %d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,Tvaraff[j])]); /\* Tvaraff not correct *\/ */ |
/* fprintf(ficresf,"%d %d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,Tvaraff[j])]); /\* Tvaraff not correct *\/ */ |
fprintf(ficresf,"%d %d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,TnsdVar[Tvaraff[j]])]); /* TnsdVar[Tvaraff] correct */ |
/* fprintf(ficresf,"%d %d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,TnsdVar[Tvaraff[j]])]); /\* TnsdVar[Tvaraff] correct *\/ */ |
fprintf(ficresf,"%.f %.f ",anprojd+yearp,agec+h*hstepm/YEARM*stepm); |
fprintf(ficresf,"%.f %.f ",anprojd+yearp,agec+h*hstepm/YEARM*stepm); |
|
|
for(j=1; j<=nlstate+ndeath;j++) { |
for(j=1; j<=nlstate+ndeath;j++) { |
Line 9541 void prevforecast(char fileres[], double
|
Line 11750 void prevforecast(char fileres[], double
|
anback2 year of end of backprojection (same day and month as back1). |
anback2 year of end of backprojection (same day and month as back1). |
prevacurrent and prev are prevalences. |
prevacurrent and prev are prevalences. |
*/ |
*/ |
int yearp, stepsize, hstepm, nhstepm, j, k, cptcod, i, h, i1, k4, nres=0; |
int yearp, stepsize, hstepm, nhstepm, j, k, i, h, nres=0; |
double agec; /* generic age */ |
double agec; /* generic age */ |
double agelim, ppij, ppi, yp,yp1,yp2; /* ,jintmean,mintmean,aintmean;*/ |
double agelim, ppij, ppi; /* ,jintmean,mintmean,aintmean;*/ |
double *popeffectif,*popcount; |
/*double *popcount;*/ |
double ***p3mat; |
double ***p3mat; |
/* double ***mobaverage; */ |
/* double ***mobaverage; */ |
char fileresfb[FILENAMELENGTH]; |
char fileresfb[FILENAMELENGTH]; |
Line 9596 void prevforecast(char fileres[], double
|
Line 11805 void prevforecast(char fileres[], double
|
/* if(jintmean==0) jintmean=1; */ |
/* if(jintmean==0) jintmean=1; */ |
/* if(mintmean==0) jintmean=1; */ |
/* if(mintmean==0) jintmean=1; */ |
|
|
i1=pow(2,cptcoveff); |
/* i1=pow(2,cptcoveff); */ |
if (cptcovn < 1){i1=1;} |
/* if (cptcovn < 1){i1=1;} */ |
|
|
fprintf(ficresfb,"# Mean day of interviews %.lf/%.lf/%.lf (%.2f) between %.2f and %.2f \n",jintmean,mintmean,aintmean,dateintmean,dateprev1,dateprev2); |
fprintf(ficresfb,"# Mean day of interviews %.lf/%.lf/%.lf (%.2f) between %.2f and %.2f \n",jintmean,mintmean,aintmean,dateintmean,dateprev1,dateprev2); |
printf("# Mean day of interviews %.lf/%.lf/%.lf (%.2f) between %.2f and %.2f \n",jintmean,mintmean,aintmean,dateintmean,dateprev1,dateprev2); |
printf("# Mean day of interviews %.lf/%.lf/%.lf (%.2f) between %.2f and %.2f \n",jintmean,mintmean,aintmean,dateintmean,dateprev1,dateprev2); |
|
|
fprintf(ficresfb,"#****** Routine prevbackforecast **\n"); |
fprintf(ficresfb,"#****** Routine prevbackforecast **\n"); |
|
|
for(nres=1; nres <= nresult; nres++) /* For each resultline */ |
for(nres=1; nres <= nresult; nres++){ /* For each resultline */ |
for(k=1; k<=i1;k++){ |
k=TKresult[nres]; |
if(i1 != 1 && TKresult[nres]!= k) |
if(TKresult[nres]==0) k=1; /* To be checked for noresult */ |
continue; |
/* for(k=1; k<=i1;k++){ */ |
if(invalidvarcomb[k]){ |
/* if(i1 != 1 && TKresult[nres]!= k) */ |
printf("\nCombination (%d) projection ignored because no cases \n",k); |
/* continue; */ |
continue; |
/* if(invalidvarcomb[k]){ */ |
} |
/* printf("\nCombination (%d) projection ignored because no cases \n",k); */ |
|
/* continue; */ |
|
/* } */ |
fprintf(ficresfb,"\n#****** hbijx=probability over h years, hb.jx is weighted by observed prev \n#"); |
fprintf(ficresfb,"\n#****** hbijx=probability over h years, hb.jx is weighted by observed prev \n#"); |
for(j=1;j<=cptcoveff;j++) { |
for(j=1;j<=cptcovs;j++){ |
fprintf(ficresfb," V%d (=) %d",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,TnsdVar[Tvaraff[j]])]); |
/* for(j=1;j<=cptcoveff;j++) { */ |
} |
/* fprintf(ficresfb," V%d (=) %d",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,TnsdVar[Tvaraff[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," V%d=%lg ",Tvresult[nres][j],TinvDoQresult[nres][Tvresult[nres][j]]); |
} |
} |
|
/* fprintf(ficrespij,"******\n"); */ |
|
/* for (k4=1; k4<= nsq; k4++){ /\* For each selected (single) quantitative value *\/ */ |
|
/* fprintf(ficresfb," V%d=%f ",Tvqresult[nres][k4],Tqresult[nres][k4]); */ |
|
/* } */ |
fprintf(ficresfb," yearbproj age"); |
fprintf(ficresfb," yearbproj age"); |
for(j=1; j<=nlstate+ndeath;j++){ |
for(j=1; j<=nlstate+ndeath;j++){ |
for(i=1; i<=nlstate;i++) |
for(i=1; i<=nlstate;i++) |
Line 9649 void prevforecast(char fileres[], double
|
Line 11864 void prevforecast(char fileres[], double
|
} |
} |
} |
} |
fprintf(ficresfb,"\n"); |
fprintf(ficresfb,"\n"); |
for(j=1;j<=cptcoveff;j++) |
/* for(j=1;j<=cptcoveff;j++) */ |
fprintf(ficresfb,"%d %d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,TnsdVar[Tvaraff[j]])]); |
for(j=1;j<=cptcovs;j++) |
|
fprintf(ficresfb,"%d %lg ",Tvresult[nres][j],TinvDoQresult[nres][Tvresult[nres][j]]); |
|
/* fprintf(ficresfb,"%d %d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,TnsdVar[Tvaraff[j]])]); */ |
fprintf(ficresfb,"%.f %.f ",anbackd+yearp,agec-h*hstepm/YEARM*stepm); |
fprintf(ficresfb,"%.f %.f ",anbackd+yearp,agec-h*hstepm/YEARM*stepm); |
for(i=1; i<=nlstate+ndeath;i++) { |
for(i=1; i<=nlstate+ndeath;i++) { |
ppij=0.;ppi=0.; |
ppij=0.;ppi=0.; |
Line 10135 double gompertz(double x[])
|
Line 12352 double gompertz(double x[])
|
A=-x[1]/(x[2])*(exp(x[2]*(agecens[i]-agegomp))-exp(x[2]*(ageexmed[i]-agegomp))); |
A=-x[1]/(x[2])*(exp(x[2]*(agecens[i]-agegomp))-exp(x[2]*(ageexmed[i]-agegomp))); |
} else if (cens[i] == 0){ |
} else if (cens[i] == 0){ |
A=-x[1]/(x[2])*(exp(x[2]*(agedc[i]-agegomp))-exp(x[2]*(ageexmed[i]-agegomp))) |
A=-x[1]/(x[2])*(exp(x[2]*(agedc[i]-agegomp))-exp(x[2]*(ageexmed[i]-agegomp))) |
+log(x[1]/YEARM) +x[2]*(agedc[i]-agegomp)+log(YEARM); |
+log(fabs(x[1])/YEARM) +x[2]*(agedc[i]-agegomp)+log(YEARM); |
|
/* +log(x[1]/YEARM) +x[2]*(agedc[i]-agegomp)+log(YEARM); */ /* To be seen */ |
} else |
} else |
printf("Gompertz cens[%d] neither 1 nor 0\n",i); |
printf("Gompertz cens[%d] neither 1 nor 0\n",i); |
/*if (wav[i] > 1 && agecens[i] > 15) {*/ /* ??? */ |
/*if (wav[i] > 1 && agecens[i] > 15) {*/ /* ??? */ |
Line 10219 void printinggnuplotmort(char fileresu[]
|
Line 12437 void printinggnuplotmort(char fileresu[]
|
|
|
char dirfileres[132],optfileres[132]; |
char dirfileres[132],optfileres[132]; |
|
|
int ng; |
/*int ng;*/ |
|
|
|
|
/*#ifdef windows */ |
/*#ifdef windows */ |
Line 10243 int readdata(char datafile[], int firsto
|
Line 12461 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, iv=0, v; |
int i = 0, j = 0, n = 0, iv = 0;/* , v;*/ |
int lstra; |
int lstra; |
int linei, month, year,iout; |
int linei, month, year,iout; |
int noffset=0; /* This is the offset if BOM data file */ |
int noffset=0; /* This is the offset if BOM data file */ |
Line 10251 int readdata(char datafile[], int firsto
|
Line 12469 int readdata(char datafile[], int firsto
|
char stra[MAXLINE], strb[MAXLINE]; |
char stra[MAXLINE], strb[MAXLINE]; |
char *stratrunc; |
char *stratrunc; |
|
|
DummyV=ivector(1,NCOVMAX); /* 1 to 3 */ |
/* DummyV=ivector(-1,NCOVMAX); /\* 1 to 3 *\/ */ |
FixedV=ivector(1,NCOVMAX); /* 1 to 3 */ |
/* FixedV=ivector(-1,NCOVMAX); /\* 1 to 3 *\/ */ |
for(v=1;v<NCOVMAX;v++){ |
|
DummyV[v]=0; |
|
FixedV[v]=0; |
|
} |
|
|
|
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]); |
|
} |
|
|
|
ncovcolt=ncovcol+nqv+ntv+nqtv; /* total of covariates in the data, not in the model equation */ |
ncovcolt=ncovcol+nqv+ntv+nqtv; /* total of covariates in the data, not in the model equation */ |
|
|
Line 10430 int readdata(char datafile[], int firsto
|
Line 12623 int readdata(char datafile[], int firsto
|
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; |
|
}else if( lval==0 || lval > nlstate+ndeath){ |
|
printf("Error in data around '%s' at line number %d for individual %d, '%s'\n Should be a state at wave %d. A state should be 1 to %d and not %ld.\n Fix your data file '%s'! Exiting.\n", strb, linei,i,line,j,nlstate+ndeath, lval, datafile);fflush(stdout); |
|
fprintf(ficlog,"Error in data around '%s' at line number %d for individual %d, '%s'\n Should be a state at wave %d. A state should be 1 to %d and not %ld.\n Fix your data file '%s'! Exiting.\n", strb, linei,i,line,j,nlstate+ndeath, lval, datafile); fflush(ficlog); |
return 1; |
return 1; |
} |
} |
} |
} |
Line 10631 int decoderesult( char resultline[], int
|
Line 12828 int decoderesult( char resultline[], int
|
printf("decoderesult:%s\n",resultline); |
printf("decoderesult:%s\n",resultline); |
|
|
strcpy(resultsav,resultline); |
strcpy(resultsav,resultline); |
printf("Decoderesult resultsav=\"%s\" resultline=\"%s\"\n", resultsav, resultline); |
/* printf("Decoderesult resultsav=\"%s\" resultline=\"%s\"\n", resultsav, resultline); */ |
if (strlen(resultsav) >1){ |
if (strlen(resultsav) >1){ |
j=nbocc(resultsav,'='); /**< j=Number of covariate values'=' in this resultline */ |
j=nbocc(resultsav,'='); /**< j=Number of covariate values'=' in this resultline */ |
} |
} |
if(j == 0){ /* Resultline but no = */ |
if(j == 0 && cptcovs== 0){ /* Resultline but no = and no covariate in the model */ |
TKresult[nres]=0; /* Combination for the nresult and the model */ |
TKresult[nres]=0; /* Combination for the nresult and the model */ |
return (0); |
return (0); |
} |
} |
if( j != cptcovs ){ /* Be careful if a variable is in a product but not single */ |
if( j != cptcovs ){ /* Be careful if a variable is in a product but not single */ |
printf("ERROR: the number of variables in the resultline which is %d, differs from the number %d of single variables used in the model line, %s.\n",j, cptcovs, model); |
fprintf(ficlog,"ERROR: the number of variables in the resultline which is %d, differs from the number %d of single variables used in the model line, 1+age+%s.\n",j, cptcovs, model);fflush(ficlog); |
fprintf(ficlog,"ERROR: the number of variables in the resultline which is %d, differs from the number %d of single variables used in the model line, %s.\n",j, cptcovs, model); |
printf("ERROR: the number of variables in the resultline which is %d, differs from the number %d of single variables used in the model line, 1+age+%s.\n",j, cptcovs, model);fflush(stdout); |
/* return 1;*/ |
if(j==0) |
|
return 1; |
} |
} |
for(k=1; k<=j;k++){ /* Loop on any covariate of the RESULT LINE */ |
for(k=1; k<=j;k++){ /* Loop on any covariate of the RESULT LINE */ |
if(nbocc(resultsav,'=') >1){ |
if(nbocc(resultsav,'=') >1){ |
Line 10691 int decoderesult( char resultline[], int
|
Line 12889 int decoderesult( char resultline[], int
|
if(Tvar[k1]==Tvarsel[k2]) {/* Tvar is coming from the model, Tvarsel from the result. Tvar[1]=5 == Tvarsel[2]=5 */ |
if(Tvar[k1]==Tvarsel[k2]) {/* Tvar is coming from the model, Tvarsel from the result. Tvar[1]=5 == Tvarsel[2]=5 */ |
modelresult[nres][k2]=k1;/* we found a Vn=1 corrresponding to Vn*age in the model modelresult[2]=1 modelresult[1]=2 modelresult[3]=3 modelresult[6]=4 modelresult[9]=5 */ |
modelresult[nres][k2]=k1;/* we found a Vn=1 corrresponding to Vn*age in the model modelresult[2]=1 modelresult[1]=2 modelresult[3]=3 modelresult[6]=4 modelresult[9]=5 */ |
resultmodel[nres][k1]=k2; /* Added here */ |
resultmodel[nres][k1]=k2; /* Added here */ |
printf("Decoderesult first modelresult[k2=%d]=%d (k1) V%d*AGE\n",k2,k1,Tvar[k1]); |
/* printf("Decoderesult first modelresult[k2=%d]=%d (k1) V%d*AGE\n",k2,k1,Tvar[k1]); */ |
match=1; /* modelresult of k2 variable of resultline is identical to k1 variable of the model good */ |
match=1; /* modelresult of k2 variable of resultline is identical to k1 variable of the model good */ |
break; |
break; |
} |
} |
Line 10701 int decoderesult( char resultline[], int
|
Line 12899 int decoderesult( char resultline[], int
|
fprintf(ficlog,"Error in result line (Product with age): V%d is missing in result: %s according to model=1+age+%s (Tvarsel[k2=%d]=%d)\n",Tvar[k1], resultline, model, k2, Tvarsel[k2]); |
fprintf(ficlog,"Error in result line (Product with age): V%d is missing in result: %s according to model=1+age+%s (Tvarsel[k2=%d]=%d)\n",Tvar[k1], resultline, model, k2, Tvarsel[k2]); |
return 1; |
return 1; |
} |
} |
}else if(Typevar[k1]==2){ /* Product No age We want to get the position in the resultline of the product in the model line*/ |
}else if(Typevar[k1]==2 || Typevar[k1]==3){ /* Product with or without age. We want to get the position in the resultline of the product in the model line*/ |
/* resultmodel[nres][of such a Vn * Vm product k1] is not unique, so can't exist, we feed Tvard[k1][1] and [2] */ |
/* resultmodel[nres][of such a Vn * Vm product k1] is not unique, so can't exist, we feed Tvard[k1][1] and [2] */ |
match=0; |
match=0; |
printf("Decoderesult very first Product Tvardk[k1=%d][1]=%d Tvardk[k1=%d][2]=%d V%d * V%d\n",k1,Tvardk[k1][1],k1,Tvardk[k1][2],Tvardk[k1][1],Tvardk[k1][2]); |
/* printf("Decoderesult very first Product Tvardk[k1=%d][1]=%d Tvardk[k1=%d][2]=%d V%d * V%d\n",k1,Tvardk[k1][1],k1,Tvardk[k1][2],Tvardk[k1][1],Tvardk[k1][2]); */ |
for(k2=1; k2 <=j;k2++){/* Loop on resultline. In result line V4=1 V5=24.1 V3=1 V2=8 V1=0 */ |
for(k2=1; k2 <=j;k2++){/* Loop on resultline. In result line V4=1 V5=24.1 V3=1 V2=8 V1=0 */ |
if(Tvardk[k1][1]==Tvarsel[k2]) {/* Tvardk is coming from the model, Tvarsel from the result. Tvar[1]=5 == Tvarsel[2]=5 */ |
if(Tvardk[k1][1]==Tvarsel[k2]) {/* Tvardk is coming from the model, Tvarsel from the result. Tvar[1]=5 == Tvarsel[2]=5 */ |
/* modelresult[k2]=k1; */ |
/* modelresult[k2]=k1; */ |
printf("Decoderesult first Product modelresult[k2=%d]=%d (k1) V%d * \n",k2,k1,Tvarsel[k2]); |
/* printf("Decoderesult first Product modelresult[k2=%d]=%d (k1) V%d * \n",k2,k1,Tvarsel[k2]); */ |
match=1; /* modelresult of k2 variable of resultline is identical to k1 variable of the model good */ |
match=1; /* modelresult of k2 variable of resultline is identical to k1 variable of the model good */ |
} |
} |
} |
} |
if(match == 0){ |
if(match == 0){ |
printf("Error in result line (Product without age first variable): V%d is missing in result: %s according to model=1+age+%s\n",Tvardk[k1][1], resultline, model); |
printf("Error in result line (Product without age first variable or double product with age): V%d is missing in result: %s according to model=1+age+%s\n",Tvardk[k1][1], resultline, model); |
fprintf(ficlog,"Error in result line (Product without age first variable): V%d is missing in result: %s according to model=1+age+%s\n",Tvardk[k1][1], resultline, model); |
fprintf(ficlog,"Error in result line (Product without age first variable or double product with age): V%d is missing in result: %s according to model=1+age+%s\n",Tvardk[k1][1], resultline, model); |
return 1; |
return 1; |
} |
} |
match=0; |
match=0; |
for(k2=1; k2 <=j;k2++){/* Loop on resultline. In result line V4=1 V5=24.1 V3=1 V2=8 V1=0 */ |
for(k2=1; k2 <=j;k2++){/* Loop on resultline. In result line V4=1 V5=24.1 V3=1 V2=8 V1=0 */ |
if(Tvardk[k1][2]==Tvarsel[k2]) {/* Tvardk is coming from the model, Tvarsel from the result. Tvar[1]=5 == Tvarsel[2]=5 */ |
if(Tvardk[k1][2]==Tvarsel[k2]) {/* Tvardk is coming from the model, Tvarsel from the result. Tvar[1]=5 == Tvarsel[2]=5 */ |
/* modelresult[k2]=k1;*/ |
/* modelresult[k2]=k1;*/ |
printf("Decoderesult second Product modelresult[k2=%d]=%d (k1) * V%d \n ",k2,k1,Tvarsel[k2]); |
/* printf("Decoderesult second Product modelresult[k2=%d]=%d (k1) * V%d \n ",k2,k1,Tvarsel[k2]); */ |
match=1; /* modelresult of k2 variable of resultline is identical to k1 variable of the model good */ |
match=1; /* modelresult of k2 variable of resultline is identical to k1 variable of the model good */ |
break; |
break; |
} |
} |
} |
} |
if(match == 0){ |
if(match == 0){ |
printf("Error in result line (Product without age second variable): V%d is missing in result: %s according to model=1+age+%s\n",Tvardk[k1][2], resultline, model); |
printf("Error in result line (Product without age second variable or double product with age): V%d is missing in result: %s according to model=1+age+%s\n",Tvardk[k1][2], resultline, model); |
fprintf(ficlog,"Error in result line (Product without age second variable): V%d is missing in result : %s according to model=1+age+%s\n",Tvardk[k1][2], resultline, model); |
fprintf(ficlog,"Error in result line (Product without age second variable or double product with age): V%d is missing in result : %s according to model=1+age+%s\n",Tvardk[k1][2], resultline, model); |
return 1; |
return 1; |
} |
} |
}/* End of testing */ |
}/* End of testing */ |
Line 10740 int decoderesult( char resultline[], int
|
Line 12938 int decoderesult( char resultline[], int
|
match=0; |
match=0; |
for(k1=1; k1<= cptcovt ;k1++){ /* loop on model: model line V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ |
for(k1=1; k1<= cptcovt ;k1++){ /* loop on model: model line V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ |
if(Typevar[k1]==0){ /* Single only */ |
if(Typevar[k1]==0){ /* Single only */ |
if(Tvar[k1]==Tvarsel[k2]) { /* Tvar[2]=4 == Tvarsel[1]=4 */ |
if(Tvar[k1]==Tvarsel[k2]) { /* Tvar[2]=4 == Tvarsel[1]=4 What if a product? */ |
resultmodel[nres][k1]=k2; /* k1th position in the model equation corresponds to k2th position in the result line. resultmodel[2]=1 resultmodel[1]=2 resultmodel[3]=3 resultmodel[6]=4 resultmodel[9]=5 */ |
resultmodel[nres][k1]=k2; /* k1th position in the model equation corresponds to k2th position in the result line. resultmodel[2]=1 resultmodel[1]=2 resultmodel[3]=3 resultmodel[6]=4 resultmodel[9]=5 */ |
modelresult[nres][k2]=k1; /* k1th position in the model equation corresponds to k2th position in the result line. modelresult[1]=2 modelresult[2]=1 modelresult[3]=3 remodelresult[4]=6 modelresult[5]=9 */ |
modelresult[nres][k2]=k1; /* k1th position in the model equation corresponds to k2th position in the result line. modelresult[1]=2 modelresult[2]=1 modelresult[3]=3 remodelresult[4]=6 modelresult[5]=9 */ |
++match; |
++match; |
Line 10781 int decoderesult( char resultline[], int
|
Line 12979 int decoderesult( char resultline[], int
|
/* k counting number of combination of single dummies in the equation model */ |
/* k counting number of combination of single dummies in the equation model */ |
/* k4 counting single dummies in the equation model */ |
/* k4 counting single dummies in the equation model */ |
/* k4q counting single quantitatives in the equation model */ |
/* k4q counting single quantitatives in the equation model */ |
if( Dummy[k1]==0 && Typevar[k1]==0 ){ /* Dummy and Single, k1 is sorting according to MODEL, but k3 to resultline */ |
if( Dummy[k1]==0 && Typevar[k1]==0 ){ /* Dummy and Single, fixed or timevarying, k1 is sorting according to MODEL, but k3 to resultline */ |
/* k4+1= (not always if quant in model) position in the resultline V(Tvarsel)=Tvalsel=Tresult[nres][pos](value); V(Tvresult[nres][pos] (variable): V(variable)=value) */ |
/* k4+1= (not always if quant in model) position in the resultline V(Tvarsel)=Tvalsel=Tresult[nres][pos](value); V(Tvresult[nres][pos] (variable): V(variable)=value) */ |
/* modelresult[k3]=k1: k3th position in the result line corresponds to the k1 position in the model line (doesn't work with products)*/ |
/* modelresult[k3]=k1: k3th position in the result line corresponds to the k1 position in the model line (doesn't work with products)*/ |
/* Value in the (current nres) resultline of the variable at the k1th position in the model equation resultmodel[nres][k1]= k3 */ |
/* Value in the (current nres) resultline of the variable at the k1th position in the model equation resultmodel[nres][k1]= k3 */ |
Line 10805 int decoderesult( char resultline[], int
|
Line 13003 int decoderesult( char resultline[], int
|
Tvresult[nres][k3]=(int)Tvarsel[k3];/* Tvresult[nres][1]=4 Tvresult[nres][3]=1 */ |
Tvresult[nres][k3]=(int)Tvarsel[k3];/* Tvresult[nres][1]=4 Tvresult[nres][3]=1 */ |
Tinvresult[nres][(int)Tvarsel[k3]]=Tvalsel[k3]; /* Tinvresult[nres][4]=1 */ |
Tinvresult[nres][(int)Tvarsel[k3]]=Tvalsel[k3]; /* Tinvresult[nres][4]=1 */ |
precov[nres][k1]=Tvalsel[k3]; /* Value from resultline of the variable at the k1 position in the model */ |
precov[nres][k1]=Tvalsel[k3]; /* Value from resultline of the variable at the k1 position in the model */ |
printf("Decoderesult Dummy k=%d, k1=%d precov[nres=%d][k1=%d]=%.f V(k2=V%d)= Tvalsel[%d]=%d, 2**(%d)\n",k, k1, nres, k1,precov[nres][k1], k2, k3, (int)Tvalsel[k3], k4); |
/* printf("Decoderesult Dummy k=%d, k1=%d precov[nres=%d][k1=%d]=%.f V(k2=V%d)= Tvalsel[%d]=%d, 2**(%d)\n",k, k1, nres, k1,precov[nres][k1], k2, k3, (int)Tvalsel[k3], k4); */ |
k4++;; |
k4++;; |
}else if( Dummy[k1]==1 && Typevar[k1]==0 ){ /* Quantitative and single */ |
}else if( Dummy[k1]==1 && Typevar[k1]==0 ){ /* Quantitative and single */ |
/* Tqresult[nres][result_position]= value of the variable at the result_position in the nres resultline */ |
/* Tqresult[nres][result_position]= value of the variable at the result_position in the nres resultline */ |
Line 10823 int decoderesult( char resultline[], int
|
Line 13021 int decoderesult( char resultline[], int
|
Tqinvresult[nres][(int)Tvarsel[k3q]]=Tvalsel[k3q]; /* Tqinvresult[nres][5]=25.1 */ |
Tqinvresult[nres][(int)Tvarsel[k3q]]=Tvalsel[k3q]; /* Tqinvresult[nres][5]=25.1 */ |
TinvDoQresult[nres][(int)Tvarsel[k3q]]=Tvalsel[k3q]; /* Tqinvresult[nres][5]=25.1 */ |
TinvDoQresult[nres][(int)Tvarsel[k3q]]=Tvalsel[k3q]; /* Tqinvresult[nres][5]=25.1 */ |
precov[nres][k1]=Tvalsel[k3q]; |
precov[nres][k1]=Tvalsel[k3q]; |
printf("Decoderesult Quantitative nres=%d,precov[nres=%d][k1=%d]=%.f V(k2q=V%d)= Tvalsel[%d]=%d, Tvarsel[%d]=%f\n",nres, nres, k1,precov[nres][k1], k2q, k3q, Tvarsel[k3q], k3q, Tvalsel[k3q]); |
/* printf("Decoderesult Quantitative nres=%d,precov[nres=%d][k1=%d]=%.f V(k2q=V%d)= Tvalsel[%d]=%d, Tvarsel[%d]=%f\n",nres, nres, k1,precov[nres][k1], k2q, k3q, Tvarsel[k3q], k3q, Tvalsel[k3q]); */ |
k4q++;; |
k4q++;; |
}else if( Dummy[k1]==2 ){ /* For dummy with age product */ |
}else if( Dummy[k1]==2 ){ /* For dummy with age product "V2+V3+V4+V6+V7+V6*V2+V7*V2+V6*V3+V7*V3+V6*V4+V7*V4+age*V2+age*V3+age*V4+age*V6+age*V7+age*V6*V2+age*V6*V3+age*V7*V3+age*V6*V4+age*V7*V4\r"*/ |
/* Tvar[k1]; */ /* Age variable */ |
/* Tvar[k1]; */ /* Age variable */ /* 17 age*V6*V2 ?*/ |
/* Wrong we want the value of variable name Tvar[k1] */ |
/* Wrong we want the value of variable name Tvar[k1] */ |
|
if(Typevar[k1]==2 || Typevar[k1]==3 ){ /* For product quant or dummy (with or without age) */ |
k3= resultmodel[nres][k1]; /* nres=1 k1=2 resultmodel[2(V4)] = 1=k3 ; k1=3 resultmodel[3(V3)] = 2=k3*/ |
precov[nres][k1]=TinvDoQresult[nres][Tvardk[k1][1]] * TinvDoQresult[nres][Tvardk[k1][2]]; |
k2=(int)Tvarsel[k3]; /* nres=1 k1=2=>k3=1 Tvarsel[resultmodel[2]]= Tvarsel[1] = 4=k2 (V4); k1=3=>k3=2 Tvarsel[2]=3 (V3)*/ |
/* printf("Decoderesult Quantitative or Dummy (not with age) nres=%d k1=%d precov[nres=%d][k1=%d]=%.f V%d(=%.f) * V%d(=%.f) \n",nres, k1, nres, k1,precov[nres][k1], Tvardk[k1][1], TinvDoQresult[nres][Tvardk[k1][1]], Tvardk[k1][2], TinvDoQresult[nres][Tvardk[k1][2]]); */ |
TinvDoQresult[nres][(int)Tvarsel[k3]]=Tvalsel[k3]; /* TinvDoQresult[nres][4]=1 */ |
}else{ |
precov[nres][k1]=Tvalsel[k3]; |
k3= resultmodel[nres][k1]; /* nres=1 k1=2 resultmodel[2(V4)] = 1=k3 ; k1=3 resultmodel[3(V3)] = 2=k3*/ |
printf("Decoderesult Dummy with age k=%d, k1=%d precov[nres=%d][k1=%d]=%.f Tvar[%d]=V%d k2=Tvarsel[%d]=%d Tvalsel[%d]=%d\n",k, k1, nres, k1,precov[nres][k1], k1, Tvar[k1], k3,(int)Tvarsel[k3], k3, (int)Tvalsel[k3]); |
k2=(int)Tvarsel[k3]; /* nres=1 k1=2=>k3=1 Tvarsel[resultmodel[2]]= Tvarsel[1] = 4=k2 (V4); k1=3=>k3=2 Tvarsel[2]=3 (V3)*/ |
|
TinvDoQresult[nres][(int)Tvarsel[k3]]=Tvalsel[k3]; /* TinvDoQresult[nres][4]=1 */ |
|
precov[nres][k1]=Tvalsel[k3]; |
|
} |
|
/* printf("Decoderesult Dummy with age k=%d, k1=%d precov[nres=%d][k1=%d]=%.f Tvar[%d]=V%d k2=Tvarsel[%d]=%d Tvalsel[%d]=%d\n",k, k1, nres, k1,precov[nres][k1], k1, Tvar[k1], k3,(int)Tvarsel[k3], k3, (int)Tvalsel[k3]); */ |
}else if( Dummy[k1]==3 ){ /* For quant with age product */ |
}else if( Dummy[k1]==3 ){ /* For quant with age product */ |
k3q= resultmodel[nres][k1]; /* resultmodel[1(V5)] = 25.1=k3q */ |
if(Typevar[k1]==2 || Typevar[k1]==3 ){ /* For product quant or dummy (with or without age) */ |
k2q=(int)Tvarsel[k3q]; /* Tvarsel[resultmodel[1]]= Tvarsel[1] = 4=k2 */ |
precov[nres][k1]=TinvDoQresult[nres][Tvardk[k1][1]] * TinvDoQresult[nres][Tvardk[k1][2]]; |
TinvDoQresult[nres][(int)Tvarsel[k3q]]=Tvalsel[k3q]; /* TinvDoQresult[nres][5]=25.1 */ |
/* printf("Decoderesult Quantitative or Dummy (not with age) nres=%d k1=%d precov[nres=%d][k1=%d]=%.f V%d(=%.f) * V%d(=%.f) \n",nres, k1, nres, k1,precov[nres][k1], Tvardk[k1][1], TinvDoQresult[nres][Tvardk[k1][1]], Tvardk[k1][2], TinvDoQresult[nres][Tvardk[k1][2]]); */ |
precov[nres][k1]=Tvalsel[k3q]; |
}else{ |
printf("Decoderesult Quantitative with age nres=%d, k1=%d, precov[nres=%d][k1=%d]=%f Tvar[%d]=V%d V(k2q=%d)= Tvarsel[%d]=%d, Tvalsel[%d]=%f\n",nres, k1, nres, k1,precov[nres][k1], k1, Tvar[k1], k2q, k3q, Tvarsel[k3q], k3q, Tvalsel[k3q]); |
k3q= resultmodel[nres][k1]; /* resultmodel[1(V5)] = 25.1=k3q */ |
}else if(Typevar[k1]==2 ){ /* For product quant or dummy (not with age) */ |
k2q=(int)Tvarsel[k3q]; /* Tvarsel[resultmodel[1]]= Tvarsel[1] = 4=k2 */ |
|
TinvDoQresult[nres][(int)Tvarsel[k3q]]=Tvalsel[k3q]; /* TinvDoQresult[nres][5]=25.1 */ |
|
precov[nres][k1]=Tvalsel[k3q]; |
|
} |
|
/* printf("Decoderesult Quantitative with age nres=%d, k1=%d, precov[nres=%d][k1=%d]=%f Tvar[%d]=V%d V(k2q=%d)= Tvarsel[%d]=%d, Tvalsel[%d]=%f\n",nres, k1, nres, k1,precov[nres][k1], k1, Tvar[k1], k2q, k3q, Tvarsel[k3q], k3q, Tvalsel[k3q]); */ |
|
}else if(Typevar[k1]==2 || Typevar[k1]==3 ){ /* For product quant or dummy (with or without age) */ |
precov[nres][k1]=TinvDoQresult[nres][Tvardk[k1][1]] * TinvDoQresult[nres][Tvardk[k1][2]]; |
precov[nres][k1]=TinvDoQresult[nres][Tvardk[k1][1]] * TinvDoQresult[nres][Tvardk[k1][2]]; |
printf("Decoderesult Quantitative or Dummy (not with age) nres=%d k1=%d precov[nres=%d][k1=%d]=%.f V%d(=%.f) * V%d(=%.f) \n",nres, k1, nres, k1,precov[nres][k1], Tvardk[k1][1], TinvDoQresult[nres][Tvardk[k1][1]], Tvardk[k1][2], TinvDoQresult[nres][Tvardk[k1][2]]); |
/* printf("Decoderesult Quantitative or Dummy (not with age) nres=%d k1=%d precov[nres=%d][k1=%d]=%.f V%d(=%.f) * V%d(=%.f) \n",nres, k1, nres, k1,precov[nres][k1], Tvardk[k1][1], TinvDoQresult[nres][Tvardk[k1][1]], Tvardk[k1][2], TinvDoQresult[nres][Tvardk[k1][2]]); */ |
}else{ |
}else{ |
printf("Error Decoderesult probably a product Dummy[%d]==%d && Typevar[%d]==%d\n", k1, Dummy[k1], k1, Typevar[k1]); |
printf("Error Decoderesult probably a product Dummy[%d]==%d && Typevar[%d]==%d\n", k1, Dummy[k1], k1, Typevar[k1]); |
fprintf(ficlog,"Error Decoderesult probably a product Dummy[%d]==%d && Typevar[%d]==%d\n", k1, Dummy[k1], k1, Typevar[k1]); |
fprintf(ficlog,"Error Decoderesult probably a product Dummy[%d]==%d && Typevar[%d]==%d\n", k1, Dummy[k1], k1, Typevar[k1]); |
Line 10871 int decodemodel( char model[], int lasto
|
Line 13078 int decodemodel( char model[], int lasto
|
*/ |
*/ |
/* V2+V1+V4+V3*age Tvar[4]=3 ; V1+V2*age Tvar[2]=2; V1+V1*age Tvar[2]=1, Tage[1]=2 */ |
/* V2+V1+V4+V3*age Tvar[4]=3 ; V1+V2*age Tvar[2]=2; V1+V1*age Tvar[2]=1, Tage[1]=2 */ |
{ |
{ |
int i, j, k, ks, v; |
int i, j, k, ks;/* , v;*/ |
int j1, k1, k2, k3, k4; |
int n,m; |
char modelsav[80]; |
int j1, k1, k11, k12, k2, k3, k4; |
char stra[80], strb[80], strc[80], strd[80],stre[80]; |
char modelsav[300]; |
|
char stra[300], strb[300], strc[300], strd[300],stre[300],strf[300]; |
char *strpt; |
char *strpt; |
|
int **existcomb; |
|
|
|
existcomb=imatrix(1,NCOVMAX,1,NCOVMAX); |
|
for(i=1;i<=NCOVMAX;i++) |
|
for(j=1;j<=NCOVMAX;j++) |
|
existcomb[i][j]=0; |
|
|
/*removespace(model);*/ |
/*removespace(model);*/ |
if (strlen(model) >1){ /* If there is at least 1 covariate */ |
if (strlen(model) >1){ /* If there is at least 1 covariate */ |
j=0, j1=0, k1=0, k2=-1, ks=0, cptcovn=0; |
j=0, j1=0, k1=0, k12=0, k2=-1, ks=0, cptcovn=0; |
if (strstr(model,"AGE") !=0){ |
if (strstr(model,"AGE") !=0){ |
printf("Error. AGE must be in lower case 'age' model=1+age+%s. ",model); |
printf("Error. AGE must be in lower case 'age' model=1+age+%s. ",model); |
fprintf(ficlog,"Error. AGE must be in lower case model=1+age+%s. ",model);fflush(ficlog); |
fprintf(ficlog,"Error. AGE must be in lower case model=1+age+%s. ",model);fflush(ficlog); |
Line 10911 int decodemodel( char model[], int lasto
|
Line 13125 int decodemodel( char model[], int lasto
|
substrchaine(modelsav, model, "age*age"); |
substrchaine(modelsav, model, "age*age"); |
}else |
}else |
nagesqr=0; |
nagesqr=0; |
if (strlen(modelsav) >1){ |
if (strlen(modelsav) >1){ /* V2 +V3 +V4 +V6 +V7 +V6*V2 +V7*V2 +V6*V3 +V7*V3 +V6*V4 +V7*V4 +age*V2 +age*V3 +age*V4 +age*V6 +age*V7 +age*V6*V2 +V7*V2 +age*V6*V3 +age*V7*V3 +age*V6*V4 +age*V7*V4 */ |
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 =5-3=2 */ |
cptcovs=0; /**< Number of simple covariates V1 +V1*age +V3 +V3*V4 +age*age => V1 + V3 =4+1-3=2 Wrong */ |
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=> 3+1=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=0; /**< Number of products V1*V2 +v3*age = 2 */ |
|
cptcovdageprod=0; /* Number of doouble products with age age*Vn*VM or Vn*age*Vm or Vn*Vm*age */ |
cptcovprodnoage=0; /**< Number of covariate products without age: V3*V4 =1 */ |
cptcovprodnoage=0; /**< Number of covariate products without age: V3*V4 =1 */ |
|
cptcovprodage=0; |
|
/* cptcovprodage=nboccstr(modelsav,"age");*/ |
|
|
/* Design |
/* Design |
* V1 V2 V3 V4 V5 V6 V7 V8 V9 Weight |
* V1 V2 V3 V4 V5 V6 V7 V8 V9 Weight |
Line 10931 int decodemodel( char model[], int lasto
|
Line 13147 int decodemodel( char model[], int lasto
|
* Model V2 + V1 + V3*age + V3 + V5*V6 + V7*V8 + V8*age + V8 |
* Model V2 + V1 + V3*age + V3 + V5*V6 + V7*V8 + V8*age + V8 |
* 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], are for fixed covariates, value of kth covariate if not including age for individual i: |
* covar[1][i]= (V1), covar[4][i]=(V4), 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[2]=1 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 + nqv (quanti fixed) with k1 |
* Tvar[k]=ncovcol+k1; # of the kth covariate product: Tvar[5]=ncovcol+1=10 Tvar[6]=ncovcol+1=11 |
* Tvar[k]=ncovcol+k1; # of the kth covariate product: Tvar[5]=ncovcol+1=10 Tvar[6]=ncovcol+1=11 |
* Tprod[k1]=k; Tprod[1]=5 Tprod[2]= 6; gives the position of the k1th product |
* Tprod[k1]=k; Tprod[1]=5 Tprod[2]= 6; gives the position of the k1th product |
* Tvard[k1][1]=m Tvard[k1][2]=m; Tvard[1][1]=5 (V5) Tvard[1][2]=6 Tvard[2][1]=7 (V7) Tvard[2][2]=8 |
* Tvard[k1][1]=m Tvard[k1][2]=m; Tvard[1][1]=5 (V5) Tvard[1][2]=6 Tvard[2][1]=7 (V7) Tvard[2][2]=8 |
* Tvar[cptcovn+k2]=Tvard[k1][1];Tvar[cptcovn+k2+1]=Tvard[k1][2]; |
* Tvar[cptcovn+k2]=Tvard[k1][1];Tvar[cptcovn+k2+1]=Tvard[k1][2]; |
* Tvar[8+1]=5;Tvar[8+2]=6;Tvar[8+3]=7;Tvar[8+4]=8 inverted |
* Tvar[8+1]=5;Tvar[8+2]=6;Tvar[8+3]=7;Tvar[8+4]=8 inverted |
* V1 V2 V3 V4 V5 V6 V7 V8 V9 V10 V11 |
* V1 V2 V3 V4 V5 V6 V7 V8 V9 V10 V11 |
* < ncovcol=8 > |
* < ncovcol=8 8 fixed covariate. Additional starts at 9 (V5*V6) and 10(V7*V8) > |
* Model V2 + V1 + V3*age + V3 + V5*V6 + V7*V8 + V8*age + V8 d1 d1 d2 d2 |
* Model V2 + V1 + V3*age + V3 + V5*V6 + V7*V8 + V8*age + V8 d1 d1 d2 d2 |
* k= 1 2 3 4 5 6 7 8 9 10 11 12 |
* k= 1 2 3 4 5 6 7 8 9 10 11 12 |
* Tvar[k]= 2 1 3 3 10 11 8 8 5 6 7 8 |
* Tvard[k]= 2 1 3 3 10 11 8 8 5 6 7 8 |
* p Tvar[1]@12={2, 1, 3, 3, 11, 10, 8, 8, 7, 8, 5, 6} |
* p Tvar[1]@12={2, 1, 3, 3, 9, 10, 8, 8} |
* p Tprod[1]@2={ 6, 5} |
* p Tprod[1]@2={ 6, 5} |
*p Tvard[1][1]@4= {7, 8, 5, 6} |
*p Tvard[1][1]@4= {7, 8, 5, 6} |
* covar[k][i]= V2 V1 ? V3 V5*V6? V7*V8? ? V8 |
* covar[k][i]= V2 V1 ? V3 V5*V6? V7*V8? ? V8 |
Line 10977 int decodemodel( char model[], int lasto
|
Line 13193 int decodemodel( char model[], int lasto
|
Tvar[k]=0; Tprod[k]=0; Tposprod[k]=0; |
Tvar[k]=0; Tprod[k]=0; Tposprod[k]=0; |
} |
} |
cptcovage=0; |
cptcovage=0; |
|
|
|
/* First loop in order to calculate */ |
|
/* for age*VN*Vm |
|
* Provides, Typevar[k], Tage[cptcovage], existcomb[n][m], FixedV[ncovcolt+k12] |
|
* Tprod[k1]=k Tposprod[k]=k1; Tvard[k1][1] =m; |
|
*/ |
|
/* Needs FixedV[Tvardk[k][1]] */ |
|
/* For others: |
|
* Sets Typevar[k]; |
|
* Tvar[k]=ncovcol+nqv+ntv+nqtv+k11; |
|
* Tposprod[k]=k11; |
|
* Tprod[k11]=k; |
|
* Tvardk[k][1] =m; |
|
* Needs FixedV[Tvardk[k][1]] == 0 |
|
*/ |
|
|
for(k=1; k<=cptcovt;k++){ /* Loop on total covariates of the model line */ |
for(k=1; k<=cptcovt;k++){ /* Loop on total covariates of the model line */ |
cutl(stra,strb,modelsav,'+'); /* keeps in strb after the first '+' cutl from left to right |
cutl(stra,strb,modelsav,'+'); /* keeps in strb after the first '+' cutl from left to right |
modelsav==V2+V1+V5*age+V4+V3*age strb=V3*age stra=V2+V1V5*age+V4 */ /* <model> "V5+V4+V3+V4*V3+V5*age+V1*age+V1" strb="V5" stra="V4+V3+V4*V3+V5*age+V1*age+V1" */ |
modelsav==V2+V1+V5*age+V4+V3*age strb=V3*age stra=V2+V1V5*age+V4 */ /* <model> "V5+V4+V3+V4*V3+V5*age+V1*age+V1" strb="V5" stra="V4+V3+V4*V3+V5*age+V1*age+V1" */ |
Line 10984 int decodemodel( char model[], int lasto
|
Line 13216 int decodemodel( char model[], int lasto
|
strcpy(strb,modelsav); /* and analyzes it */ |
strcpy(strb,modelsav); /* and analyzes it */ |
/* printf("i=%d a=%s b=%s sav=%s\n",i, stra,strb,modelsav);*/ |
/* printf("i=%d a=%s b=%s sav=%s\n",i, stra,strb,modelsav);*/ |
/*scanf("%d",i);*/ |
/*scanf("%d",i);*/ |
if (strchr(strb,'*')) { /**< Model includes a product V2+V1+V5*age+ V4+V3*age strb=V3*age */ |
if (strchr(strb,'*')) { /**< Model includes a product V2+V1+V5*age+ V4+V3*age strb=V3*age OR double product with age strb=age*V6*V2 or V6*V2*age or V6*age*V2 */ |
cutl(strc,strd,strb,'*'); /**< k=1 strd*strc Vm*Vn: strb=V3*age(input) strc=age strd=V3 ; V3*V2 strc=V2, strd=V3 */ |
cutl(strc,strd,strb,'*'); /**< k=1 strd*strc Vm*Vn: strb=V3*age(input) strc=age strd=V3 ; V3*V2 strc=V2, strd=V3 OR strb=age*V6*V2 strc=V6*V2 strd=age OR c=V2*age OR c=age*V2 */ |
if (strcmp(strc,"age")==0) { /**< Model includes age: Vn*age */ |
if(strchr(strc,'*')) { /**< Model with age and DOUBLE product: allowed since 0.99r44, strc=V6*V2 or V2*age or age*V2, strd=age or V6 or V6 */ |
/* covar is not filled and then is empty */ |
Typevar[k]=3; /* 3 for age and double product age*Vn*Vm varying of fixed */ |
cptcovprod--; |
if(strstr(strc,"age")!=0) { /* It means that strc=V2*age or age*V2 and thus that strd=Vn */ |
cutl(stre,strb,strd,'V'); /* strd=V3(input): stre="3" */ |
cutl(stre,strf,strc,'*') ; /* strf=age or Vm, stre=Vm or age. If strc=V6*V2 then strf=V6 and stre=V2 */ |
Tvar[k]=atoi(stre); /* V2+V1+V5*age+V4+V3*age Tvar[5]=3 ; V1+V2*age Tvar[2]=2; V1+V1*age Tvar[2]=1 */ |
strcpy(strc,strb); /* save strb(=age*Vn*Vm) into strc */ |
Typevar[k]=1; /* 1 for age product */ |
/* We want strb=Vn*Vm */ |
cptcovage++; /* Counts the number of covariates which include age as a product */ |
if(strcmp(strf,"age")==0){ /* strf is "age" so that stre=Vm =V2 . */ |
Tage[cptcovage]=k; /* V2+V1+V4+V3*age Tvar[4]=3, Tage[1] = 4 or V1+V1*age Tvar[2]=1, Tage[1]=2 */ |
strcpy(strb,strd); |
/*printf("stre=%s ", stre);*/ |
strcat(strb,"*"); |
} else if (strcmp(strd,"age")==0) { /* or age*Vn */ |
strcat(strb,stre); |
cptcovprod--; |
}else{ /* strf=Vm If strf=V6 then stre=V2 */ |
cutl(stre,strb,strc,'V'); |
strcpy(strb,strf); |
Tvar[k]=atoi(stre); |
strcat(strb,"*"); |
Typevar[k]=1; /* 1 for age product */ |
strcat(strb,stre); |
cptcovage++; |
strcpy(strd,strb); /* in order for strd to not be "age" for next test (will be Vn*Vm */ |
Tage[cptcovage]=k; |
} |
} else { /* Age is not in the model product V2+V1+V1*V4+V3*age+V3*V2 strb=V3*V2*/ |
/* printf("DEBUG FIXED k=%d, Tage[k]=%d, Tvar[Tage[k]=%d,FixedV[Tvar[Tage[k]]]=%d\n",k,Tage[k],Tvar[Tage[k]],FixedV[Tvar[Tage[k]]]); */ |
/* loops on k1=1 (V3*V2) and k1=2 V4*V3 */ |
/* FixedV[Tvar[Tage[k]]]=0; /\* HERY not sure if V7*V4*age Fixed might not exist yet*\/ */ |
cptcovn++; |
}else{ /* strc=Vn*Vm (and strd=age) and should be strb=Vn*Vm but want to keep original strb double product */ |
cptcovprodnoage++;k1++; |
strcpy(stre,strb); /* save full b in stre */ |
|
strcpy(strb,strc); /* save short c in new short b for next block strb=Vn*Vm*/ |
|
strcpy(strf,strc); /* save short c in new short f */ |
|
cutl(strc,strd,strf,'*'); /* We get strd=Vn and strc=Vm for next block (strb=Vn*Vm)*/ |
|
/* strcpy(strc,stre);*/ /* save full e in c for future */ |
|
} |
|
cptcovdageprod++; /* double product with age Which product is it? */ |
|
/* strcpy(strb,strc); /\* strb was age*V6*V2 or V6*V2*age or V6*age*V2 IS now V6*V2 or V2*age or age*V2 *\/ */ |
|
/* cutl(strc,strd,strb,'*'); /\* strd= V6 or V2 or age and strc= V2 or age or V2 *\/ */ |
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+nqv+ntv+nqtv+k1; /* ncovcolt+k1; For model-covariate k tells which data-covariate to use but |
n=atoi(stre); |
because this model-covariate is a construction we invent a new column |
|
which is after existing variables ncovcol+nqv+ntv+nqtv + k1 |
|
If already ncovcol=4 and model= V2 + V1 + V1*V4 + age*V3 + V3*V2 |
|
thus after V4 we invent V5 and V6 because age*V3 will be computed in 4 |
|
Tvar[3=V1*V4]=4+1=5 Tvar[5=V3*V2]=4 + 2= 6, Tvar[4=age*V3]=3 etc */ |
|
/* Please remark that the new variables are model dependent */ |
|
/* If we have 4 variable but the model uses only 3, like in |
|
* model= V1 + age*V1 + V2 + V3 + age*V2 + age*V3 + V1*V2 + V1*V3 |
|
* k= 1 2 3 4 5 6 7 8 |
|
* Tvar[k]=1 1 2 3 2 3 (5 6) (and not 4 5 because of V4 missing) |
|
* Tage[kk] [1]= 2 [2]=5 [3]=6 kk=1 to cptcovage=3 |
|
* Tvar[Tage[kk]][1]=2 [2]=2 [3]=3 |
|
*/ |
|
Typevar[k]=2; /* 2 for product */ |
|
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 */ |
m=atoi(strc); |
Tposprod[k]=k1; /* Tposprod[3]=1, Tposprod[2]=5 */ |
cptcovage++; /* Counts the number of covariates which include age as a product */ |
Tvard[k1][1] =atoi(strc); /* m 1 for V1*/ |
Tage[cptcovage]=k; /* For age*V3*V2 gives the position in model of covariates associated with age Tage[1]=6 HERY too*/ |
Tvardk[k][1] =atoi(strc); /* m 1 for V1*/ |
if(existcomb[n][m] == 0){ |
Tvard[k1][2] =atoi(stre); /* n 4 for V4*/ |
/* r /home/brouard/Documents/Recherches/REVES/Zachary/Zach-2022/Feinuo_Sun/Feinuo-threeway/femV12V15_3wayintNBe.imach */ |
Tvardk[k][2] =atoi(stre); /* n 4 for V4*/ |
printf("Warning in model combination V%d*V%d should exist in the model before adding V%d*V%d*age !\n",n,m,n,m); |
k2=k2+2; /* k2 is initialize to -1, We want to store the n and m in Vn*Vm at the end of Tvar */ |
fprintf(ficlog,"Warning in model combination V%d*V%d should exist in the model before adding V%d*V%d*age !\n",n,m,n,m); |
/* Tvar[cptcovt+k2]=Tvard[k1][1]; /\* Tvar[(cptcovt=4+k2=1)=5]= 1 (V1) *\/ */ |
fflush(ficlog); |
/* Tvar[cptcovt+k2+1]=Tvard[k1][2]; /\* Tvar[(cptcovt=4+(k2=1)+1)=6]= 4 (V4) *\/ */ |
k1++; /* The combination Vn*Vm will be in the model so we create it at k1 */ |
/*ncovcol=4 and model=V2+V1+V1*V4+age*V3+V3*V2, Tvar[3]=5, Tvar[4]=6, cptcovt=5 */ |
k12++; |
/* 1 2 3 4 5 | Tvar[5+1)=1, Tvar[7]=2 */ |
existcomb[n][m]=k1; |
if( FixedV[Tvardk[k][1]] == 0 && FixedV[Tvardk[k][2]] == 0){ /* If the product is a fixed covariate then we feed the new column with Vn*Vm */ |
existcomb[m][n]=k1; |
for (i=1; i<=lastobs;i++){/* For fixed product */ |
Tvar[k]=ncovcol+nqv+ntv+nqtv+k1; |
/* Computes the new covariate which is a product of |
Tprod[k1]=k; /* Tprod[1]=3(=V1*V4) for V2+V1+V1*V4+age*V3+V3*V2+ age*V6*V3 Gives the k position of the k1 double product Vn*Vm or age*Vn*Vm*/ |
covar[n][i]* covar[m][i] and stores it at ncovol+k1 May not be defined */ |
Tposprod[k]=k1; /* Tposprod[3]=1, Tposprod[2]=5 Gives the k1 double product Vn*Vm or age*Vn*Vm at the k position */ |
covar[ncovcolt+k1][i]=covar[atoi(stre)][i]*covar[atoi(strc)][i]; |
Tvard[k1][1] =m; /* m 1 for V1*/ |
|
Tvardk[k][1] =m; /* m 1 for V1*/ |
|
Tvard[k1][2] =n; /* n 4 for V4*/ |
|
Tvardk[k][2] =n; /* n 4 for V4*/ |
|
/* Tvar[Tage[cptcovage]]=k1;*/ /* Tvar[6=age*V3*V2]=9 (new fixed covariate) */ /* We don't know about Fixed yet HERE */ |
|
if( FixedV[Tvardk[k][1]] == 0 && FixedV[Tvardk[k][2]] == 0){ /* If the product is a fixed covariate then we feed the new column with Vn*Vm */ |
|
for (i=1; i<=lastobs;i++){/* For fixed product */ |
|
/* 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[ncovcolt+k1][i]=covar[atoi(stre)][i]*covar[atoi(strc)][i]; |
|
} |
|
cptcovprodage++; /* Counting the number of fixed covariate with age */ |
|
FixedV[ncovcolt+k12]=0; /* We expand Vn*Vm */ |
|
k12++; |
|
FixedV[ncovcolt+k12]=0; |
|
}else{ /*End of FixedV */ |
|
cptcovprodvage++; /* Counting the number of varying covariate with age */ |
|
FixedV[ncovcolt+k12]=1; /* We expand Vn*Vm */ |
|
k12++; |
|
FixedV[ncovcolt+k12]=1; |
} |
} |
} /*End of FixedV */ |
}else{ /* k1 Vn*Vm already exists */ |
} /* End age is not in the model */ |
k11=existcomb[n][m]; |
} /* End if model includes a product */ |
Tposprod[k]=k11; /* OK */ |
else { /* not a product */ |
Tvar[k]=Tvar[Tprod[k11]]; /* HERY */ |
|
Tvardk[k][1]=m; |
|
Tvardk[k][2]=n; |
|
if( FixedV[Tvardk[k][1]] == 0 && FixedV[Tvardk[k][2]] == 0){ /* If the product is a fixed covariate then we feed the new column with Vn*Vm */ |
|
/*cptcovage++;*/ /* Counts the number of covariates which include age as a product */ |
|
cptcovprodage++; /* Counting the number of fixed covariate with age */ |
|
/*Tage[cptcovage]=k;*/ /* For age*V3*V2 Tage[1]=V3*V3=9 HERY too*/ |
|
Tvar[Tage[cptcovage]]=k1; |
|
FixedV[ncovcolt+k12]=0; /* We expand Vn*Vm */ |
|
k12++; |
|
FixedV[ncovcolt+k12]=0; |
|
}else{ /* Already exists but time varying (and age) */ |
|
/*cptcovage++;*/ /* Counts the number of covariates which include age as a product */ |
|
/*Tage[cptcovage]=k;*/ /* For age*V3*V2 Tage[1]=V3*V3=9 HERY too*/ |
|
/* Tvar[Tage[cptcovage]]=k1; */ |
|
cptcovprodvage++; |
|
FixedV[ncovcolt+k12]=1; /* We expand Vn*Vm */ |
|
k12++; |
|
FixedV[ncovcolt+k12]=1; |
|
} |
|
} |
|
/* Tage[cptcovage]=k; /\* V2+V1+V4+V3*age Tvar[4]=3, Tage[1] = 4 or V1+V1*age Tvar[2]=1, Tage[1]=2 *\/ */ |
|
/* Tvar[k]=k11; /\* HERY *\/ */ |
|
} else {/* simple product strb=age*Vn so that c=Vn and d=age, or strb=Vn*age so that c=age and d=Vn, or b=Vn*Vm so that c=Vm and d=Vn */ |
|
cptcovprod++; |
|
if (strcmp(strc,"age")==0) { /**< Model includes age: strb= Vn*age c=age d=Vn*/ |
|
/* covar is not filled and then is empty */ |
|
cutl(stre,strb,strd,'V'); /* strd=V3(input): stre="3" */ |
|
Tvar[k]=atoi(stre); /* V2+V1+V5*age+V4+V3*age Tvar[5]=3 ; V1+V2*age Tvar[2]=2; V1+V1*age Tvar[2]=1 */ |
|
Typevar[k]=1; /* 1 for age product */ |
|
cptcovage++; /* Counts the number of covariates which include age as a product */ |
|
Tage[cptcovage]=k; /* V2+V1+V4+V3*age Tvar[4]=3, Tage[1] = 4 or V1+V1*age Tvar[2]=1, Tage[1]=2 */ |
|
if( FixedV[Tvar[k]] == 0){ |
|
cptcovprodage++; /* Counting the number of fixed covariate with age */ |
|
}else{ |
|
cptcovprodvage++; /* Counting the number of fixedvarying covariate with age */ |
|
} |
|
/*printf("stre=%s ", stre);*/ |
|
} else if (strcmp(strd,"age")==0) { /* strb= age*Vn c=Vn */ |
|
cutl(stre,strb,strc,'V'); |
|
Tvar[k]=atoi(stre); |
|
Typevar[k]=1; /* 1 for age product */ |
|
cptcovage++; |
|
Tage[cptcovage]=k; |
|
if( FixedV[Tvar[k]] == 0){ |
|
cptcovprodage++; /* Counting the number of fixed covariate with age */ |
|
}else{ |
|
cptcovprodvage++; /* Counting the number of fixedvarying covariate with age */ |
|
} |
|
}else{ /* for product Vn*Vm */ |
|
Typevar[k]=2; /* 2 for product Vn*Vm */ |
|
cutl(stre,strb,strc,'V'); /* strc= Vn, stre is n; strb=V3*V2 stre=3 strc=*/ |
|
n=atoi(stre); |
|
cutl(strc,strb,strd,'V'); /* strd was Vm, strc is m */ |
|
m=atoi(strc); |
|
k1++; |
|
cptcovprodnoage++; |
|
if(existcomb[n][m] != 0 || existcomb[m][n] != 0){ |
|
printf("Warning in model combination V%d*V%d already exists in the model in position k1=%d!\n",n,m,existcomb[n][m]); |
|
fprintf(ficlog,"Warning in model combination V%d*V%d already exists in the model in position k1=%d!\n",n,m,existcomb[n][m]); |
|
fflush(ficlog); |
|
k11=existcomb[n][m]; |
|
Tvar[k]=ncovcol+nqv+ntv+nqtv+k11; |
|
Tposprod[k]=k11; |
|
Tprod[k11]=k; |
|
Tvardk[k][1] =m; /* m 1 for V1*/ |
|
/* Tvard[k11][1] =m; /\* n 4 for V4*\/ */ |
|
Tvardk[k][2] =n; /* n 4 for V4*/ |
|
/* Tvard[k11][2] =n; /\* n 4 for V4*\/ */ |
|
}else{ /* combination Vn*Vm doesn't exist we create it (no age)*/ |
|
existcomb[n][m]=k1; |
|
existcomb[m][n]=k1; |
|
Tvar[k]=ncovcol+nqv+ntv+nqtv+k1; /* ncovcolt+k1; For model-covariate k tells which data-covariate to use but |
|
because this model-covariate is a construction we invent a new column |
|
which is after existing variables ncovcol+nqv+ntv+nqtv + k1 |
|
If already ncovcol=4 and model= V2 + V1 + V1*V4 + age*V3 + V3*V2 |
|
thus after V4 we invent V5 and V6 because age*V3 will be computed in 4 |
|
Tvar[3=V1*V4]=4+1=5 Tvar[5=V3*V2]=4 + 2= 6, Tvar[4=age*V3]=3 etc */ |
|
/* Please remark that the new variables are model dependent */ |
|
/* If we have 4 variable but the model uses only 3, like in |
|
* model= V1 + age*V1 + V2 + V3 + age*V2 + age*V3 + V1*V2 + V1*V3 |
|
* k= 1 2 3 4 5 6 7 8 |
|
* Tvar[k]=1 1 2 3 2 3 (5 6) (and not 4 5 because of V4 missing) |
|
* Tage[kk] [1]= 2 [2]=5 [3]=6 kk=1 to cptcovage=3 |
|
* Tvar[Tage[kk]][1]=2 [2]=2 [3]=3 |
|
*/ |
|
/* We need to feed some variables like TvarVV, but later on next loop because of ncovv (k2) is not correct */ |
|
Tprod[k1]=k; /* Tprod[1]=3(=V1*V4) for V2+V1+V1*V4+age*V3+V3*V2 +V6*V2*age */ |
|
Tposprod[k]=k1; /* Tposprod[3]=1, Tposprod[2]=5 */ |
|
Tvard[k1][1] =m; /* m 1 for V1*/ |
|
Tvardk[k][1] =m; /* m 1 for V1*/ |
|
Tvard[k1][2] =n; /* n 4 for V4*/ |
|
Tvardk[k][2] =n; /* n 4 for V4*/ |
|
k2=k2+2; /* k2 is initialize to -1, We want to store the n and m in Vn*Vm at the end of Tvar */ |
|
/* Tvar[cptcovt+k2]=Tvard[k1][1]; /\* Tvar[(cptcovt=4+k2=1)=5]= 1 (V1) *\/ */ |
|
/* Tvar[cptcovt+k2+1]=Tvard[k1][2]; /\* Tvar[(cptcovt=4+(k2=1)+1)=6]= 4 (V4) *\/ */ |
|
/*ncovcol=4 and model=V2+V1+V1*V4+age*V3+V3*V2, Tvar[3]=5, Tvar[4]=6, cptcovt=5 */ |
|
/* 1 2 3 4 5 | Tvar[5+1)=1, Tvar[7]=2 */ |
|
if( FixedV[Tvardk[k][1]] == 0 && FixedV[Tvardk[k][2]] == 0){ /* If the product is a fixed covariate then we feed the new column with Vn*Vm */ |
|
for (i=1; i<=lastobs;i++){/* For fixed product */ |
|
/* 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[ncovcolt+k1][i]=covar[atoi(stre)][i]*covar[atoi(strc)][i]; |
|
} |
|
/* TvarVV[k2]=n; */ |
|
/* FixedV[ncovcolt+k2]=0; /\* or FixedV[Tvar[k]]=0; FixedV[TvarVV[ncovv]]=0 HERE *\/ */ |
|
/* TvarVV[k2+1]=m; */ |
|
/* FixedV[ncovcolt+k2]=0; /\* or FixedV[Tvar[k]]=0; FixedV[TvarVV[ncovv]]=0 HERE *\/ */ |
|
}else{ /* not FixedV */ |
|
/* TvarVV[k2]=n; */ |
|
/* FixedV[ncovcolt+k2]=0; /\* or FixedV[Tvar[k]]=0; FixedV[TvarVV[ncovv]]=0 HERE *\/ */ |
|
/* TvarVV[k2+1]=m; */ |
|
/* FixedV[ncovcolt+k2]=0; /\* or FixedV[Tvar[k]]=0; FixedV[TvarVV[ncovv]]=0 HERE *\/ */ |
|
} |
|
} /* End of creation of Vn*Vm if not created by age*Vn*Vm earlier */ |
|
} /* End of product Vn*Vm */ |
|
} /* End of age*double product or simple product */ |
|
}else { /* not a product */ |
/*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'); |
Line 11056 int decodemodel( char model[], int lasto
|
Line 13418 int decodemodel( char model[], int lasto
|
/*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) */ |
|
cptcovs=cptcovt - cptcovdageprod - cptcovprod;/**< Number of simple covariates V1 +V1*age +V3 +V3*V4 +age*age + age*v4*V3=> V1 + V3 =4+1-3=2 */ |
|
|
/*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*/ |
|
|
Line 11084 int decodemodel( char model[], int lasto
|
Line 13449 int decodemodel( char model[], int lasto
|
/* Tvar[k] is the value n of Vn with n varying for 1 to nvcol, or p Vp=Vn*Vm for 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 */ |
/* Computing effective variables, ie used by the model, that is from the cptcovt variables */ |
printf("Model=1+age+%s\n\ |
printf("Model=1+age+%s\n\ |
Typevar: 0 for simple covariate (dummy, quantitative, fixed or varying), 1 for age product, 2 for product \n\ |
Typevar: 0 for simple covariate (dummy, quantitative, fixed or varying), 1 for age product, 2 for product, 3 for double product with age \n\ |
Fixed[k] 0=fixed (product or simple), 1 varying, 2 fixed with age product, 3 varying with age 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); |
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=1+age+%s\n\ |
fprintf(ficlog,"Model=1+age+%s\n\ |
Typevar: 0 for simple covariate (dummy, quantitative, fixed or varying), 1 for age product, 2 for product \n\ |
Typevar: 0 for simple covariate (dummy, quantitative, fixed or varying), 1 for age product, 2 for product, 3 for double product with age \n\ |
Fixed[k] 0=fixed (product or simple), 1 varying, 2 fixed with age product, 3 varying with age 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); |
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;k<=NCOVMAX; 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, ncovvt=0;k<=cptcovt; k++){ /* or cptocvt */ |
for(k=1;k<=NCOVMAX; k++){TvarFind[k]=0; TvarVind[k]=0;} |
|
|
|
|
|
/* Second loop for calculating Fixed[k], Dummy[k]*/ |
|
|
|
|
|
for(k=1, ncovf=0, nsd=0, nsq=0, ncovv=0,ncovva=0,ncovvta=0, ncova=0, ncoveff=0, nqfveff=0, ntveff=0, nqtveff=0, ncovvt=0;k<=cptcovt; k++){ /* or cptocvt loop on k from model */ |
if (Tvar[k] <=ncovcol && Typevar[k]==0 ){ /* Simple fixed dummy (<=ncovcol) covariates */ |
if (Tvar[k] <=ncovcol && Typevar[k]==0 ){ /* Simple fixed dummy (<=ncovcol) covariates */ |
Fixed[k]= 0; |
Fixed[k]= 0; |
Dummy[k]= 0; |
Dummy[k]= 0; |
Line 11108 Dummy[k] 0=dummy (0 1), 1 quantitative (
|
Line 13479 Dummy[k] 0=dummy (0 1), 1 quantitative (
|
TvarFD[ncoveff]=Tvar[k]; /* TvarFD[1]=V1 in V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1 */ |
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 */ |
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 For a fixed product k is higher than ncovcol *\/ */ |
/* }else if( Tvar[k] <=ncovcol && Typevar[k]==2){ /\* Product of fixed dummy (<=ncovcol) covariates For a fixed product k is higher than ncovcol *\/ */ |
}else if( Tposprod[k]>0 && Typevar[k]==2 && FixedV[Tvardk[k][1]] == 0 && FixedV[Tvardk[k][2]] == 0){ /* Needs a fixed product Product of fixed dummy (<=ncovcol) covariates For a fixed product k is higher than ncovcol */ |
|
Fixed[k]= 0; |
|
Dummy[k]= 0; |
|
ncoveff++; |
|
ncovf++; |
|
modell[k].maintype= FTYPE; |
|
TvarF[ncovf]=Tvar[k]; |
|
/* TnsdVar[Tvar[k]]=nsd; */ /* To be done */ |
|
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 */ |
}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; |
Fixed[k]= 0; |
Dummy[k]= 1; |
Dummy[k]= 1; |
Line 11180 Dummy[k] 0=dummy (0 1), 1 quantitative (
|
Line 13540 Dummy[k] 0=dummy (0 1), 1 quantitative (
|
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 */ |
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 */ |
TmodelInvQind[nqtveff]=Tvar[k]- ncovcol-nqv-ntv;/* Only simple time varying quantitative variable */ |
/* Tmodeliqind[k]=nqtveff;/\* 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 TmodelQind[%d]=%d,Tvar[TmodelQind[%d]]=V%d, ncovcol=%d, nqv=%d, ntv=%Ad,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); |
/* printf("Quasi TmodelInvQind[%d]=%d\n",k,Tvar[k]- ncovcol-nqv-ntv); */ |
}else if (Typevar[k] == 1) { /* product with age */ |
}else if (Typevar[k] == 1) { /* product with age */ |
ncova++; |
ncova++; |
TvarA[ncova]=Tvar[k]; |
TvarA[ncova]=Tvar[k]; |
TvarAind[ncova]=k; |
TvarAind[ncova]=k; |
|
/** Fixed[k] 0=fixed, 1 varying, 2 fixed with age product, 3 varying with age product */ |
|
/** Dummy[k] 0=dummy (0 1), 1 quantitative (single or product without age), 2 dummy with age product, 3 quant with age product */ |
if (Tvar[k] <=ncovcol ){ /* Product age with fixed dummy covariatee */ |
if (Tvar[k] <=ncovcol ){ /* Product age with fixed dummy covariatee */ |
Fixed[k]= 2; |
Fixed[k]= 2; |
Dummy[k]= 2; |
Dummy[k]= 2; |
modell[k].maintype= ATYPE; |
modell[k].maintype= ATYPE; |
modell[k].subtype= APFD; |
modell[k].subtype= APFD; |
|
ncovta++; |
|
TvarAVVA[ncovta]=Tvar[k]; /* (2)age*V3 */ |
|
TvarAVVAind[ncovta]=k; |
/* ncoveff++; */ |
/* ncoveff++; */ |
}else if( Tvar[k] <=ncovcol+nqv) { /* Remind that product Vn*Vm are added in k*/ |
}else if( Tvar[k] <=ncovcol+nqv) { /* Remind that product Vn*Vm are added in k*/ |
Fixed[k]= 2; |
Fixed[k]= 2; |
Dummy[k]= 3; |
Dummy[k]= 3; |
modell[k].maintype= ATYPE; |
modell[k].maintype= ATYPE; |
modell[k].subtype= APFQ; /* Product age * fixed quantitative */ |
modell[k].subtype= APFQ; /* Product age * fixed quantitative */ |
|
ncovta++; |
|
TvarAVVA[ncovta]=Tvar[k]; /* */ |
|
TvarAVVAind[ncovta]=k; |
/* nqfveff++; /\* Only simple fixed quantitative variable *\/ */ |
/* nqfveff++; /\* Only simple fixed quantitative variable *\/ */ |
}else if( Tvar[k] <=ncovcol+nqv+ntv ){ |
}else if( Tvar[k] <=ncovcol+nqv+ntv ){ |
Fixed[k]= 3; |
Fixed[k]= 3; |
Dummy[k]= 2; |
Dummy[k]= 2; |
modell[k].maintype= ATYPE; |
modell[k].maintype= ATYPE; |
modell[k].subtype= APVD; /* Product age * varying dummy */ |
modell[k].subtype= APVD; /* Product age * varying dummy */ |
|
ncovva++; |
|
TvarVVA[ncovva]=Tvar[k]; /* (1)+age*V6 + (2)age*V7 */ |
|
TvarVVAind[ncovva]=k; |
|
ncovta++; |
|
TvarAVVA[ncovta]=Tvar[k]; /* */ |
|
TvarAVVAind[ncovta]=k; |
/* ntveff++; /\* Only simple time varying dummy variable *\/ */ |
/* ntveff++; /\* Only simple time varying dummy variable *\/ */ |
}else if( Tvar[k] <=ncovcol+nqv+ntv+nqtv){ |
}else if( Tvar[k] <=ncovcol+nqv+ntv+nqtv){ |
Fixed[k]= 3; |
Fixed[k]= 3; |
Dummy[k]= 3; |
Dummy[k]= 3; |
modell[k].maintype= ATYPE; |
modell[k].maintype= ATYPE; |
modell[k].subtype= APVQ; /* Product age * varying quantitative */ |
modell[k].subtype= APVQ; /* Product age * varying quantitative */ |
|
ncovva++; |
|
TvarVVA[ncovva]=Tvar[k]; /* */ |
|
TvarVVAind[ncovva]=k; |
|
ncovta++; |
|
TvarAVVA[ncovta]=Tvar[k]; /* (1)+age*V6 + (2)age*V7 */ |
|
TvarAVVAind[ncovta]=k; |
/* nqtveff++;/\* Only simple time varying quantitative variable *\/ */ |
/* nqtveff++;/\* Only simple time varying quantitative variable *\/ */ |
} |
} |
}else if (Typevar[k] == 2) { /* product Vn * Vm without age, V1+V3+age*V1+age*V3+V1*V3 looking at V1*V3, Typevar={0, 0, 1, 1, 2}, k=5, V1 is fixed, V3 is timevary, V5 is a product */ |
}else if( Tposprod[k]>0 && Typevar[k]==2){ /* Detects if fixed product no age Vm*Vn */ |
|
printf("MEMORY ERRORR k=%d Tposprod[k]=%d, Typevar[k]=%d\n ",k, Tposprod[k], Typevar[k]); |
|
if(FixedV[Tvardk[k][1]] == 0 && FixedV[Tvardk[k][2]] == 0){ /* Needs a fixed product Product of fixed dummy (<=ncovcol) covariates For a fixed product k is higher than ncovcol V3*V2 */ |
|
printf("MEMORY ERRORR k=%d Tvardk[k][1]=%d, Tvardk[k][2]=%d, FixedV[Tvardk[k][1]]=%d,FixedV[Tvardk[k][2]]=%d\n ",k,Tvardk[k][1],Tvardk[k][2],FixedV[Tvardk[k][1]],FixedV[Tvardk[k][2]]); |
|
Fixed[k]= 0; |
|
Dummy[k]= 0; |
|
ncoveff++; |
|
ncovf++; |
|
/* ncovv++; */ |
|
/* TvarVV[ncovv]=Tvardk[k][1]; */ |
|
/* FixedV[ncovcolt+ncovv]=0; /\* or FixedV[TvarVV[ncovv]]=0 HERE *\/ */ |
|
/* ncovv++; */ |
|
/* TvarVV[ncovv]=Tvardk[k][2]; */ |
|
/* FixedV[ncovcolt+ncovv]=0; /\* or FixedV[TvarVV[ncovv]]=0 HERE *\/ */ |
|
modell[k].maintype= FTYPE; |
|
TvarF[ncovf]=Tvar[k]; |
|
/* TnsdVar[Tvar[k]]=nsd; */ /* To be done */ |
|
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{/* product varying Vn * Vm without age, V1+V3+age*V1+age*V3+V1*V3 looking at V1*V3, Typevar={0, 0, 1, 1, 2}, k=5, V1 is fixed, V3 is timevary, V5 is a product */ |
|
/*# ID V1 V2 weight birth death 1st s1 V3 V4 V5 2nd s2 */ |
|
/* model V1+V3+age*V1+age*V3+V1*V3 + V1*V3*age*/ |
|
/* Tvar={1, 3, 1, 3, 6, 6}, the 6 comes from the fact that there are already V1, V2, V3, V4, V5 native covariates */ |
|
k1=Tposprod[k]; /* Position in the products of product k, Tposprod={0, 0, 0, 0, 1, 1} k1=1 first product but second time varying because of V3 */ |
|
ncovvt++; |
|
TvarVV[ncovvt]=Tvard[k1][1]; /* TvarVV[2]=V1 (because TvarVV[1] was V3, first time varying covariates */ |
|
TvarVVind[ncovvt]=k; /* TvarVVind[2]=5 (because TvarVVind[2] was V1*V3 at position 5 */ |
|
ncovvt++; |
|
TvarVV[ncovvt]=Tvard[k1][2]; /* TvarVV[3]=V3 */ |
|
TvarVVind[ncovvt]=k; /* TvarVVind[2]=5 (because TvarVVind[2] was V1*V3 at position 5 */ |
|
|
|
/** Fixed[k] 0=fixed, 1 varying, 2 fixed with age product, 3 varying with age product */ |
|
/** Dummy[k] 0=dummy (0 1), 1 quantitative (single or product without age), 2 dummy with age product, 3 quant with age product */ |
|
|
|
if(Tvard[k1][1] <=ncovcol){ /* Vn is dummy fixed, (Tvard[1][1]=V1), (Tvard[1][1]=V3 time varying) */ |
|
if(Tvard[k1][2] <=ncovcol){ /* Vm is dummy fixed */ |
|
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){ /* Vm is quanti fixed */ |
|
Fixed[k]= 0; /* Fixed product */ |
|
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){ /* Vm is a time varying dummy covariate */ |
|
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]; /* TvarV[1]=Tvar[5]=5 because there is a V4 */ |
|
TvarVind[ncovv]=k;/* TvarVind[1]=5 */ |
|
}else if(Tvard[k1][2] <=ncovcol+nqv+ntv+nqtv){ /* Vm is a time varying quantitative covariate */ |
|
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){ /* Vn is fixed quanti */ |
|
if(Tvard[k1][2] <=ncovcol){ /* Vm is fixed dummy */ |
|
Fixed[k]= 0; /* Fixed product */ |
|
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){ /* Vm is time varying */ |
|
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){ /* Vm is time varying quanti */ |
|
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){ /* Vn is time varying dummy */ |
|
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){ /* Vn is time varying quanti */ |
|
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 if(Typevar[k] == 3){ /* product Vn * Vm with age, V1+V3+age*V1+age*V3+V1*V3 looking at V1*V3, Typevar={0, 0, 1, 1, 2}, k=5, V1 is fixed, V3 is timevary, V5 is a product */ |
/*# ID V1 V2 weight birth death 1st s1 V3 V4 V5 2nd s2 */ |
/*# ID V1 V2 weight birth death 1st s1 V3 V4 V5 2nd s2 */ |
/* model V1+V3+age*V1+age*V3+V1*V3 */ |
/* model V1+V3+age*V1+age*V3+V1*V3 + V1*V3*age*/ |
/* Tvar={1, 3, 1, 3, 6}, the 6 comes from the fact that there are already V1, V2, V3, V4, V5 native covariates */ |
/* Tvar={1, 3, 1, 3, 6, 6}, the 6 comes from the fact that there are already V1, V2, V3, V4, V5 native covariates */ |
k1=Tposprod[k]; /* Position in the products of product k, Tposprod={0, 0, 0, 0, 1} k1=1 first product but second time varying because of V3 */ |
k1=Tposprod[k]; /* Position in the products of product k, Tposprod={0, 0, 0, 0, 1, 1} k1=1 first product but second time varying because of V3 */ |
ncovvt++; |
ncova++; |
TvarVV[ncovvt]=Tvard[k1][1]; /* TvarVV[2]=V1 (because TvarVV[1] was V3, first time varying covariates */ |
TvarA[ncova]=Tvard[k1][1]; /* TvarVV[2]=V1 (because TvarVV[1] was V3, first time varying covariates */ |
TvarVVind[ncovvt]=k; /* TvarVVind[2]=5 (because TvarVVind[2] was V1*V3 at position 5 */ |
TvarAind[ncova]=k; /* TvarVVind[2]=5 (because TvarVVind[2] was V1*V3 at position 5 */ |
ncovvt++; |
ncova++; |
TvarVV[ncovvt]=Tvard[k1][2]; /* TvarVV[3]=V3 */ |
TvarA[ncova]=Tvard[k1][2]; /* TvarVV[3]=V3 */ |
TvarVVind[ncovvt]=k; /* TvarVVind[2]=5 (because TvarVVind[2] was V1*V3 at position 5 */ |
TvarAind[ncova]=k; /* TvarVVind[2]=5 (because TvarVVind[2] was V1*V3 at position 5 */ |
|
|
|
|
|
/** Fixed[k] 0=fixed, 1 varying, 2 fixed with age product, 3 varying with age product */ |
|
/** Dummy[k] 0=dummy (0 1), 1 quantitative (single or product without age), 2 dummy with age product, 3 quant with age product */ |
|
if( FixedV[Tvardk[k][1]] == 0 && FixedV[Tvardk[k][2]] == 0){ |
|
ncovta++; |
|
TvarAVVA[ncovta]=Tvard[k1][1]; /* age*V6*V3 +age*V7*V3 + age*V6*V4 +age*V7*V4 */ |
|
TvarAVVAind[ncovta]=k; |
|
ncovta++; |
|
TvarAVVA[ncovta]=Tvard[k1][2]; /* age*V6*V3 +age*V7*V3 + age*V6*V4 +age*V7*V4 */ |
|
TvarAVVAind[ncovta]=k; |
|
}else{ |
|
ncovva++; /* HERY reached */ |
|
TvarVVA[ncovva]=Tvard[k1][1]; /* age*V6*V3 +age*V7*V3 + age*V6*V4 +age*V7*V4 */ |
|
TvarVVAind[ncovva]=k; |
|
ncovva++; |
|
TvarVVA[ncovva]=Tvard[k1][2]; /* */ |
|
TvarVVAind[ncovva]=k; |
|
ncovta++; |
|
TvarAVVA[ncovta]=Tvard[k1][1]; /* age*V6*V3 +age*V7*V3 + age*V6*V4 +age*V7*V4 */ |
|
TvarAVVAind[ncovta]=k; |
|
ncovta++; |
|
TvarAVVA[ncovta]=Tvard[k1][2]; /* age*V6*V3 +age*V7*V3 + age*V6*V4 +age*V7*V4 */ |
|
TvarAVVAind[ncovta]=k; |
|
} |
if(Tvard[k1][1] <=ncovcol){ /* Vn is dummy fixed, (Tvard[1][1]=V1), (Tvard[1][1]=V3 time varying) */ |
if(Tvard[k1][1] <=ncovcol){ /* Vn is dummy fixed, (Tvard[1][1]=V1), (Tvard[1][1]=V3 time varying) */ |
if(Tvard[k1][2] <=ncovcol){ /* Vm is dummy fixed */ |
if(Tvard[k1][2] <=ncovcol){ /* Vm is dummy fixed */ |
Fixed[k]= 1; |
Fixed[k]= 2; |
Dummy[k]= 0; |
Dummy[k]= 2; |
modell[k].maintype= FTYPE; |
modell[k].maintype= FTYPE; |
modell[k].subtype= FPDD; /* Product fixed dummy * fixed dummy */ |
modell[k].subtype= FPDD; /* Product fixed dummy * fixed dummy */ |
ncovf++; /* Fixed variables without age */ |
/* TvarF[ncova]=Tvar[k]; /\* Problem to solve *\/ */ |
TvarF[ncovf]=Tvar[k]; |
/* TvarFind[ncova]=k; */ |
TvarFind[ncovf]=k; |
|
}else if(Tvard[k1][2] <=ncovcol+nqv){ /* Vm is quanti fixed */ |
}else if(Tvard[k1][2] <=ncovcol+nqv){ /* Vm is quanti fixed */ |
Fixed[k]= 0; /* Fixed product */ |
Fixed[k]= 2; /* Fixed product */ |
Dummy[k]= 1; |
Dummy[k]= 3; |
modell[k].maintype= FTYPE; |
modell[k].maintype= FTYPE; |
modell[k].subtype= FPDQ; /* Product fixed dummy * fixed quantitative */ |
modell[k].subtype= FPDQ; /* Product fixed dummy * fixed quantitative */ |
ncovf++; /* Varying variables without age */ |
/* TvarF[ncova]=Tvar[k]; */ |
TvarF[ncovf]=Tvar[k]; |
/* TvarFind[ncova]=k; */ |
TvarFind[ncovf]=k; |
|
}else if(Tvard[k1][2] <=ncovcol+nqv+ntv){ /* Vm is a time varying dummy covariate */ |
}else if(Tvard[k1][2] <=ncovcol+nqv+ntv){ /* Vm is a time varying dummy covariate */ |
Fixed[k]= 1; |
Fixed[k]= 3; |
Dummy[k]= 0; |
Dummy[k]= 2; |
modell[k].maintype= VTYPE; |
modell[k].maintype= VTYPE; |
modell[k].subtype= VPDD; /* Product fixed dummy * varying dummy */ |
modell[k].subtype= VPDD; /* Product fixed dummy * varying dummy */ |
ncovv++; /* Varying variables without age */ |
TvarV[ncova]=Tvar[k]; /* TvarV[1]=Tvar[5]=5 because there is a V4 */ |
TvarV[ncovv]=Tvar[k]; /* TvarV[1]=Tvar[5]=5 because there is a V4 */ |
TvarVind[ncova]=k;/* TvarVind[1]=5 */ |
TvarVind[ncovv]=k;/* TvarVind[1]=5 */ |
|
}else if(Tvard[k1][2] <=ncovcol+nqv+ntv+nqtv){ /* Vm is a time varying quantitative covariate */ |
}else if(Tvard[k1][2] <=ncovcol+nqv+ntv+nqtv){ /* Vm is a time varying quantitative covariate */ |
Fixed[k]= 1; |
Fixed[k]= 3; |
Dummy[k]= 1; |
Dummy[k]= 3; |
modell[k].maintype= VTYPE; |
modell[k].maintype= VTYPE; |
modell[k].subtype= VPDQ; /* Product fixed dummy * varying quantitative */ |
modell[k].subtype= VPDQ; /* Product fixed dummy * varying quantitative */ |
ncovv++; /* Varying variables without age */ |
/* ncovv++; /\* Varying variables without age *\/ */ |
TvarV[ncovv]=Tvar[k]; |
/* TvarV[ncovv]=Tvar[k]; */ |
TvarVind[ncovv]=k; |
/* TvarVind[ncovv]=k; */ |
} |
} |
}else if(Tvard[k1][1] <=ncovcol+nqv){ /* Vn is fixed quanti */ |
}else if(Tvard[k1][1] <=ncovcol+nqv){ /* Vn is fixed quanti */ |
if(Tvard[k1][2] <=ncovcol){ /* Vm is fixed dummy */ |
if(Tvard[k1][2] <=ncovcol){ /* Vm is fixed dummy */ |
Fixed[k]= 0; /* Fixed product */ |
Fixed[k]= 2; /* Fixed product */ |
Dummy[k]= 1; |
Dummy[k]= 2; |
modell[k].maintype= FTYPE; |
modell[k].maintype= FTYPE; |
modell[k].subtype= FPDQ; /* Product fixed quantitative * fixed dummy */ |
modell[k].subtype= FPDQ; /* Product fixed quantitative * fixed dummy */ |
ncovf++; /* Fixed variables without age */ |
/* ncova++; /\* Fixed variables with age *\/ */ |
TvarF[ncovf]=Tvar[k]; |
/* TvarF[ncovf]=Tvar[k]; */ |
TvarFind[ncovf]=k; |
/* TvarFind[ncovf]=k; */ |
}else if(Tvard[k1][2] <=ncovcol+nqv+ntv){ /* Vm is time varying */ |
}else if(Tvard[k1][2] <=ncovcol+nqv+ntv){ /* Vm is time varying */ |
Fixed[k]= 1; |
Fixed[k]= 2; |
Dummy[k]= 1; |
Dummy[k]= 3; |
modell[k].maintype= VTYPE; |
modell[k].maintype= VTYPE; |
modell[k].subtype= VPDQ; /* Product fixed quantitative * varying dummy */ |
modell[k].subtype= VPDQ; /* Product fixed quantitative * varying dummy */ |
ncovv++; /* Varying variables without age */ |
/* ncova++; /\* Varying variables with age *\/ */ |
TvarV[ncovv]=Tvar[k]; |
/* TvarV[ncova]=Tvar[k]; */ |
TvarVind[ncovv]=k; |
/* TvarVind[ncova]=k; */ |
}else if(Tvard[k1][2] <=ncovcol+nqv+ntv+nqtv){ /* Vm is time varying quanti */ |
}else if(Tvard[k1][2] <=ncovcol+nqv+ntv+nqtv){ /* Vm is time varying quanti */ |
Fixed[k]= 1; |
Fixed[k]= 3; |
Dummy[k]= 1; |
Dummy[k]= 2; |
modell[k].maintype= VTYPE; |
modell[k].maintype= VTYPE; |
modell[k].subtype= VPQQ; /* Product fixed quantitative * varying quantitative */ |
modell[k].subtype= VPQQ; /* Product fixed quantitative * varying quantitative */ |
ncovv++; /* Varying variables without age */ |
ncova++; /* Varying variables without age */ |
TvarV[ncovv]=Tvar[k]; |
TvarV[ncova]=Tvar[k]; |
TvarVind[ncovv]=k; |
TvarVind[ncova]=k; |
ncovv++; /* Varying variables without age */ |
/* ncova++; /\* Varying variables without age *\/ */ |
TvarV[ncovv]=Tvar[k]; |
/* TvarV[ncova]=Tvar[k]; */ |
TvarVind[ncovv]=k; |
/* TvarVind[ncova]=k; */ |
} |
} |
}else if(Tvard[k1][1] <=ncovcol+nqv+ntv){ /* Vn is time varying dummy */ |
}else if(Tvard[k1][1] <=ncovcol+nqv+ntv){ /* Vn is time varying dummy */ |
if(Tvard[k1][2] <=ncovcol){ |
if(Tvard[k1][2] <=ncovcol){ |
Fixed[k]= 1; |
Fixed[k]= 2; |
Dummy[k]= 1; |
Dummy[k]= 2; |
modell[k].maintype= VTYPE; |
modell[k].maintype= VTYPE; |
modell[k].subtype= VPDD; /* Product time varying dummy * fixed dummy */ |
modell[k].subtype= VPDD; /* Product time varying dummy * fixed dummy */ |
ncovv++; /* Varying variables without age */ |
/* ncova++; /\* Varying variables with age *\/ */ |
TvarV[ncovv]=Tvar[k]; |
/* TvarV[ncova]=Tvar[k]; */ |
TvarVind[ncovv]=k; |
/* TvarVind[ncova]=k; */ |
}else if(Tvard[k1][2] <=ncovcol+nqv){ |
}else if(Tvard[k1][2] <=ncovcol+nqv){ |
Fixed[k]= 1; |
Fixed[k]= 2; |
Dummy[k]= 1; |
Dummy[k]= 3; |
modell[k].maintype= VTYPE; |
modell[k].maintype= VTYPE; |
modell[k].subtype= VPDQ; /* Product time varying dummy * fixed quantitative */ |
modell[k].subtype= VPDQ; /* Product time varying dummy * fixed quantitative */ |
ncovv++; /* Varying variables without age */ |
/* ncova++; /\* Varying variables with age *\/ */ |
TvarV[ncovv]=Tvar[k]; |
/* TvarV[ncova]=Tvar[k]; */ |
TvarVind[ncovv]=k; |
/* TvarVind[ncova]=k; */ |
}else if(Tvard[k1][2] <=ncovcol+nqv+ntv){ |
}else if(Tvard[k1][2] <=ncovcol+nqv+ntv){ |
Fixed[k]= 1; |
Fixed[k]= 3; |
Dummy[k]= 0; |
Dummy[k]= 2; |
modell[k].maintype= VTYPE; |
modell[k].maintype= VTYPE; |
modell[k].subtype= VPDD; /* Product time varying dummy * time varying dummy */ |
modell[k].subtype= VPDD; /* Product time varying dummy * time varying dummy */ |
ncovv++; /* Varying variables without age */ |
/* ncova++; /\* Varying variables with age *\/ */ |
TvarV[ncovv]=Tvar[k]; |
/* TvarV[ncova]=Tvar[k]; */ |
TvarVind[ncovv]=k; |
/* TvarVind[ncova]=k; */ |
}else if(Tvard[k1][2] <=ncovcol+nqv+ntv+nqtv){ |
}else if(Tvard[k1][2] <=ncovcol+nqv+ntv+nqtv){ |
Fixed[k]= 1; |
Fixed[k]= 3; |
Dummy[k]= 1; |
Dummy[k]= 3; |
modell[k].maintype= VTYPE; |
modell[k].maintype= VTYPE; |
modell[k].subtype= VPDQ; /* Product time varying dummy * time varying quantitative */ |
modell[k].subtype= VPDQ; /* Product time varying dummy * time varying quantitative */ |
ncovv++; /* Varying variables without age */ |
/* ncova++; /\* Varying variables with age *\/ */ |
TvarV[ncovv]=Tvar[k]; |
/* TvarV[ncova]=Tvar[k]; */ |
TvarVind[ncovv]=k; |
/* TvarVind[ncova]=k; */ |
} |
} |
}else if(Tvard[k1][1] <=ncovcol+nqv+ntv+nqtv){ /* Vn is time varying quanti */ |
}else if(Tvard[k1][1] <=ncovcol+nqv+ntv+nqtv){ /* Vn is time varying quanti */ |
if(Tvard[k1][2] <=ncovcol){ |
if(Tvard[k1][2] <=ncovcol){ |
Fixed[k]= 1; |
Fixed[k]= 2; |
Dummy[k]= 1; |
Dummy[k]= 2; |
modell[k].maintype= VTYPE; |
modell[k].maintype= VTYPE; |
modell[k].subtype= VPDQ; /* Product time varying quantitative * fixed dummy */ |
modell[k].subtype= VPDQ; /* Product time varying quantitative * fixed dummy */ |
ncovv++; /* Varying variables without age */ |
/* ncova++; /\* Varying variables with age *\/ */ |
TvarV[ncovv]=Tvar[k]; |
/* TvarV[ncova]=Tvar[k]; */ |
TvarVind[ncovv]=k; |
/* TvarVind[ncova]=k; */ |
}else if(Tvard[k1][2] <=ncovcol+nqv){ |
}else if(Tvard[k1][2] <=ncovcol+nqv){ |
Fixed[k]= 1; |
Fixed[k]= 2; |
Dummy[k]= 1; |
Dummy[k]= 3; |
modell[k].maintype= VTYPE; |
modell[k].maintype= VTYPE; |
modell[k].subtype= VPQQ; /* Product time varying quantitative * fixed quantitative */ |
modell[k].subtype= VPQQ; /* Product time varying quantitative * fixed quantitative */ |
ncovv++; /* Varying variables without age */ |
/* ncova++; /\* Varying variables with age *\/ */ |
TvarV[ncovv]=Tvar[k]; |
/* TvarV[ncova]=Tvar[k]; */ |
TvarVind[ncovv]=k; |
/* TvarVind[ncova]=k; */ |
}else if(Tvard[k1][2] <=ncovcol+nqv+ntv){ |
}else if(Tvard[k1][2] <=ncovcol+nqv+ntv){ |
Fixed[k]= 1; |
Fixed[k]= 3; |
Dummy[k]= 1; |
Dummy[k]= 2; |
modell[k].maintype= VTYPE; |
modell[k].maintype= VTYPE; |
modell[k].subtype= VPDQ; /* Product time varying quantitative * time varying dummy */ |
modell[k].subtype= VPDQ; /* Product time varying quantitative * time varying dummy */ |
ncovv++; /* Varying variables without age */ |
/* ncova++; /\* Varying variables with age *\/ */ |
TvarV[ncovv]=Tvar[k]; |
/* TvarV[ncova]=Tvar[k]; */ |
TvarVind[ncovv]=k; |
/* TvarVind[ncova]=k; */ |
}else if(Tvard[k1][2] <=ncovcol+nqv+ntv+nqtv){ |
}else if(Tvard[k1][2] <=ncovcol+nqv+ntv+nqtv){ |
Fixed[k]= 1; |
Fixed[k]= 3; |
Dummy[k]= 1; |
Dummy[k]= 3; |
modell[k].maintype= VTYPE; |
modell[k].maintype= VTYPE; |
modell[k].subtype= VPQQ; /* Product time varying quantitative * time varying quantitative */ |
modell[k].subtype= VPQQ; /* Product time varying quantitative * time varying quantitative */ |
ncovv++; /* Varying variables without age */ |
/* ncova++; /\* Varying variables with age *\/ */ |
TvarV[ncovv]=Tvar[k]; |
/* TvarV[ncova]=Tvar[k]; */ |
TvarVind[ncovv]=k; |
/* TvarVind[ncova]=k; */ |
} |
} |
}else{ |
}else{ |
printf("Error unknown type of covariate: Tvard[%d][1]=%d,Tvard[%d][2]=%d\n",k1,Tvard[k1][1],k1,Tvard[k1][2]); |
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]); |
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*/ |
} /*end k1*/ |
}else{ |
} else{ |
printf("Error, current version can't treat for performance reasons, Tvar[%d]=%d, Typevar[%d]=%d\n", k, Tvar[k], k, Typevar[k]); |
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]); |
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("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); |
/* 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]); |
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]); |
} |
} |
|
ncovvta=ncovva; |
/* Searching for doublons in the model */ |
/* Searching for doublons in the model */ |
for(k1=1; k1<= cptcovt;k1++){ |
for(k1=1; k1<= cptcovt;k1++){ |
for(k2=1; k2 <k1;k2++){ |
for(k2=1; k2 <k1;k2++){ |
Line 11394 Dummy[k] 0=dummy (0 1), 1 quantitative (
|
Line 13965 Dummy[k] 0=dummy (0 1), 1 quantitative (
|
fprintf(ficlog,"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); |
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); |
fprintf(ficlog,"ncovf=%d, ncovv=%d, ncova=%d, nsd=%d, nsq=%d\n",ncovf,ncovv,ncova,nsd, nsq); |
|
|
|
free_imatrix(existcomb,1,NCOVMAX,1,NCOVMAX); |
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: "); |
Line 11933 int hPijx(double *p, int bage, int fage)
|
Line 14506 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, k4, nres=0; |
int h, i, i1, j, k, nres=0; |
|
|
double agedeb; |
double agedeb; |
double ***p3mat; |
double ***p3mat; |
Line 12137 int main(int argc, char *argv[])
|
Line 14710 int main(int argc, char *argv[])
|
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 ageminout=-AGEOVERFLOW,agemaxout=AGEOVERFLOW; /* Smaller Age range redefined after movingaverage */ |
|
|
|
double stdpercent; /* for computing the std error of percent e.i: e.i/e.. */ |
double fret; |
double fret; |
double dum=0.; /* Dummy variable */ |
double dum=0.; /* Dummy variable */ |
double ***p3mat; |
/* double*** p3mat;*/ |
/* double ***mobaverage; */ |
/* double ***mobaverage; */ |
double wald; |
double wald; |
|
|
char line[MAXLINE]; |
char line[MAXLINE], linetmp[MAXLINE]; |
char path[MAXLINE],pathc[MAXLINE],pathcd[MAXLINE],pathtot[MAXLINE]; |
char path[MAXLINE],pathc[MAXLINE],pathcd[MAXLINE],pathtot[MAXLINE]; |
|
|
char modeltemp[MAXLINE]; |
char modeltemp[MAXLINE]; |
Line 12152 int main(int argc, char *argv[])
|
Line 14726 int main(int argc, char *argv[])
|
char pathr[MAXLINE], pathimach[MAXLINE]; |
char pathr[MAXLINE], pathimach[MAXLINE]; |
char *tok, *val; /* pathtot */ |
char *tok, *val; /* pathtot */ |
/* int firstobs=1, lastobs=10; /\* nobs = lastobs-firstobs declared globally ;*\/ */ |
/* int firstobs=1, lastobs=10; /\* nobs = lastobs-firstobs declared globally ;*\/ */ |
int c, h , cpt, c2; |
int c, h; /* c2; */ |
int jl=0; |
int jl=0; |
int i1, j1, jk, stepsize=0; |
int i1, j1, jk, stepsize=0; |
int count=0; |
int count=0; |
Line 12187 int main(int argc, char *argv[])
|
Line 14761 int main(int argc, char *argv[])
|
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; |
|
|
Line 12245 int main(int argc, char *argv[])
|
Line 14819 int main(int argc, char *argv[])
|
getcwd(pathcd, size); |
getcwd(pathcd, size); |
#endif |
#endif |
syscompilerinfo(0); |
syscompilerinfo(0); |
printf("\nIMaCh version %s, %s\n%s",version, copyright, fullversion); |
printf("\nIMaCh prax version %s, %s\n%s",version, copyright, fullversion); |
if(argc <=1){ |
if(argc <=1){ |
printf("\nEnter the parameter file name: "); |
printf("\nEnter the parameter file name: "); |
if(!fgets(pathr,FILENAMELENGTH,stdin)){ |
if(!fgets(pathr,FILENAMELENGTH,stdin)){ |
Line 12476 int main(int argc, char *argv[])
|
Line 15050 int main(int argc, char *argv[])
|
}else |
}else |
break; |
break; |
} |
} |
if((num_filled=sscanf(line,"model=1+age%[^.\n]", model)) !=EOF){ |
if((num_filled=sscanf(line,"model=%[^.\n]", model)) !=EOF){ /* Every character after model but dot and return */ |
|
if (num_filled != 1){ |
|
printf("ERROR %d: Model should be at minimum 'model=1+age+' instead of '%s'\n",num_filled, line); |
|
fprintf(ficlog,"ERROR %d: Model should be at minimum 'model=1+age+' instead of '%s'\n",num_filled, line); |
|
model[0]='\0'; |
|
goto end; |
|
}else{ |
|
trimbtab(linetmp,line); /* Trims multiple blanks in line */ |
|
strcpy(line, linetmp); |
|
} |
|
} |
|
if((num_filled=sscanf(line,"model=1+age%[^.\n]", model)) !=EOF){ /* Every character after 1+age but dot and return */ |
if (num_filled != 1){ |
if (num_filled != 1){ |
printf("ERROR %d: Model should be at minimum 'model=1+age+' instead of '%s'\n",num_filled, line); |
printf("ERROR %d: Model should be at minimum 'model=1+age+' instead of '%s'\n",num_filled, line); |
fprintf(ficlog,"ERROR %d: Model should be at minimum 'model=1+age+' instead of '%s'\n",num_filled, line); |
fprintf(ficlog,"ERROR %d: Model should be at minimum 'model=1+age+' instead of '%s'\n",num_filled, line); |
Line 12518 int main(int argc, char *argv[])
|
Line 15103 int main(int argc, char *argv[])
|
numlinepar++; |
numlinepar++; |
if(line[1]=='q'){ /* This #q will quit imach (the answer is q) */ |
if(line[1]=='q'){ /* This #q will quit imach (the answer is q) */ |
z[0]=line[1]; |
z[0]=line[1]; |
|
}else if(line[1]=='d'){ /* For debugging individual values of covariates in ficresilk */ |
|
debugILK=1;printf("DebugILK\n"); |
} |
} |
/* printf("****line [1] = %c \n",line[1]); */ |
/* printf("****line [1] = %c \n",line[1]); */ |
fputs(line, stdout); |
fputs(line, stdout); |
Line 12815 Please run with mle=-1 to get a correct
|
Line 15402 Please run with mle=-1 to get a correct
|
TvarVQind=ivector(1,NCOVMAX); /* */ |
TvarVQind=ivector(1,NCOVMAX); /* */ |
TvarVV=ivector(1,NCOVMAX); /* */ |
TvarVV=ivector(1,NCOVMAX); /* */ |
TvarVVind=ivector(1,NCOVMAX); /* */ |
TvarVVind=ivector(1,NCOVMAX); /* */ |
|
TvarVVA=ivector(1,NCOVMAX); /* */ |
|
TvarVVAind=ivector(1,NCOVMAX); /* */ |
|
TvarAVVA=ivector(1,NCOVMAX); /* */ |
|
TvarAVVAind=ivector(1,NCOVMAX); /* */ |
|
|
Tvalsel=vector(1,NCOVMAX); /* */ |
Tvalsel=vector(1,NCOVMAX); /* */ |
Tvarsel=ivector(1,NCOVMAX); /* */ |
Tvarsel=ivector(1,NCOVMAX); /* */ |
Typevar=ivector(-1,NCOVMAX); /* -1 to 2 */ |
Typevar=ivector(-1,NCOVMAX); /* -1 to 2 */ |
Fixed=ivector(-1,NCOVMAX); /* -1 to 3 */ |
Fixed=ivector(-1,NCOVMAX); /* -1 to 3 */ |
Dummy=ivector(-1,NCOVMAX); /* -1 to 3 */ |
Dummy=ivector(-1,NCOVMAX); /* -1 to 3 */ |
|
DummyV=ivector(-1,NCOVMAX); /* 1 to 3 */ |
|
FixedV=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 12840 Please run with mle=-1 to get a correct
|
Line 15434 Please run with mle=-1 to get a correct
|
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 |
* For V3*V2 (in V2+V1+V1*V4+age*V3+V3*V2), V3*V2 position is 2nd. |
* For V3*V2 (in V2+V1+V1*V4+age*V3+V3*V2), V3*V2 position is 2nd. |
* Tvard[k1=2][1]=3 (V3) Tvard[k1=2][2]=2(V2) */ |
* Tvard[k1=2][1]=3 (V3) Tvard[k1=2][2]=2(V2) */ |
Tvardk=imatrix(1,NCOVMAX,1,2); |
Tvardk=imatrix(0,NCOVMAX,1,2); |
Tage=ivector(1,NCOVMAX); /* Gives the covariate id of covariates associated with age: V2 + V1 + age*V4 + V3*age |
Tage=ivector(1,NCOVMAX); /* Gives the covariate id of covariates associated with age: V2 + V1 + age*V4 + V3*age |
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 |
Line 12860 Please run with mle=-1 to get a correct
|
Line 15454 Please run with mle=-1 to get a correct
|
* Tmodelqind[1]=1,Tvaraff[1]@9={4, |
* Tmodelqind[1]=1,Tvaraff[1]@9={4, |
* 3, 1, 0, 0, 0, 0, 0, 0}, |
* 3, 1, 0, 0, 0, 0, 0, 0}, |
* model=V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1*/ |
* model=V5+V4+V3+V4*V3+V5*age+V2+V1*V2+V1*age+V1*/ |
|
|
|
/* Probably useless zeroes */ |
|
for(i=1;i<NCOVMAX;i++){ |
|
DummyV[i]=0; |
|
FixedV[i]=0; |
|
} |
|
|
|
for(i=1; i <=ncovcol;i++){ |
|
DummyV[i]=0; |
|
FixedV[i]=0; |
|
} |
|
for(i=ncovcol+1; i <=ncovcol+nqv;i++){ |
|
DummyV[i]=1; |
|
FixedV[i]=0; |
|
} |
|
for(i=ncovcol+nqv+1; i <=ncovcol+nqv+ntv;i++){ |
|
DummyV[i]=0; |
|
FixedV[i]=1; |
|
} |
|
for(i=ncovcol+nqv+ntv+1; i <=ncovcol+nqv+ntv+nqtv;i++){ |
|
DummyV[i]=1; |
|
FixedV[i]=1; |
|
} |
|
for(i=1; i <=ncovcol+nqv+ntv+nqtv;i++){ |
|
printf("Covariate type in the data: V%d, DummyV(V%d)=%d, FixedV(V%d)=%d\n",i,i,DummyV[i],i,FixedV[i]); |
|
fprintf(ficlog,"Covariate type in the data: V%d, DummyV(V%d)=%d, FixedV(V%d)=%d\n",i,i,DummyV[i],i,FixedV[i]); |
|
} |
|
|
|
|
|
|
/* Main decodemodel */ |
/* Main decodemodel */ |
|
|
|
|
Line 13097 This file: <a href=\"%s\">%s</a></br>Tit
|
Line 15721 This file: <a href=\"%s\">%s</a></br>Tit
|
/* 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 for any valid combination of covariates |
and prints on file fileres'p'. */ |
and prints on file fileres'p'. */ |
freqsummary(fileres, p, pstart, agemin, agemax, s, agev, nlstate, imx, Tvaraff, invalidvarcomb, nbcode, ncodemax,mint,anint,strstart, \ |
freqsummary(fileres, p, pstart, (double)agemin, agemax, s, agev, nlstate, imx, Tvaraff, invalidvarcomb, nbcode, ncodemax,mint,anint,strstart, \ |
firstpass, lastpass, stepm, weightopt, model); |
firstpass, lastpass, stepm, weightopt, model); |
|
|
fprintf(fichtm,"\n"); |
fprintf(fichtm,"\n"); |
Line 13188 Interval (in months) between two waves:
|
Line 15812 Interval (in months) between two waves:
|
#ifdef GSL |
#ifdef GSL |
printf("GSL optimization\n"); fprintf(ficlog,"Powell\n"); |
printf("GSL optimization\n"); fprintf(ficlog,"Powell\n"); |
#else |
#else |
printf("Powell\n"); fprintf(ficlog,"Powell\n"); |
printf("Powell-mort\n"); fprintf(ficlog,"Powell-mort\n"); |
#endif |
#endif |
strcpy(filerespow,"POW-MORT_"); |
strcpy(filerespow,"POW-MORT_"); |
strcat(filerespow,fileresu); |
strcat(filerespow,fileresu); |
Line 13283 Interval (in months) between two waves:
|
Line 15907 Interval (in months) between two waves:
|
gsl_multimin_fminimizer_free (sfm); /* p *(sfm.x.data) et p *(sfm.x.data+1) */ |
gsl_multimin_fminimizer_free (sfm); /* p *(sfm.x.data) et p *(sfm.x.data+1) */ |
#endif |
#endif |
#ifdef POWELL |
#ifdef POWELL |
powell(p,ximort,NDIM,ftol,&iter,&fret,gompertz); |
#ifdef LINMINORIGINAL |
#endif |
#else /* LINMINORIGINAL */ |
|
|
|
flatdir=ivector(1,npar); |
|
for (j=1;j<=npar;j++) flatdir[j]=0; |
|
#endif /*LINMINORIGINAL */ |
|
/* powell(p,ximort,NDIM,ftol,&iter,&fret,gompertz); */ |
|
/* double h0=0.25; */ |
|
macheps=pow(16.0,-13.0); |
|
printf("Praxis Gegenfurtner mle=%d\n",mle); |
|
fprintf(ficlog, "Praxis Gegenfurtner mle=%d\n", mle);fflush(ficlog); |
|
/* ffmin = praxis(ftol,macheps, h0, npar, prin, p, gompertz); */ |
|
/* For the Gompertz we use only two parameters */ |
|
int _npar=2; |
|
ffmin = praxis(ftol,macheps, h0, _npar, 4, p, gompertz); |
|
printf("End Praxis\n"); |
fclose(ficrespow); |
fclose(ficrespow); |
|
#ifdef LINMINORIGINAL |
|
#else |
|
free_ivector(flatdir,1,npar); |
|
#endif /* LINMINORIGINAL*/ |
|
#endif /* POWELL */ |
hesscov(matcov, hess, p, NDIM, delti, 1e-4, gompertz); |
hesscov(matcov, hess, p, NDIM, delti, 1e-4, gompertz); |
|
|
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 "); |
Line 13420 Please run with mle=-1 to get a correct
|
Line 16062 Please run with mle=-1 to get a correct
|
fprintf(ficlog," + age*age "); |
fprintf(ficlog," + age*age "); |
fprintf(fichtm, "<th>+ age*age</th>"); |
fprintf(fichtm, "<th>+ age*age</th>"); |
} |
} |
for(j=1;j <=ncovmodel-2;j++){ |
for(j=1;j <=ncovmodel-2-nagesqr;j++){ |
if(Typevar[j]==0) { |
if(Typevar[j]==0) { |
printf(" + V%d ",Tvar[j]); |
printf(" + V%d ",Tvar[j]); |
fprintf(ficres," + V%d ",Tvar[j]); |
fprintf(ficres," + V%d ",Tvar[j]); |
Line 13436 Please run with mle=-1 to get a correct
|
Line 16078 Please run with mle=-1 to get a correct
|
fprintf(ficres," + V%d*V%d ",Tvard[Tposprod[j]][1],Tvard[Tposprod[j]][2]); |
fprintf(ficres," + 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]); |
fprintf(ficlog," + V%d*V%d ",Tvard[Tposprod[j]][1],Tvard[Tposprod[j]][2]); |
fprintf(fichtm, "<th>+ V%d*V%d</th>",Tvard[Tposprod[j]][1],Tvard[Tposprod[j]][2]); |
fprintf(fichtm, "<th>+ V%d*V%d</th>",Tvard[Tposprod[j]][1],Tvard[Tposprod[j]][2]); |
|
}else if(Typevar[j]==3) { /* TO VERIFY */ |
|
printf(" + V%d*V%d*age ",Tvard[Tposprod[j]][1],Tvard[Tposprod[j]][2]); |
|
fprintf(ficres," + V%d*V%d*age ",Tvard[Tposprod[j]][1],Tvard[Tposprod[j]][2]); |
|
fprintf(ficlog," + V%d*V%d*age ",Tvard[Tposprod[j]][1],Tvard[Tposprod[j]][2]); |
|
fprintf(fichtm, "<th>+ V%d*V%d*age</th>",Tvard[Tposprod[j]][1],Tvard[Tposprod[j]][2]); |
} |
} |
} |
} |
printf("\n"); |
printf("\n"); |
Line 13486 Please run with mle=-1 to get a correct
|
Line 16133 Please run with mle=-1 to get a correct
|
fprintf(ficlog," + age*age "); |
fprintf(ficlog," + age*age "); |
fprintf(fichtm, "<th>+ age*age</th>"); |
fprintf(fichtm, "<th>+ age*age</th>"); |
} |
} |
for(j=1;j <=ncovmodel-2;j++){ |
for(j=1;j <=ncovmodel-2-nagesqr;j++){ |
if(Typevar[j]==0) { |
if(Typevar[j]==0) { |
printf(" + V%d ",Tvar[j]); |
printf(" + V%d ",Tvar[j]); |
fprintf(fichtm, "<th>+ V%d</th>",Tvar[j]); |
fprintf(fichtm, "<th>+ V%d</th>",Tvar[j]); |
Line 13495 Please run with mle=-1 to get a correct
|
Line 16142 Please run with mle=-1 to get a correct
|
fprintf(fichtm, "<th>+ V%d*age</th>",Tvar[j]); |
fprintf(fichtm, "<th>+ V%d*age</th>",Tvar[j]); |
}else if(Typevar[j]==2) { |
}else if(Typevar[j]==2) { |
fprintf(fichtm, "<th>+ V%d*V%d</th>",Tvard[Tposprod[j]][1],Tvard[Tposprod[j]][2]); |
fprintf(fichtm, "<th>+ V%d*V%d</th>",Tvard[Tposprod[j]][1],Tvard[Tposprod[j]][2]); |
|
}else if(Typevar[j]==3) { /* TO VERIFY */ |
|
fprintf(fichtm, "<th>+ V%d*V%d*age</th>",Tvard[Tposprod[j]][1],Tvard[Tposprod[j]][2]); |
} |
} |
} |
} |
fprintf(fichtm, "</tr>\n"); |
fprintf(fichtm, "</tr>\n"); |
Line 13552 Please run with mle=-1 to get a correct
|
Line 16201 Please run with mle=-1 to get a correct
|
} |
} |
|
|
fprintf(ficres,"# Covariance matrix \n# 121 Var(a12)\n# 122 Cov(b12,a12) Var(b12)\n# ...\n# 232 Cov(b23,a12) Cov(b23,b12) ... Var (b23)\n"); |
fprintf(ficres,"# Covariance matrix \n# 121 Var(a12)\n# 122 Cov(b12,a12) Var(b12)\n# ...\n# 232 Cov(b23,a12) Cov(b23,b12) ... Var (b23)\n"); |
if(mle >= 1) /* To big for the screen */ |
if(mle >= 1) /* Too big for the screen */ |
printf("# Covariance matrix \n# 121 Var(a12)\n# 122 Cov(b12,a12) Var(b12)\n# ...\n# 232 Cov(b23,a12) Cov(b23,b12) ... Var (b23)\n"); |
printf("# Covariance matrix \n# 121 Var(a12)\n# 122 Cov(b12,a12) Var(b12)\n# ...\n# 232 Cov(b23,a12) Cov(b23,b12) ... Var (b23)\n"); |
fprintf(ficlog,"# Covariance matrix \n# 121 Var(a12)\n# 122 Cov(b12,a12) Var(b12)\n# ...\n# 232 Cov(b23,a12) Cov(b23,b12) ... Var (b23)\n"); |
fprintf(ficlog,"# Covariance matrix \n# 121 Var(a12)\n# 122 Cov(b12,a12) Var(b12)\n# ...\n# 232 Cov(b23,a12) Cov(b23,b12) ... Var (b23)\n"); |
/* # 121 Var(a12)\n\ */ |
/* # 121 Var(a12)\n\ */ |
Line 13738 Please run with mle=-1 to get a correct
|
Line 16387 Please run with mle=-1 to get a correct
|
} |
} |
|
|
/* Results */ |
/* Results */ |
/* Value of covariate in each resultine will be compututed (if product) and sorted according to model rank */ |
/* Value of covariate in each resultine will be computed (if product) and sorted according to model rank */ |
/* It is precov[] because we need the varying age in order to compute the real cov[] of the model equation */ |
/* It is precov[] because we need the varying age in order to compute the real cov[] of the model equation */ |
precov=matrix(1,MAXRESULTLINESPONE,1,NCOVMAX+1); |
precov=matrix(1,MAXRESULTLINESPONE,1,NCOVMAX+1); |
endishere=0; |
endishere=0; |
Line 13816 Please run with mle=-1 to get a correct
|
Line 16465 Please run with mle=-1 to get a correct
|
case 13: |
case 13: |
num_filled=sscanf(line,"result:%[^\n]\n",resultlineori); |
num_filled=sscanf(line,"result:%[^\n]\n",resultlineori); |
nresult++; /* Sum of resultlines */ |
nresult++; /* Sum of resultlines */ |
printf("Result %d: result:%s\n",nresult, resultlineori); |
/* printf("Result %d: result:%s\n",nresult, resultlineori); */ |
/* removefirstspace(&resultlineori); */ |
/* removefirstspace(&resultlineori); */ |
|
|
if(strstr(resultlineori,"v") !=0){ |
if(strstr(resultlineori,"v") !=0){ |
Line 13825 Please run with mle=-1 to get a correct
|
Line 16474 Please run with mle=-1 to get a correct
|
return 1; |
return 1; |
} |
} |
trimbb(resultline, resultlineori); /* Suppressing double blank in the resultline */ |
trimbb(resultline, resultlineori); /* Suppressing double blank in the resultline */ |
printf("Decoderesult resultline=\"%s\" resultlineori=\"%s\"\n", resultline, resultlineori); |
/* printf("Decoderesult resultline=\"%s\" resultlineori=\"%s\"\n", resultline, resultlineori); */ |
if(nresult > MAXRESULTLINESPONE-1){ |
if(nresult > MAXRESULTLINESPONE-1){ |
printf("ERROR: Current version of IMaCh limits the number of resultlines to %d, you used %d\nYou can use the 'r' parameter file '%s' which uses option mle=0 to get other results. ",MAXRESULTLINESPONE-1,nresult,rfileres); |
printf("ERROR: Current version of IMaCh limits the number of resultlines to %d, you used %d\nYou can use the 'r' parameter file '%s' which uses option mle=0 to get other results. ",MAXRESULTLINESPONE-1,nresult,rfileres); |
fprintf(ficlog,"ERROR: Current version of IMaCh limits the number of resultlines to %d, you used %d\nYou can use the 'r' parameter file '%s' which uses option mle=0 to get other results. ",MAXRESULTLINESPONE-1,nresult,rfileres); |
fprintf(ficlog,"ERROR: Current version of IMaCh limits the number of resultlines to %d, you used %d\nYou can use the 'r' parameter file '%s' which uses option mle=0 to get other results. ",MAXRESULTLINESPONE-1,nresult,rfileres); |
Line 13908 Please run with mle=-1 to get a correct
|
Line 16557 Please run with mle=-1 to get a correct
|
date2dmy(datebackf,&jbackf, &mbackf, &anbackf); |
date2dmy(datebackf,&jbackf, &mbackf, &anbackf); |
} |
} |
|
|
printinggnuplot(fileresu, optionfilefiname,ageminpar,agemaxpar,bage, fage, prevfcast, prevbcast, pathc,p, (int)anprojd-bage, (int)anbackd-fage); |
printinggnuplot(fileresu, optionfilefiname,ageminpar,agemaxpar,bage, fage, prevfcast, prevbcast, pathc,p, (int)anprojd-bage, (int)anbackd-fage);/* HERE valgrind Tvard*/ |
} |
} |
printinghtml(fileresu,title,datafile, firstpass, lastpass, stepm, weightopt, \ |
printinghtml(fileresu,title,datafile, firstpass, lastpass, stepm, weightopt, \ |
model,imx,jmin,jmax,jmean,rfileres,popforecast,mobilav,prevfcast,mobilavproj,prevbcast, estepm, \ |
model,imx,jmin,jmax,jmean,rfileres,popforecast,mobilav,prevfcast,mobilavproj,prevbcast, estepm, \ |
Line 14058 Please run with mle=-1 to get a correct
|
Line 16707 Please run with mle=-1 to get a correct
|
|
|
pstamp(ficreseij); |
pstamp(ficreseij); |
|
|
i1=pow(2,cptcoveff); /* Number of combination of dummy covariates */ |
/* i1=pow(2,cptcoveff); /\* Number of combination of dummy covariates *\/ */ |
if (cptcovn < 1){i1=1;} |
/* if (cptcovn < 1){i1=1;} */ |
|
|
for(nres=1; nres <= nresult; nres++) /* For each resultline */ |
for(nres=1; nres <= nresult; nres++){ /* For each resultline */ |
for(k=1; k<=i1;k++){ /* For any combination of dummy covariates, fixed and varying */ |
/* for(k=1; k<=i1;k++){ /\* For any combination of dummy covariates, fixed and varying *\/ */ |
if(i1 != 1 && TKresult[nres]!= k) |
/* if(i1 != 1 && TKresult[nres]!= k) */ |
continue; |
/* continue; */ |
fprintf(ficreseij,"\n#****** "); |
fprintf(ficreseij,"\n#****** "); |
printf("\n#****** "); |
printf("\n#****** "); |
for(j=1;j<=cptcoveff;j++) { |
for(j=1;j<=cptcovs;j++){ |
fprintf(ficreseij,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,TnsdVar[Tvaraff[j]])]); |
/* for(j=1;j<=cptcoveff;j++) { */ |
printf("V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,TnsdVar[Tvaraff[j]])]); |
/* fprintf(ficreseij,"V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,TnsdVar[Tvaraff[j]])]); */ |
|
fprintf(ficreseij," V%d=%lg ",Tvresult[nres][j],TinvDoQresult[nres][Tvresult[nres][j]]); |
|
printf(" V%d=%lg ",Tvresult[nres][j],TinvDoQresult[nres][Tvresult[nres][j]]); |
|
/* printf("V%d=%d ",Tvaraff[j],nbcode[Tvaraff[j]][codtabm(k,TnsdVar[Tvaraff[j]])]); */ |
} |
} |
for (j=1; j<= nsq; j++){ /* For each selected (single) quantitative value */ |
for (j=1; j<= nsq; j++){ /* For each selected (single) quantitative value */ |
printf(" V%d=%lg ",TvarsQ[j], TinvDoQresult[nres][TvarsQ[j]]); /* TvarsQ[j] gives the name of the jth quantitative (fixed or time v) */ |
printf(" V%d=%lg ",TvarsQ[j], TinvDoQresult[nres][TvarsQ[j]]); /* TvarsQ[j] gives the name of the jth quantitative (fixed or time v) */ |
Line 14138 Please run with mle=-1 to get a correct
|
Line 16790 Please run with mle=-1 to get a correct
|
/* */ |
/* */ |
if(i1 != 1 && TKresult[nres]!= k) /* TKresult[nres] is the combination of this nres resultline. All the i1 combinations are not output */ |
if(i1 != 1 && TKresult[nres]!= k) /* TKresult[nres] is the combination of this nres resultline. All the i1 combinations are not output */ |
continue; |
continue; |
printf("\n# model %s \n#****** Result for:", model); |
printf("\n# model=1+age+%s \n#****** Result for:", model); /* HERE model is empty */ |
fprintf(ficrest,"\n# model %s \n#****** Result for:", model); |
fprintf(ficrest,"\n# model=1+age+%s \n#****** Result for:", model); |
fprintf(ficlog,"\n# model %s \n#****** Result for:", model); |
fprintf(ficlog,"\n# model=1+age+%s \n#****** Result for:", model); |
/* It might not be a good idea to mix dummies and quantitative */ |
/* It might not be a good idea to mix dummies and quantitative */ |
/* for(j=1;j<=cptcoveff;j++){ /\* j=resultpos. Could be a loop on cptcovs: number of single dummy covariate in the result line as well as in the model *\/ */ |
/* for(j=1;j<=cptcoveff;j++){ /\* j=resultpos. Could be a loop on cptcovs: number of single dummy covariate in the result line as well as in the model *\/ */ |
for(j=1;j<=cptcovs;j++){ /* j=resultpos. Could be a loop on cptcovs: number of single covariate (dummy or quantitative) in the result line as well as in the model */ |
for(j=1;j<=cptcovs;j++){ /* j=resultpos. Could be a loop on cptcovs: number of single covariate (dummy or quantitative) in the result line as well as in the model */ |
Line 14162 Please run with mle=-1 to get a correct
|
Line 16814 Please run with mle=-1 to get a correct
|
/* Tvresult[nres][j] Name of the variable at position j in this resultline */ |
/* Tvresult[nres][j] Name of the variable at position j in this resultline */ |
/* Tresult[nres][j] Value of this variable at position j could be a float if quantitative */ |
/* Tresult[nres][j] Value of this variable at position j could be a float if quantitative */ |
/* We give up with the combinations!! */ |
/* We give up with the combinations!! */ |
printf("\n j=%d In computing T_ Dummy[modelresult[%d][%d]]=%d, modelresult[%d][%d]=%d cptcovs=%d, cptcoveff=%d Fixed[modelresult[nres][j]]=%d\n", j, nres, j, Dummy[modelresult[nres][j]],nres,j,modelresult[nres][j],cptcovs, cptcoveff,Fixed[modelresult[nres][j]]); /* end if dummy or quanti */ |
/* if(debugILK) */ |
|
/* printf("\n j=%d In computing T_ Dummy[modelresult[%d][%d]]=%d, modelresult[%d][%d]=%d cptcovs=%d, cptcoveff=%d Fixed[modelresult[nres][j]]=%d\n", j, nres, j, Dummy[modelresult[nres][j]],nres,j,modelresult[nres][j],cptcovs, cptcoveff,Fixed[modelresult[nres][j]]); /\* end if dummy or quanti *\/ */ |
|
|
if(Dummy[modelresult[nres][j]]==0){/* Dummy variable of the variable in position modelresult in the model corresponding to j in resultline */ |
if(Dummy[modelresult[nres][j]]==0){/* Dummy variable of the variable in position modelresult in the model corresponding to j in resultline */ |
printf("V%d=%lg ",Tvresult[nres][j],TinvDoQresult[nres][j]); /* Output of each value for the combination TKresult[nres], ordere by the covariate values in the resultline */ |
/* printf("V%d=%lg ",Tvresult[nres][j],TinvDoQresult[nres][j]); /\* Output of each value for the combination TKresult[nres], ordere by the covariate values in the resultline *\/ */ /* TinvDoQresult[nres][Name of the variable] */ |
fprintf(ficlog,"V%d=%lg ",Tvresult[nres][j],TinvDoQresult[nres][j]); /* Output of each value for the combination TKresult[nres], ordere by the covariate values in the resultline */ |
printf("V%d=%lg ",Tvresult[nres][j],TinvDoQresult[nres][Tvresult[nres][j]]); /* Output of each value for the combination TKresult[nres], ordered by the covariate values in the resultline */ |
fprintf(ficrest,"V%d=%lg ",Tvresult[nres][j],TinvDoQresult[nres][j]); /* Output of each value for the combination TKresult[nres], ordere by the covariate values in the resultline */ |
fprintf(ficlog,"V%d=%lg ",Tvresult[nres][j],TinvDoQresult[nres][Tvresult[nres][j]]); /* Output of each value for the combination TKresult[nres], ordere by the covariate values in the resultline */ |
|
fprintf(ficrest,"V%d=%lg ",Tvresult[nres][j],TinvDoQresult[nres][Tvresult[nres][j]]); /* Output of each value for the combination TKresult[nres], ordere by the covariate values in the resultline */ |
if(Fixed[modelresult[nres][j]]==0){ /* Fixed */ |
if(Fixed[modelresult[nres][j]]==0){ /* Fixed */ |
printf("fixed ");fprintf(ficlog,"fixed ");fprintf(ficrest,"fixed "); |
printf("fixed ");fprintf(ficlog,"fixed ");fprintf(ficrest,"fixed "); |
}else{ |
}else{ |
Line 14246 Please run with mle=-1 to get a correct
|
Line 16900 Please run with mle=-1 to get a correct
|
for(vpopbased=0; vpopbased <= popbased; vpopbased++){ /* Done for vpopbased=0 and vpopbased=1 if popbased==1*/ |
for(vpopbased=0; vpopbased <= popbased; vpopbased++){ /* Done for vpopbased=0 and vpopbased=1 if popbased==1*/ |
oldm=oldms;savm=savms; /* ZZ Segmentation fault */ |
oldm=oldms;savm=savms; /* ZZ Segmentation fault */ |
cptcod= 0; /* To be deleted */ |
cptcod= 0; /* To be deleted */ |
printf("varevsij vpopbased=%d \n",vpopbased); |
printf("varevsij vpopbased=%d popbased=%d \n",vpopbased,popbased); |
fprintf(ficlog, "varevsij vpopbased=%d \n",vpopbased); |
fprintf(ficlog, "varevsij vpopbased=%d popbased=%d \n",vpopbased,popbased); |
|
/* Call to varevsij to get cov(e.i, e.j)= vareij[i][j][(int)age]=sum_h sum_k trgrad(h_p.i) V(theta) grad(k_p.k) Equation 20 */ |
|
/* Depending of popbased which changes the prevalences, either cross-sectional or period */ |
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 */ |
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 state\n\ |
|
# (these are 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); |
else |
else |
fprintf(ficrest,"the age specific forward period (stable) prevalences in each health state \n"); |
fprintf(ficrest,"the age specific forward period (stable) prevalences in each state) \n"); |
|
fprintf(ficrest,"# with proportions of time spent in each state with standard error (on the right of the table.\n "); |
fprintf(ficrest,"# Age popbased mobilav e.. (std) "); /* Adding covariate values? */ |
fprintf(ficrest,"# Age popbased mobilav e.. (std) "); /* Adding covariate values? */ |
for (i=1;i<=nlstate;i++) fprintf(ficrest,"e.%d (std) ",i); |
for (i=1;i<=nlstate;i++) fprintf(ficrest,"e.%d (std) ",i); |
|
for (i=1;i<=nlstate;i++) fprintf(ficrest," %% e.%d/e.. (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"); */ |
printf("Computing age specific forward period (stable) prevalences in each health state \n"); |
printf("Computing age specific forward period (stable) prevalences in each health state \n"); |
Line 14281 Please run with mle=-1 to get a correct
|
Line 16940 Please run with mle=-1 to get a correct
|
/*ZZZ printf("%lf %lf ", prlim[i][i] ,eij[i][j][(int)age]);*/ |
/*ZZZ printf("%lf %lf ", prlim[i][i] ,eij[i][j][(int)age]);*/ |
/* printf("%lf %lf ", prlim[i][i] ,eij[i][j][(int)age]); */ |
/* printf("%lf %lf ", prlim[i][i] ,eij[i][j][(int)age]); */ |
} |
} |
epj[nlstate+1] +=epj[j]; |
epj[nlstate+1] +=epj[j]; /* epp=sum_j epj = sum_j sum_i w_i e_ij */ |
} |
} |
/* printf(" age %4.0f \n",age); */ |
/* printf(" age %4.0f \n",age); */ |
|
|
for(i=1, vepp=0.;i <=nlstate;i++) |
for(i=1, vepp=0.;i <=nlstate;i++) /* Variance of total life expectancy e.. */ |
for(j=1;j <=nlstate;j++) |
for(j=1;j <=nlstate;j++) |
vepp += vareij[i][j][(int)age]; |
vepp += vareij[i][j][(int)age]; /* sum_i sum_j cov(e.i, e.j) = var(e..) */ |
fprintf(ficrest," %7.3f (%7.3f)", epj[nlstate+1],sqrt(vepp)); |
fprintf(ficrest," %7.3f (%7.3f)", epj[nlstate+1],sqrt(vepp)); |
|
/* vareij[i][j] is the covariance cov(e.i, e.j) and vareij[j][j] is the variance of e.j */ |
for(j=1;j <=nlstate;j++){ |
for(j=1;j <=nlstate;j++){ |
fprintf(ficrest," %7.3f (%7.3f)", epj[j],sqrt(vareij[j][j][(int)age])); |
fprintf(ficrest," %7.3f (%7.3f)", epj[j],sqrt(vareij[j][j][(int)age])); |
} |
} |
|
/* And proportion of time spent in state j */ |
|
/* $$ E[r(X,Y)-E(r(X,Y))]^2=[\frac{1}{\mu_y} -\frac{\mu_x}{{\mu_y}^2}]' Var(X,Y)[\frac{1}{\mu_y} -\frac{\mu_x}{{\mu_y}^2}]$$ */ |
|
/* \frac{\mu_x^2}{\mu_y^2} ( \frac{\sigma^2_x}{\mu_x^2}-2\frac{\sigma_{xy}}{\mu_x\mu_y} +\frac{\sigma^2_y}{\mu_y^2}) */ |
|
/* \frac{e_{.i}^2}{e_{..}^2} ( \frac{\Var e_{.i}}{e_{.i}^2}-2\frac{\Var e_{.i} + \sum_{j\ne i} \Cov e_{.j},e_{.i}}{e_{.i}e_{..}} +\frac{\Var e_{..}}{e_{..}^2})*/ |
|
/*\mu_x = epj[j], \sigma^2_x = vareij[j][j][(int)age] and \mu_y=epj[nlstate+1], \sigma^2_y=vepp \sigmaxy= */ |
|
/* vareij[j][j][(int)age]/epj[nlstate+1]^2 + vepp/epj[nlstate+1]^4 */ |
|
for(j=1;j <=nlstate;j++){ |
|
/* fprintf(ficrest," %7.3f (%7.3f)", epj[j]/epj[nlstate+1], sqrt( vareij[j][j][(int)age]/epj[j]/epj[j] + vepp/epj[j]/epj[j]/epj[j]/epj[j] )); */ |
|
/* fprintf(ficrest," %7.3f (%7.3f)", epj[j]/epj[nlstate+1], sqrt( vareij[j][j][(int)age]/epj[j]/epj[j] + vepp/epj[j]/epj[j]/epj[j]/epj[j] )); */ |
|
|
|
for(i=1,stdpercent=0.;i<=nlstate;i++){ /* Computing cov(e..,e.j)=cov(sum_i e.i,e.j)=sum_i cov(e.i, e.j) */ |
|
stdpercent += vareij[i][j][(int)age]; |
|
} |
|
stdpercent= epj[j]*epj[j]/epj[nlstate+1]/epj[nlstate+1]* (vareij[j][j][(int)age]/epj[j]/epj[j]-2.*stdpercent/epj[j]/epj[nlstate+1]+ vepp/epj[nlstate+1]/epj[nlstate+1]); |
|
/* stdpercent= epj[j]*epj[j]/epj[nlstate+1]/epj[nlstate+1]*(vareij[j][j][(int)age]/epj[j]/epj[j] + vepp/epj[nlstate+1]/epj[nlstate+1]); */ /* Without covariance */ |
|
/* fprintf(ficrest," %7.3f (%7.3f)", epj[j]/epj[nlstate+1], sqrt( vareij[j][j][(int)age]/epj[nlstate+1]/epj[nlstate+1] + epj[j]*epj[j]*vepp/epj[nlstate+1]/epj[nlstate+1]/epj[nlstate+1]/epj[nlstate+1] )); */ |
|
fprintf(ficrest," %7.3f (%7.3f)", epj[j]/epj[nlstate+1], sqrt(stdpercent)); |
|
} |
fprintf(ficrest,"\n"); |
fprintf(ficrest,"\n"); |
} |
} |
} /* End vpopbased */ |
} /* End vpopbased */ |
Line 14311 Please run with mle=-1 to get a correct
|
Line 16989 Please run with mle=-1 to get a correct
|
|
|
|
|
free_vector(weight,firstobs,lastobs); |
free_vector(weight,firstobs,lastobs); |
free_imatrix(Tvardk,1,NCOVMAX,1,2); |
free_imatrix(Tvardk,0,NCOVMAX,1,2); |
free_imatrix(Tvard,1,NCOVMAX,1,2); |
free_imatrix(Tvard,1,NCOVMAX,1,2); |
free_imatrix(s,1,maxwav+1,firstobs,lastobs); |
free_imatrix(s,1,maxwav+1,firstobs,lastobs); |
free_matrix(anint,1,maxwav,firstobs,lastobs); |
free_matrix(anint,1,maxwav,firstobs,lastobs); |
Line 14333 Please run with mle=-1 to get a correct
|
Line 17011 Please run with mle=-1 to get a correct
|
free_matrix(pmmij,1,nlstate+ndeath,1,nlstate+ndeath); |
free_matrix(pmmij,1,nlstate+ndeath,1,nlstate+ndeath); |
} /* mle==-3 arrives here for freeing */ |
} /* mle==-3 arrives here for freeing */ |
/* endfree:*/ |
/* endfree:*/ |
|
if(mle!=-3) free_matrix(precov, 1,MAXRESULTLINESPONE,1,NCOVMAX+1); /* Could be elsewhere ?*/ |
free_matrix(oldms, 1,nlstate+ndeath,1,nlstate+ndeath); |
free_matrix(oldms, 1,nlstate+ndeath,1,nlstate+ndeath); |
free_matrix(newms, 1,nlstate+ndeath,1,nlstate+ndeath); |
free_matrix(newms, 1,nlstate+ndeath,1,nlstate+ndeath); |
free_matrix(savms, 1,nlstate+ndeath,1,nlstate+ndeath); |
free_matrix(savms, 1,nlstate+ndeath,1,nlstate+ndeath); |
Line 14353 Please run with mle=-1 to get a correct
|
Line 17032 Please run with mle=-1 to get a correct
|
free_ivector(ncodemaxwundef,1,NCOVMAX); |
free_ivector(ncodemaxwundef,1,NCOVMAX); |
free_ivector(Dummy,-1,NCOVMAX); |
free_ivector(Dummy,-1,NCOVMAX); |
free_ivector(Fixed,-1,NCOVMAX); |
free_ivector(Fixed,-1,NCOVMAX); |
free_ivector(DummyV,1,NCOVMAX); |
free_ivector(DummyV,-1,NCOVMAX); |
free_ivector(FixedV,1,NCOVMAX); |
free_ivector(FixedV,-1,NCOVMAX); |
free_ivector(Typevar,-1,NCOVMAX); |
free_ivector(Typevar,-1,NCOVMAX); |
free_ivector(Tvar,1,NCOVMAX); |
free_ivector(Tvar,1,NCOVMAX); |
free_ivector(TvarsQ,1,NCOVMAX); |
free_ivector(TvarsQ,1,NCOVMAX); |
Line 14376 Please run with mle=-1 to get a correct
|
Line 17055 Please run with mle=-1 to get a correct
|
free_ivector(TvarVDind,1,NCOVMAX); |
free_ivector(TvarVDind,1,NCOVMAX); |
free_ivector(TvarVQ,1,NCOVMAX); |
free_ivector(TvarVQ,1,NCOVMAX); |
free_ivector(TvarVQind,1,NCOVMAX); |
free_ivector(TvarVQind,1,NCOVMAX); |
|
free_ivector(TvarAVVA,1,NCOVMAX); |
|
free_ivector(TvarAVVAind,1,NCOVMAX); |
|
free_ivector(TvarVVA,1,NCOVMAX); |
|
free_ivector(TvarVVAind,1,NCOVMAX); |
free_ivector(TvarVV,1,NCOVMAX); |
free_ivector(TvarVV,1,NCOVMAX); |
free_ivector(TvarVVind,1,NCOVMAX); |
free_ivector(TvarVVind,1,NCOVMAX); |
|
|
Line 14390 Please run with mle=-1 to get a correct
|
Line 17073 Please run with mle=-1 to get a correct
|
free_ivector(TmodelInvind,1,NCOVMAX); |
free_ivector(TmodelInvind,1,NCOVMAX); |
free_ivector(TmodelInvQind,1,NCOVMAX); |
free_ivector(TmodelInvQind,1,NCOVMAX); |
|
|
free_matrix(precov, 1,MAXRESULTLINESPONE,1,NCOVMAX+1); /* Could be elsewhere ?*/ |
/* free_matrix(precov, 1,MAXRESULTLINESPONE,1,NCOVMAX+1); /\* Could be elsewhere ?*\/ */ |
|
|
free_imatrix(nbcode,0,NCOVMAX,0,NCOVMAX); |
free_imatrix(nbcode,0,NCOVMAX,0,NCOVMAX); |
/* free_imatrix(codtab,1,100,1,10); */ |
/* free_imatrix(codtab,1,100,1,10); */ |