--- imach/src/imach.c 2024/05/12 20:29:32 1.361
+++ imach/src/imach.c 2024/06/28 09:31:55 1.363
@@ -1,6 +1,14 @@
-/* $Id: imach.c,v 1.361 2024/05/12 20:29:32 brouard Exp $
+/* $Id: imach.c,v 1.363 2024/06/28 09:31:55 brouard Exp $
$State: Exp $
$Log: imach.c,v $
+ 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
@@ -1405,12 +1413,12 @@ double gnuplotversion=GNUPLOTVERSION;
#define ODIRSEPARATOR '\\'
#endif
-/* $Id: imach.c,v 1.361 2024/05/12 20:29:32 brouard Exp $ */
+/* $Id: imach.c,v 1.363 2024/06/28 09:31:55 brouard Exp $ */
/* $State: Exp $ */
#include "version.h"
char version[]=__IMACH_VERSION__;
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: 1.361 $ $Date: 2024/05/12 20:29:32 $";
+char fullversion[]="$Revision: 1.363 $ $Date: 2024/06/28 09:31:55 $";
char strstart[80];
char optionfilext[10], optionfilefiname[FILENAMELENGTH];
int erreur=0, nberr=0, nbwarn=0; /* Error number, number of errors number of warnings */
@@ -1531,6 +1539,12 @@ char *endptr;
long lval;
double dval;
+/* This for praxis gegen */
+ /* int prin=1; */
+ double h0=0.25;
+ double macheps;
+ double ffmin;
+
#define NR_END 1
#define FREE_ARG char*
#define FTOL 1.0e-10
@@ -3007,24 +3021,30 @@ static void print2() /* print a line of
/* 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 ( "\n" ); */
printf ( " 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(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]);
+ 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");
}
@@ -3231,7 +3251,7 @@ L1: /* L1 or try loop */
if (k > 0) *d2 = 0;
}
#ifdef DEBUGPRAX
- printf(" bebe end of min x1=%14.8e fx=%14.8e d2=%14.8e\n",*x1, fx, *d2);
+ 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;
@@ -3707,7 +3727,7 @@ mloop:
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 */
+ 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
@@ -4218,7 +4238,7 @@ void powell(double p[], double **xi, int
printf(" + 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) {
printf(" + V%d ",Tvar[j]);
fprintf(ficlog," + V%d ",Tvar[j]);
@@ -6593,10 +6613,10 @@ void mlikeli(FILE *ficres,double p[], in
#else /* FLATSUP */
/* powell(p,xi,npar,ftol,&iter,&fret,func);*/
/* praxis ( t0, h0, n, prin, x, beale_f ); */
- int prin=1;
- double h0=0.25;
- double macheps;
- double fmin;
+ /* int prin=1; */
+ /* 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] */
@@ -6606,7 +6626,7 @@ 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); */
- fmin = praxis(ftol,macheps, h0, npar, prin, p, func);
+ ffmin = praxis(ftol,macheps, h0, npar, prin, p, func);
printf("End Praxis\n");
#endif /* FLATSUP */
@@ -8602,7 +8622,7 @@ void concatwav(int wav[], int **dh, int
double ***gradg, ***trgradg; /**< for var eij */
double **gradgp, **trgradgp; /**< for var p point j */
double *gpp, *gmp; /**< for var p point j */
- double **varppt; /**< for var e.. nlstate+1 to nlstate+ndeath */
+ double **varppt; /**< for var p.3 p.death nlstate+1 to nlstate+ndeath */
double ***p3mat;
double age,agelim, hf;
/* double ***mobaverage; */
@@ -12283,7 +12303,8 @@ double gompertz(double x[])
A=-x[1]/(x[2])*(exp(x[2]*(agecens[i]-agegomp))-exp(x[2]*(ageexmed[i]-agegomp)));
} else if (cens[i] == 0){
A=-x[1]/(x[2])*(exp(x[2]*(agedc[i]-agegomp))-exp(x[2]*(ageexmed[i]-agegomp)))
- +log(x[1]/YEARM) +x[2]*(agedc[i]-agegomp)+log(YEARM);
+ +log(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
printf("Gompertz cens[%d] neither 1 nor 0\n",i);
/*if (wav[i] > 1 && agecens[i] > 15) {*/ /* ??? */
@@ -15843,8 +15864,16 @@ Interval (in months) between two waves:
flatdir=ivector(1,npar);
for (j=1;j<=npar;j++) flatdir[j]=0;
#endif /*LINMINORIGINAL */
- powell(p,ximort,NDIM,ftol,&iter,&fret,gompertz);
-#endif
+ /* 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);
#ifdef LINMINORIGINAL
#else
@@ -15984,7 +16013,7 @@ Please run with mle=-1 to get a correct
fprintf(ficlog," + age*age ");
fprintf(fichtm, "| + age*age | ");
}
- for(j=1;j <=ncovmodel-2;j++){
+ for(j=1;j <=ncovmodel-2-nagesqr;j++){
if(Typevar[j]==0) {
printf(" + V%d ",Tvar[j]);
fprintf(ficres," + V%d ",Tvar[j]);
@@ -16055,7 +16084,7 @@ Please run with mle=-1 to get a correct
fprintf(ficlog," + age*age ");
fprintf(fichtm, "+ age*age | ");
}
- for(j=1;j <=ncovmodel-2;j++){
+ for(j=1;j <=ncovmodel-2-nagesqr;j++){
if(Typevar[j]==0) {
printf(" + V%d ",Tvar[j]);
fprintf(fichtm, "+ V%d | ",Tvar[j]);