source: trunk/GDE/PHYML20130708/phyml/src/stats.c

Last change on this file was 10307, checked in by aboeckma, 11 years ago

added most recent version of phyml

File size: 145.1 KB
Line 
1/*
2
3PhyML:  a program that  computes maximum likelihood phylogenies from
4DNA or AA homologous sequences.
5
6Copyright (C) Stephane Guindon. Oct 2003 onward.
7
8All parts of the source except where indicated are distributed under
9the GNU public licence. See http://www.opensource.org for details.
10
11*/
12
13#include "stats.h"
14
15
16//////////////////////////////////////////////////////////////
17//////////////////////////////////////////////////////////////
18
19/* RANDOM VARIATES GENERATORS */
20//////////////////////////////////////////////////////////////
21//////////////////////////////////////////////////////////////
22
23
24/*********************************************************************/
25/* A C-function for TT800 : July 8th 1996 Version */
26/* by M. Matsumoto, email: matumoto@math.keio.ac.jp */
27/* tt800() generate one pseudorandom number with double precision */
28/* which is uniformly distributed on [0,1]-interval */
29/* for each call.  One may choose any initial 25 seeds */
30/* except all zeros. */
31
32/* See: ACM Transactions on Modelling and Computer Simulation, */
33/* Vol. 4, No. 3, 1994, pages 254-266. */
34
35phydbl tt800()
36{
37  int M=7;
38  unsigned long y;
39  static int k = 0;
40  static unsigned long x[25]={ /* initial 25 seeds, change as you wish */
41    0x95f24dab, 0x0b685215, 0xe76ccae7, 0xaf3ec239, 0x715fad23,
42    0x24a590ad, 0x69e4b5ef, 0xbf456141, 0x96bc1b7b, 0xa7bdf825,
43    0xc1de75b7, 0x8858a9c9, 0x2da87693, 0xb657f9dd, 0xffdc8a9f,
44    0x8121da71, 0x8b823ecb, 0x885d05f5, 0x4e20cd47, 0x5a9ad5d9,
45    0x512c0c03, 0xea857ccd, 0x4cc1d30f, 0x8891a8a1, 0xa6b7aadb
46  };
47  static unsigned long mag01[2]={ 
48    0x0, 0x8ebfd028 /* this is magic vector `a', don't change */
49  };
50  if (k==25) { /* generate 25 words at one time */
51    int kk;
52    for (kk=0;kk<25-M;kk++) {
53      x[kk] = x[kk+M] ^ (x[kk] >> 1) ^ mag01[x[kk] % 2];
54    }
55    for (; kk<25;kk++) {
56      x[kk] = x[kk+(M-25)] ^ (x[kk] >> 1) ^ mag01[x[kk] % 2];
57    }
58    k=0;
59  }
60  y = x[k];
61  y ^= (y << 7) & 0x2b5b2500; /* s and b, magic vectors */
62  y ^= (y << 15) & 0xdb8b0000; /* t and c, magic vectors */
63  y &= 0xffffffff; /* you may delete this line if word size = 32 */
64  /*
65     the following line was added by Makoto Matsumoto in the 1996 version
66     to improve lower bit's corellation.
67     Delete this line to o use the code published in 1994.
68  */
69  y ^= (y >> 16); /* added to the 1994 version */
70  k++;
71  return((phydbl)y / (unsigned long) 0xffffffff);
72}
73
74/*********************************************************************/
75
76phydbl Uni()
77{
78  phydbl r,mx;
79  mx = (phydbl)RAND_MAX;
80  r  = (phydbl)rand();
81  r /= mx;
82  /* r = tt800(); */
83  return r;
84}
85
86/*********************************************************************/
87
88int Rand_Int(int min, int max)
89{
90/*   phydbl u;   */
91/*   u = (phydbl)rand(); */
92/*   u /=  (RAND_MAX); */
93/*   u *= (max - min + 1); */
94/*   u += min; */
95/*   return (int)FLOOR(u); */
96
97  int u;
98  u = rand();
99  return (u%(max+1-min)+min);
100
101}
102
103//////////////////////////////////////////////////////////////
104//////////////////////////////////////////////////////////////
105
106
107
108/********************* random Gamma generator ************************
109* Properties:
110* (1) X = Gamma(alpha,lambda) = Gamma(alpha,1)/lambda
111* (2) X1 = Gamma(alpha1,1), X2 = Gamma(alpha2,1) independent
112*     then X = X1+X2 = Gamma(alpha1+alpha2,1)
113* (3) alpha = k = integer then
114*     X = Gamma(k,1) = Erlang(k,1) = -sum(LOG(Ui)) = -LOG(prod(Ui))
115*     where U1,...Uk iid uniform(0,1)
116*
117* Decompose alpha = k+delta with k = [alpha], and 0<delta<1
118* Apply (3) for Gamma(k,1)
119* Apply Ahrens-Dieter algorithm for Gamma(delta,1)
120*/
121 
122phydbl Ahrensdietergamma(phydbl alpha)
123{
124  phydbl x = 0.;
125
126  if (alpha>0.) 
127    {
128      phydbl y = 0.;
129      phydbl b = (alpha+EXP(1.))/EXP(1.);
130      phydbl p = 1./alpha;
131      int go = 0;
132      while (go==0) 
133        {
134          phydbl u = Uni();
135          phydbl w = Uni();
136          phydbl v = b*u;
137          if (v<=1.) 
138            {
139              x = POW(v,p);
140              y = EXP(-x);
141            }
142          else 
143            {
144              x = -LOG(p*(b-v));
145              y = POW(x,alpha-1.);
146            }
147          go = (w<y); // x is accepted when go=1
148        }
149    }
150  return x;
151}
152
153//////////////////////////////////////////////////////////////
154//////////////////////////////////////////////////////////////
155
156
157phydbl Rgamma(phydbl shape, phydbl scale)
158{
159  int i;
160  phydbl x1 = 0.;
161  phydbl delta = shape;
162  if (shape>=1.) 
163    {
164      int k = (int)FLOOR(shape);
165      delta = shape - k;
166      phydbl u = 1.;
167      for (i=0; i<k; i++)
168        u *= Uni();
169      x1 = -LOG(u);
170    }
171  phydbl x2 = Ahrensdietergamma(delta);
172  return (x1 + x2)*scale;
173}
174
175//////////////////////////////////////////////////////////////
176//////////////////////////////////////////////////////////////
177
178
179phydbl Rexp(phydbl lambda)
180{
181  return -LOG(Uni()+1.E-30)/lambda;
182}
183
184//////////////////////////////////////////////////////////////
185//////////////////////////////////////////////////////////////
186
187
188phydbl Rnorm(phydbl mean, phydbl sd)
189{
190  /* Box-Muller transformation */
191  phydbl u1, u2, res;
192 
193  /* u1=Uni(); */
194  /* u2=Uni(); */
195  /* u1 = SQRT(-2.*LOG(u1))*COS(6.28318530717959f*u2); */
196
197  /* Polar */
198  phydbl d,x,y;
199
200  do
201    {
202      u1=Uni();
203      u2=Uni();
204      x = 2.*u1-1.;
205      y = 2.*u2-1.;
206      d = x*x + y*y;
207      if(d>.0 && d<1.) break;
208    }
209  while(1);
210  u1 = x*SQRT((-2.*LOG(d))/d);
211
212  res = u1*sd+mean;
213
214  if(isnan(res) || isinf(res))
215    {
216      printf("\n. res=%f sd=%f mean=%f u1=%f u2=%f",res,sd,mean,u1,u2);
217    }
218  return res;
219}
220
221//////////////////////////////////////////////////////////////
222//////////////////////////////////////////////////////////////
223
224
225phydbl *Rnorm_Multid(phydbl *mu, phydbl *cov, int dim)
226{
227  phydbl *L,*x,*y;
228  int i,j;
229 
230  x = (phydbl *)mCalloc(dim,sizeof(phydbl));
231  y = (phydbl *)mCalloc(dim,sizeof(phydbl));
232
233  L = (phydbl *)Cholesky_Decomp(cov,dim);
234
235  For(i,dim) x[i]=Rnorm(0.0,1.0);
236  For(i,dim) For(j,dim) y[i] += L[i*dim+j]*x[j];
237  For(i,dim) y[i] += mu[i];
238
239  Free(L);
240  Free(x);
241
242  return(y);
243}
244
245//////////////////////////////////////////////////////////////
246//////////////////////////////////////////////////////////////
247
248
249phydbl Rnorm_Trunc_Inverse(phydbl mean, phydbl sd, phydbl min, phydbl max, int *error)
250{
251
252  phydbl u, ret_val,eps;
253  phydbl z;
254  phydbl z_min,z_max;
255  phydbl cdf_min, cdf_max;
256
257  z      = 0.0;
258  u      = -1.0;
259  *error = 0;
260 
261  if(sd < 1.E-100)
262    {
263      PhyML_Printf("\n. Small variance detected in Rnorm_Trunc.");
264      PhyML_Printf("\n. mean=%f sd=%f min=%f max=%f",mean,sd,min,max);
265      *error = 1;
266      return -1.0;
267    }
268
269  z_min = (min - mean)/sd;
270  z_max = (max - mean)/sd;
271
272  eps = (z_max-z_min)/1E+6;
273
274
275  /*       Simple inversion method. Seems to work well. Needs more thorough testing though... */
276  cdf_min = Pnorm(z_min,0.0,1.0);
277  cdf_max = Pnorm(z_max,0.0,1.0);
278  u = cdf_min + (cdf_max-cdf_min) * Uni();
279  z = PointNormal(u);
280       
281  if((z < z_min-eps) || (z > z_max+eps))
282    {
283      *error = 1;
284      PhyML_Printf("\n. Numerical precision issue detected in Rnorm_Trunc.");
285      PhyML_Printf("\n. z = %f",z);
286      PhyML_Printf("\n. mean=%f sd=%f z_min=%f z_max=%f min=%f max=%f",mean,sd,z_min,z_max,min,max);
287      ret_val = (max - min)/2.;
288      Exit("\n");
289    }
290 
291  ret_val = z*sd+mean;
292 
293  return ret_val;
294}
295
296//////////////////////////////////////////////////////////////
297//////////////////////////////////////////////////////////////
298
299
300phydbl Rnorm_Trunc(phydbl mean, phydbl sd, phydbl min, phydbl max, int *error)
301{
302
303  phydbl ret_val,eps;
304  int iter;
305  phydbl z;
306  phydbl z_min,z_max;
307
308  z      = 0.0;
309  *error = NO;
310 
311  if(sd < 1.E-100)
312    {
313      PhyML_Printf("\n. Small variance detected in Rnorm_Trunc.");
314      PhyML_Printf("\n. mean=%f sd=%f min=%f max=%f",mean,sd,min,max);
315      *error = YES;
316      return -1.0;
317    }
318
319  if(max < min)
320    {
321      PhyML_Printf("\n. Max < Min");
322      PhyML_Printf("\n. mean=%f sd=%f min=%f max=%f",mean,sd,min,max);
323      *error = YES;
324      return -1.0;
325    }
326
327  z_min = (min - mean)/sd;
328  z_max = (max - mean)/sd;
329
330  eps = (z_max-z_min)/1E+6;
331
332  /* Damien and Walker (2001) method */
333  phydbl y,slice_min,slice_max;
334
335/*   if((z_min < -10.) && (z_max > +10.)) /\* cdf < 1.E-6, we should be safe. *\/ */
336/*     { */
337/*       z = Rnorm(0.0,1.0); */
338/*     } */
339/*   else */
340/*     { */
341
342
343      iter = 0;
344      do
345        {
346          y   = Uni()*EXP(-(z*z)/2.);
347          slice_min = MAX(z_min,-SQRT(-2.*LOG(y)));
348          slice_max = MIN(z_max, SQRT(-2.*LOG(y)));
349          z   = Uni()*(slice_max - slice_min) + slice_min;
350          iter++;
351          if(iter > 1000) break;
352        }
353      while(slice_max < slice_min || iter < 10);
354
355      if(iter > 1000)
356        {
357          PhyML_Printf("\n. Too many iterations in Rnorm_Trunc...");
358          *error = 1;
359        }
360
361/*     } */
362
363  /* Inverson method */
364/*   phydbl cdf_min, cdf_max; */
365/*   if((z_min < -10.) && (z_max > +10.)) /\* cdf < 1.E-6, we should be safe. *\/ */
366/*     { */
367/*       z = Rnorm(0.0,1.0); */
368/*     } */
369/*   else */
370/*     { */
371/* /\*       Simple inversion method. Seems to work well. Needs more thorough testing though... *\/ */
372/*       cdf_min = Pnorm(z_min,0.0,1.0); */
373/*       cdf_max = Pnorm(z_max,0.0,1.0); */
374/*       u = cdf_min + (cdf_max-cdf_min) * Uni(); */
375/*       z = PointNormal(u); */
376/*     } */
377
378
379   if((z < z_min-eps) || (z > z_max+eps))
380    {
381      *error = YES;
382      PhyML_Printf("\n. Numerical precision issue detected in Rnorm_Trunc.");
383      PhyML_Printf("\n. z = %f",z);
384      PhyML_Printf("\n. mean=%f sd=%f z_min=%f z_max=%f min=%f max=%f",mean,sd,z_min,z_max,min,max);
385      ret_val = (max - min)/2.;
386      Exit("\n");
387    }
388
389  ret_val = z*sd+mean;
390
391  return ret_val;
392}
393
394//////////////////////////////////////////////////////////////
395//////////////////////////////////////////////////////////////
396
397
398phydbl *Rnorm_Multid_Trunc(phydbl *mean, phydbl *cov, phydbl *min, phydbl *max, int dim)
399{
400  int i,j;
401  phydbl *L,*x, *u;
402  phydbl up, low, rec;
403  int err;
404 
405  u = (phydbl *)mCalloc(dim,sizeof(phydbl)); 
406  x = (phydbl *)mCalloc(dim,sizeof(phydbl));
407 
408  L = Cholesky_Decomp(cov,dim);
409 
410  low = (min[0]-mean[0])/L[0*dim+0];
411  up  = (max[0]-mean[0])/L[0*dim+0];
412  u[0] = Rnorm_Trunc(0.0,1.0,low,up,&err);
413
414  for(i=1;i<dim;i++)
415    {
416      rec = .0;
417      For(j,i) rec += L[i*dim+j] * u[j];
418      low  = (min[i]-mean[i]-rec)/L[i*dim+i];
419      up   = (max[i]-mean[i]-rec)/L[i*dim+i];
420      u[i] = Rnorm_Trunc(0.0,1.0,low,up,&err);
421    }
422
423  x = Matrix_Mult(L,u,dim,dim,dim,1);
424
425/*   PhyML_Printf("\n>>>\n"); */
426/*   For(i,dim) */
427/*     { */
428/*       For(j,dim) */
429/*      { */
430/*        PhyML_Printf("%10lf ",L[i*dim+j]); */
431/*      } */
432/*       PhyML_Printf("\n"); */
433/*     } */
434/*   PhyML_Printf("\n"); */
435
436/*   For(i,dim) PhyML_Printf("%f ",u[i]); */
437/*   PhyML_Printf("\n"); */
438
439 
440/*   PhyML_Printf("\n"); */
441/*   For(i,dim) PhyML_Printf("%10lf ",x[i]); */
442/*   PhyML_Printf("\n<<<\n"); */
443
444  For(i,dim) x[i] += mean[i];
445
446  Free(L);
447  Free(u);
448 
449  return x;
450}
451
452//////////////////////////////////////////////////////////////
453//////////////////////////////////////////////////////////////
454
455/* DENSITIES / PROBA */
456//////////////////////////////////////////////////////////////
457//////////////////////////////////////////////////////////////
458
459
460phydbl Dnorm_Moments(phydbl x, phydbl mean, phydbl var)
461{
462  phydbl dens,sd,pi;
463
464  pi = 3.141593;
465  sd = SQRT(var);
466
467  dens = 1./(SQRT(2*pi)*sd)*EXP(-((x-mean)*(x-mean)/(2.*sd*sd)));
468
469  return dens;
470}
471
472//////////////////////////////////////////////////////////////
473//////////////////////////////////////////////////////////////
474
475
476phydbl Dnorm(phydbl x, phydbl mean, phydbl sd)
477{
478  phydbl dens;
479
480  /* dens = -(.5*LOG2PI+LOG(sd))  - .5*POW(x-mean,2)/POW(sd,2); */
481  /* return EXP(dens); */
482 
483  x = (x-mean)/sd;
484
485  dens = M_1_SQRT_2_PI * EXP(-0.5*x*x);
486 
487  return dens / sd;
488}
489
490//////////////////////////////////////////////////////////////
491//////////////////////////////////////////////////////////////
492
493
494phydbl Log_Dnorm(phydbl x, phydbl mean, phydbl sd, int *err)
495{
496  phydbl dens;
497
498  *err = NO;
499
500  x = (x-mean)/sd;
501 
502  /* dens = -(phydbl)LOG_SQRT_2_PI - x*x*0.5 - LOG(sd); */
503  dens = -(phydbl)LOG(SQRT(2.*PI)) - x*x*0.5 - LOG(sd);
504
505  if(dens < -BIG)
506    {
507      PhyML_Printf("\n. dens=%f -- x=%f mean=%f sd=%f\n",dens,x,mean,sd);
508      *err = 1;
509    }
510
511  return dens;
512}
513
514//////////////////////////////////////////////////////////////
515//////////////////////////////////////////////////////////////
516
517
518phydbl Log_Dnorm_Trunc(phydbl x, phydbl mean, phydbl sd, phydbl lo, phydbl up, int *err)
519{
520  phydbl log_dens;
521  phydbl cdf_up, cdf_lo;
522
523  *err = NO;
524  cdf_lo = cdf_up = 0.0;
525
526  log_dens = Log_Dnorm(x,mean,sd,err);
527
528  if(*err == YES)
529    {
530      PhyML_Printf("\n== mean=%f sd=%f lo=%f up=%f cdf_lo=%G CDF_up=%G log_dens=%G",mean,sd,lo,up,cdf_lo,cdf_up,log_dens);
531      PhyML_Printf("\n== Warning in file %s at line %d\n",__FILE__,__LINE__);
532      *err = YES;
533    }
534
535  cdf_up = Pnorm(up,mean,sd);
536  cdf_lo = Pnorm(lo,mean,sd);
537
538  if(cdf_up - cdf_lo < 1.E-20)
539    {
540      log_dens = -230.; /* ~LOG(1.E-100) */
541    }
542  else
543    {
544      log_dens -= LOG(cdf_up - cdf_lo);
545    }
546
547  if(isnan(log_dens) || isinf(FABS(log_dens)))
548    {
549      PhyML_Printf("\n. x=%f mean=%f sd=%f lo=%f up=%f cdf_lo=%G CDF_up=%G log_dens=%G",x,mean,sd,lo,up,cdf_lo,cdf_up,log_dens);
550      PhyML_Printf("\n. Warning in file %s at line %d\n",__FILE__,__LINE__);
551      *err = YES;
552    }
553
554  return log_dens;
555}
556
557//////////////////////////////////////////////////////////////
558//////////////////////////////////////////////////////////////
559
560
561phydbl Dnorm_Trunc(phydbl x, phydbl mean, phydbl sd, phydbl lo, phydbl up)
562{
563  phydbl dens;
564  phydbl cdf_up, cdf_lo;
565
566  dens   = Dnorm(x,mean,sd);
567  cdf_up = Pnorm(up,mean,sd);
568  cdf_lo = Pnorm(lo,mean,sd);
569
570  dens /= (cdf_up - cdf_lo);
571
572  if(isnan(dens) || isinf(FABS(dens)))
573    {
574      PhyML_Printf("\n. mean=%f sd=%f lo=%f up=%f cdf_lo=%G CDF_up=%G",mean,sd,lo,up,cdf_lo,cdf_up);
575      PhyML_Printf("\n. Err in file %s at line %d\n",__FILE__,__LINE__);
576      Exit("\n");
577    }
578
579  return dens;
580}
581
582//////////////////////////////////////////////////////////////
583//////////////////////////////////////////////////////////////
584
585
586phydbl Dnorm_Multi(phydbl *x, phydbl *mu, phydbl *cov, int size, int _log)
587{
588  phydbl *xmmu,*invcov;
589  phydbl *buff1,*buff2;
590  int i;
591  phydbl det,density;
592
593  xmmu   = (phydbl *)mCalloc(size,sizeof(phydbl));
594  invcov = (phydbl *)mCalloc(size*size,sizeof(phydbl));
595
596  For(i,size) xmmu[i] = x[i] - mu[i];
597  For(i,size*size) invcov[i] = cov[i];
598 
599  if(!Matinv(invcov,size,size,NO))
600    {
601      PhyML_Printf("\n== Err in file %s at line %d\n",__FILE__,__LINE__);
602      Exit("\n");     
603    }
604
605  buff1 = Matrix_Mult(xmmu,invcov,1,size,size,size);
606  buff2 = Matrix_Mult(buff1,xmmu,1,size,size,1);
607 
608  det = Matrix_Det(cov,size,NO);
609  /* det_1D(cov,size,&det); */
610
611  density = size * LOG2PI + LOG(det) + buff2[0];
612  density /= -2.;
613
614/*   density = (1./(POW(2.*PI,size/2.)*SQRT(FABS(det)))) * EXP(-0.5*buff2[0]); */
615
616  Free(xmmu);
617  Free(invcov);
618  Free(buff1);
619  Free(buff2);
620
621  return (_log)?(density):(EXP(density));
622}
623
624//////////////////////////////////////////////////////////////
625//////////////////////////////////////////////////////////////
626
627
628phydbl Dnorm_Multi_Given_InvCov_Det(phydbl *x, phydbl *mu, phydbl *invcov, phydbl log_det, int size, int _log)
629{
630  phydbl *xmmu;
631  phydbl *buff1,*buff2;
632  int i;
633  phydbl density;
634
635  xmmu = (phydbl *)mCalloc(size,sizeof(phydbl));
636
637  For(i,size) xmmu[i] = x[i] - mu[i];
638 
639  buff1 = Matrix_Mult(xmmu,invcov,1,size,size,size);
640  buff2 = Matrix_Mult(buff1,xmmu,1,size,size,1);
641
642  density = size * LOG2PI + log_det + buff2[0];
643  density /= -2.;
644
645  Free(xmmu);
646  Free(buff1);
647  Free(buff2);
648 
649  return (_log)?(density):(EXP(density));
650}
651
652//////////////////////////////////////////////////////////////
653//////////////////////////////////////////////////////////////
654
655
656phydbl Pbinom(int N, int ni, phydbl p)
657{
658  return Bico(N,ni)*POW(p,ni)*POW(1-p,N-ni);
659}
660
661//////////////////////////////////////////////////////////////
662//////////////////////////////////////////////////////////////
663
664
665phydbl Bivariate_Normal_Density(phydbl x, phydbl y, phydbl mux, phydbl muy, phydbl sdx, phydbl sdy, phydbl rho)
666{
667  phydbl cx, cy;
668  phydbl pi;
669  phydbl dens;
670  phydbl rho2;
671
672  pi = 3.141593;
673
674  cx = x - mux;
675  cy = y - muy;
676
677  rho2 = rho*rho;
678
679  dens = 1./(2*pi*sdx*sdy*SQRT(1.-rho2));
680  dens *= EXP((-1./(2.*(1.-rho2)))*(cx*cx/(sdx*sdx)+cy*cy/(sdy*sdy)+2*rho*cx*cy/(sdx*sdy)));
681             
682  return dens;
683}
684
685//////////////////////////////////////////////////////////////
686//////////////////////////////////////////////////////////////
687
688
689phydbl Dgamma_Moments(phydbl x, phydbl mean, phydbl var)
690{
691  phydbl shape, scale;
692
693  if(var < 1.E-20) 
694    {
695/*       var  = 1.E-20;  */
696      PhyML_Printf("\n. var=%f mean=%f",var,mean);
697      PhyML_Printf("\n. Err in file %s at line %d\n",__FILE__,__LINE__);
698      Exit("\n");     
699    }
700
701  if(mean < 1.E-20) 
702    { 
703/*       mean = 1.E-20;  */
704      PhyML_Printf("\n. var=%f mean=%f",var,mean);
705      PhyML_Printf("\n. Err in file %s at line %d\n",__FILE__,__LINE__);
706      Exit("\n");
707    }
708
709
710  shape = mean * mean / var;
711  scale = var / mean;
712 
713  return(Dgamma(x,shape,scale));
714}
715
716//////////////////////////////////////////////////////////////
717//////////////////////////////////////////////////////////////
718
719
720phydbl Dgamma(phydbl x, phydbl shape, phydbl scale)
721{
722  phydbl v;
723
724  if(x > INFINITY) 
725    {
726      PhyML_Printf("\n. WARNING: huge value of x -> x = %G",x);
727      x = 1.E+10;
728    }
729
730  if(x < 1.E-20)
731    {
732      if(x < 0.0) return 0.0;
733      else
734        {
735          PhyML_Printf("\n. WARNING: small value of x -> x = %G",x);
736          x = 1.E-20;
737        }
738    }
739
740
741  if(scale < 0.0 || shape < 0.0)
742    {
743      PhyML_Printf("\n. scale=%f shape=%f",scale,shape);
744      Exit("\n");
745    }
746
747
748  v = (shape-1.) * LOG(x) - shape * LOG(scale) - x / scale - LnGamma(shape);
749
750
751  if(v < 500.)
752    {
753      v = EXP(v);
754    }
755  else
756    {
757      PhyML_Printf("\n. WARNING v=%f x=%f shape=%f scale=%f",v,x,shape,scale);
758      PhyML_Printf("\n. LOG(x) = %G LnGamma(shape)=%G",LOG(x),LnGamma(shape));
759      v = EXP(v);
760      /* PhyML_Printf("\n. Err in file %s at line %d\n",__FILE__,__LINE__); */
761      /* Exit("\n"); */
762    }
763
764         
765  return v;
766}
767
768//////////////////////////////////////////////////////////////
769//////////////////////////////////////////////////////////////
770
771
772phydbl Dexp(phydbl x, phydbl param)
773{
774  return param * EXP(-param * x);
775}
776
777//////////////////////////////////////////////////////////////
778//////////////////////////////////////////////////////////////
779
780phydbl Dpois(phydbl x, phydbl param)
781{
782  phydbl v;
783
784  if(x < 0) 
785    {
786      PhyML_Printf("\n. x = %f",x);
787      PhyML_Printf("\n. Err in file %s at line %d\n",__FILE__,__LINE__);
788      Warn_And_Exit("");
789    }
790
791  v = x * LOG(param) - param - LnGamma(x+1);
792
793  if(v < 500)
794    {
795      v = EXP(v);
796    }
797  else
798    {
799      PhyML_Printf("\n. WARNING v=%f x=%f param=%f",v,x,param);
800      v = EXP(500);
801    }
802 
803/*   PhyML_Printf("\n. Poi %f %f (x=%f param=%f)", */
804/*       v, */
805/*       POW(param,x) * EXP(-param) / EXP(LnGamma(x+1)), */
806/*       x,param); */
807/*   return POW(param,x) * EXP(-param) / EXP(LnGamma(x+1)); */
808 
809  return v;
810}
811
812//////////////////////////////////////////////////////////////
813//////////////////////////////////////////////////////////////
814
815
816
817//////////////////////////////////////////////////////////////
818//////////////////////////////////////////////////////////////
819
820/* CDFs */
821//////////////////////////////////////////////////////////////
822//////////////////////////////////////////////////////////////
823
824
825phydbl Pnorm(phydbl x, phydbl mean, phydbl sd)
826{
827/*   const phydbl b1 =  0.319381530; */
828/*   const phydbl b2 = -0.356563782; */
829/*   const phydbl b3 =  1.781477937; */
830/*   const phydbl b4 = -1.821255978; */
831/*   const phydbl b5 =  1.330274429; */
832/*   const phydbl p  =  0.2316419; */
833/*   const phydbl c  =  0.39894228; */
834 
835  x = (x-mean)/sd;
836 
837/*   if(x >= 0.0) */
838/*     { */
839/*       phydbl t = 1.0 / ( 1.0 + p * x ); */
840/*       return (1.0 - c * EXP( -x * x / 2.0 ) * t * */
841/*            ( t *( t * ( t * ( t * b5 + b4 ) + b3 ) + b2 ) + b1 )); */
842/*     } */
843/*   else */
844/*     { */
845/*       phydbl t = 1.0 / ( 1.0 - p * x ); */
846/*       return ( c * EXP( -x * x / 2.0 ) * t * */
847/*             ( t *( t * ( t * ( t * b5 + b4 ) + b3 ) + b2 ) + b1 )); */
848/*     } */
849
850/* i_tail in {0,1,2} means: "lower", "upper", or "both" :
851   if(lower) return  *cum := P[X <= x]
852   if(upper) return *ccum := P[X >  x] = 1 - P[X <= x]
853*/
854
855/*   return Pnorm_Marsaglia(x); */
856  return Pnorm_Ihaka_Derived_From_Cody(x);
857}
858
859
860/* G. Marsaglia. "Evaluating the Normal distribution". Journal of Statistical Software. 2004. Vol. 11. Issue 4. */
861phydbl  Pnorm_Marsaglia(phydbl x)
862{
863  long double s=x,t=0,b=x,q=x*x,i=1;
864  while(s!=t) s=(t=s)+(b*=q/(i+=2)); 
865  return .5+s*exp(-.5*q-.91893853320467274178L);
866
867}
868
869
870
871/* Stolen from R source code */
872#define SIXTEN 16
873
874phydbl Pnorm_Ihaka_Derived_From_Cody(phydbl x)
875{
876
877    const static double a[5] = {
878        2.2352520354606839287,
879        161.02823106855587881,
880        1067.6894854603709582,
881        18154.981253343561249,
882        0.065682337918207449113
883    };
884    const static double b[4] = {
885        47.20258190468824187,
886        976.09855173777669322,
887        10260.932208618978205,
888        45507.789335026729956
889    };
890    const static double c[9] = {
891        0.39894151208813466764,
892        8.8831497943883759412,
893        93.506656132177855979,
894        597.27027639480026226,
895        2494.5375852903726711,
896        6848.1904505362823326,
897        11602.651437647350124,
898        9842.7148383839780218,
899        1.0765576773720192317e-8
900    };
901    const static double d[8] = {
902        22.266688044328115691,
903        235.38790178262499861,
904        1519.377599407554805,
905        6485.558298266760755,
906        18615.571640885098091,
907        34900.952721145977266,
908        38912.003286093271411,
909        19685.429676859990727
910    };
911    const static double p[6] = {
912        0.21589853405795699,
913        0.1274011611602473639,
914        0.022235277870649807,
915        0.001421619193227893466,
916        2.9112874951168792e-5,
917        0.02307344176494017303
918    };
919    const static double q[5] = {
920        1.28426009614491121,
921        0.468238212480865118,
922        0.0659881378689285515,
923        0.00378239633202758244,
924        7.29751555083966205e-5
925    };
926
927    double xden, xnum, temp, del, eps, xsq, y;
928    int i, lower, upper;
929    double cum,ccum;
930    int i_tail;
931   
932    i_tail = 0;
933    cum = ccum = 0.0;
934
935    if(isnan(x)) { cum = ccum = x; return (phydbl)cum; }
936
937    /* Consider changing these : */
938    eps = DBL_EPSILON * 0.5;
939
940    /* i_tail in {0,1,2} =^= {lower, upper, both} */
941    lower = i_tail != 1;
942    upper = i_tail != 0;
943
944    y = fabs(x);
945    if (y <= 0.67448975) { /* qnorm(3/4) = .6744.... -- earlier had 0.66291 */
946        if (y > eps) {
947            xsq = x * x;
948            xnum = a[4] * xsq;
949            xden = xsq;
950            for (i = 0; i < 3; ++i) {
951                xnum = (xnum + a[i]) * xsq;
952                xden = (xden + b[i]) * xsq;
953            }
954        } else xnum = xden = 0.0;
955
956        temp = x * (xnum + a[3]) / (xden + b[3]);
957        if(lower)  cum = 0.5 + temp;
958        if(upper) ccum = 0.5 - temp;
959        }   
960    else if (y <= M_SQRT_32) {
961
962        /* Evaluate pnorm for 0.674.. = qnorm(3/4) < |x| <= SQRT(32) ~= 5.657 */
963
964        xnum = c[8] * y;
965        xden = y;
966        for (i = 0; i < 7; ++i) {
967            xnum = (xnum + c[i]) * y;
968            xden = (xden + d[i]) * y;
969        }
970        temp = (xnum + c[7]) / (xden + d[7]);
971
972#define do_del(X)                                                       \
973        xsq = floor(X * SIXTEN) / SIXTEN;                       \
974        del = (X - xsq) * (X + xsq);                                    \
975        cum = exp(-xsq * xsq * 0.5) * exp(-del * 0.5) * temp;           \
976        ccum = 1.0 - cum;                                               \
977       
978#define swap_tail                                               \
979        if (x > 0.) {/* swap  ccum <--> cum */                  \
980            temp = cum; if(lower) cum = ccum; ccum = temp;      \
981        }
982
983        do_del(y);
984        swap_tail;
985    }
986
987/* else   |x| > SQRT(32) = 5.657 :
988 * the next two case differentiations were really for lower=T, log=F
989 * Particularly  *not*  for  log_p !
990
991 * Cody had (-37.5193 < x  &&  x < 8.2924) ; R originally had y < 50
992 *
993 * Note that we do want symmetry(0), lower/upper -> hence use y
994 */
995    else if((lower && -37.5193 < x  &&  x < 8.2924) || (upper && -8.2924  < x  &&  x < 37.5193)) 
996      {
997        /* Evaluate pnorm for x in (-37.5, -5.657) union (5.657, 37.5) */
998        xsq = 1.0 / (x * x);
999        xnum = p[5] * xsq;
1000        xden = xsq;
1001        for (i = 0; i < 4; ++i) {
1002            xnum = (xnum + p[i]) * xsq;
1003            xden = (xden + q[i]) * xsq;
1004        }
1005        temp = xsq * (xnum + p[4]) / (xden + q[4]);
1006        temp = (M_1_SQRT_2_PI - temp) / y;
1007
1008        do_del(x);
1009        swap_tail;
1010      }
1011    else 
1012      { /* no log_p , large x such that probs are 0 or 1 */
1013        if(x > 0) {     cum = 1.; ccum = 0.;    }
1014        else {          cum = 0.; ccum = 1.;    }
1015      }
1016
1017    return (phydbl)cum;
1018
1019
1020}
1021
1022//////////////////////////////////////////////////////////////
1023//////////////////////////////////////////////////////////////
1024
1025
1026phydbl Pgamma(phydbl x, phydbl shape, phydbl scale)
1027{
1028  return IncompleteGamma(x/scale,shape,LnGamma(shape));
1029}
1030
1031//////////////////////////////////////////////////////////////
1032//////////////////////////////////////////////////////////////
1033
1034
1035phydbl Ppois(phydbl x, phydbl param)
1036{
1037  /* Press et al. (1990) approximation of the CDF for the Poisson distribution */
1038  if(param < SMALL || x < 0.0) 
1039    {
1040      PhyML_Printf("\n. param = %G x=%G",param,x);
1041      PhyML_Printf("\n. Err in file %s at line %d\n",__FILE__,__LINE__);
1042      Warn_And_Exit("");
1043    }
1044  return IncompleteGamma(x,param,LnGamma(param));
1045}
1046
1047//////////////////////////////////////////////////////////////
1048//////////////////////////////////////////////////////////////
1049
1050
1051//////////////////////////////////////////////////////////////
1052//////////////////////////////////////////////////////////////
1053
1054/* Inverse CDFs */
1055//////////////////////////////////////////////////////////////
1056//////////////////////////////////////////////////////////////
1057
1058
1059phydbl PointChi2 (phydbl prob, phydbl v)
1060{
1061/* returns z so that Prob{x<z}=prob where x is Chi2 distributed with df=v
1062   returns -1 if in error.   0.000002<prob<0.999998
1063   RATNEST FORTRAN by
1064       Best DJ & Roberts DE (1975) The percentage points of the
1065       Chi2 distribution.  Applied Statistics 24: 385-388.  (AS91)
1066   Converted into C by Ziheng Yang, Oct. 1993.
1067*/
1068   double aa=.6931471805, p=prob, g;
1069   double xx, c, ch, a=0,q=0,p1=0,p2=0,t=0,x=0,b=0,s1,s2,s3,s4,s5,s6;
1070   double e=.5e-6;
1071   
1072   if (p<.000002 || p>.999998 || v<=0) return ((phydbl)-1);
1073
1074   g = (double)LnGamma(v/2);
1075   xx=v/2;   c=xx-1;
1076   if (v >= -1.24*log(p)) goto l1;
1077
1078   ch=pow((p*xx*exp(g+xx*aa)), 1/xx);
1079   if (ch-e<0) return (ch);
1080   goto l4;
1081l1:
1082   if (v>.32) goto l3;
1083   ch=0.4;   a=log(1-p);
1084l2:
1085   q=ch;  p1=1+ch*(4.67+ch);  p2=ch*(6.73+ch*(6.66+ch));
1086   t=-0.5+(4.67+2*ch)/p1 - (6.73+ch*(13.32+3*ch))/p2;
1087   ch-=(1-exp(a+g+.5*ch+c*aa)*p2/p1)/t;
1088   if (fabs(q/ch-1)-.01 <= 0) goto l4;
1089   else                       goto l2;
1090
1091l3:
1092   x=(double)PointNormal (p);
1093   p1=0.222222/v;   ch=v*pow((x*sqrt(p1)+1-p1), 3.0);
1094   if (ch>2.2*v+6)  ch=-2*(log(1-p)-c*log(.5*ch)+g);
1095l4:
1096   q=ch;   p1=.5*ch;
1097   if ((t=(double)IncompleteGamma (p1, xx, g))<0) {
1098      PhyML_Printf ("\nerr IncompleteGamma");
1099      return ((phydbl)-1.);
1100   }
1101   p2=p-t;
1102   t=p2*exp(xx*aa+g+p1-c*log(ch));
1103   b=t/ch;  a=0.5*t-b*c;
1104
1105   s1=(210+a*(140+a*(105+a*(84+a*(70+60*a))))) / 420;
1106   s2=(420+a*(735+a*(966+a*(1141+1278*a))))/2520;
1107   s3=(210+a*(462+a*(707+932*a)))/2520;
1108   s4=(252+a*(672+1182*a)+c*(294+a*(889+1740*a)))/5040;
1109   s5=(84+264*a+c*(175+606*a))/2520;
1110   s6=(120+c*(346+127*c))/5040;
1111   ch+=t*(1+0.5*t*s1-b*c*(s1-b*(s2-b*(s3-b*(s4-b*(s5-b*s6))))));
1112   if (FABS(q/ch-1) > e) goto l4;
1113
1114   return (phydbl)(ch);
1115}
1116
1117//////////////////////////////////////////////////////////////
1118//////////////////////////////////////////////////////////////
1119
1120
1121
1122/*
1123  The following function was extracted from the source code of R.
1124  It implements the methods referenced below.
1125 *  REFERENCE
1126 *
1127 *      Beasley, J. D. and S. G. Springer (1977).
1128 *      Algorithm AS 111: The percentage points of the normal distribution,
1129 *      Applied Statistics, 26, 118-121.
1130 *
1131 *      Wichura, M.J. (1988).
1132 *      Algorithm AS 241: The Percentage Points of the Normal Distribution.
1133 *      Applied Statistics, 37, 477-484.
1134 */
1135
1136
1137phydbl PointNormal (phydbl prob)
1138{
1139/* returns z so that Prob{x<z}=prob where x ~ N(0,1) and (1e-12)<prob<1-(1e-12)
1140   returns (-9999) if in error
1141   Odeh RE & Evans JO (1974) The percentage points of the normal distribution.
1142   Applied Statistics 22: 96-97 (AS70)
1143
1144   Newer methods:
1145     Wichura MJ (1988) Algorithm AS 241: the percentage points of the
1146       normal distribution.  37: 477-484.
1147     Beasley JD & Springer SG  (1977).  Algorithm AS 111: the percentage
1148       points of the normal distribution.  26: 118-121.
1149*/
1150   phydbl a0=-.322232431088, a1=-1, a2=-.342242088547, a3=-.0204231210245;
1151   phydbl a4=-.453642210148e-4, b0=.0993484626060, b1=.588581570495;
1152   phydbl b2=.531103462366, b3=.103537752850, b4=.0038560700634;
1153   phydbl y, z=0, p=prob, p1;
1154
1155   p1 = (p<0.5 ? p : 1-p);
1156   if (p1<1e-20) z=999;
1157   else {
1158      y = SQRT (LOG(1/(p1*p1)));   
1159      z = y + ((((y*a4+a3)*y+a2)*y+a1)*y+a0) / ((((y*b4+b3)*y+b2)*y+b1)*y+b0);
1160   }
1161   return (p<0.5 ? -z : z);
1162}
1163
1164
1165/* phydbl PointNormal(phydbl p) */
1166/* { */
1167/*     double p_, q, r, val; */
1168
1169/*     p_ = p; */
1170/*     q = p_ - 0.5; */
1171
1172/*     /\*-- use AS 241 --- *\/ */
1173/*     /\* double ppnd16_(double *p, long *ifault)*\/ */
1174/*     /\*      ALGORITHM AS241  APPL. STATIST. (1988) VOL. 37, NO. 3 */
1175
1176/*          Produces the normal deviate Z corresponding to a given lower */
1177/*          tail area of P; Z is accurate to about 1 part in 10**16. */
1178
1179/*          (original fortran code used PARAMETER(..) for the coefficients */
1180/*          and provided hash codes for checking them...) */
1181/* *\/ */
1182/*     if (fabs(q) <= .425)  */
1183/*       {/\* 0.075 <= p <= 0.925 *\/ */
1184/*      r = .180625 - q * q; */
1185/*      val = */
1186/*        q * (((((((r * 2509.0809287301226727 + */
1187/*                   33430.575583588128105) * r + 67265.770927008700853) * r + */
1188/*                 45921.953931549871457) * r + 13731.693765509461125) * r + */
1189/*               1971.5909503065514427) * r + 133.14166789178437745) * r + */
1190/*             3.387132872796366608) */
1191/*        / (((((((r * 5226.495278852854561 + */
1192/*                 28729.085735721942674) * r + 39307.89580009271061) * r + */
1193/*               21213.794301586595867) * r + 5394.1960214247511077) * r + */
1194/*             687.1870074920579083) * r + 42.313330701600911252) * r + 1.); */
1195/*       } */
1196/*     else  */
1197/*       { /\* closer than 0.075 from {0,1} boundary *\/ */
1198
1199/*      /\* r = min(p, 1-p) < 0.075 *\/ */
1200/*      if (q > 0) */
1201/*        r = 1-p;/\* 1-p *\/ */
1202/*      else */
1203/*        r = p_;/\* = R_DT_Iv(p) ^=  p *\/ */
1204       
1205/*      r = sqrt(-log(r)); */
1206/*         /\* r = sqrt(-log(r))  <==>  min(p, 1-p) = exp( - r^2 ) *\/ */
1207       
1208/*         if (r <= 5.) { /\* <==> min(p,1-p) >= exp(-25) ~= 1.3888e-11 *\/ */
1209/*        r += -1.6; */
1210/*        val = (((((((r * 7.7454501427834140764e-4 + */
1211/*                        .0227238449892691845833) * r + .24178072517745061177) * */
1212/*                      r + 1.27045825245236838258) * r + */
1213/*                     3.64784832476320460504) * r + 5.7694972214606914055) * */
1214/*                   r + 4.6303378461565452959) * r + */
1215/*                  1.42343711074968357734) */
1216/*          / (((((((r * */
1217/*                   1.05075007164441684324e-9 + 5.475938084995344946e-4) * */
1218/*                  r + .0151986665636164571966) * r + */
1219/*                 .14810397642748007459) * r + .68976733498510000455) * */
1220/*               r + 1.6763848301838038494) * r + */
1221/*              2.05319162663775882187) * r + 1.); */
1222/*         } */
1223/*         else  */
1224/*        { /\* very close to  0 or 1 *\/ */
1225/*          r += -5.; */
1226/*          val = (((((((r * 2.01033439929228813265e-7 + */
1227/*                       2.71155556874348757815e-5) * r + */
1228/*                      .0012426609473880784386) * r + .026532189526576123093) * */
1229/*                    r + .29656057182850489123) * r + */
1230/*                   1.7848265399172913358) * r + 5.4637849111641143699) * */
1231/*                 r + 6.6579046435011037772) */
1232/*            / (((((((r * */
1233/*                     2.04426310338993978564e-15 + 1.4215117583164458887e-7)* */
1234/*                    r + 1.8463183175100546818e-5) * r + */
1235/*                   7.868691311456132591e-4) * r + .0148753612908506148525) */
1236/*                 * r + .13692988092273580531) * r + */
1237/*                .59983220655588793769) * r + 1.); */
1238/*        } */
1239       
1240/*      if(q < 0.0) */
1241/*        val = -val; */
1242/*         /\* return (q >= 0.)? r : -r ;*\/ */
1243/*       } */
1244/*     return (phydbl)val; */
1245/* } */
1246
1247//////////////////////////////////////////////////////////////
1248//////////////////////////////////////////////////////////////
1249
1250/* MISCs */
1251//////////////////////////////////////////////////////////////
1252//////////////////////////////////////////////////////////////
1253
1254
1255//////////////////////////////////////////////////////////////
1256//////////////////////////////////////////////////////////////
1257
1258
1259phydbl Bico(int n, int k)
1260{
1261  return FLOOR(0.5+EXP(Factln(n)-Factln(k)-Factln(n-k)));
1262}
1263
1264
1265//////////////////////////////////////////////////////////////
1266//////////////////////////////////////////////////////////////
1267
1268
1269phydbl Factln(int n)
1270{
1271  static phydbl a[101];
1272 
1273  if (n < 0)    { Warn_And_Exit("\n== Err: negative factorial in routine FACTLN"); }
1274  if (n <= 1)     return 0.0;
1275  if (n <= 100)   return (a[n]>SMALL) ? a[n] : (a[n]=Gammln(n+1.0));
1276  else return     Gammln(n+1.0);
1277}
1278
1279//////////////////////////////////////////////////////////////
1280//////////////////////////////////////////////////////////////
1281
1282
1283phydbl Gammln(phydbl xx)
1284{
1285  double x,tmp,ser;
1286  static double cof[6]={76.18009173,-86.50532033,24.01409822,
1287                        -1.231739516,0.120858003e-2,-0.536382e-5};
1288  int j;
1289 
1290  x=xx-1.0;
1291  tmp=x+5.5;
1292  tmp -= (x+0.5)*log(tmp);
1293  ser=1.0;
1294  for (j=0;j<=5;j++) 
1295    {
1296      x += 1.0;
1297      ser += cof[j]/x;
1298    }
1299  return (phydbl)(-tmp+log(2.50662827465*ser));
1300}
1301
1302//////////////////////////////////////////////////////////////
1303//////////////////////////////////////////////////////////////
1304
1305
1306/* void Plim_Binom(phydbl pH0, int N, phydbl *pinf, phydbl *psup) */
1307/* { */
1308/*   *pinf = pH0 - 1.64*SQRT(pH0*(1-pH0)/(phydbl)N); */
1309/*   if(*pinf < 0) *pinf = .0; */
1310/*   *psup = pH0 + 1.64*SQRT(pH0*(1-pH0)/(phydbl)N); */
1311/* } */
1312
1313//////////////////////////////////////////////////////////////
1314//////////////////////////////////////////////////////////////
1315
1316
1317phydbl LnGamma (phydbl alpha)
1318{
1319/* returns ln(gamma(alpha)) for alpha>0, accurate to 10 decimal places.
1320   Stirling's formula is used for the central polynomial part of the procedure.
1321   Pike MC & Hill ID (1966) Algorithm 291: Logarithm of the gamma function.
1322   Communications of the Association for Computing Machinery, 9:684
1323*/
1324   double x=alpha, f=0, z;
1325   if (x<7) {
1326      f=1;  z=x-1;
1327      while (++z<7)  f*=z;
1328      x=z;   f=-log(f);
1329   }
1330   z = 1/(x*x);
1331   return (phydbl)(f + (x-0.5)*log(x) - x + .918938533204673
1332                   + (((-.000595238095238*z+.000793650793651)*z-.002777777777778)*z
1333                      +.083333333333333)/x);
1334}
1335
1336//////////////////////////////////////////////////////////////
1337//////////////////////////////////////////////////////////////
1338
1339
1340phydbl IncompleteGamma(phydbl x, phydbl alpha, phydbl ln_gamma_alpha)
1341{
1342/* returns the incomplete gamma ratio I(x,alpha) where x is the upper
1343           limit of the integration and alpha is the shape parameter.
1344   returns (-1) if in error
1345   ln_gamma_alpha = ln(Gamma(alpha)), is almost redundant.
1346   (1) series expansion     if (alpha>x || x<=1)
1347   (2) continued fraction   otherwise
1348   RATNEST FORTRAN by
1349   Bhattacharjee GP (1970) The incomplete gamma integral.  Applied Statistics,
1350   19: 285-287 (AS32)
1351*/
1352   int i;
1353   double p=alpha, g=ln_gamma_alpha;
1354   double accurate=1e-8, overflow=1e30;
1355   double factor, gin=0, rn=0, a=0,b=0,an=0,dif=0, term=0, pn[6];
1356
1357   if (fabs(x) < SMALL) return ((phydbl).0);
1358   if (x<0 || p<=0)        return ((phydbl)-1);
1359
1360   factor=exp(p*log(x)-x-g);
1361   if (x>1 && x>=p) goto l30;
1362   /* (1) series expansion */
1363   gin=1;  term=1;  rn=p;
1364 l20:
1365   rn++;
1366   term*=x/rn;   gin+=term;
1367
1368   if (term > accurate) goto l20;
1369   gin*=factor/p;
1370   goto l50;
1371 l30:
1372   /* (2) continued fraction */
1373   a=1-p;   b=a+x+1;  term=0;
1374   pn[0]=1;  pn[1]=x;  pn[2]=x+1;  pn[3]=x*b;
1375   gin=pn[2]/pn[3];
1376 l32:
1377   a++;  b+=2;  term++;   an=a*term;
1378   for (i=0; i<2; i++) pn[i+4]=b*pn[i+2]-an*pn[i];
1379   if (fabs(pn[5]) < .0) goto l35;
1380   rn=pn[4]/pn[5];   dif=fabs(gin-rn);
1381   if (dif>accurate) goto l34;
1382   if (dif<=accurate*rn) goto l42;
1383 l34:
1384   gin=rn;
1385 l35:
1386   for (i=0; i<4; i++) pn[i]=pn[i+2];
1387   if (fabs(pn[4]) < overflow) goto l32;
1388   for (i=0; i<4; i++) pn[i]/=overflow;
1389   goto l32;
1390 l42:
1391   gin=1-factor*gin;
1392
1393 l50:
1394   return (phydbl)(gin);
1395}
1396
1397
1398//////////////////////////////////////////////////////////////
1399//////////////////////////////////////////////////////////////
1400
1401
1402int DiscreteGamma (phydbl freqK[], phydbl rK[],
1403                   phydbl alfa, phydbl beta, int K, int median)
1404{
1405  /* discretization of gamma distribution with equal proportions in each
1406     category
1407  */
1408   
1409  int i;
1410  phydbl gap05=1.0/(2.0*K), t, factor=alfa/beta*K, lnga1;
1411
1412  if(K==1)
1413    {
1414      freqK[0] = 1.0;
1415      rK[0] = 1.0;
1416      return 0;
1417    }
1418
1419   if (median) 
1420     {
1421       for (i=0; i<K; i++)     rK[i]=PointGamma((i*2.0+1)*gap05, alfa, beta);
1422       for (i=0,t=0; i<K; i++) t+=rK[i];
1423       for (i=0; i<K; i++)     rK[i]*=factor/t;
1424     }
1425   else {
1426
1427      lnga1=LnGamma(alfa+1);
1428      for (i=0; i<K-1; i++)
1429         freqK[i]=PointGamma((i+1.0)/K, alfa, beta);
1430      for (i=0; i<K-1; i++)
1431         freqK[i]=IncompleteGamma(freqK[i]*beta, alfa+1, lnga1);
1432      rK[0] = freqK[0]*factor;
1433      rK[K-1] = (1-freqK[K-2])*factor;
1434      for (i=1; i<K-1; i++)  rK[i] = (freqK[i]-freqK[i-1])*factor;
1435   }
1436   for (i=0; i<K; i++) freqK[i]=1.0/K;
1437   return (0);
1438}
1439
1440//////////////////////////////////////////////////////////////
1441//////////////////////////////////////////////////////////////
1442
1443
1444/* Return LOG(n!) */
1445
1446phydbl LnFact(int n)
1447{
1448  int i;
1449  phydbl res;
1450
1451  res = 0;
1452  for(i=2;i<=n;i++) res += LOG(i);
1453 
1454  return(res);
1455}
1456
1457//////////////////////////////////////////////////////////////
1458//////////////////////////////////////////////////////////////
1459
1460
1461int Choose(int n, int k)
1462{
1463  phydbl accum;
1464  int i;
1465
1466  if (k > n) return(0);
1467  if (k > n/2) k = n-k;
1468  if(!k) return(1);
1469
1470  accum = 1.;
1471  for(i=1;i<k+1;i++) accum = accum * (n-k+i) / i;
1472
1473  return((int)accum);
1474}
1475
1476//////////////////////////////////////////////////////////////
1477//////////////////////////////////////////////////////////////
1478
1479
1480
1481phydbl *Covariance_Matrix(t_tree *tree)
1482{
1483  phydbl *cov, *mean;
1484  int *ori_wght,*site_num;
1485  int dim,i,j,replicate,n_site,position,sample_size;
1486
1487  sample_size = 100;
1488  dim = 2*tree->n_otu-3;
1489
1490  cov      = (phydbl *)mCalloc(dim*dim,sizeof(phydbl));
1491  mean     = (phydbl *)mCalloc(    dim,sizeof(phydbl));
1492  ori_wght = (int *)mCalloc(tree->data->crunch_len,sizeof(int));
1493  site_num = (int *)mCalloc(tree->data->init_len,sizeof(int));
1494 
1495  For(i,tree->data->crunch_len) ori_wght[i] = tree->data->wght[i];
1496
1497  n_site = 0;
1498  For(i,tree->data->crunch_len) For(j,tree->data->wght[i])
1499    {
1500      site_num[n_site] = i;
1501      n_site++;
1502    }
1503
1504 
1505  tree->mod->s_opt->print = 0;
1506  For(replicate,sample_size)
1507    {
1508      For(i,2*tree->n_otu-3) tree->a_edges[i]->l->v = .1;
1509
1510      For(i,tree->data->crunch_len) tree->data->wght[i] = 0;
1511
1512      For(i,tree->data->init_len)
1513        {
1514          position = Rand_Int(0,(int)(tree->data->init_len-1.0));
1515          tree->data->wght[site_num[position]] += 1;
1516        }
1517
1518      Round_Optimize(tree,tree->data,ROUND_MAX);
1519     
1520      For(i,2*tree->n_otu-3) For(j,2*tree->n_otu-3) cov[i*dim+j] += LOG(tree->a_edges[i]->l->v) * LOG(tree->a_edges[j]->l->v); 
1521      For(i,2*tree->n_otu-3) mean[i] += LOG(tree->a_edges[i]->l->v);
1522
1523      PhyML_Printf("[%3d/%3d]",replicate,sample_size); fflush(NULL);
1524/*       PhyML_Printf("\n. %3d %12f %12f %12f ", */
1525/*           replicate, */
1526/*           cov[1*dim+1]/(replicate+1)-mean[1]*mean[1]/POW(replicate+1,2), */
1527/*           tree->a_edges[1]->l->v, */
1528/*           mean[1]/(replicate+1)); */
1529   }
1530
1531  For(i,2*tree->n_otu-3) mean[i] /= (phydbl)sample_size;
1532  For(i,2*tree->n_otu-3) For(j,2*tree->n_otu-3) cov[i*dim+j] /= (phydbl)sample_size;
1533  For(i,2*tree->n_otu-3) For(j,2*tree->n_otu-3) cov[i*dim+j] -= mean[i]*mean[j];
1534/*   For(i,2*tree->n_otu-3) if(cov[i*dim+i] < var_min) cov[i*dim+i] = var_min; */
1535 
1536
1537/*   PhyML_Printf("\n"); */
1538/*   For(i,2*tree->n_otu-3) PhyML_Printf("%f %f\n",mean[i],tree->a_edges[i]->l->v); */
1539/*   PhyML_Printf("\n"); */
1540/*   PhyML_Printf("\n"); */
1541/*   For(i,2*tree->n_otu-3) */
1542/*     { */
1543/*       For(j,2*tree->n_otu-3) */
1544/*      { */
1545/*        PhyML_Printf("%G\n",cov[i*dim+j]); */
1546/*      } */
1547/*       PhyML_Printf("\n"); */
1548/*     } */
1549
1550  For(i,tree->data->crunch_len) tree->data->wght[i] = ori_wght[i];
1551
1552  Free(mean);
1553  Free(ori_wght);
1554  Free(site_num);
1555
1556  return cov;
1557}
1558
1559//////////////////////////////////////////////////////////////
1560//////////////////////////////////////////////////////////////
1561
1562/* Work out the Hessian for the likelihood function. Only branch lengths are considered as variable.
1563   This function is very much inspired from Jeff Thorne's 'hessian' function in his program 'estbranches'. */
1564phydbl *Hessian(t_tree *tree)
1565{
1566  phydbl *hessian;
1567  phydbl *plus_plus, *minus_minus, *plus_zero, *minus_zero, *plus_minus, zero_zero;
1568  phydbl *ori_bl,*inc,*buff;
1569  int *ok_edges,*is_ok;
1570  int dim;
1571  int n_ok_edges;
1572  int i,j;
1573  phydbl eps;
1574  phydbl lk;
1575  phydbl lnL,lnL1,lnL2,ori_lnL;
1576  phydbl l_inf;
1577
1578  dim = 2*tree->n_otu-3;
1579  eps = (tree->mod->log_l == YES)?(0.2):(1E-4);
1580
1581  hessian     = (phydbl *)mCalloc((int)dim*dim,sizeof(phydbl));
1582  ori_bl      = (phydbl *)mCalloc((int)dim,sizeof(phydbl));
1583  plus_plus   = (phydbl *)mCalloc((int)dim*dim,sizeof(phydbl));
1584  minus_minus = (phydbl *)mCalloc((int)dim*dim,sizeof(phydbl));
1585  plus_minus  = (phydbl *)mCalloc((int)dim*dim,sizeof(phydbl));
1586  plus_zero   = (phydbl *)mCalloc((int)dim    ,sizeof(phydbl));
1587  minus_zero  = (phydbl *)mCalloc((int)dim    ,sizeof(phydbl));
1588  inc         = (phydbl *)mCalloc((int)dim    ,sizeof(phydbl));
1589  buff        = (phydbl *)mCalloc((int)dim*dim,sizeof(phydbl));
1590  ok_edges    = (int *)mCalloc((int)dim,sizeof(int));
1591  is_ok       = (int *)mCalloc((int)dim,sizeof(int));
1592
1593  lnL = lnL1 = lnL2 = UNLIKELY;
1594
1595  Set_Both_Sides(YES,tree);
1596  Lk(NULL,tree);
1597  ori_lnL = tree->c_lnL;
1598
1599
1600  For(i,dim) ori_bl[i] = tree->a_edges[i]->l->v;
1601
1602  if(tree->mod->log_l == NO)
1603    l_inf = MAX(tree->mod->l_min,1./(phydbl)tree->data->init_len);
1604  else
1605    l_inf = MAX(tree->mod->l_min,-LOG((phydbl)tree->data->init_len));
1606
1607
1608  n_ok_edges = 0;
1609  For(i,dim) 
1610    {
1611      if(tree->a_edges[i]->l->v*(1.-eps) > l_inf)
1612        {
1613          inc[i] = eps * tree->a_edges[i]->l->v;
1614          ok_edges[n_ok_edges] = i;
1615          n_ok_edges++;
1616          is_ok[i] = 1;
1617        }
1618      else
1619        {
1620          inc[i] = -1.0;
1621          is_ok[i] = 0;
1622        }
1623    }
1624
1625
1626  /* Fine tune the increments */
1627  For(i,dim)
1628    {
1629      do
1630        {
1631          tree->a_edges[i]->l->v += inc[i];
1632          lnL1 = Lk(tree->a_edges[i],tree);
1633          tree->a_edges[i]->l->v = ori_bl[i];
1634          inc[i] *= 1.1;
1635        }while((FABS(lnL1 - ori_lnL) < 1.E-1) && 
1636               (tree->a_edges[i]->l->v+inc[i] < tree->mod->l_max));
1637      inc[i] /= 1.1;
1638    }
1639
1640
1641
1642  /* zero zero */ 
1643  zero_zero = tree->c_lnL;
1644
1645  /* plus zero */ 
1646  For(i,dim) 
1647    {
1648      if(is_ok[i])
1649        {
1650          tree->a_edges[i]->l->v += inc[i];
1651          lk = Lk(tree->a_edges[i],tree);
1652          plus_zero[i] = lk;
1653          tree->a_edges[i]->l->v = ori_bl[i];
1654        }
1655    }
1656
1657
1658  /* minus zero */ 
1659  For(i,dim) 
1660    {
1661      if(is_ok[i])
1662        {
1663          tree->a_edges[i]->l->v -= inc[i];
1664          lk = Lk(tree->a_edges[i],tree);
1665          minus_zero[i] = lk;
1666          tree->a_edges[i]->l->v = ori_bl[i];
1667        }
1668    }
1669
1670
1671  For(i,dim) Update_PMat_At_Given_Edge(tree->a_edges[i],tree);
1672
1673  /* plus plus  */ 
1674  For(i,dim)
1675    {
1676      if(is_ok[i])
1677        {
1678          tree->a_edges[i]->l->v += inc[i];
1679          Update_PMat_At_Given_Edge(tree->a_edges[i],tree);
1680
1681          For(j,3)
1682            if((!tree->a_edges[i]->left->tax) && (tree->a_edges[i]->left->v[j] != tree->a_edges[i]->rght))
1683              Recurr_Hessian(tree->a_edges[i]->left,tree->a_edges[i]->left->v[j],1,inc,plus_plus+i*dim,is_ok,tree);
1684         
1685          For(j,3)
1686            if((!tree->a_edges[i]->rght->tax) && (tree->a_edges[i]->rght->v[j] != tree->a_edges[i]->left))
1687              Recurr_Hessian(tree->a_edges[i]->rght,tree->a_edges[i]->rght->v[j],1,inc,plus_plus+i*dim,is_ok,tree);
1688                     
1689          tree->a_edges[i]->l->v = ori_bl[i];
1690          Lk(NULL,tree);
1691        }
1692    }
1693
1694
1695  /* plus minus */ 
1696  For(i,dim)
1697    {
1698      if(is_ok[i])
1699        {
1700          tree->a_edges[i]->l->v += inc[i];
1701          Update_PMat_At_Given_Edge(tree->a_edges[i],tree);
1702         
1703          For(j,3)
1704            if((!tree->a_edges[i]->left->tax) && (tree->a_edges[i]->left->v[j] != tree->a_edges[i]->rght))
1705              Recurr_Hessian(tree->a_edges[i]->left,tree->a_edges[i]->left->v[j],-1,inc,plus_minus+i*dim,is_ok,tree);
1706         
1707          For(j,3)
1708            if((!tree->a_edges[i]->rght->tax) && (tree->a_edges[i]->rght->v[j] != tree->a_edges[i]->left))
1709              Recurr_Hessian(tree->a_edges[i]->rght,tree->a_edges[i]->rght->v[j],-1,inc,plus_minus+i*dim,is_ok,tree);
1710         
1711          tree->a_edges[i]->l->v = ori_bl[i];
1712          Lk(NULL,tree);
1713        }
1714    }
1715
1716
1717  /* minus minus */ 
1718  For(i,dim)
1719    {
1720      if(is_ok[i])
1721        {
1722          tree->a_edges[i]->l->v -= inc[i];
1723         
1724          Update_PMat_At_Given_Edge(tree->a_edges[i],tree);
1725         
1726          For(j,3)
1727            if((!tree->a_edges[i]->left->tax) && (tree->a_edges[i]->left->v[j] != tree->a_edges[i]->rght))
1728              Recurr_Hessian(tree->a_edges[i]->left,tree->a_edges[i]->left->v[j],-1,inc,minus_minus+i*dim,is_ok,tree);
1729         
1730          For(j,3)
1731            if((!tree->a_edges[i]->rght->tax) && (tree->a_edges[i]->rght->v[j] != tree->a_edges[i]->left))
1732              Recurr_Hessian(tree->a_edges[i]->rght,tree->a_edges[i]->rght->v[j],-1,inc,minus_minus+i*dim,is_ok,tree);
1733         
1734          tree->a_edges[i]->l->v = ori_bl[i];
1735          Lk(NULL,tree);
1736        }
1737    }
1738
1739
1740 
1741  For(i,dim)
1742    {
1743      if(is_ok[i])
1744        {
1745          hessian[i*dim+i] = (plus_zero[i]-2*zero_zero+minus_zero[i])/(POW(inc[i],2));
1746
1747          for(j=i+1;j<dim;j++)
1748            {
1749              if(is_ok[j])
1750                {
1751                  hessian[i*dim+j] = 
1752                    (plus_plus[i*dim+j]-plus_minus[i*dim+j]-plus_minus[j*dim+i]+minus_minus[i*dim+j])/
1753                    (4*inc[i]*inc[j]);
1754                  hessian[j*dim+i] = hessian[i*dim+j];
1755                }
1756            }
1757        }
1758    }
1759       
1760  For(i,n_ok_edges)
1761    {
1762      For(j,n_ok_edges)
1763        {
1764          buff[i*n_ok_edges+j] = -1.0*hessian[ok_edges[i]*dim+ok_edges[j]];
1765        }
1766    }
1767
1768
1769  if(!Matinv(buff,n_ok_edges,n_ok_edges,NO))
1770    {
1771      PhyML_Printf("\n. Err in file %s at line %d\n",__FILE__,__LINE__);
1772      Exit("\n");     
1773    }
1774
1775  For(i,n_ok_edges)
1776    {
1777      For(j,n_ok_edges)
1778        {
1779          hessian[ok_edges[i]*dim+ok_edges[j]] = buff[i*n_ok_edges+j];
1780        }
1781    }
1782
1783/*   eps = 1./(phydbl)tree->data->init_len; */
1784  /* Approximate variance for very short branches */
1785  For(i,dim)
1786    if(inc[i] < 0.0 || hessian[i*dim+i] < MIN_VAR_BL)
1787      { 
1788        eps = 0.2 * tree->a_edges[i]->l->v;
1789        do
1790          {
1791            lnL  = Lk(tree->a_edges[i],tree);   
1792            tree->a_edges[i]->l->v += eps;
1793            lnL1 = Lk(tree->a_edges[i],tree);
1794            tree->a_edges[i]->l->v += eps;
1795            lnL2 = Lk(tree->a_edges[i],tree);
1796            tree->a_edges[i]->l->v -= 2.*eps;
1797           
1798            hessian[i*dim+i] = (lnL2 - 2.*lnL1 + lnL) / POW(eps,2);
1799       
1800/*          printf("\n* l=%G eps=%f lnL=%f lnL1=%f lnL2=%f var=%f",tree->a_edges[i]->l->v,eps,lnL,lnL1,lnL2,hessian[i*dim+i]); */
1801            eps *= 5.;
1802          }while(FABS(lnL2 - lnL) < 1.E-3);
1803
1804        hessian[i*dim+i] = -1.0 / hessian[i*dim+i];
1805
1806      }
1807 
1808
1809  /* Fit a straight line to the log-likelihood (i.e., an exponential to the likelihood) */
1810  /* It is only a straight line when considering branch length (rather than log(branch lengths)) */
1811  For(i,dim)
1812    if((tree->a_edges[i]->l->v / tree->mod->l_min < 1.1) &&
1813       (tree->a_edges[i]->l->v / tree->mod->l_min > 0.9))
1814      {
1815        phydbl *x,*y,l;
1816        phydbl cov,var;
1817       
1818        x=plus_plus;
1819        y=minus_minus;
1820        l=(tree->mod->log_l == YES)?(EXP(tree->a_edges[i]->l->v)):(tree->a_edges[i]->l->v); /* Get actual branch length */
1821       
1822        For(j,dim)
1823          {
1824            x[j] = l + (100.*l-l)*((phydbl)j/dim);
1825            tree->a_edges[i]->l->v = (tree->mod->log_l)?(LOG(x[j])):(x[j]); /* Transform to log if necessary */
1826            y[j] = Lk(tree->a_edges[i],tree);
1827            tree->a_edges[i]->l->v = (tree->mod->log_l)?(LOG(l)):(l); /* Go back to initial edge length */
1828          }
1829       
1830        cov = Covariance(x,y,dim);
1831        var = Covariance(x,x,dim);
1832       
1833        /* cov/var is minus the parameter of the exponential distribution.
1834           The variance is therefore : */
1835        hessian[i*dim+i] = 1.0 / pow(cov/var,2);
1836       
1837        /*          printf("\n. Hessian = %G cov=%G var=%G",hessian[i*dim+i],cov,var); */
1838      }
1839  /*     } */
1840
1841
1842  For(i,dim)
1843    if(hessian[i*dim+i] < 0.0)
1844      {
1845        PhyML_Printf("\n. l=%G var=%G",tree->a_edges[i]->l->v,hessian[i*dim+i]);
1846/*      PhyML_Printf("\n. Err in file %s at line %d\n",__FILE__,__LINE__); */
1847/*      Exit("\n"); */
1848        hessian[i*dim+i] = MIN_VAR_BL;
1849      }
1850
1851  For(i,dim)
1852    {
1853      if(hessian[i*dim+i] < MIN_VAR_BL)
1854        {
1855          PhyML_Printf("\n. l=%10G var(l)=%12G. WARNING: numerical precision issues may affect this analysis.",
1856                       tree->a_edges[i]->l->v,hessian[i*dim+i]);
1857          hessian[i*dim+i] = MIN_VAR_BL;
1858        }
1859      if(hessian[i*dim+i] > MAX_VAR_BL)
1860        {
1861          PhyML_Printf("\n. l=%10G var(l)=%12G. WARNING: numerical precision issues may affect this analysis.",
1862                       tree->a_edges[i]->l->v,hessian[i*dim+i]);
1863          hessian[i*dim+i] = MAX_VAR_BL;
1864        }
1865    }
1866 
1867  Iter_Matinv(hessian,dim,dim,NO);
1868
1869  For(i,dim*dim) hessian[i] = -1.0*hessian[i];
1870
1871  For(i,dim)
1872    {
1873      For(j,dim)
1874        {
1875          if(FABS(hessian[i*dim+j]-hessian[j*dim+i]) > 1.E-3)
1876            {
1877              PhyML_Printf("\n. Hessian not symmetrical.");
1878              PhyML_Printf("\n. Err in file %s at line %d\n",__FILE__,__LINE__);
1879              Exit("\n");
1880            }
1881          hessian[i*dim+j] = (hessian[i*dim+j] + hessian[j*dim+i]) / 2.; 
1882          hessian[j*dim+i] = hessian[i*dim+j]; 
1883        }
1884    }
1885 
1886/*   printf("\n"); */
1887/*   printf("HESSIAN\n"); */
1888/*   For(i,dim) */
1889/*     { */
1890/*       PhyML_Printf("[%f] ",tree->a_edges[i]->l->v); */
1891/*       For(j,dim) */
1892/*      { */
1893/*        PhyML_Printf("%12lf ",hessian[i*dim+j]); */
1894/*      } */
1895/*       PhyML_Printf("\n"); */
1896/*     } */
1897
1898  /* Matinv(hessian,dim,dim,NO); */
1899
1900  /* PhyML_Printf("\n"); */
1901
1902  /* For(i,dim) */
1903  /*   { */
1904  /*     PhyML_Printf("[%f] ",tree->a_edges[i]->l->v); */
1905  /*     For(j,dim) */
1906  /*    { */
1907  /*      PhyML_Printf("%12G ",-hessian[i*dim+j]); */
1908  /*    } */
1909  /*     PhyML_Printf("\n"); */
1910  /*   } */
1911  /* Exit("\n"); */
1912
1913
1914  /* Make sure to update likelihood before bailing out */
1915  Set_Both_Sides(YES,tree);
1916  Lk(NULL,tree);
1917
1918  Free(ori_bl);
1919  Free(plus_plus);
1920  Free(minus_minus);
1921  Free(plus_zero);
1922  Free(minus_zero);
1923  Free(plus_minus);
1924  Free(inc);
1925  Free(buff);
1926  Free(ok_edges);
1927  Free(is_ok);
1928
1929  return hessian;
1930
1931}
1932
1933//////////////////////////////////////////////////////////////
1934//////////////////////////////////////////////////////////////
1935
1936
1937/* Work out the gradient for the likelihood function. Only branch lengths are considered as variable.
1938 */
1939phydbl *Gradient(t_tree *tree)
1940{
1941  phydbl *gradient;
1942  phydbl *plus, *minus;
1943  phydbl *ori_bl,*inc;
1944  int *is_ok;
1945  int dim;
1946  int i;
1947  phydbl eps;
1948  phydbl lk;
1949  phydbl lnL,lnL1,lnL2;
1950  phydbl l_inf;
1951
1952  dim = 2*tree->n_otu-3;
1953  eps = (tree->mod->log_l == YES)?(0.2):(1.E-6);
1954
1955  gradient    = (phydbl *)mCalloc((int)dim,sizeof(phydbl));
1956  ori_bl      = (phydbl *)mCalloc((int)dim,sizeof(phydbl));
1957  plus        = (phydbl *)mCalloc((int)dim,sizeof(phydbl));
1958  minus       = (phydbl *)mCalloc((int)dim,sizeof(phydbl));
1959  inc         = (phydbl *)mCalloc((int)dim    ,sizeof(phydbl));
1960  is_ok       = (int *)mCalloc((int)dim,sizeof(int));
1961
1962  lnL = lnL1 = lnL2 = UNLIKELY;
1963
1964  Set_Both_Sides(YES,tree);
1965  Lk(NULL,tree);
1966
1967  For(i,dim) ori_bl[i] = tree->a_edges[i]->l->v;
1968
1969  if(tree->mod->log_l == NO)
1970    l_inf = MAX(tree->mod->l_min,1./(phydbl)tree->data->init_len);
1971  else
1972    l_inf = MAX(tree->mod->l_min,-LOG((phydbl)tree->data->init_len));
1973
1974  For(i,dim) 
1975    {
1976      if(tree->a_edges[i]->l->v*(1.-eps) > l_inf)
1977        {
1978          inc[i] = eps * tree->a_edges[i]->l->v;
1979          is_ok[i] = YES;
1980        }
1981      else
1982        {
1983          inc[i] = -1.0;
1984          is_ok[i] = NO;
1985        }
1986    }
1987
1988  /* plus */ 
1989  For(i,dim) 
1990    {
1991      if(is_ok[i] == YES)
1992        {
1993          tree->a_edges[i]->l->v += inc[i];
1994          lk = Lk(tree->a_edges[i],tree);
1995          plus[i] = lk;
1996          tree->a_edges[i]->l->v = ori_bl[i];
1997        }
1998    }
1999
2000
2001  /* minus */ 
2002  For(i,dim)
2003    {
2004      if(is_ok[i] == YES)
2005        {
2006          tree->a_edges[i]->l->v -= inc[i];
2007          lk = Lk(tree->a_edges[i],tree);
2008          minus[i] = lk;
2009          tree->a_edges[i]->l->v = ori_bl[i];
2010        }
2011    }
2012
2013
2014  For(i,dim)
2015    {
2016      if(is_ok[i] == YES)
2017        {
2018          gradient[i] = (plus[i] - minus[i])/(2.*inc[i]);
2019        }
2020    }
2021
2022
2023  For(i,dim)
2024    {
2025      if(is_ok[i] == NO)
2026        {
2027          eps = FABS(0.2 * tree->a_edges[i]->l->v);
2028          lnL  = Lk(tree->a_edges[i],tree);     
2029          tree->a_edges[i]->l->v += eps;
2030          lnL1 = Lk(tree->a_edges[i],tree);
2031          tree->a_edges[i]->l->v += eps;
2032          lnL2 = Lk(tree->a_edges[i],tree);
2033          tree->a_edges[i]->l->v -= eps;
2034          tree->a_edges[i]->l->v -= eps;
2035          gradient[i] = (4.*lnL1 - lnL2 - 3.*lnL) / (2.*eps);
2036        }
2037    }
2038
2039  /* Make sure to update likelihood before bailing out */
2040  Set_Both_Sides(YES,tree);
2041  Lk(NULL,tree);
2042
2043  Free(ori_bl);
2044  Free(plus);
2045  Free(minus);
2046  Free(inc);
2047  Free(is_ok);
2048 
2049
2050/*   printf("\n"); */
2051/*   printf("GRADIENT\n"); */
2052/*   For(i,dim) */
2053/*     { */
2054/*       PhyML_Printf("[%f] ",tree->a_edges[i]->l->v); */
2055/*       For(j,dim) */
2056/*      { */
2057/*        printf("%12lf ",gradient[i]*gradient[j]); */
2058/*      } */
2059/*       printf("\n"); */
2060/*     } */
2061/*   printf("\n"); */
2062/*   For(i,dim) */
2063/*     { */
2064/*       PhyML_Printf("[%f] [%f]\n",tree->a_edges[i]->l->v,gradient[i]); */
2065/*     } */
2066
2067/*   Exit("\n"); */
2068
2069  return gradient;
2070
2071}
2072
2073//////////////////////////////////////////////////////////////
2074//////////////////////////////////////////////////////////////
2075
2076
2077/* Work out the Hessian for the likelihood function using the method described by Seo et al., 2004, MBE.
2078   Corresponds to the outer product of the scores approach described in Porter, 2002. (matrix J1)
2079*/
2080phydbl *Hessian_Seo(t_tree *tree)
2081{
2082  phydbl *hessian,*site_hessian;
2083  phydbl *gradient;
2084  phydbl *plus, *minus, *plusplus, *zero;
2085  phydbl *ori_bl,*inc_plus,*inc_minus,*inc;
2086  int *is_ok;
2087  int dim;
2088  int i,j,k;
2089  phydbl eps;
2090  phydbl ori_lnL,lnL1,lnL2;
2091  phydbl l_inf;
2092  int l,n;
2093  phydbl small_var;
2094
2095  dim = 2*tree->n_otu-3;
2096  eps = (tree->mod->log_l == YES)?(0.2):(1.E-4);
2097
2098  hessian      = (phydbl *)mCalloc((int)dim*dim,sizeof(phydbl));
2099  site_hessian = (phydbl *)mCalloc((int)dim*dim,sizeof(phydbl));
2100  gradient     = (phydbl *)mCalloc((int)dim,sizeof(phydbl));
2101  ori_bl       = (phydbl *)mCalloc((int)dim,sizeof(phydbl));
2102  plus         = (phydbl *)mCalloc((int)dim*tree->n_pattern,sizeof(phydbl));
2103  plusplus     = (phydbl *)mCalloc((int)dim*tree->n_pattern,sizeof(phydbl));
2104  minus        = (phydbl *)mCalloc((int)dim*tree->n_pattern,sizeof(phydbl));
2105  zero         = (phydbl *)mCalloc((int)dim*tree->n_pattern,sizeof(phydbl));
2106  inc_plus     = (phydbl *)mCalloc((int)dim,sizeof(phydbl));
2107  inc_minus    = (phydbl *)mCalloc((int)dim,sizeof(phydbl));
2108  inc          = (phydbl *)mCalloc((int)dim,sizeof(phydbl));
2109  is_ok        = (int *)mCalloc((int)dim,sizeof(int));
2110
2111  lnL1 = lnL2 = UNLIKELY;
2112 
2113  Set_Both_Sides(YES,tree);
2114  Lk(NULL,tree);
2115  ori_lnL = tree->c_lnL;
2116
2117  For(i,dim) ori_bl[i] = tree->a_edges[i]->l->v;
2118
2119  if(tree->mod->log_l == NO)
2120    l_inf = MAX(tree->mod->l_min,1./(phydbl)tree->data->init_len);
2121  else
2122    l_inf = MAX(tree->mod->l_min,-LOG((phydbl)tree->data->init_len));
2123
2124  For(i,dim) 
2125    {
2126      if(tree->a_edges[i]->l->v*(1.-eps) > l_inf)
2127        {
2128          inc_plus[i]  = FABS(eps * tree->a_edges[i]->l->v);
2129          inc_minus[i] = FABS(eps * tree->a_edges[i]->l->v);
2130          is_ok[i]     = YES;
2131        }
2132      else
2133        {
2134          inc_plus[i]  = FABS(0.2 * tree->a_edges[i]->l->v);
2135          inc_minus[i] = FABS(0.2 * tree->a_edges[i]->l->v);
2136          is_ok[i]     = NO;
2137        }
2138    }
2139
2140
2141  /* Fine tune the increments */
2142  For(i,dim)
2143    {
2144      do
2145        {
2146          tree->a_edges[i]->l->v += inc_plus[i];         
2147          lnL1 = Lk(tree->a_edges[i],tree);
2148          tree->a_edges[i]->l->v = ori_bl[i];
2149          inc_plus[i] *= 1.1;
2150        }while((FABS(lnL1 - ori_lnL) < 1.E-1) && 
2151               (tree->a_edges[i]->l->v+inc_plus[i] < tree->mod->l_max));
2152      inc_plus[i] /= 1.1;
2153    }
2154
2155  For(i,dim)
2156    {
2157      do
2158        {
2159          tree->a_edges[i]->l->v -= inc_minus[i];
2160          lnL1 = Lk(tree->a_edges[i],tree);
2161          tree->a_edges[i]->l->v = ori_bl[i];
2162          inc_minus[i] *= 1.1;
2163        }while((FABS(lnL1 - ori_lnL) < 1.E-1) && 
2164               (tree->a_edges[i]->l->v -inc_minus[i] > tree->mod->l_min));
2165      inc_minus[i] /= 1.1;
2166    }
2167
2168  For(i,dim) 
2169    {
2170      inc[i] = MIN(inc_plus[i],inc_minus[i]);
2171    }
2172
2173  /* plus */ 
2174  For(i,dim) 
2175    {
2176      if(is_ok[i] == YES)
2177        {
2178          tree->a_edges[i]->l->v += inc[i];
2179          Lk(tree->a_edges[i],tree);
2180          For(j,tree->n_pattern) plus[i*tree->n_pattern+j] = LOG(tree->cur_site_lk[j]);
2181          tree->a_edges[i]->l->v = ori_bl[i];
2182        }
2183    }
2184
2185
2186  /* minus */
2187  For(i,dim)
2188    {
2189      if(is_ok[i] == YES)
2190        {
2191          tree->a_edges[i]->l->v -= inc[i];
2192          Lk(tree->a_edges[i],tree);
2193          For(j,tree->n_pattern) minus[i*tree->n_pattern+j] = LOG(tree->cur_site_lk[j]);
2194          tree->a_edges[i]->l->v = ori_bl[i];
2195        }
2196    }
2197
2198
2199  For(i,dim)
2200    {
2201      if(is_ok[i] == NO)
2202        {
2203          Lk(tree->a_edges[i],tree);   
2204          For(j,tree->n_pattern) zero[i*tree->n_pattern+j] = LOG(tree->cur_site_lk[j]);
2205         
2206          tree->a_edges[i]->l->v += inc[i];
2207          lnL1 = Lk(tree->a_edges[i],tree);
2208          For(j,tree->n_pattern) plus[i*tree->n_pattern+j] = LOG(tree->cur_site_lk[j]);
2209         
2210          tree->a_edges[i]->l->v += inc[i];
2211          lnL2 = Lk(tree->a_edges[i],tree);
2212          For(j,tree->n_pattern) plusplus[i*tree->n_pattern+j] = LOG(tree->cur_site_lk[j]);
2213         
2214          tree->a_edges[i]->l->v = ori_bl[i];   
2215
2216        }
2217    }
2218
2219  For(i,dim*dim) hessian[i] = 0.0;
2220
2221  For(k,tree->n_pattern)
2222    {
2223      For(i,dim) 
2224        {
2225          if(is_ok[i] == YES)
2226            gradient[i] = (plus[i*tree->n_pattern+k] - minus[i*tree->n_pattern+k])/(inc[i] + inc[i]); 
2227          else
2228            gradient[i] = (4.*plus[i*tree->n_pattern+k] - plusplus[i*tree->n_pattern+k] - 3.*zero[i*tree->n_pattern+k])/(inc[i] + inc[i]);
2229         
2230          /* if(is_ok[i] == NO) */
2231          /*   printf("\n. i=%d site=%d l=%G plus=%G plusplus=%G zero=%G num=%f grad=%G", */
2232          /*       i,k,tree->a_edges[i]->l->v, */
2233          /*       plus[i*tree->n_pattern+k],plusplus[i*tree->n_pattern+k],zero[i*tree->n_pattern+k], */
2234          /*       (4.*plus[i*tree->n_pattern+k] - plusplus[i*tree->n_pattern+k] - 3.*zero[i*tree->n_pattern+k]), */
2235          /*       gradient[i]); */
2236        }
2237      For(i,dim) For(j,dim) site_hessian[i*dim+j] = gradient[i] * gradient[j];
2238      For(i,dim*dim) hessian[i] -= site_hessian[i] * tree->data->wght[k]; 
2239    }
2240
2241
2242  /* Make sure to update likelihood before bailing out */
2243  Set_Both_Sides(YES,tree);
2244  Lk(NULL,tree);
2245
2246  l = tree->data->init_len;
2247  n = tree->mod->ns;
2248  /* Delta method for variance. Assume Jukes and Cantor with p=1/n */
2249  small_var = (1./(l*l))*(1.-1./l)*(n-1.)*(n-1.)/(n-1.-n/l);
2250  For(i,dim)
2251    if(is_ok[i] == NO)
2252      {
2253        For(j,dim)
2254          {
2255            hessian[i*dim+j] = 0.;
2256            hessian[j*dim+i] = 0.;
2257          }
2258        hessian[i*dim+i] = -1./small_var;
2259
2260        if(tree->mod->log_l == YES) 
2261          {
2262            hessian[i*dim+i] = small_var * POW(EXP(tree->a_edges[i]->l->v),-2); 
2263            hessian[i*dim+i] = -1./hessian[i*dim+i];
2264          }
2265      }
2266
2267  For(i,dim)
2268    if(is_ok[i] == YES && hessian[i*dim+i] < -1./small_var)
2269      {
2270        For(j,dim)
2271          {
2272            hessian[i*dim+j] = 0.;
2273            hessian[j*dim+i] = 0.;
2274          }
2275        hessian[i*dim+i] = -1./small_var;
2276
2277        if(tree->mod->log_l == YES)
2278          {
2279            hessian[i*dim+i] = small_var * POW(EXP(tree->a_edges[i]->l->v),-2);
2280            hessian[i*dim+i] = -1./hessian[i*dim+i];
2281          }
2282      }
2283
2284
2285  For(i,dim)
2286    {
2287      For(j,dim)
2288        {
2289          if(FABS(hessian[i*dim+j]-hessian[j*dim+i]) > 1.E-3)
2290            {
2291              PhyML_Printf("\n== Hessian not symmetrical.");
2292              PhyML_Printf("\n== Err in file %s at line %d\n",__FILE__,__LINE__);
2293              Exit("\n");
2294            }
2295          hessian[i*dim+j] = (hessian[i*dim+j] + hessian[j*dim+i]) / 2.; 
2296          hessian[j*dim+i] = hessian[i*dim+j]; 
2297        }
2298    }
2299
2300  /* printf("\n"); */
2301  /* printf("HESSIAN SEO\n"); */
2302  /* For(i,dim) */
2303  /*   { */
2304  /*     PhyML_Printf("[%f] ",tree->a_edges[i]->l->v); */
2305  /*     For(j,dim) */
2306  /*    { */
2307  /*      PhyML_Printf("%12lf ",hessian[i*dim+j]); */
2308  /*    } */
2309  /*     PhyML_Printf("\n"); */
2310  /*   } */
2311
2312  Free(site_hessian);
2313  Free(ori_bl);
2314  Free(plus);
2315  Free(minus);
2316  Free(plusplus);
2317  Free(zero);
2318  Free(inc);
2319  Free(inc_plus);
2320  Free(inc_minus);
2321  Free(is_ok);
2322  Free(gradient);
2323 
2324  return hessian;
2325
2326}
2327
2328//////////////////////////////////////////////////////////////
2329//////////////////////////////////////////////////////////////
2330
2331
2332void Recurr_Hessian(t_node *a, t_node *d, int plus_minus, phydbl *inc, phydbl *res, int *is_ok, t_tree *tree)
2333{
2334  int i;
2335  phydbl ori_l;
2336
2337  For(i,3)
2338    if(a->v[i] == d)
2339      {
2340        Update_P_Lk(tree,a->b[i],a);
2341
2342        ori_l = a->b[i]->l->v;
2343        if(is_ok[a->b[i]->num])
2344          {
2345            if(plus_minus > 0) a->b[i]->l->v += inc[a->b[i]->num];
2346            else               a->b[i]->l->v -= inc[a->b[i]->num];
2347            res[a->b[i]->num] = Lk(a->b[i],tree);
2348            a->b[i]->l->v = ori_l;
2349            Update_PMat_At_Given_Edge(a->b[i],tree);
2350          }
2351        break;
2352      }
2353
2354  if(d->tax) return;
2355  else 
2356    For(i,3) 
2357      if(d->v[i] != a) 
2358        Recurr_Hessian(d,d->v[i],plus_minus,inc,res,is_ok,tree);
2359}
2360
2361//////////////////////////////////////////////////////////////
2362//////////////////////////////////////////////////////////////
2363
2364
2365/* Work out the Hessian for the likelihood function. Only LOGARITHM of branch lengths are considered as variable.
2366   This function is very much inspired from Jeff Thorne's 'hessian' function in his program 'estbranches'. */
2367phydbl *Hessian_Log(t_tree *tree)
2368{
2369  phydbl *hessian;
2370  phydbl *plus_plus, *minus_minus, *plus_zero, *minus_zero, *plus_minus, *zero_zero;
2371  phydbl *ori_bl,*inc,*buff;
2372  int *ok_edges,*is_ok;
2373  int dim;
2374  int n_ok_edges;
2375  int i,j;
2376  phydbl eps;
2377  phydbl lk;
2378
2379  dim = 2*tree->n_otu-3;
2380  eps = 1.E-4;
2381
2382  hessian     = (phydbl *)mCalloc((int)dim*dim,sizeof(phydbl));
2383  ori_bl      = (phydbl *)mCalloc((int)dim,    sizeof(phydbl));
2384  plus_plus   = (phydbl *)mCalloc((int)dim*dim,sizeof(phydbl));
2385  minus_minus = (phydbl *)mCalloc((int)dim*dim,sizeof(phydbl));
2386  plus_minus  = (phydbl *)mCalloc((int)dim*dim,sizeof(phydbl));
2387  plus_zero   = (phydbl *)mCalloc((int)dim    ,sizeof(phydbl));
2388  minus_zero  = (phydbl *)mCalloc((int)dim    ,sizeof(phydbl));
2389  zero_zero   = (phydbl *)mCalloc((int)dim    ,sizeof(phydbl));
2390  inc         = (phydbl *)mCalloc((int)dim    ,sizeof(phydbl));
2391  buff        = (phydbl *)mCalloc((int)dim*dim,sizeof(phydbl));
2392  ok_edges    = (int *)mCalloc((int)dim,       sizeof(int));
2393  is_ok       = (int *)mCalloc((int)dim,       sizeof(int));
2394 
2395  Set_Both_Sides(YES,tree);
2396  Lk(NULL,tree);
2397
2398  For(i,dim) ori_bl[i] = tree->a_edges[i]->l->v;
2399
2400  n_ok_edges = 0;
2401  For(i,dim) 
2402    {
2403      if(tree->a_edges[i]->l->v > 3.0/(phydbl)tree->data->init_len)
2404        {
2405          inc[i] = FABS(eps * tree->a_edges[i]->l->v);
2406          ok_edges[n_ok_edges] = i;
2407          n_ok_edges++;
2408          is_ok[i] = 1;
2409        }
2410      else is_ok[i] = 0;
2411    }
2412
2413  /* zero zero */ 
2414  lk = Log_Det(is_ok,tree);
2415  For(i,dim) if(is_ok[i]) zero_zero[i] = tree->c_lnL+lk;
2416
2417  /* plus zero */ 
2418  For(i,dim) 
2419    {
2420      if(is_ok[i])
2421        {
2422          tree->a_edges[i]->l->v += inc[i];
2423          lk = Lk(tree->a_edges[i],tree);
2424          plus_zero[i] = lk+Log_Det(is_ok,tree);
2425          tree->a_edges[i]->l->v = ori_bl[i];
2426        }
2427    }
2428
2429
2430  /* minus zero */
2431  For(i,dim) 
2432    {
2433      if(is_ok[i])
2434        {
2435          tree->a_edges[i]->l->v -= inc[i];
2436          lk = Lk(tree->a_edges[i],tree);
2437          minus_zero[i] = lk+Log_Det(is_ok,tree);
2438          tree->a_edges[i]->l->v = ori_bl[i];
2439        }
2440    }
2441
2442  For(i,dim) Update_PMat_At_Given_Edge(tree->a_edges[i],tree);
2443
2444  /* plus plus  */ 
2445  For(i,dim)
2446    {
2447      if(is_ok[i])
2448        {
2449          tree->a_edges[i]->l->v += inc[i];
2450          Update_PMat_At_Given_Edge(tree->a_edges[i],tree);
2451
2452          For(j,3)
2453            if((!tree->a_edges[i]->left->tax) && (tree->a_edges[i]->left->v[j] != tree->a_edges[i]->rght))
2454              Recurr_Hessian_Log(tree->a_edges[i]->left,tree->a_edges[i]->left->v[j],1,inc,plus_plus+i*dim,is_ok,tree);
2455         
2456          For(j,3)
2457            if((!tree->a_edges[i]->rght->tax) && (tree->a_edges[i]->rght->v[j] != tree->a_edges[i]->left))
2458              Recurr_Hessian_Log(tree->a_edges[i]->rght,tree->a_edges[i]->rght->v[j],1,inc,plus_plus+i*dim,is_ok,tree);
2459
2460/*        For(j,dim)  */
2461/*          if(j != i) */
2462/*            { */
2463/*              if(inc[j] > 0.0) */
2464/*                { */
2465/*                  tree->a_edges[j]->l->v += inc[j]; */
2466/*                  Lk(tree); */
2467/*                  plus_plus[i*dim+j]=tree->c_lnL; */
2468/*                  tree->a_edges[j]->l->v = ori_bl[j]; */
2469/*                } */
2470/*            } */
2471                     
2472          tree->a_edges[i]->l->v = ori_bl[i];
2473          Lk(NULL,tree);
2474        }
2475    }
2476
2477  /* plus minus */ 
2478  For(i,dim)
2479    {
2480      if(is_ok[i])
2481        {
2482          tree->a_edges[i]->l->v += inc[i];
2483          Update_PMat_At_Given_Edge(tree->a_edges[i],tree);
2484         
2485          For(j,3)
2486            if((!tree->a_edges[i]->left->tax) && (tree->a_edges[i]->left->v[j] != tree->a_edges[i]->rght))
2487              Recurr_Hessian_Log(tree->a_edges[i]->left,tree->a_edges[i]->left->v[j],-1,inc,plus_minus+i*dim,is_ok,tree);
2488         
2489          For(j,3)
2490            if((!tree->a_edges[i]->rght->tax) && (tree->a_edges[i]->rght->v[j] != tree->a_edges[i]->left))
2491              Recurr_Hessian_Log(tree->a_edges[i]->rght,tree->a_edges[i]->rght->v[j],-1,inc,plus_minus+i*dim,is_ok,tree);
2492         
2493/*        For(j,dim)  */
2494/*          if(j != i) */
2495/*            { */
2496/*              if(inc[j] > 0.0) */
2497/*                { */
2498/*                  tree->a_edges[j]->l->v -= inc[j]; */
2499/*                  Lk(tree); */
2500/*                  plus_minus[i*dim+j] = tree->c_lnL; */
2501/*                  tree->a_edges[j]->l->v = ori_bl[j]; */
2502/*                } */
2503/*            } */
2504
2505          tree->a_edges[i]->l->v = ori_bl[i];
2506          Lk(NULL,tree);
2507        }
2508    }
2509
2510
2511  /* minus minus */ 
2512  For(i,dim)
2513    {
2514      if(is_ok[i])
2515        {
2516          tree->a_edges[i]->l->v -= inc[i];
2517         
2518          Update_PMat_At_Given_Edge(tree->a_edges[i],tree);
2519         
2520          For(j,3)
2521            if((!tree->a_edges[i]->left->tax) && (tree->a_edges[i]->left->v[j] != tree->a_edges[i]->rght))
2522              Recurr_Hessian_Log(tree->a_edges[i]->left,tree->a_edges[i]->left->v[j],-1,inc,minus_minus+i*dim,is_ok,tree);
2523         
2524          For(j,3)
2525            if((!tree->a_edges[i]->rght->tax) && (tree->a_edges[i]->rght->v[j] != tree->a_edges[i]->left))
2526              Recurr_Hessian_Log(tree->a_edges[i]->rght,tree->a_edges[i]->rght->v[j],-1,inc,minus_minus+i*dim,is_ok,tree);
2527         
2528/*        For(j,dim)  */
2529/*          if(j != i) */
2530/*            { */
2531/*              if(inc[j] > 0.0) */
2532/*                { */
2533/*                  tree->a_edges[j]->l->v -= inc[j]; */
2534/*                  Lk(tree); */
2535/*                  minus_minus[i*dim+j] = tree->c_lnL; */
2536/*                  tree->a_edges[j]->l->v = ori_bl[j]; */
2537/*                } */
2538/*            } */
2539
2540          tree->a_edges[i]->l->v = ori_bl[i];
2541          Lk(NULL,tree);
2542        }
2543    }
2544
2545/*   For(i,dim) if(is_ok[i]) inc[i] = POW(tree->a_edges[i]->l->v+inc[i],2)-POW(tree->a_edges[i]->l->v,2); */
2546  For(i,dim) if(is_ok[i]) inc[i] = LOG(tree->a_edges[i]->l->v+inc[i])-LOG(tree->a_edges[i]->l->v);
2547/*   For(i,dim) inc[i] = 2.*inc[i]; */
2548/*   For(i,dim) if(is_ok[i]) inc[i] = SQRT(tree->a_edges[i]->l->v+inc[i])-SQRT(tree->a_edges[i]->l->v); */
2549 
2550  For(i,dim)
2551    {
2552      if(is_ok[i])
2553        {
2554          hessian[i*dim+i] = (plus_zero[i]-2*zero_zero[i]+minus_zero[i])/(POW(inc[i],2));
2555
2556          for(j=i+1;j<dim;j++)
2557            {
2558              if(is_ok[j])
2559                {
2560                  hessian[i*dim+j] = 
2561                    (plus_plus[i*dim+j]-plus_minus[i*dim+j]-plus_minus[j*dim+i]+minus_minus[i*dim+j])/
2562                    (4*inc[i]*inc[i]);
2563                  hessian[j*dim+i] = hessian[i*dim+j];
2564                }
2565            }
2566        }
2567    }
2568       
2569
2570  For(i,n_ok_edges)
2571    {
2572      For(j,n_ok_edges)
2573        {
2574          buff[i*n_ok_edges+j] = -hessian[ok_edges[i]*dim+ok_edges[j]];
2575        }
2576    }
2577
2578  if(!Matinv(buff,n_ok_edges,n_ok_edges,NO))
2579    {
2580      PhyML_Printf("\n. Err in file %s at line %d\n",__FILE__,__LINE__);
2581      Exit("\n");     
2582    }
2583
2584  For(i,n_ok_edges)
2585    {
2586      For(j,n_ok_edges)
2587        {
2588          hessian[ok_edges[i]*dim+ok_edges[j]] = buff[i*n_ok_edges+j];
2589        }
2590    }
2591
2592  /* Approximate variance for very short branches */
2593  For(i,dim)
2594    if(!is_ok[i])
2595      {
2596        hessian[i*dim+i] = 1./POW(tree->data->init_len,2);
2597      }
2598
2599  if(!Matinv(hessian,dim,dim,NO))
2600    {
2601      PhyML_Printf("\n. Err in file %s at line %d\n",__FILE__,__LINE__);
2602      Exit("\n");     
2603    }
2604
2605  For(i,dim*dim) hessian[i] = -1.0*hessian[i];
2606
2607/*   For(i,dim) */
2608/*     { */
2609/*       PhyML_Printf("[%f] ",tree->a_edges[i]->l->v); */
2610/*       For(j,i+1) */
2611/*      { */
2612/*        PhyML_Printf("%12lf ",hessian[i*dim+j]); */
2613/*      } */
2614/*       PhyML_Printf("\n"); */
2615/*     } */
2616
2617/*   Matinv(hessian,dim,dim); */
2618
2619/*   PhyML_Printf("\n"); */
2620
2621  For(i,dim)
2622    {
2623      PhyML_Printf("[%f] ",tree->a_edges[i]->l->v);
2624      For(j,i+1)
2625        {
2626          PhyML_Printf("%12lf ",hessian[i*dim+j]);
2627        }
2628      PhyML_Printf("\n");
2629    }
2630/*   Exit("\n"); */
2631
2632
2633  Free(ori_bl);
2634  Free(plus_plus);
2635  Free(minus_minus);
2636  Free(plus_zero);
2637  Free(minus_zero);
2638  Free(plus_minus);
2639  Free(zero_zero);
2640  Free(inc);
2641  Free(buff);
2642  Free(ok_edges);
2643  Free(is_ok);
2644
2645  return hessian;
2646
2647}
2648
2649//////////////////////////////////////////////////////////////
2650//////////////////////////////////////////////////////////////
2651
2652
2653void Recurr_Hessian_Log(t_node *a, t_node *d, int plus_minus, phydbl *inc, phydbl *res, int *is_ok, t_tree *tree)
2654{
2655  int i;
2656  phydbl ori_l;
2657
2658  For(i,3)
2659    if(a->v[i] == d)
2660      {
2661        Update_P_Lk(tree,a->b[i],a);
2662
2663        ori_l = a->b[i]->l->v;
2664        if(is_ok[a->b[i]->num])
2665          {
2666            if(plus_minus > 0) a->b[i]->l->v += inc[a->b[i]->num];
2667            else               a->b[i]->l->v -= inc[a->b[i]->num];
2668            res[a->b[i]->num]  = Lk(a->b[i],tree);
2669            res[a->b[i]->num] += Log_Det(is_ok,tree);
2670            a->b[i]->l->v = ori_l;
2671            Update_PMat_At_Given_Edge(a->b[i],tree);
2672          }
2673        break;
2674      }
2675
2676  if(d->tax) return;
2677  else 
2678    For(i,3) 
2679      if(d->v[i] != a) 
2680        Recurr_Hessian_Log(d,d->v[i],plus_minus,inc,res,is_ok,tree);
2681}
2682
2683//////////////////////////////////////////////////////////////
2684//////////////////////////////////////////////////////////////
2685
2686
2687phydbl Log_Det(int *is_ok, t_tree *tree)
2688{
2689  int i;
2690  phydbl ldet;
2691
2692  ldet = 0.0;
2693/*   For(i,2*tree->n_otu-3) if(is_ok[i]) ldet += LOG(2.*SQRT(tree->a_edges[i]->l->v)); */
2694  For(i,2*tree->n_otu-3) if(is_ok[i]) ldet += LOG(tree->a_edges[i]->l->v);
2695/*   For(i,2*tree->n_otu-3) if(is_ok[i]) ldet -= LOG(2*tree->a_edges[i]->l->v); */
2696 
2697  return ldet;
2698
2699}
2700
2701//////////////////////////////////////////////////////////////
2702//////////////////////////////////////////////////////////////
2703
2704
2705phydbl Normal_Trunc_Mean(phydbl mu, phydbl sd, phydbl min, phydbl max)
2706{
2707  phydbl mean;
2708
2709  mean = mu + sd * 
2710    (Dnorm((min-mu)/sd,0.,1.)-Dnorm((max-mu)/sd,0.,1.))/
2711    (Pnorm((max-mu)/sd,0.,1.)-Pnorm((min-mu)/sd,0.,1.));
2712  return mean;
2713}
2714
2715//////////////////////////////////////////////////////////////
2716//////////////////////////////////////////////////////////////
2717
2718
2719phydbl Constraint_Normal_Trunc_Mean(phydbl wanted_mu, phydbl sd, phydbl min, phydbl max)
2720{
2721  int j;
2722  phydbl dx,f,fmid,xmid,rtb;
2723  phydbl x1, x2;
2724
2725  x1 = min;
2726  x2 = max;
2727
2728  f    = Normal_Trunc_Mean(x1,sd,min,max) - wanted_mu;
2729  fmid = Normal_Trunc_Mean(x2,sd,min,max) - wanted_mu;
2730 
2731  if(f*fmid >= 0.0)
2732    {
2733      PhyML_Printf("\n. Root must be bracketed for bisection!");
2734      PhyML_Printf("\n. f=%f fmid=%f",f,fmid);
2735      PhyML_Printf("\n. Err in file %s at line %d\n",__FILE__,__LINE__);
2736      Exit("\n");
2737    }
2738
2739  rtb = f < 0.0 ? (dx=x2-x1,x1) : (dx=x1-x2,x2);
2740
2741  For(j,100) 
2742    {
2743      xmid=rtb+(dx *= 0.5);
2744      fmid=Normal_Trunc_Mean(xmid,sd,min,max)-wanted_mu;
2745      if(fmid <= 0.0) rtb=xmid;
2746      if(fmid > -1.E-10 && fmid < 1.E-10) return rtb;
2747    }
2748
2749  Exit("Too many bisections in RTBIS");
2750  return(-1.);
2751}
2752
2753//////////////////////////////////////////////////////////////
2754//////////////////////////////////////////////////////////////
2755
2756
2757int Matinv(phydbl *x, int n, int m, int verbose)
2758{
2759
2760/* x[n*m]  ... m>=n
2761*/
2762
2763   int i,j,k;
2764   int *irow;
2765   phydbl ee, t,t1,xmax;
2766   phydbl det;
2767
2768   ee = 1.0E-10;
2769   det = 1.0;
2770   
2771   irow = (int *)mCalloc(n,sizeof(int));
2772
2773   For (i,n)
2774     {
2775       xmax = 0.;
2776       for (j=i; j<n; j++)
2777         if (xmax < FABS(x[j*m+i]))
2778           {
2779             xmax = FABS(x[j*m+i]);
2780             irow[i]=j;
2781           }
2782
2783      det *= xmax;
2784      if (xmax < ee)
2785        {
2786          Free(irow);
2787          if(verbose)
2788            {
2789              PhyML_Printf("\n== Determinant becomes zero at %3d!\t", i+1);
2790              PhyML_Printf("\n== Failed to invert the matrix.");
2791            }
2792          return(0);
2793        }
2794      if (irow[i] != i)
2795        {
2796          For (j,m)
2797            {
2798              t = x[i*m+j];
2799              x[i*m+j] = x[irow[i]*m+j];
2800              x[irow[i]*m+j] = t;
2801            }
2802        }
2803      t = 1./x[i*m+i];
2804      For (j,n)
2805        {
2806          if (j == i) continue;
2807          t1 = t*x[j*m+i];
2808          For(k,m)  x[j*m+k] -= t1*x[i*m+k];
2809          x[j*m+i] = -t1;
2810        }
2811      For(j,m)   x[i*m+j] *= t;
2812      x[i*m+i] = t;
2813   }                            /* i  */
2814   for (i=n-1; i>=0; i--)
2815     {
2816       if (irow[i] == i) continue;
2817       For(j,n)
2818         {
2819           t = x[j*m+i];
2820           x[j*m+i] = x[j*m + irow[i]];
2821           x[j*m + irow[i]] = t;
2822         }
2823     }
2824
2825   Free(irow);
2826   return (1);
2827
2828/*   int i, j, k, lower, upper; */
2829/*   phydbl temp; */
2830/*   phydbl *a; */
2831/*   int nsize; */
2832
2833/*   nsize = n; */
2834/*   a = x; */
2835 
2836/*   /\*Gauss-Jordan reduction -- invert matrix a in place, */
2837/*          overwriting previous contents of a.  On exit, matrix a */
2838/*          contains the inverse.*\/ */
2839/*   lower = 0; */
2840/*   upper = nsize-1; */
2841/*   for(i = lower; i <= upper; i++)  */
2842/*     { */
2843/*       temp = 1.0 / a[i*n+i]; */
2844/*       a[i*n+i] = 1.0; */
2845/*       for (j = lower; j <= upper; j++)  */
2846/*      { */
2847/*        a[i*n+j] *= temp; */
2848/*      } */
2849/*       for (j = lower; j <= upper; j++)  */
2850/*      { */
2851/*        if (j != i)  */
2852/*          { */
2853/*            temp = a[j*n+i]; */
2854/*            a[j*n+i] = 0.0; */
2855/*            for (k = lower; k <= upper; k++)  */
2856/*              { */
2857/*                a[j*n+k] -= temp * a[i*n+k]; */
2858/*              }              */
2859/*          } */
2860/*      } */
2861/*     } */
2862
2863  return(1);
2864
2865}
2866
2867//////////////////////////////////////////////////////////////
2868//////////////////////////////////////////////////////////////
2869
2870
2871int Iter_Matinv(phydbl *x, int n, int m, int verbose)
2872{
2873  phydbl *buff;
2874  int i,iter;
2875  phydbl scaler;
2876  int pb;
2877
2878  buff = (phydbl *)mCalloc(n*m,sizeof(phydbl));
2879
2880  pb = NO;
2881  iter   = 0;
2882  scaler = 1.;
2883  For(i,n*m) buff[i] = x[i];
2884  while(!Matinv(buff,n,m,verbose))
2885    {
2886      pb = YES;
2887      For(i,n*m) buff[i] = x[i];
2888      scaler *= 10.;
2889      For(i,n*m) buff[i] *= scaler;
2890      iter++;
2891
2892      if(iter > 100)
2893        {
2894          PhyML_Printf("\n== Err in file %s at line %d.",__FILE__,__LINE__);
2895          return 0;
2896        }     
2897    }
2898  if(pb)  PhyML_Printf("\n== Managed to fix the problem by rescaling the matrix.");
2899  For(i,n*m) x[i] = buff[i]*scaler;
2900  Free(buff);
2901  return 1;
2902}
2903
2904
2905//////////////////////////////////////////////////////////////
2906//////////////////////////////////////////////////////////////
2907
2908
2909phydbl *Matrix_Mult(phydbl *A, phydbl *B, int nra, int nca, int nrb, int ncb)
2910{
2911  int i,j,k;
2912  phydbl *C;
2913
2914  C = (phydbl *)mCalloc(nra*ncb,sizeof(phydbl));
2915
2916  if(nca != nrb)
2917    {
2918      PhyML_Printf("\n. Matrices dimensions don't match.");
2919      PhyML_Printf("\n. Err in file %s at line %d\n",__FILE__,__LINE__);
2920      Exit("\n");     
2921    }
2922 
2923  For(i,nra)
2924    For(j,ncb)
2925       For(k,nca)
2926         C[i*ncb+j] += A[i*nca+k] * B[k*ncb+j];
2927 
2928  return C;
2929}
2930
2931//////////////////////////////////////////////////////////////
2932//////////////////////////////////////////////////////////////
2933
2934
2935phydbl *Matrix_Transpose(phydbl *A, int dim)
2936{
2937  phydbl *tA,buff;
2938  int i,j;
2939
2940  tA = (phydbl *)mCalloc(dim*dim,sizeof(phydbl));
2941
2942  For(i,dim*dim) tA[i]=A[i];
2943
2944  For(i,dim) for(j=i+1;j<dim;j++) 
2945    {
2946      buff        = tA[i*dim+j];
2947      tA[i*dim+j] = tA[j*dim+i];
2948      tA[j*dim+i]  = buff;
2949    }
2950
2951  return tA;
2952}
2953
2954//////////////////////////////////////////////////////////////
2955//////////////////////////////////////////////////////////////
2956
2957
2958phydbl Matrix_Det(phydbl *A, int size, int _log)
2959{
2960  phydbl *triA;
2961  int i;
2962  phydbl det;
2963
2964  triA = Cholesky_Decomp(A,size);
2965  det = 0.0;
2966  For(i,size) det += LOG(triA[i*size+i]);
2967  Free(triA);
2968 
2969  if(_log == NO)
2970    {
2971      det = EXP(det);
2972      return det*det;
2973    }
2974  else
2975    {
2976      return 2.*det;
2977    }
2978}
2979
2980//////////////////////////////////////////////////////////////
2981//////////////////////////////////////////////////////////////
2982
2983
2984/* http://en.wikipedia.org/wiki/Multivariate_normal_distribution (Conditional distributions) */
2985void Normal_Conditional(phydbl *mu, phydbl *cov, phydbl *a, int n, short int *is_1, int n1, phydbl *cond_mu, phydbl *cond_cov)
2986{
2987  phydbl *mu1,*mu2;
2988  phydbl *sig11,*sig12,*sig21,*sig22,*sig12_invsig22,*buff;
2989  phydbl *ctrd_a;
2990  phydbl *cond_cov_norder,*cond_mu_norder;
2991  int    n2;
2992  int i,j,nr,nc;
2993  phydbl *buff_mat;
2994
2995  n2 = n-n1;
2996
2997  mu1             = (phydbl *)mCalloc(n1,   sizeof(phydbl));
2998  mu2             = (phydbl *)mCalloc(n2,   sizeof(phydbl));
2999  sig11           = (phydbl *)mCalloc(n1*n1,sizeof(phydbl));
3000  sig12           = (phydbl *)mCalloc(n1*n2,sizeof(phydbl));
3001  sig21           = (phydbl *)mCalloc(n2*n1,sizeof(phydbl));
3002  sig22           = (phydbl *)mCalloc(n2*n2,sizeof(phydbl));
3003  ctrd_a          = (phydbl *)mCalloc(n2,   sizeof(phydbl)); 
3004  cond_cov_norder = (phydbl *)mCalloc(n1*n1,sizeof(phydbl));
3005  cond_mu_norder  = (phydbl *)mCalloc(n1*n1,sizeof(phydbl));
3006  buff_mat        = (phydbl *)mCalloc(n2*n2,sizeof(phydbl));
3007
3008  nr=0;
3009  For(i,n) { if(!is_1[i]) { ctrd_a[nr] = a[i]-mu[i]; nr++; } }
3010
3011  nr=0;
3012  For(i,n) { if( is_1[i]) { mu1[nr] = mu[i]; nr++; } }
3013
3014  nr=0;
3015  For(i,n) { if(!is_1[i]) { mu2[nr] = mu[i]; nr++; } }
3016
3017  nr=0; nc=0;
3018  For(i,n)
3019    {
3020      if(is_1[i])
3021        {
3022          nc = nr;
3023          for(j=i;j<n;j++)
3024/*        nc = 0; */
3025/*        For(j,n) */
3026            {
3027              if(is_1[j])
3028                {
3029                  sig11[nr*n1+nc] = cov[i*n+j];
3030                  sig11[nc*n1+nr] = cov[i*n+j];
3031                  nc++;
3032                }
3033            }
3034          nr++;
3035        }
3036    }
3037
3038
3039  nr=0; nc=0;
3040  For(i,n)
3041    {
3042      if(is_1[i])
3043        {
3044/*        nc = nr; */
3045/*        for(j=i;j<n;j++) */
3046          nc = 0;
3047          For(j,n)
3048            {
3049              if(!is_1[j])
3050                {
3051                  sig12[nr*n2+nc] = cov[i*n+j];
3052/*                sig12[nc*n2+nr] = cov[i*n+j]; */
3053                  nc++;
3054                }
3055            }
3056          nr++;
3057        }
3058    }
3059
3060  nr=0; nc=0;
3061  For(i,n)
3062    {
3063      if(!is_1[i])
3064        {
3065/*        nc = nr; */
3066/*        for(j=i;j<n;j++) */
3067          nc = 0;
3068          For(j,n)
3069            {
3070              if(is_1[j])
3071                {
3072                  sig21[nr*n1+nc] = cov[i*n+j];
3073/*                sig21[nc*n1+nr] = cov[i*n+j]; */
3074                  nc++;
3075                }
3076            }
3077          nr++;
3078        }
3079    }
3080
3081
3082  nr=0; nc=0;
3083  For(i,n)
3084    {
3085      if(!is_1[i])
3086        {
3087          nc = nr;
3088          for(j=i;j<n;j++)
3089/*        nc = 0; */
3090/*        For(j,n) */
3091            {
3092              if(!is_1[j])
3093                {
3094                  sig22[nr*n2+nc] = cov[i*n+j];
3095                  sig22[nc*n2+nr] = cov[i*n+j];
3096                  nc++;
3097                }
3098            }
3099          nr++;
3100        }
3101    }
3102
3103  Iter_Matinv(sig22,n2,n2,NO);
3104
3105  sig12_invsig22 = Matrix_Mult(sig12,sig22,n1,n2,n2,n2);
3106
3107  buff = Matrix_Mult(sig12_invsig22,ctrd_a,n1,n2,n2,1);
3108  For(i,n1) cond_mu_norder[i] = mu1[i]+buff[i];
3109  Free(buff);
3110
3111  buff = Matrix_Mult(sig12_invsig22,sig21,n1,n2,n2,n1);
3112  For(i,n1) For(j,n1) cond_cov_norder[i*n1+j] = sig11[i*n1+j] - buff[i*n1+j];
3113  Free(buff);
3114
3115  nr = 0;
3116  For(i,n) if(is_1[i]) { cond_mu[i] = cond_mu_norder[nr]; nr++; }
3117
3118  nr = nc = 0;
3119  For(i,n) 
3120    {
3121      if(is_1[i]) 
3122        { 
3123          nc = 0;
3124          For(j,n)
3125            {
3126              if(is_1[j]) 
3127                {                 
3128                  cond_cov[i*n+j] = cond_cov_norder[nr*n1+nc]; 
3129                  nc++;
3130                }
3131            }
3132          nr++;
3133        }
3134    }
3135
3136/*   For(i,n1) */
3137/*     { */
3138/*       for(j=i;j<n1;j++) */
3139/*      if(FABS(cond_cov_norder[i*n1+j] - cond_cov_norder[j*n1+i]) > 1.E-3) */
3140/*        { */
3141/*          PhyML_Printf("\n. Err in file %s at line %d\n",__FILE__,__LINE__); */
3142/*          Warn_And_Exit(""); */
3143/*        } */
3144/*     } */
3145
3146
3147  For(i,n)
3148    {
3149      for(j=i+1;j<n;j++)
3150        if(FABS(cond_cov[i*n+j] - cond_cov[j*n+i]) > 1.E-3)
3151          {
3152            PhyML_Printf("\n. Err in file %s at line %d\n",__FILE__,__LINE__);
3153            Warn_And_Exit("");
3154          }
3155    }
3156
3157  Free(mu1);
3158  Free(mu2);
3159  Free(sig11);
3160  Free(sig12);
3161  Free(sig21);
3162  Free(sig22);
3163  Free(ctrd_a);
3164  Free(cond_cov_norder);
3165  Free(cond_mu_norder);
3166  Free(sig12_invsig22);
3167  Free(buff_mat);
3168}
3169
3170
3171//////////////////////////////////////////////////////////////
3172//////////////////////////////////////////////////////////////
3173
3174
3175/* http://en.wikipedia.org/wiki/Multivariate_normal_distribution (Conditional distributions) */
3176void Normal_Conditional_Unsorted(phydbl *mu, phydbl *cov, phydbl *a, int n, short int *is_1, int n1, phydbl *cond_mu, phydbl *cond_cov)
3177{
3178  phydbl *mu1,*mu2;
3179  phydbl *sig11,*sig12,*sig21,*sig22,*sig12_invsig22,*buff;
3180  phydbl *ctrd_a;
3181  int    n2;
3182  int i,j,nr,nc;
3183
3184  n2 = n-n1;
3185
3186  mu1             = (phydbl *)mCalloc(n1,   sizeof(phydbl));
3187  mu2             = (phydbl *)mCalloc(n2,   sizeof(phydbl));
3188  sig11           = (phydbl *)mCalloc(n1*n1,sizeof(phydbl));
3189  sig12           = (phydbl *)mCalloc(n1*n2,sizeof(phydbl));
3190  sig21           = (phydbl *)mCalloc(n2*n1,sizeof(phydbl));
3191  sig22           = (phydbl *)mCalloc(n2*n2,sizeof(phydbl));
3192  ctrd_a          = (phydbl *)mCalloc(n2,   sizeof(phydbl)); 
3193
3194  nr=0;
3195  For(i,n) { if(!is_1[i]) { ctrd_a[nr] = a[i]-mu[i]; nr++; } }
3196
3197  nr=0;
3198  For(i,n) { if( is_1[i]) { mu1[nr] = mu[i]; nr++; } }
3199
3200  nr=0;
3201  For(i,n) { if(!is_1[i]) { mu2[nr] = mu[i]; nr++; } }
3202
3203  nr=0; nc=0;
3204  For(i,n)
3205    {
3206      if(is_1[i])
3207        {
3208          nc = nr;
3209          for(j=i;j<n;j++)
3210/*        nc = 0; */
3211/*        For(j,n) */
3212            {
3213              if(is_1[j])
3214                {
3215                  sig11[nr*n1+nc] = cov[i*n+j];
3216                  sig11[nc*n1+nr] = cov[i*n+j];
3217                  nc++;
3218                }
3219            }
3220          nr++;
3221        }
3222    }
3223
3224
3225  nr=0; nc=0;
3226  For(i,n)
3227    {
3228      if(is_1[i])
3229        {
3230/*        nc = nr; */
3231/*        for(j=i;j<n;j++) */
3232          nc = 0;
3233          For(j,n)
3234            {
3235              if(!is_1[j])
3236                {
3237                  sig12[nr*n2+nc] = cov[i*n+j];
3238/*                sig12[nc*n2+nr] = cov[i*n+j]; */
3239                  nc++;
3240                }
3241            }
3242          nr++;
3243        }
3244    }
3245
3246  nr=0; nc=0;
3247  For(i,n)
3248    {
3249      if(!is_1[i])
3250        {
3251/*        nc = nr; */
3252/*        for(j=i;j<n;j++) */
3253          nc = 0;
3254          For(j,n)
3255            {
3256              if(is_1[j])
3257                {
3258                  sig21[nr*n1+nc] = cov[i*n+j];
3259/*                sig21[nc*n1+nr] = cov[i*n+j]; */
3260                  nc++;
3261                }
3262            }
3263          nr++;
3264        }
3265    }
3266
3267
3268  nr=0; nc=0;
3269  For(i,n)
3270    {
3271      if(!is_1[i])
3272        {
3273          nc = nr;
3274          for(j=i;j<n;j++)
3275/*        nc = 0; */
3276/*        For(j,n) */
3277            {
3278              if(!is_1[j])
3279                {
3280                  sig22[nr*n2+nc] = cov[i*n+j];
3281                  sig22[nc*n2+nr] = cov[i*n+j];
3282                  nc++;
3283                }
3284            }
3285          nr++;
3286        }
3287    }
3288
3289  if(!Matinv(sig22,n2,n2,NO))
3290    {
3291      PhyML_Printf("\n. Err in file %s at line %d\n",__FILE__,__LINE__);
3292      Exit("\n");     
3293    }
3294  sig12_invsig22 = Matrix_Mult(sig12,sig22,n1,n2,n2,n2);
3295
3296  buff = Matrix_Mult(sig12_invsig22,ctrd_a,n1,n2,n2,1);
3297  For(i,n1) cond_mu[i] = mu1[i]+buff[i];
3298  Free(buff);
3299
3300  buff = Matrix_Mult(sig12_invsig22,sig21,n1,n2,n2,n1);
3301  For(i,n1) For(j,n1) cond_cov[i*n1+j] = sig11[i*n1+j] - buff[i*n1+j];
3302
3303
3304  Free(mu1);
3305  Free(mu2);
3306  Free(sig11);
3307  Free(sig12);
3308  Free(sig21);
3309  Free(sig22);
3310  Free(ctrd_a);
3311  Free(sig12_invsig22);
3312}
3313
3314
3315//////////////////////////////////////////////////////////////
3316//////////////////////////////////////////////////////////////
3317
3318
3319/* http://en.wikipedia.org/wiki/Multivariate_normal_distribution (Conditional distributions) */
3320void Get_Reg_Coeff(phydbl *mu, phydbl *cov, phydbl *a, int n, short int *is_1, int n1, phydbl *reg_coeff)
3321{
3322  phydbl *sig12,*sig22,*sig12_invsig22;
3323  int    n2;
3324  int    i,j,nr,nc;
3325
3326  n2 = n-n1;
3327
3328  sig12 = (phydbl *)mCalloc(n1*n2,sizeof(phydbl));
3329  sig22 = (phydbl *)mCalloc(n2*n2,sizeof(phydbl));
3330
3331  nr=0; nc=0;
3332  For(i,n)
3333    {
3334      if(is_1[i])
3335        {
3336          nc = 0;
3337          For(j,n)
3338            {
3339              if(!is_1[j])
3340                {
3341                  sig12[nr*n2+nc] = cov[i*n+j];
3342                  nc++;
3343                }
3344            }
3345          nr++;
3346        }
3347    }
3348
3349
3350  nr=0; nc=0;
3351  For(i,n)
3352    {
3353      if(!is_1[i])
3354        {
3355          nc = nr;
3356          for(j=i;j<n;j++)
3357            {
3358              if(!is_1[j])
3359                {
3360                  sig22[nr*n2+nc] = cov[i*n+j];
3361                  sig22[nc*n2+nr] = cov[i*n+j];
3362                  nc++;
3363                }
3364            }
3365          nr++;
3366        }
3367    }
3368
3369
3370  if(!Matinv(sig22,n2,n2,NO))
3371    {
3372      PhyML_Printf("\n. Err in file %s at line %d\n",__FILE__,__LINE__);
3373      Exit("\n");     
3374    }
3375  sig12_invsig22 = Matrix_Mult(sig12,sig22,n1,n2,n2,n2);
3376
3377
3378  For(i,n) reg_coeff[i] = 0.0;
3379
3380/*   nr = 0; */
3381/*   For(i,n) if(!is_1[i]) { reg_coeff[i] = sig12_invsig22[nr]; nr++; } */
3382
3383  nc = 0;
3384  nr = 0;
3385  For(i,n1) 
3386    {
3387      nc = 0;
3388      For(j,n)
3389        if(!is_1[j]) 
3390          { 
3391            reg_coeff[i*n+j] = sig12_invsig22[nr*n2+nc]; 
3392            nc++; 
3393          }
3394      nr++;
3395    }
3396
3397
3398  if(nc != n2 || nr != n1)
3399    {
3400      PhyML_Printf("\n. Err in file %s at line %d\n",__FILE__,__LINE__);
3401      Exit("\n");
3402    }
3403
3404
3405  Free(sig12);
3406  Free(sig22);
3407  Free(sig12_invsig22);
3408}
3409
3410
3411//////////////////////////////////////////////////////////////
3412//////////////////////////////////////////////////////////////
3413
3414
3415phydbl Norm_Trunc_Sd(phydbl mu, phydbl sd, phydbl a, phydbl b)
3416{
3417  phydbl pdfa, pdfb;
3418  phydbl cdfa, cdfb;
3419  phydbl ctra, ctrb;
3420  phydbl cond_var;
3421  phydbl cdfbmcdfa;
3422
3423  ctra = (a - mu)/sd;
3424  ctrb = (b - mu)/sd;
3425
3426  pdfa = Dnorm(ctra,0.0,1.0);
3427  pdfb = Dnorm(ctrb,0.0,1.0);
3428
3429  cdfa = Pnorm(ctra,0.0,1.0);
3430  cdfb = Pnorm(ctrb,0.0,1.0);
3431
3432  cdfbmcdfa = cdfb - cdfa;
3433
3434  if(cdfbmcdfa < SMALL) 
3435    {
3436      cdfbmcdfa = SMALL;
3437      PhyML_Printf("\n. mu=%G sd=%G a=%G b=%G",mu,sd,a,b);
3438      PhyML_Printf("\n. Numerical precision issue detected.");
3439      PhyML_Printf("\n. Err in file %s at line %d\n",__FILE__,__LINE__);
3440    }
3441           
3442  cond_var = sd*sd*(1. + (ctra*pdfa - ctrb*pdfb)/cdfbmcdfa - POW((pdfa - pdfb)/cdfbmcdfa,2));
3443
3444  return SQRT(cond_var);
3445}
3446
3447//////////////////////////////////////////////////////////////
3448//////////////////////////////////////////////////////////////
3449
3450
3451phydbl Norm_Trunc_Mean(phydbl mu, phydbl sd, phydbl a, phydbl b)
3452{
3453  phydbl pdfa, pdfb;
3454  phydbl cdfa, cdfb;
3455  phydbl ctra, ctrb;
3456  phydbl cond_mu;
3457  phydbl cdfbmcdfa;
3458
3459  ctra = (a - mu)/sd;
3460  ctrb = (b - mu)/sd;
3461
3462  pdfa = Dnorm(ctra,0.0,1.0);
3463  pdfb = Dnorm(ctrb,0.0,1.0);
3464
3465  cdfa = Pnorm(ctra,0.0,1.0);
3466  cdfb = Pnorm(ctrb,0.0,1.0);
3467 
3468  cdfbmcdfa = cdfb - cdfa;
3469
3470  if(cdfbmcdfa < SMALL)
3471    {
3472      cdfbmcdfa = SMALL;
3473      PhyML_Printf("\n. mu=%G sd=%G a=%G b=%G",mu,sd,a,b);
3474      PhyML_Printf("\n. Numerical precision issue detected.");
3475      PhyML_Printf("\n. Err in file %s at line %d\n",__FILE__,__LINE__);
3476    }
3477 
3478  cond_mu = mu + sd*(pdfa - pdfb)/cdfbmcdfa;
3479
3480  return cond_mu;
3481}
3482
3483//////////////////////////////////////////////////////////////
3484//////////////////////////////////////////////////////////////
3485
3486
3487int Norm_Trunc_Mean_Sd(phydbl mu, phydbl sd, phydbl a, phydbl b, phydbl *trunc_mu, phydbl *trunc_sd)
3488{
3489
3490  phydbl pdfa, pdfb;
3491  phydbl cdfa, cdfb;
3492  phydbl ctra, ctrb;
3493  phydbl cdfbmcdfa;
3494
3495  ctra = (a - mu)/sd;
3496  ctrb = (b - mu)/sd;
3497
3498  pdfa = Dnorm(ctra,0.0,1.0);
3499  pdfb = Dnorm(ctrb,0.0,1.0);
3500
3501  cdfa = Pnorm(ctra,0.0,1.0);
3502  cdfb = Pnorm(ctrb,0.0,1.0);
3503 
3504  cdfbmcdfa = cdfb - cdfa;
3505
3506  if(cdfbmcdfa < SMALL)
3507    {
3508      cdfbmcdfa = SMALL;
3509      PhyML_Printf("\n. mu=%G sd=%G a=%G b=%G",mu,sd,a,b);
3510      PhyML_Printf("\n. cdfa=%G cdfb=%G",cdfa,cdfb);
3511      PhyML_Printf("\n. Numerical precision issue detected.");
3512      PhyML_Printf("\n. Err in file %s at line %d\n",__FILE__,__LINE__);
3513      return 0;
3514    }
3515 
3516  *trunc_mu = mu + sd*(pdfa - pdfb)/cdfbmcdfa;
3517  *trunc_sd = sd*sd*(1. + (ctra*pdfa - ctrb*pdfb)/cdfbmcdfa - POW((pdfa - pdfb)/cdfbmcdfa,2));
3518  *trunc_sd = SQRT(*trunc_sd);
3519  return 1;
3520}
3521
3522//////////////////////////////////////////////////////////////
3523//////////////////////////////////////////////////////////////
3524
3525
3526void VarCov_Approx_Likelihood(t_tree *tree)
3527{
3528  int i,j;
3529  phydbl *cov;
3530  phydbl *mean;
3531  int dim;
3532  int iter;
3533  phydbl cur_mean,new_mean,diff_mean,max_diff_mean;
3534  phydbl cur_cov,new_cov,diff_cov,max_diff_cov;
3535  FILE *fp;
3536
3537 
3538  cov = tree->rates->cov_l;
3539  mean = tree->rates->mean_l;
3540  dim = 2*tree->n_otu-3;
3541
3542  fp = fopen("covariance","w");
3543  fprintf(fp,"\n");
3544  fprintf(fp,"Run\t");
3545  fprintf(fp,"lnL\t");
3546  For(i,dim) fprintf(fp,"Edge%d[%f]\t",i,tree->rates->u_ml_l[i]);
3547
3548 
3549  For(i,dim)     mean[i] = .0;
3550  For(i,dim*dim) cov[i]  = .0;
3551
3552  MCMC_Randomize_Branch_Lengths(tree);
3553 
3554  /* For(i,2*tree->n_otu-3) tree->a_edges[i]->l->v *= Rgamma(5.,1./5.); */
3555 
3556  Set_Both_Sides(YES,tree);
3557  Lk(NULL,tree);
3558
3559  iter = 0;
3560  do
3561    {
3562      /* tree->both_sides = YES; */
3563      /* Lk(tree); */
3564      MCMC_Br_Lens(tree);
3565      /* MCMC_Scale_Br_Lens(tree); */
3566
3567
3568      max_diff_mean = 0.0;
3569      For(i,dim)
3570        {
3571          cur_mean = mean[i];
3572
3573          mean[i] *= (phydbl)iter;
3574          mean[i] += tree->a_edges[i]->l->v;
3575          mean[i] /= (phydbl)(iter+1);
3576
3577          new_mean = mean[i];     
3578          diff_mean = MAX(cur_mean,new_mean)/MIN(cur_mean,new_mean);
3579          if(diff_mean > max_diff_mean) max_diff_mean = diff_mean;
3580          /* printf("\n. %d diff_mean = %f %f %f %f",i,diff_mean,cur_mean,new_mean,tree->a_edges[i]->l->v); */
3581        }
3582
3583      max_diff_cov = 0.0;
3584      For(i,dim)
3585        {
3586          For(j,dim)
3587            {
3588              cur_cov = cov[i*dim+j];
3589
3590              cov[i*dim+j] *= (phydbl)iter;
3591              cov[i*dim+j] += tree->a_edges[i]->l->v * tree->a_edges[j]->l->v;
3592              cov[i*dim+j] /= (phydbl)(iter+1);
3593
3594              new_cov = cov[i*dim+j];
3595              diff_cov = MAX(cur_cov,new_cov)/MIN(cur_cov,new_cov);
3596              if(diff_cov > max_diff_cov) max_diff_cov = diff_cov;
3597            }
3598        }
3599      iter++;
3600     
3601      /* if(!(iter%10)) */
3602      /* printf("\n. iter=%d max_diff_mean=%f max_diff_cov=%f",iter,max_diff_mean,max_diff_cov); */
3603
3604      /* if(iter && max_diff_mean < 1.01 && max_diff_cov < 1.01) break; */
3605     
3606      if(!(iter%20))
3607        {
3608          fprintf(fp,"\n");
3609          fprintf(fp,"%d\t",iter);
3610          fprintf(fp,"%f\t",tree->c_lnL);
3611          For(i,dim) fprintf(fp,"%f\t",tree->a_edges[i]->l->v);
3612          fflush(NULL);
3613        }
3614
3615    }while(iter < 5000);
3616
3617
3618  For(i,dim)
3619    {
3620      For(j,dim)
3621        {
3622          cov[i*dim+j] = cov[i*dim+j] - mean[i]*mean[j];
3623          if(i == j && cov[i*dim+j] < MIN_VAR_BL) cov[i*dim+j] = MIN_VAR_BL;
3624        }
3625    }
3626
3627  fclose(fp);
3628}
3629
3630//////////////////////////////////////////////////////////////
3631//////////////////////////////////////////////////////////////
3632
3633
3634/* Order statistic. x_is are uniformily distributed in [min,max] */
3635phydbl Dorder_Unif(phydbl x, int r, int n, phydbl min, phydbl max)
3636{
3637  phydbl cons;
3638  phydbl Fx;
3639  phydbl dens;
3640
3641  if(x < min || x > max || min > max)
3642    {
3643      PhyML_Printf("\n. Err in file %s at line %d\n",__FILE__,__LINE__);
3644      Exit("\n");
3645    }
3646
3647  cons = LnGamma(n+1) - LnGamma(r) - LnGamma(n-r+1);
3648  cons = EXP(cons);
3649  cons = ROUND(cons);
3650
3651  Fx = (x-min)/(max-min);
3652 
3653  dens = cons * pow(Fx,r-1) * pow(1.-Fx,n-r) * (1./(max-min));
3654
3655  /* printf("\n. x=%f r=%d n=%d min=%f max=%f dens=%f",x,r,n,min,max,dens); */
3656  /* Exit("\n"); */
3657
3658  return(dens);
3659}
3660
3661//////////////////////////////////////////////////////////////
3662//////////////////////////////////////////////////////////////
3663
3664
3665phydbl Covariance(phydbl *x, phydbl *y, int n)
3666{
3667  int i;
3668  phydbl mean_x,mean_y,mean_xy;
3669
3670  mean_x = .0;
3671  For(i,n) mean_x += x[i];
3672  mean_x /= (phydbl)n;
3673
3674  mean_y = .0;
3675  For(i,n) mean_y += y[i];
3676  mean_y /= (phydbl)n;
3677
3678  mean_xy = .0;
3679  For(i,n) mean_xy += x[i]*y[i];
3680  mean_xy /= (phydbl)n;
3681 
3682  return (mean_xy - mean_x*mean_y);
3683}
3684
3685//////////////////////////////////////////////////////////////
3686//////////////////////////////////////////////////////////////
3687
3688/* Sample X from a multivariate normal with mean mu and covariance cov, within
3689   the interval [min,max], under the linear constraint X.lambda=k
3690*/
3691   
3692phydbl *Rnorm_Multid_Trunc_Constraint(phydbl *mu, phydbl *cov, phydbl *min, phydbl *max, phydbl *lambda, phydbl k, phydbl *res, int len)
3693{
3694
3695  phydbl *loc_res;
3696  int i,j,cond,iter;
3697  phydbl *x;
3698  phydbl cond_mean,cond_var;
3699  phydbl cov_zic,cov_zii,cov_zcc;
3700  phydbl mean_zi, mean_zc;
3701  phydbl alpha;
3702  phydbl sum;
3703  int err;
3704  phydbl zi;
3705
3706
3707  cond    = 0;
3708
3709  loc_res = NULL;
3710  if(!res) 
3711    {
3712      loc_res = (phydbl *)mCalloc(len,sizeof(phydbl));
3713      x = loc_res;
3714    }
3715  else x = res;
3716 
3717
3718
3719  /* zi = x[i] . lambda[i] */
3720
3721  iter = 0;
3722  do
3723    {
3724      sum = 0.0;
3725      For(i,len)
3726        {     
3727          if(i != cond)
3728            {
3729              cov_zic = lambda[i]    * lambda[cond] * cov[i*len+cond];
3730              cov_zii = lambda[i]    * lambda[i]    * cov[i*len+i];
3731              cov_zcc = lambda[cond] * lambda[cond] * cov[cond*len+cond];
3732             
3733              mean_zi = lambda[i];
3734              mean_zc = lambda[cond];
3735             
3736              /* alpha = k - \sum_{j != cond, j !=i} z_j */
3737              alpha = k;
3738              For(j,len) if(j != cond && j != i) alpha -= lambda[j] * x[j];
3739             
3740              cond_mean = mean_zi + (cov_zii + cov_zic) / (cov_zii + 2.*cov_zic + cov_zcc) * (alpha - mean_zi - mean_zc);
3741              cond_var  = cov_zii - POW(cov_zii + cov_zic,2)/(cov_zii + 2.*cov_zic + cov_zcc);
3742             
3743              if(lambda[i]*min[i] > alpha - lambda[cond]*min[i])
3744                {
3745                  PhyML_Printf("\n. Cannot satisfy the constraint.\n");
3746                  PhyML_Printf("\n. Err in file %s at line %d\n",__FILE__,__LINE__);
3747                  Exit("\n");
3748                }
3749
3750              err = NO;
3751              zi = Rnorm_Trunc(cond_mean,SQRT(cond_var),
3752                               MAX(lambda[i]*min[i],alpha-lambda[cond]*max[cond]),
3753                               MIN(lambda[i]*max[i],alpha-lambda[cond]*min[cond]),&err);
3754              if(err == YES)
3755                {
3756                  PhyML_Printf("\n. Err in file %s at line %d\n",__FILE__,__LINE__);
3757                  Exit("\n");
3758                }
3759              sum += zi;
3760              x[i] = zi / lambda[i];
3761            }
3762        }
3763     
3764      x[cond] = (k - sum)/lambda[cond];
3765   
3766    }while(iter++ < 10);
3767
3768  return(loc_res);
3769
3770}
3771
3772//////////////////////////////////////////////////////////////
3773//////////////////////////////////////////////////////////////
3774
3775
3776void PMat_MGF_Gamma(phydbl *Pij, phydbl shape, phydbl scale, phydbl scaling_fact, t_mod *mod)
3777{
3778  int dim;
3779  int i,j,k;
3780  phydbl *uexpt,*imbd;
3781
3782  dim = mod->eigen->size;
3783  uexpt = mod->eigen->r_e_vect_im;
3784  imbd  = mod->eigen->e_val_im;
3785
3786  /* Get the eigenvalues of Q (not the exponentials) */
3787  For(i,dim) imbd[i]  = LOG(mod->eigen->e_val[i]);
3788
3789  /* Multiply them by the scaling factor */
3790  For(i,dim) imbd[i]  *= scaling_fact;
3791
3792  For(i,dim) imbd[i] *= -scale;
3793  For(i,dim) imbd[i] += 1.0;
3794  For(i,dim) imbd[i]  = POW(imbd[i],-shape);
3795
3796  For(i,dim) For(k,dim) uexpt[i*dim+k] = mod->eigen->r_e_vect[i*dim+k] * imbd[k];
3797
3798  For(i,dim) For(k,dim) Pij[dim*i+k] = .0;
3799
3800  For(i,dim)
3801    {
3802      For(j,dim)
3803        {
3804          For(k,dim)
3805            {
3806              Pij[dim*i+j] += (uexpt[i*dim+k] * mod->eigen->l_e_vect[k*dim+j]);
3807            }
3808          if(Pij[dim*i+j] < SMALL_PIJ) Pij[dim*i+j] = SMALL_PIJ;
3809        }
3810    }
3811
3812  /* printf("\n. shape = %f scale = %f",shape,scale); */
3813  /* printf("\n. Qmat"); */
3814  /* For(i,dim) */
3815  /*   { */
3816  /*     printf("\n"); */
3817  /*     For(j,dim) */
3818  /*    { */
3819  /*      printf("%12f ",mod->qmat[i*dim+j]); */
3820  /*    } */
3821  /*   } */
3822
3823  /* printf("\n. Pmat"); */
3824  /* For(i,dim) */
3825  /*   { */
3826  /*     printf("\n"); */
3827  /*     For(j,dim) */
3828  /*    { */
3829  /*      printf("%12f ",Pij[i*dim+j]); */
3830  /*    } */
3831  /*   } */
3832  /* Exit("\n"); */
3833}
3834
3835//////////////////////////////////////////////////////////////
3836//////////////////////////////////////////////////////////////
3837
3838
3839void Integrated_Brownian_Bridge_Moments(phydbl x_beg, phydbl x_end, 
3840                                        phydbl y_beg, phydbl y_end, 
3841                                        phydbl brownian_var, phydbl *mean, phydbl *var)
3842{
3843  /* phydbl *y; */
3844  /* phydbl *y_mean; */
3845  /* int n_rep; */
3846  int n_breaks;
3847  int i;
3848  /* int j; */
3849  /* phydbl traj_mean, traj_sd; */
3850  /* phydbl x_prev, x_curr; */
3851  phydbl x;
3852  phydbl x_step;
3853  phydbl sum;
3854  /* phydbl sumsum; */
3855  phydbl scaled_var;
3856
3857  scaled_var = brownian_var/FABS(x_end - x_beg);
3858
3859  n_breaks = 100;
3860
3861
3862  /* n_rep    = 500;   */
3863
3864  /* x_step   = (x_end - x_beg)/(n_breaks+1); */
3865
3866  /* y      = (phydbl *)mCalloc(n_breaks+2,sizeof(phydbl)); */
3867  /* y_mean = (phydbl *)mCalloc(n_rep,sizeof(phydbl)); */
3868
3869  /* y[0] = y_beg; */
3870  /* y[n_breaks+1] = y_end; */
3871
3872  /* For(i,n_rep) */
3873  /*   { */
3874  /*     for(j=1;j<n_breaks+1;j++) */
3875  /*    { */
3876  /*      x_prev = x_beg + (j-1)*x_step; */
3877  /*      x_curr = x_prev + x_step; */
3878
3879  /*      traj_mean = y[j-1] + (y_end - y[j-1])*(x_curr - x_prev)/(x_end - x_prev); */
3880  /*      traj_sd   = SQRT(scaled_var*(x_curr - x_prev)*(x_end - x_curr)/(x_end - x_prev)); */
3881
3882  /*      if(isnan(traj_mean) || isnan(traj_sd)) */
3883  /*        { */
3884  /*          PhyML_Printf("\n. traj_mean=%f traj_sd=%f x_end=%f x_prev=%f x_step=%f [%f %f %f %f %f %f %f] j=%d n_breaks=%d", */
3885  /*                       traj_mean,traj_sd,x_end,x_prev,x_step, */
3886  /*                       y[j-1],y_end,y[j-1],x_curr,x_prev,x_end,x_prev,j,n_breaks); */
3887  /*          Exit("\n"); */
3888  /*        } */
3889
3890  /*      y[j] = Rnorm(traj_mean,traj_sd); */
3891
3892  /*      if(isnan(y[j]) || isinf(y[j])) */
3893  /*        { */
3894  /*          printf("\n. mean=%f sd=%f %f j=%d y[j]=%f",traj_sd,traj_mean,Rnorm(traj_mean,traj_sd),j,y[j]); */
3895  /*          Exit("\n"); */
3896  /*        } */
3897
3898  /*    } */
3899     
3900  /*     sum = 0.0; */
3901  /*     For(j,n_breaks+2) sum += FABS(y[j]); */
3902  /*     y_mean[i] = sum/(n_breaks+2); */
3903  /*   } */
3904
3905  /* sum = sumsum = 0.0; */
3906  /* For(i,n_rep) */
3907  /*   { */
3908  /*     sum += y_mean[i]; */
3909  /*     sumsum += y_mean[i] * y_mean[i]; */
3910  /*   } */
3911
3912  /* *mean = sum/n_rep; */
3913  /* *var = sumsum/n_rep - (*mean) * (*mean); */
3914
3915  /* if(isnan(*mean) || isnan(*var)) */
3916  /*   { */
3917  /*     PhyML_Printf("\n. sum=%f sumsum=%f n_rep=%d",sum,sumsum,n_rep); */
3918  /*     Exit("\n"); */
3919  /*   } */
3920
3921  /* Free(y); */
3922  /* Free(y_mean); */
3923
3924  /* /\* printf("\n. [%f %f]",*mean,*var); *\/ */
3925
3926  phydbl mux,six;
3927
3928  x_step = (x_end - x_beg)/(n_breaks+1);
3929  sum = y_beg;
3930  for(i=1;i<n_breaks+1;i++)
3931    {
3932      x = x_beg + i*x_step;
3933
3934      mux = y_beg + (y_end - y_beg)*(x - x_beg)/(x_end - x_beg);
3935      six = SQRT(scaled_var*(x - x_beg)*(x_end - x)/(x_end - x_beg));
3936
3937      sum += 
3938        (2.*six)/SQRT(2.*PI)*EXP(-POW(mux,2)/(2.*POW(six,2))) + 
3939        2.*mux*Pnorm(mux/six,.0,1.) - mux;
3940    }
3941  sum += y_end;
3942
3943  (*mean) = sum / (n_breaks+2.);
3944  (*var)  = (1./12.)*scaled_var*(x_end - x_beg);
3945
3946  /* printf(" [%f %f] -- x_beg=%f x_end=%f y_beg=%f y_end=%f sd=%f", */
3947  /*     (*mean),(*var),x_beg,x_end,y_beg,y_end,brownian_var); */
3948}
3949
3950
3951//////////////////////////////////////////////////////////////
3952//////////////////////////////////////////////////////////////
3953
3954//////////////////////////////////////////////////////////////
3955//////////////////////////////////////////////////////////////
3956
3957//////////////////////////////////////////////////////////////
3958//////////////////////////////////////////////////////////////
3959
3960
3961/* Let X'(t) = A + (B-A)t/T + X(t) and X(t) = W(t) + t/T * W(T),
3962i.e., X(t) is a Brownian bridge starting at 0 at t=0 and stopping
3963at 0 at t=T. X'(t) starts at X'(t)=A at t=0 and stops at X'(t)=B at
3964t=T. This function calculates the mean and variance of
3965Z(T) = 1/T \int_0^T exp(X'(t)) dt. It uses a 10th order approximation
3966to exp(X) = 1 + X + (1/2!)X^2 + ... (1/10!)X^10
3967*/
3968
3969void Integrated_Geometric_Brownian_Bridge_Moments(phydbl T, phydbl A, phydbl B, phydbl u, phydbl *mean, phydbl *var)
3970{
3971  Integrated_Geometric_Brownian_Bridge_Mean(T,A,B,u,mean);
3972  Integrated_Geometric_Brownian_Bridge_Var(T,A,B,u,var);
3973}
3974
3975//////////////////////////////////////////////////////////////
3976//////////////////////////////////////////////////////////////
3977
3978/*
3979with(CodeGeneration); C(exp(A)*(int(sum(((B-A)*s/t+(1/2)*u*(t-s)*s/t)^k/factorial(k), k = 0 .. 13), s = 0 .. t))/t, optimize)
3980*/
3981
3982void Integrated_Geometric_Brownian_Bridge_Mean(phydbl T, phydbl A, phydbl B, phydbl u, phydbl *mean)
3983{
3984phydbl t1 = exp(A);
3985phydbl t2 = A * A;
3986phydbl t3 = t2 * t2;
3987phydbl t4 = t3 * t3;
3988phydbl t5 = t4 * t2;
3989phydbl t6 = B * B;
3990phydbl t7 = t6 * B;
3991phydbl t10 = t4 * A;
3992phydbl t11 = t6 * t6;
3993phydbl t14 = t2 * A;
3994phydbl t15 = t4 * t14;
3995phydbl t18 = t11 * B;
3996phydbl t21 = t4 * t3;
3997phydbl t24 = t11 * t11;
3998phydbl t25 = t24 * t7;
3999phydbl t26 = t25 * A;
4000phydbl t28 = t14 * t7;
4001phydbl t30 = t6 * A;
4002phydbl t32 = B * t2;
4003phydbl t34 = t7 * A;
4004phydbl t36 = B * t14;
4005phydbl t38 = t7 * t2;
4006phydbl t40 = t11 * t4;
4007phydbl t42 = B * t10;
4008phydbl t44 = t7 * t10;
4009phydbl t46 = t6 * t5;
4010phydbl t48 = B * t15;
4011phydbl t50 = -0.46994831769600e14 * t5 * t7 + 0.117487079424000e15 * t10 * t11 + 0.12816772300800e14 * t15 * t6 - 0.211476742963200e15 * t4 * t18 - 0.2136128716800e13 * t21 * B + 0.27605355724800e14 * t26 + 0.56844948508508160000e20 * t28 + 0.1790615878018007040000e22 * t30 - 0.1790615878018007040000e22 * t32 + 0.477497567471468544000e21 * t34 + 0.477497567471468544000e21 * t36 - 0.198957319779778560000e21 * t38 - 0.1138720923648000e16 * t40 + 0.3588696244224000e16 * t42 + 0.506098188288000e15 * t44 - 0.151829456486400e15 * t46 + 0.27605355724800e14 * t48;
4012phydbl t51 = u * u;
4013phydbl t52 = t51 * t51;
4014phydbl t53 = t52 * t52;
4015phydbl t54 = t53 * t52;
4016phydbl t55 = T * T;
4017phydbl t56 = t55 * t55;
4018phydbl t57 = t56 * t56;
4019phydbl t58 = t57 * t56;
4020phydbl t61 = t3 * t14;
4021phydbl t62 = t11 * t61;
4022phydbl t64 = t53 * t51;
4023phydbl t65 = t57 * t55;
4024phydbl t66 = t64 * t65;
4025phydbl t68 = t24 * B;
4026phydbl t69 = t68 * A;
4027phydbl t70 = t51 * u;
4028phydbl t71 = t55 * T;
4029phydbl t72 = t70 * t71;
4030phydbl t75 = t24 * t6;
4031phydbl t76 = t75 * A;
4032phydbl t77 = t51 * t55;
4033phydbl t80 = u * T;
4034phydbl t83 = t24 * t3;
4035phydbl t86 = t3 * t2;
4036phydbl t87 = B * t86;
4037phydbl t88 = t52 * t51;
4038phydbl t89 = t56 * t55;
4039phydbl t90 = t88 * t89;
4040phydbl t93 = t11 * t86;
4041phydbl t96 = t7 * t86;
4042phydbl t97 = t52 * t56;
4043phydbl t100 = t18 * t86;
4044phydbl t103 = t6 * t86;
4045phydbl t104 = t52 * u;
4046phydbl t105 = t56 * T;
4047phydbl t106 = t104 * t105;
4048phydbl t109 = t4 * t6;
4049phydbl t112 = t5 * B;
4050phydbl t117 = B * t61;
4051phydbl t122 = t11 * t6;
4052phydbl t123 = t122 * A;
4053phydbl t126 = -0.108e3 * t54 * t58 + 0.9868914671616000e16 * t62 - 0.993600e6 * t66 + 0.86387558400e11 * t69 * t72 + 0.293717698560e12 * t76 * t77 + 0.854451486720e12 * t26 * t80 - 0.35246123827200e14 * t83 * t80 - 0.795674880e9 * t87 * t90 - 0.1814138726400e13 * t93 * t72 - 0.201570969600e12 * t96 * t97 - 0.12336143339520e14 * t100 * t77 - 0.15913497600e11 * t103 * t106 - 0.388744012800e12 * t109 * t72 - 0.293717698560e12 * t112 * t77 + 0.86387558400e11 * t42 * t72 + 0.4546713600e10 * t117 * t106 + 0.854451486720e12 * t48 * t80 + 0.103520083968000e15 * t72 * t123;
4054phydbl t128 = t6 * t3;
4055phydbl t131 = t18 * t14;
4056phydbl t134 = t11 * t3;
4057phydbl t137 = t18 * A;
4058phydbl t140 = t11 * t7;
4059phydbl t141 = t140 * A;
4060phydbl t146 = B * A;
4061phydbl t151 = t24 * t14;
4062phydbl t154 = t24 * t2;
4063phydbl t159 = t24 * A;
4064phydbl t162 = t140 * t3;
4065phydbl t165 = t6 * t2;
4066phydbl t170 = t6 * t14;
4067phydbl t173 = B * t3;
4068phydbl t176 = -0.51760041984000e14 * t97 * t128 + 0.2898562351104000e16 * t77 * t131 - 0.3623202938880000e16 * t77 * t134 + 0.20704016793600e14 * t97 * t137 + 0.414080335872000e15 * t77 * t141 - 0.177640464089088000e18 * t32 * t72 + 0.16149133099008000e17 * t146 * t97 + 0.1184269760593920000e19 * t36 * t77 + 0.162674417664000e15 * t151 * t80 - 0.16267441766400e14 * t154 * t77 - 0.10658427845345280000e20 * t38 * t80 + 0.1016715110400e13 * t159 * t72 - 0.325348835328000e15 * t162 * t80 - 0.1776404640890880000e19 * t165 * t77 + 0.177640464089088000e18 * t30 * t72 + 0.10658427845345280000e20 * t170 * t80 - 0.5329213922672640000e19 * t173 * t80;
4069phydbl t177 = t11 * A;
4070phydbl t184 = t3 * A;
4071phydbl t185 = t122 * t184;
4072phydbl t188 = t140 * t14;
4073phydbl t191 = t140 * t2;
4074phydbl t196 = t6 * t184;
4075phydbl t199 = t52 * t70;
4076phydbl t200 = t56 * t71;
4077phydbl t201 = t199 * t200;
4078phydbl t208 = B * t184;
4079phydbl t213 = t7 * t184;
4080phydbl t224 = 0.5329213922672640000e19 * t177 * t80 + 0.1184269760593920000e19 * t34 * t77 + 0.239227084800e12 * t141 * t97 + 0.455488369459200e15 * t185 * t80 + 0.43379844710400e14 * t188 * t77 - 0.4066860441600e13 * t191 * t72 + 0.116290944000e12 * t90 * t170 + 0.7117005772800e13 * t97 * t196 - 0.9180864000e10 * t201 * t165 + 0.6120576000e10 * t201 * t34 + 0.40668604416000e14 * t77 * t159 + 0.828988832415744000e18 * t208 * t80 - 0.4710163820544000e16 * t32 * t97 + 0.75914728243200e14 * t72 * t213 + 0.4710163820544000e16 * t30 * t97 + 0.75914728243200e14 * t72 * t131 - 0.1046618496000e13 * t106 * t128 + 0.2372335257600e13 * t97 * t123;
4081phydbl t227 = t7 * t3;
4082phydbl t234 = t122 * t3;
4083phydbl t237 = t122 * t14;
4084phydbl t242 = t11 * t2;
4085phydbl t245 = t7 * t61;
4086phydbl t260 = t18 * t184;
4087phydbl t267 = -0.11861676288000e14 * t97 * t227 - 0.116290944000e12 * t90 * t38 + 0.1395491328000e13 * t106 * t28 - 0.75914728243200e14 * t234 * t77 + 0.9489341030400e13 * t237 * t72 - 0.414494416207872000e18 * t38 * t77 - 0.2072472081039360000e19 * t242 * t80 + 0.1518294564864000e16 * t80 * t245 + 0.10844961177600e14 * t72 * t141 + 0.418647398400e12 * t106 * t137 + 0.414494416207872000e18 * t170 * t77 - 0.94893410304000e14 * t72 * t134 - 0.2657015488512000e16 * t80 * t93 + 0.2763296108052480000e19 * t28 * t80 + 0.3188418586214400e16 * t80 * t260 + 0.37681310564352000e17 * t34 * t72 + 0.126524547072000e15 * t80 * t69;
4088phydbl t268 = t122 * t2;
4089phydbl t285 = t24 * t11;
4090phydbl t297 = B * t52;
4091phydbl t300 = t7 * t51;
4092phydbl t303 = t6 * u;
4093phydbl t309 = -0.837294796800e12 * t268 * t97 + 0.46516377600e11 * t123 * t106 + 0.1518294564864000e16 * t80 * t188 - 0.569360461824000e15 * t80 * t154 - 0.2657015488512000e16 * t80 * t234 + 0.207247208103936000e18 * t177 * t77 + 0.828988832415744000e18 * t137 * t80 - 0.2072472081039360000e19 * t128 * t80 + 0.2136128716800e13 * t285 * A - 0.119374391867867136000e21 * t11 - 0.2387487837357342720000e22 * t6 + 0.596871959339335680000e21 * t14 - 0.296067440148480000e18 * t2 * t70 * t71 + 0.1776404640890880000e19 * t14 * t51 * t55 - 0.29606744014848000e17 * t297 * t56 - 0.1776404640890880000e19 * t300 * t55 - 0.179061587801800704000e21 * t303 * T + 0.596871959339335680000e21 * A * u * T;
4094phydbl t311 = B * u;
4095phydbl t332 = B * t88;
4096phydbl t341 = t7 * t52;
4097phydbl t347 = t6 * t104;
4098phydbl t362 = -0.596871959339335680000e21 * t311 * T + 0.29606744014848000e17 * A * t52 * t56 - 0.7105618563563520000e19 * t3 * u * T + 0.41449441620787200e17 * t184 * t51 * t55 - 0.181160146944000e15 * t2 * t104 * t105 + 0.1570054606848000e16 * t14 * t52 * t56 - 0.138164805402624000e18 * t86 * u * T - 0.12940010496000e14 * t332 * t89 - 0.138164805402624000e18 * t122 * u * T - 0.9420327641088000e16 * t11 * t70 * t71 - 0.1570054606848000e16 * t341 * t56 - 0.41449441620787200e17 * t18 * t51 * t55 - 0.181160146944000e15 * t347 * t105 + 0.1065842784534528000e19 * t184 * u * T - 0.8074566549504000e16 * t2 * t52 * t56 + 0.672880545792000e15 * A * t104 * t105 - 0.296067440148480000e18 * t3 * t51 * t55;
4099phydbl t366 = B * t104;
4100phydbl t372 = t6 * t52;
4101phydbl t375 = t7 * t70;
4102phydbl t381 = t6 * t51;
4103phydbl t388 = t4 * B;
4104phydbl t391 = t61 * t6;
4105phydbl t394 = t4 * t7;
4106phydbl t399 = t10 * t6;
4107phydbl t406 = 0.59213488029696000e17 * t14 * t70 * t71 - 0.672880545792000e15 * t366 * t105 - 0.296067440148480000e18 * t11 * t51 * t55 - 0.8074566549504000e16 * t372 * t56 - 0.59213488029696000e17 * t375 * t71 - 0.1065842784534528000e19 * t18 * u * T - 0.8526742276276224000e19 * t381 * t55 - 0.7162463512072028160000e22 * B + 0.7162463512072028160000e22 * A - 0.596871959339335680000e21 * t7 - 0.2387487837357342720000e22 * t2 - 0.21596889600e11 * t388 * t97 + 0.86387558400e11 * t391 * t97 - 0.4405765478400e13 * t394 * t77 - 0.35246123827200e14 * t40 * t80 + 0.1468588492800e13 * t399 * t77 + 0.15664943923200e14 * t44 * t80 + 0.1036650700800e13 * t245 * t72;
4108phydbl t412 = t18 * t61;
4109phydbl t429 = t184 * t70;
4110phydbl t449 = t2 * t88;
4111phydbl t453 = t53 * u;
4112phydbl t455 = t57 * T;
4113phydbl t467 = t3 * t52;
4114phydbl t475 = 0.8811530956800e13 * t62 * t77 + 0.56393798123520e14 * t412 * t80 - 0.4699483176960e13 * t46 * t80 + 0.113667840e9 * t184 * t199 * t200 * B + 0.302356454400e12 * t184 * t52 * t56 * t11 + 0.31826995200e11 * t184 * t104 * t105 * t7 + 0.2176966471680e13 * t429 * t71 * t18 + 0.2387024640e10 * t184 * t88 * t89 * t6 - 0.70200e5 * t2 * t64 * t65 * B - 0.284169600e9 * t2 * t199 * t200 * t11 - 0.25833600e8 * t2 * t53 * t57 * t7 - 0.2387024640e10 * t449 * t89 * t18 - 0.1684800e7 * t2 * t453 * t455 * t6 - 0.284169600e9 * t3 * t199 * t200 * t6 + 0.1123200e7 * t14 * t453 * t455 * B - 0.302356454400e12 * t467 * t56 * t18 - 0.12916800e8 * t3 * t53 * t57 * B;
4115phydbl t496 = t14 * t104;
4116phydbl t500 = t53 * t70;
4117phydbl t502 = t57 * t71;
4118phydbl t510 = A * t453;
4119phydbl t514 = A * t199;
4120phydbl t522 = t105 * t3;
4121phydbl t527 = t184 * t11;
4122phydbl t536 = t11 * t14;
4123phydbl t539 = 0.25833600e8 * t14 * t53 * t57 * t6 - 0.3978374400e10 * t3 * t88 * t89 * t7 - 0.39783744000e11 * t3 * t104 * t105 * t11 + 0.378892800e9 * t14 * t199 * t200 * t7 + 0.3978374400e10 * t14 * t88 * t89 * t11 + 0.31826995200e11 * t496 * t105 * t18 + 0.2808e4 * A * t500 * t502 * B + 0.12916800e8 * A * t53 * t57 * t11 + 0.1123200e7 * t510 * t455 * t7 + 0.113667840e9 * t514 * t200 * t18 + 0.70200e5 * A * t64 * t65 * t6 - 0.3235002624000e13 * t366 * t522 - 0.162674417664000e15 * t77 * t191 + 0.14234011545600e14 * t527 * t72 - 0.2093236992000e13 * t134 * t97 + 0.325348835328000e15 * t62 * t80 - 0.75914728243200e14 * t93 * t77 + 0.232581888000e12 * t536 * t106;
4124phydbl t547 = t7 * u;
4125phydbl t548 = T * t4;
4126phydbl t561 = B * t199;
4127phydbl t562 = t200 * t2;
4128phydbl t565 = B * t51;
4129phydbl t566 = t55 * t61;
4130phydbl t571 = t18 * t2;
4131phydbl t582 = -0.18361728000e11 * t242 * t90 + 0.30145048451481600e17 * t208 * t77 + 0.918086400e9 * t177 * t201 - 0.162674417664000e15 * t547 * t548 + 0.966187450368000e15 * t36 * t97 - 0.103520083968000e15 * t32 * t106 - 0.110531844322099200e18 * t87 * t80 + 0.6901338931200e13 * t146 * t90 - 0.12560436854784000e17 * t38 * t72 - 0.31715712000e11 * t561 * t562 + 0.414080335872000e15 * t565 * t566 + 0.100483494838272000e18 * t28 * t77 - 0.331595532966297600e18 * t571 * t80 - 0.75362621128704000e17 * t242 * t77 + 0.966187450368000e15 * t34 * t97 - 0.1449281175552000e16 * t165 * t97 + 0.331595532966297600e18 * t196 * t80;
4132phydbl t601 = t56 * t184;
4133phydbl t604 = B * t53;
4134phydbl t605 = t57 * A;
4135phydbl t610 = t7 * t104;
4136phydbl t615 = t71 * t86;
4137phydbl t621 = 0.103520083968000e15 * t30 * t106 + 0.12560436854784000e17 * t170 * t72 - 0.75362621128704000e17 * t128 * t77 - 0.6280218427392000e16 * t173 * t72 + 0.30145048451481600e17 * t137 * t77 + 0.6280218427392000e16 * t177 * t72 + 0.552659221610496000e18 * t536 * t80 - 0.552659221610496000e18 * t227 * t80 + 0.110531844322099200e18 * t123 * t80 + 0.20704016793600e14 * t297 * t601 + 0.1669248000e10 * t604 * t605 + 0.1674589593600e13 * t341 * t601 - 0.232581888000e12 * t610 * t522 + 0.43379844710400e14 * t300 * t566 - 0.9489341030400e13 * t375 * t615 - 0.3947565868646400e16 * t68 + 0.3947565868646400e16 * t10 - 0.1345761091584000e16 * t106;
4138phydbl t643 = B * t70;
4139phydbl t649 = t6 * t70;
4140phydbl t660 = t53 * t57;
4141phydbl t665 = 0.39791463955955712000e20 * t14 * u * T + 0.1065842784534528000e19 * A * t70 * t71 - 0.8526742276276224000e19 * t2 * t51 * t55 - 0.179061587801800704000e21 * t2 * u * T - 0.29843597966966784000e20 * t565 * t55 + 0.29843597966966784000e20 * A * t51 * t55 - 0.39791463955955712000e20 * t547 * T - 0.1065842784534528000e19 * t643 * t71 - 0.7105618563563520000e19 * t11 * u * T - 0.296067440148480000e18 * t649 * t71 - 0.2842247425425408000e19 * t86 - 0.2842247425425408000e19 * t122 + 0.11861676288000e14 * t97 * t536 - 0.1046618496000e13 * t106 * t242 - 0.56521965846528000e17 * t165 * t72 + 0.459043200e9 * t660 * t30 - 0.37957364121600e14 * t72 * t103;
4142phydbl t696 = t68 * t2;
4143phydbl t703 = 0.6470005248000e13 * t106 * t170 - 0.570882816000e12 * t90 * t165 - 0.207247208103936000e18 * t173 * t77 + 0.37681310564352000e17 * t36 * t72 + 0.362320293888000e15 * t146 * t106 + 0.310560251904000e15 * t72 * t196 + 0.1345761091584000e16 * t80 * t159 + 0.358123175603601408000e21 * t146 * t80 + 0.10844961177600e14 * t76 * t80 + 0.119374391867867136000e21 * t30 * t80 + 0.17053484552552448000e20 * t146 * t77 - 0.119374391867867136000e21 * t32 * t80 + 0.380588544000e12 * t90 * t34 + 0.2898562351104000e16 * t77 * t213 + 0.28422474254254080000e20 * t36 * t80 - 0.54224805888000e14 * t696 * t80 + 0.592134880296960000e18 * t146 * t72 + 0.69013389312000e14 * t97 * t28;
4144phydbl t740 = -0.14324927024144056320000e23 - 0.5329213922672640000e19 * t32 * t77 - 0.6470005248000e13 * t106 * t38 - 0.517600419840000e15 * t72 * t227 + 0.3614987059200e13 * t69 * t77 - 0.42633711381381120000e20 * t165 * t80 + 0.5329213922672640000e19 * t30 * t77 + 0.28422474254254080000e20 * t34 * t80 + 0.355280928178176000e18 * t61 - 0.39475658686464000e17 * t24 - 0.39475658686464000e17 * t4 - 0.1404e4 * t6 * t500 * t502 - 0.2583360e7 * t18 * t53 * t57 - 0.280800e6 * t11 * t453 * t455 - 0.23400e5 * t7 * t64 * t65 - 0.54e2 * B * t54 * t58 - 0.21859200e8 * t11 * t53 * t57;
4145phydbl t765 = t453 * t455;
4146phydbl t772 = t500 * t502;
4147phydbl t783 = -0.1987200e7 * t7 * t453 * t455 - 0.129600e6 * t6 * t64 * t65 - 0.5400e4 * B * t500 * t502 + 0.985905561600e12 * t15 * u * T - 0.361498705920e12 * t77 * t5 + 0.112968345600e12 * t72 * t10 - 0.29903385600e11 * t97 * t4 - 0.1224115200e10 * t90 * t86 + 0.183617280e9 * t201 * t184 + 0.6645196800e10 * t106 * t61 + 0.1987200e7 * t765 * t14 - 0.129600e6 * t66 * t2 - 0.21859200e8 * t660 * t3 + 0.5400e4 * t772 * A + 0.6120576000e10 * t201 * t36 - 0.2372335257600e13 * t97 * t87 + 0.418647398400e12 * t106 * t208 + 0.10844961177600e14 * t72 * t117;
4148phydbl t794 = t18 * t3;
4149phydbl t823 = -0.459043200e9 * t660 * t32 - 0.58145472000e11 * t90 * t173 + 0.162674417664000e15 * t77 * t391 - 0.569360461824000e15 * t77 * t794 - 0.40668604416000e14 * t77 * t388 - 0.569360461824000e15 * t80 * t109 + 0.126524547072000e15 * t80 * t42 + 0.21859200e8 * t765 * t146 - 0.379573641216000e15 * t77 * t96 - 0.455488369459200e15 * t100 * t80 + 0.91097673891840e14 * t260 * t77 - 0.14234011545600e14 * t794 * t72 + 0.1674589593600e13 * t131 * t97 - 0.139549132800e12 * t571 * t106 + 0.7344691200e10 * t137 * t90 + 0.379573641216000e15 * t77 * t237 + 0.569360461824000e15 * t77 * t527;
4150phydbl t826 = t89 * t14;
4151phydbl t835 = t122 * t86;
4152phydbl t850 = t140 * t184;
4153phydbl t859 = t75 * t2;
4154phydbl t864 = -0.103520083968000e15 * t643 * t615 + 0.380588544000e12 * t332 * t826 + 0.12336143339520e14 * t185 * t77 - 0.15913497600e11 * t268 * t106 + 0.201570969600e12 * t237 * t97 - 0.65792764477440e14 * t835 * t80 - 0.388744012800e12 * t154 * t72 + 0.795674880e9 * t123 * t90 - 0.1814138726400e13 * t234 * t72 - 0.8811530956800e13 * t162 * t77 + 0.1036650700800e13 * t188 * t72 + 0.4546713600e10 * t141 * t106 + 0.56393798123520e14 * t850 * t80 - 0.86387558400e11 * t191 * t97 + 0.21596889600e11 * t159 * t97 - 0.1468588492800e13 * t696 * t77 - 0.4699483176960e13 * t859 * t80 + 0.4405765478400e13 * t151 * t77;
4155phydbl t866 = t68 * t14;
4156phydbl t905 = 0.15664943923200e14 * t866 * t80 - 0.1345761091584000e16 * t311 * t548 + 0.24482304000e11 * t7 * t88 * t826 - 0.1836172800e10 * t7 * t199 * t562 + 0.87436800e8 * t7 * t53 * t605 + 0.54224805888000e14 * t303 * T * t10 - 0.18840655282176000e17 * t80 * t794 + 0.5383044366336000e16 * t80 * t391 - 0.113043931693056000e18 * t80 * t134 + 0.12919306479206400e17 * t80 * t117 - 0.45217572677222400e17 * t80 * t103 + 0.90435145354444800e17 * t80 * t131 + 0.90435145354444800e17 * t80 * t213 - 0.45217572677222400e17 * t80 * t268 + 0.20704016793600e14 * t106 * t34 - 0.2173921763328000e16 * t72 * t242 - 0.11304393169305600e17 * t77 * t571;
4157phydbl t938 = t6 * t88;
4158phydbl t949 = 0.2898562351104000e16 * t72 * t28 - 0.310560251904000e15 * t97 * t38 + 0.114176563200e12 * t201 * t146 - 0.3768131056435200e16 * t77 * t87 - 0.1941001574400e13 * t90 * t32 + 0.20704016793600e14 * t106 * t36 + 0.869568705331200e15 * t72 * t208 + 0.12919306479206400e17 * t80 * t141 + 0.58145472000e11 * t90 * t177 + 0.1941001574400e13 * t90 * t30 + 0.11304393169305600e17 * t77 * t196 - 0.31056025190400e14 * t106 * t165 - 0.16267441766400e14 * t381 * t55 * t4 + 0.4066860441600e13 * t649 * t71 * t61 + 0.310560251904000e15 * t97 * t170 - 0.18361728000e11 * t938 * t89 * t3 + 0.1836172800e10 * t6 * t199 * t200 * t14 - 0.837294796800e12 * t372 * t56 * t86;
4159phydbl t979 = 0.139549132800e12 * t347 * t105 * t184 - 0.2173921763328000e16 * t72 * t128 - 0.131155200e9 * t6 * t53 * t57 * t2 + 0.5961600e7 * t30 * t765 - 0.155280125952000e15 * t97 * t173 + 0.869568705331200e15 * t72 * t137 - 0.29905802035200e14 * t25 - 0.2300446310400e13 * t285 - 0.12816772300800e14 * t25 * t2 - 0.355280928178176000e18 * t140 - 0.2131685569069056000e19 * t72 - 0.716246351207202816000e21 * t165 - 0.10800e5 * t772 - 0.59687195933933568000e20 * t77 + 0.4774975674714685440000e22 * t146 + 0.99478659889889280000e20 * t177 - 0.99478659889889280000e20 * t173;
4160phydbl t998 = -0.59213488029696000e17 * t97 - 0.151829456486400e15 * t859 + 0.198957319779778560000e21 * t170 + 0.17053484552552448000e20 * t137 - 0.42633711381381120000e20 * t242 + 0.17053484552552448000e20 * t208 - 0.42633711381381120000e20 * t128 - 0.12434832486236160000e20 * t227 + 0.12434832486236160000e20 * t536 + 0.7460899491741696000e19 * t196 - 0.7460899491741696000e19 * t571 + 0.2486966497247232000e19 * t123 - 0.2486966497247232000e19 * t87 - 0.25880020992000e14 * t90 - 0.431333683200e12 * t201 + 0.315805269491712000e18 * t117 + 0.43064354930688000e17 * t245 - 0.75362621128704000e17 * t234;
4161phydbl t1017 = -0.1138720923648000e16 * t83 - 0.2763296108052480000e19 * t134 - 0.16149133099008000e17 * t154 + 0.43064354930688000e17 * t188 - 0.1105318443220992000e19 * t268 + 0.2210636886441984000e19 * t131 + 0.3588696244224000e16 * t69 + 0.90435145354444800e17 * t260 - 0.75362621128704000e17 * t93 - 0.1105318443220992000e19 * t103 - 0.6343142400e10 * t660 + 0.1821953477836800e16 * t850 - 0.83462400e8 * t765 - 0.2125612390809600e16 * t835 - 0.1193743918678671360000e22 * t80 + 0.1821953477836800e16 * t412 + 0.315805269491712000e18 * t141;
4162phydbl t1038 = 0.2210636886441984000e19 * t213 - 0.331595532966297600e18 * t96 - t53 * t104 * t57 * t105 + 0.506098188288000e15 * t866 - 0.16149133099008000e17 * t109 - 0.497393299449446400e18 * t794 + 0.35528092817817600e17 * t159 - 0.142112371271270400e18 * t191 + 0.331595532966297600e18 * t237 + 0.497393299449446400e18 * t527 + 0.142112371271270400e18 * t391 - 0.35528092817817600e17 * t388 - 0.4934457335808000e16 * t394 + 0.1644819111936000e16 * t399 - 0.328963822387200e15 * t112 - 0.9868914671616000e16 * t162 + 0.328963822387200e15 * t76 - 0.1644819111936000e16 * t696;
4163phydbl t1070 = 0.4934457335808000e16 * t151 + 0.13816480540262400e17 * t185 - 0.13816480540262400e17 * t100 + 0.281968990617600e15 * t122 * t61 - 0.117487079424000e15 * t68 * t3 + 0.46994831769600e14 * t75 * t14 + 0.211476742963200e15 * t24 * t184 - 0.281968990617600e15 * t140 * t86 - 0.358869624422400e15 * t75 - 0.358869624422400e15 * t5 + 0.29905802035200e14 * t15 + 0.155280125952000e15 * t97 * t177 - 0.18840655282176000e17 * t77 * t227 + 0.18840655282176000e17 * t77 * t536 + 0.3768131056435200e16 * t77 * t123 - 0.12560436854784000e17 * t80 * t96 + 0.12560436854784000e17 * t80 * t237;
4164phydbl t1093 = B * t453;
4165phydbl t1119 = -0.10844961177600e14 * t311 * T * t5 + 0.3614987059200e13 * t565 * t55 * t10 - 0.1016715110400e13 * t643 * t71 * t4 + 0.239227084800e12 * t297 * t56 * t61 - 0.46516377600e11 * t366 * t105 * t86 + 0.7344691200e10 * t332 * t89 * t184 + 0.18840655282176000e17 * t80 * t527 - 0.5383044366336000e16 * t80 * t191 - 0.5961600e7 * t1093 * t455 * t2 + 0.259200e6 * B * t64 * t65 * A - 0.918086400e9 * t561 * t200 * t3 + 0.87436800e8 * t604 * t57 * t14 + 0.3235002624000e13 * t106 * t177 - 0.310560251904000e15 * t72 * t571 - 0.1449281175552000e16 * t77 * t268 + 0.517600419840000e15 * t72 * t536 - 0.51760041984000e14 * t97 * t242 + 0.31715712000e11 * t201 * t30;
4166phydbl t1160 = -0.1449281175552000e16 * t77 * t103 - 0.7117005772800e13 * t97 * t571 - 0.37957364121600e14 * t72 * t268 - 0.164317593600e12 * t24 * t18 + 0.164317593600e12 * t4 * t184 + 0.215666841600e12 * t514 * t200 + 0.1256043685478400e16 * t429 * t71 - 0.3450669465600e13 * t449 * t89 + 0.15790263474585600e17 * t61 * u * T - 0.241546862592000e15 * t467 * t56 + 0.34506694656000e14 * t496 * t105 - 0.5024174741913600e16 * t86 * t51 * t55 - 0.215666841600e12 * t561 * t200 - 0.34506694656000e14 * t610 * t105 - 0.5024174741913600e16 * t122 * t51 * t55 - 0.241546862592000e15 * t11 * t52 * t56 - 0.1256043685478400e16 * t18 * t70 * t71;
4167phydbl t1200 = -0.15790263474585600e17 * t140 * u * T - 0.3450669465600e13 * t938 * t89 + 0.12940010496000e14 * A * t88 * t89 - 0.9420327641088000e16 * t3 * t70 * t71 - 0.57088281600e11 * t201 * t6 - 0.538304436633600e15 * t77 * t140 - 0.31056025190400e14 * t97 * t18 - 0.5176004198400e13 * t106 * t11 - 0.144928117555200e15 * t72 * t122 - 0.647000524800e12 * t90 * t7 - 0.3171571200e10 * t660 * B - 0.144928117555200e15 * t72 * t86 + 0.647000524800e12 * t90 * t14 - 0.5176004198400e13 * t106 * t3 + 0.538304436633600e15 * t77 * t61 - 0.57088281600e11 * t201 * t2 + 0.31056025190400e14 * t97 * t184 + 0.3171571200e10 * t660 * A;
4168phydbl t1239 = -0.1614913309900800e16 * t80 * t4 - 0.1614913309900800e16 * t80 * t24 - 0.985905561600e12 * t25 * u * T - 0.361498705920e12 * t75 * t51 * t55 - 0.112968345600e12 * t68 * t70 * t71 - 0.29903385600e11 * t24 * t52 * t56 - 0.6645196800e10 * t140 * t104 * t105 - 0.12652454707200e14 * t80 * t5 - 0.1355620147200e13 * t72 * t24 - 0.12652454707200e14 * t80 * t75 - 0.1224115200e10 * t122 * t88 * t89 - 0.1530144000e10 * t201 * t11 - 0.119374391867867136000e21 * t3 - 0.19895731977977856000e20 * t18 + 0.19895731977977856000e20 * t184 - 0.2300446310400e13 * t21 - 0.338905036800e12 * t97 * t140;
4169phydbl t1277 = -0.153014400e9 * t660 * t7 - 0.69774566400e11 * t106 * t122 + 0.11629094400e11 * t90 * t184 - 0.1530144000e10 * t201 * t3 + 0.153014400e9 * t660 * t14 - 0.1355620147200e13 * t72 * t4 - 0.4518733824000e13 * t77 * t68 - 0.69774566400e11 * t106 * t86 - 0.11629094400e11 * t90 * t18 - 0.10929600e8 * t765 * t6 - 0.10929600e8 * t765 * t2 + 0.496800e6 * t66 * A + 0.338905036800e12 * t97 * t61 - 0.496800e6 * t66 * B + 0.4518733824000e13 * t77 * t10 - 0.51760041984000e14 * t77 * t24 - 0.10571904000e11 * t201 * t7 - 0.183617280e9 * t18 * t199 * t200;
4170phydbl t1314 = -0.3450669465600e13 * t97 * t122 - 0.95147136000e11 * t90 * t11 - 0.14788583424000e14 * t72 * t140 - 0.647000524800e12 * t106 * t18 - 0.834624000e9 * t660 * t6 - 0.149529010176000e15 * t80 * t68 - 0.3450669465600e13 * t97 * t86 + 0.10571904000e11 * t201 * t14 - 0.51760041984000e14 * t77 * t4 + 0.647000524800e12 * t106 * t184 - 0.95147136000e11 * t90 * t3 + 0.14788583424000e14 * t72 * t61 - 0.41731200e8 * t1093 * t455 - 0.834624000e9 * t660 * t2 + 0.41731200e8 * t510 * t455 + 0.149529010176000e15 * t80 * t10 - 0.113667840e9 * t140 * t88 * t89;
4171phydbl t1369 = -0.71204290560e11 * t285 * u * T - 0.8638755840e10 * t75 * t70 * t71 - 0.2399654400e10 * t68 * t52 * t56 - 0.26701608960e11 * t25 * t51 * t55 - 0.568339200e9 * t24 * t104 * t105 - 0.18944640e8 * t122 * t199 * t200 + 0.26701608960e11 * t15 * t51 * t55 - 0.568339200e9 * t4 * t104 * t105 + 0.2399654400e10 * t10 * t52 * t56 - 0.71204290560e11 * t21 * u * T + 0.113667840e9 * t61 * t88 * t89 - 0.8638755840e10 * t5 * t70 * t71 - 0.18944640e8 * t86 * t199 * t200 + 0.2583360e7 * t184 * t53 * t57 - 0.280800e6 * t3 * t453 * t455 + 0.23400e5 * t14 * t64 * t65 - 0.1404e4 * t2 * t500 * t502 + 0.54e2 * A * t54 * t58;
4172*mean = -t1 * (t126 + t1160 + t823 + t665 + t621 + t1369 + t267 + t1070 + t1314 + t475 + t783 + t1200 + t703 + t1119 + t740 + t582 + t406 + t1239 + t1017 + t979 + t539 + t309 + t224 + t50 + t1277 + t905 + t864 + t998 + t949 + t1038 + t362 + t176) / 0.14324927024144056320000e23;
4173 
4174
4175 /* printf("\n. Taylor: %f",*mean); */
4176 
4177 /*  /\* C(int(exp((B-A)*s/T+(1/2)*u*(T-s)*s/T), s = 0 .. T)) *\/ */
4178 /*  /\* Correct but numerically unstable dur to EXP(TOO BIG)*\/ */
4179
4180 /* *mean = */
4181 /*   SQRT(0.2e1) *  */
4182 /*   SQRT(0.3141592654e1) *  */
4183 /*   EXP((double) ((4 * B * B - 8 * B * A + 4 * B * u * T + 4 * A * A - 4 * A * u * T + u * u * T * T) / u / T) / 0.8e1) *  */
4184 /*   (-erf(SQRT(0.2e1) * (double) (-2 * B + 2 * A - u * T) / (double) T * pow((double) (u / T), -0.1e1 / 0.2e1) / 0.4e1)  */
4185 /*    +erf(SQRT(0.2e1) * (double) (u *  T - 2 * B + 2 * A) / (double) T * pow((double) (u / T), -0.1e1 / 0.2e1) / 0.4e1))*  */
4186 /*   pow((double) (u / T), -0.1e1 / 0.2e1) / 0.2e1; */
4187 
4188 /* *mean /= T; */
4189 /* *mean *= EXP(A); */
4190
4191 /* printf("\nErf: %f [%f %f %f]", */
4192 /*        *mean, */
4193 /*        EXP((double) ((4 * B * B - 8 * B * A + 4 * B * u * T + 4 * A * A - 4 * A * u * T + u * u * T * T) / u / T) / 0.8e1), */
4194 /*        (double) ((4 * B * B - 8 * B * A + 4 * B * u * T + 4 * A * A - 4 * A * u * T + u * u * T * T) / u / T) / 0.8e1, */
4195 /*        (-erf(SQRT(0.2e1) * (double) (-2 * B + 2 * A - u * T) / (double) T * pow((double) (u / T), -0.1e1 / 0.2e1) / 0.4e1) + erf(SQRT(0.2e1) * (double) (u * T - 2 * B + 2 * A) / (double) T * pow((double) (u / T), -0.1e1 / 0.2e1) / 0.4e1)) * pow((double) (u / T), -0.1e1 / 0.2e1) / 0.2e1); */
4196
4197 }
4198 
4199//////////////////////////////////////////////////////////////
4200//////////////////////////////////////////////////////////////
4201
4202 void Integrated_Geometric_Brownian_Bridge_Var(phydbl T, phydbl A, phydbl B, phydbl u, phydbl *var)
4203 { 
4204phydbl t2 = exp(0.2e1 * A);
4205phydbl t3 = A * A;
4206phydbl t7 = u * u;
4207phydbl t8 = B * t7;
4208phydbl t9 = T * T;
4209phydbl t12 = B * B;
4210phydbl t13 = t7 * u;
4211phydbl t14 = t7 * t7;
4212phydbl t15 = t14 * t14;
4213phydbl t16 = t15 * t13;
4214phydbl t18 = t9 * T;
4215phydbl t19 = t9 * t9;
4216phydbl t20 = t19 * t19;
4217phydbl t21 = t20 * t18;
4218phydbl t24 = t12 * t12;
4219phydbl t25 = t24 * B;
4220phydbl t29 = t15 * u;
4221phydbl t31 = t20 * T;
4222phydbl t34 = t12 * B;
4223phydbl t35 = t15 * t7;
4224phydbl t37 = t20 * t9;
4225phydbl t40 = t15 * t14;
4226phydbl t42 = t20 * t19;
4227phydbl t57 = t3 * A;
4228phydbl t58 = t3 * t3;
4229phydbl t59 = t58 * t58;
4230phydbl t60 = t59 * t57;
4231phydbl t64 = t7 * t9;
4232phydbl t65 = t59 * t3;
4233phydbl t68 = t13 * t18;
4234phydbl t69 = t59 * A;
4235phydbl t72 = t14 * t19;
4236phydbl t75 = t14 * t7;
4237phydbl t76 = t19 * t9;
4238phydbl t77 = t75 * t76;
4239phydbl t78 = t58 * t3;
4240phydbl t81 = -0.4722222240e18 * t3 * u * T - 0.2222222160e18 * t8 * t9 - 0.2370000e7 * t12 * t16 * t21 - 0.745270000e9 * t25 * t15 * t20 - 0.143603000e9 * t24 * t29 * t31 - 0.13704400e8 * t34 * t35 * t37 + 0.220000e6 * B * t40 * t42 - 0.3230000000e10 * t24 * t15 * t20 - 0.565000000e9 * t34 * t29 * t31 - 0.100000000e9 * t12 * t35 * t37 - 0.85000e5 * B * t16 * t21 + 0.6891165130e12 * t60 * u * T - 0.8770304000e12 * t64 * t65 + 0.6541049000e12 * t68 * t69 - 0.3577430000e12 * t72 * t59 - 0.5328000000e11 * t77 * t78;
4241phydbl t82 = t14 * t13;
4242phydbl t83 = t19 * t18;
4243phydbl t84 = t82 * t83;
4244phydbl t85 = t58 * A;
4245phydbl t88 = t14 * u;
4246phydbl t89 = t19 * T;
4247phydbl t90 = t88 * t89;
4248phydbl t91 = t58 * t57;
4249phydbl t94 = t29 * t31;
4250phydbl t97 = t35 * t37;
4251phydbl t100 = t15 * t20;
4252phydbl t103 = t16 * t21;
4253phydbl t106 = t34 * t88;
4254phydbl t107 = t89 * t58;
4255phydbl t110 = t34 * t7;
4256phydbl t111 = t9 * t91;
4257phydbl t114 = t34 * t13;
4258phydbl t115 = t18 * t78;
4259phydbl t118 = B * u;
4260phydbl t119 = T * t59;
4261phydbl t123 = t76 * t57;
4262phydbl t127 = t83 * t3;
4263phydbl t131 = t20 * A;
4264phydbl t134 = t12 * u;
4265phydbl t138 = u * T;
4266phydbl t139 = t25 * t58;
4267phydbl t142 = t91 * t12;
4268phydbl t145 = t24 * t58;
4269phydbl t148 = 0.1479000000e11 * t84 * t85 + 0.1539200000e12 * t90 * t91 + 0.587000000e9 * t94 * t57 - 0.92460000e8 * t97 * t3 - 0.3259400000e10 * t100 * t58 + 0.10000000e8 * t103 * A - 0.5386900000e13 * t106 * t107 + 0.1052436300e15 * t110 * t111 - 0.5494474000e14 * t114 * t115 - 0.2664291708e15 * t118 * t119 + 0.1065273000e13 * t34 * t75 * t123 - 0.1479180000e12 * t34 * t82 * t127 + 0.1338774000e11 * t34 * t15 * t131 + 0.3790140862e14 * t134 * T * t69 - 0.3730008441e16 * t138 * t139 + 0.1065716712e16 * t138 * t142 - 0.1197449022e17 * t138 * t145;
4270phydbl t150 = B * t91;
4271phydbl t153 = t12 * t78;
4272phydbl t156 = t25 * t57;
4273phydbl t159 = t34 * t85;
4274phydbl t162 = t24 * t12;
4275phydbl t163 = t162 * t3;
4276phydbl t166 = t34 * A;
4277phydbl t169 = t24 * t3;
4278phydbl t172 = t25 * t3;
4279phydbl t175 = t34 * t57;
4280phydbl t178 = t34 * t3;
4281phydbl t181 = B * A;
4282phydbl t184 = B * t78;
4283phydbl t187 = B * t3;
4284phydbl t190 = B * t57;
4285phydbl t193 = B * t85;
4286phydbl t196 = t24 * t34;
4287phydbl t197 = t196 * A;
4288phydbl t200 = t24 * A;
4289phydbl t203 = 0.1368513200e16 * t138 * t150 - 0.4789796130e16 * t138 * t153 + 0.9579592368e16 * t138 * t156 + 0.9579592019e16 * t138 * t159 - 0.4789796148e16 * t138 * t163 + 0.6456120000e14 * t90 * t166 - 0.1780077270e16 * t68 * t169 - 0.4005331107e16 * t64 * t172 + 0.2373436550e16 * t68 * t175 - 0.5114963006e15 * t72 * t178 + 0.1197000000e13 * t84 * t181 - 0.1335110261e16 * t64 * t184 - 0.1115603000e14 * t77 * t187 + 0.6455912700e14 * t90 * t190 + 0.7120309141e15 * t68 * t193 + 0.1368513201e16 * t138 * t197 + 0.1291400000e13 * t77 * t200;
4290phydbl t204 = t12 * A;
4291phydbl t207 = t12 * t85;
4292phydbl t210 = t12 * t3;
4293phydbl t213 = t12 * t7;
4294phydbl t217 = t12 * t13;
4295phydbl t221 = t12 * t57;
4296phydbl t224 = t12 * t75;
4297phydbl t232 = t12 * t14;
4298phydbl t236 = t12 * t88;
4299phydbl t240 = t12 * t58;
4300phydbl t249 = B * t58;
4301phydbl t252 = t25 * A;
4302phydbl t257 = t34 * t58;
4303phydbl t260 = 0.1115831100e14 * t77 * t204 + 0.4005330927e16 * t64 * t207 - 0.9683950000e14 * t90 * t210 - 0.3946635700e14 * t213 * t9 * t59 + 0.2354776600e14 * t217 * t18 * t91 + 0.5114971000e15 * t72 * t221 - 0.7991390000e12 * t224 * t76 * t58 + 0.1481000000e12 * t12 * t82 * t83 * t57 - 0.1001680000e14 * t232 * t19 * t78 + 0.3232259000e13 * t236 * t89 * t85 - 0.1780077100e16 * t68 * t240 - 0.1933540000e11 * t12 * t15 * t20 * t3 + 0.1300000000e10 * t204 * t94 - 0.2557472700e15 * t72 * t249 + 0.7120305100e15 * t68 * t252 + 0.2557476700e15 * t72 * t200 - 0.6675552600e16 * t64 * t257;
4304phydbl t263 = t24 * t57;
4305phydbl t266 = t162 * A;
4306phydbl t269 = t34 * t78;
4307phydbl t272 = t162 * t57;
4308phydbl t281 = B * t13;
4309phydbl t285 = B * t14;
4310phydbl t289 = B * t88;
4311phydbl t293 = B * t75;
4312phydbl t297 = t85 * t24;
4313phydbl t300 = t196 * t3;
4314phydbl t303 = B * t29;
4315phydbl t311 = B * t82;
4316phydbl t315 = B * t15;
4317phydbl t321 = 0.6675550630e16 * t64 * t263 + 0.1335110310e16 * t64 * t266 - 0.2486672290e16 * t138 * t269 + 0.2486672264e16 * t138 * t272 - 0.7580281740e13 * t118 * T * t65 + 0.8770300400e13 * t8 * t9 * t69 - 0.5886921000e13 * t281 * t18 * t59 + 0.2861957000e13 * t285 * t19 * t91 - 0.1077430000e13 * t289 * t89 * t78 + 0.3195000000e12 * t293 * t76 * t85 + 0.3730008390e16 * t138 * t297 - 0.1065716699e16 * t138 * t300 - 0.1395750000e10 * t303 * t31 * t3 + 0.152478000e9 * B * t35 * t37 * A - 0.7417900000e11 * t311 * t83 * t58 + 0.1310000000e11 * t315 * t20 * t57 + 0.1971235000e14 * t90 * t200;
4318phydbl t354 = -0.4879631000e15 * t68 * t172 - 0.9734606000e15 * t64 * t163 + 0.8132711424e15 * t68 * t263 - 0.1652248000e15 * t72 * t169 + 0.6575580000e12 * t84 * t204 - 0.9734607070e15 * t64 * t153 - 0.3000000000e10 * t12 + 0.1000000000e10 * t57 + 0.7331618000e14 * t72 * t263 - 0.1244100000e14 * t90 * t169 - 0.1253983358e17 * t210 * t68 + 0.3439800000e11 * t100 * t204 - 0.1144586120e15 * t68 * t153 + 0.3942690000e14 * t90 * t221 - 0.6457200000e13 * t77 * t210 - 0.2050264784e17 * t249 * t64 + 0.8359887000e16 * t190 * t68;
4319phydbl t360 = t24 * t24;
4320phydbl t361 = t360 * A;
4321phydbl t366 = t360 * t12;
4322phydbl t367 = t366 * A;
4323phydbl t374 = t360 * B;
4324phydbl t381 = t34 * u;
4325phydbl t397 = 0.2929910910e15 * t181 * t90 + 0.4879629976e15 * t68 * t207 + 0.2664291701e15 * t138 * t361 + 0.9444444500e18 * t181 * t138 + 0.7580281461e13 * t367 * t138 + 0.5833333338e18 * t204 * t138 + 0.2460317400e18 * t181 * t64 + 0.200000e6 * t374 - 0.200000e6 * t69 + 0.100000000e9 * t24 + 0.2222222150e18 * A * t7 * t9 - 0.1944444438e18 * t381 * T - 0.3224206410e17 * t281 * t18 - 0.6398809530e17 * t24 * u * T - 0.1755952430e17 * t217 * t18 - 0.1230158726e18 * t3 * t7 * t9 + 0.3224206250e17 * A * t13 * t18;
4326phydbl t444 = 0.1944444429e18 * t57 * u * T - 0.1755952280e17 * t3 * t13 * t18 + 0.4894179970e17 * t57 * t7 * t9 - 0.3339945030e16 * t285 * t19 - 0.4894180056e17 * t110 * t9 - 0.4722222240e18 * t134 * T + 0.8333333350e18 * A * u * T - 0.8333333400e18 * t118 * T + 0.3339946425e16 * A * t14 * t19 - 0.6398809540e17 * t58 * u * T + 0.4100529100e16 * t85 * t7 * t9 - 0.1464959090e15 * t3 * t88 * t89 + 0.6839256369e15 * t57 * t14 * t19 - 0.4238315719e16 * t78 * u * T - 0.1897556340e14 * t293 * t76 - 0.4238315750e16 * t162 * u * T - 0.2089971880e16 * t24 * t13 * t18;
4327phydbl t448 = t34 * t14;
4328phydbl t478 = t360 * t3;
4329phydbl t481 = t162 * t58;
4330phydbl t490 = -0.6839241185e15 * t448 * t19 - 0.4100529178e16 * t25 * t7 * t9 - 0.1464966800e15 * t236 * t89 + 0.1769179920e17 * t85 * u * T - 0.1797238280e16 * t3 * t14 * t19 + 0.2747601900e15 * A * t88 * t89 - 0.1547619080e17 * t58 * t7 * t9 + 0.6812170220e16 * t57 * t13 * t18 - 0.2747571750e15 * t289 * t89 - 0.1547619200e17 * t24 * t7 * t9 - 0.20000000e8 * t25 - 0.30000000e8 * t85 - 0.2114391104e15 * t138 * t478 - 0.9867158400e15 * t138 * t481 + 0.2050264696e17 * t200 * t64 + 0.2542989412e17 * t252 * t138 - 0.6357473500e17 * t240 * t138;
4331phydbl t507 = t59 * B;
4332phydbl t510 = t12 * t59;
4333phydbl t513 = B * t69;
4334phydbl t520 = t25 * t78;
4335phydbl t523 = t25 * t85;
4336phydbl t530 = 0.2508160000e12 * t84 * t190 - 0.1466339000e14 * t72 * t184 + 0.4976610000e13 * t90 * t193 + 0.3270245000e14 * t68 * t150 - 0.3450000000e11 * t100 * t187 - 0.1291300000e13 * t77 * t249 + 0.2074777207e15 * t64 * t142 - 0.7261721108e15 * t64 * t139 - 0.5186943795e14 * t64 * t507 - 0.2114391078e15 * t138 * t510 + 0.4698646924e14 * t138 * t513 + 0.3070300000e10 * t94 * t181 - 0.4841145120e15 * t64 * t269 - 0.3183718246e15 * t520 * t138 + 0.2210116600e15 * t523 * t64 - 0.8241728800e14 * t139 * t68 + 0.2003340000e14 * t156 * t72;
4337phydbl t553 = t19 * t85;
4338phydbl t559 = -0.3232400000e13 * t172 * t90 + 0.3196000000e12 * t252 * t77 + 0.4841147005e15 * t64 * t272 + 0.7261720740e15 * t64 * t297 - 0.1626544080e15 * t281 * t115 + 0.4303517000e13 * t293 * t123 - 0.3000000e7 * t360 - 0.3000000e7 * t59 - 0.17000000e8 * t196 - 0.4399012000e14 * t72 * t172 - 0.1144586200e15 * t68 * t163 - 0.48000e5 * t366 - 0.20000e5 * t65 + 0.2003375000e14 * t448 * t553 - 0.10000000e8 * t78 - 0.50000000e8 * t162 + 0.8000000e7 * t91;
4339phydbl t561 = t59 * t58;
4340phydbl t574 = A * t82;
4341phydbl t577 = t85 * t13;
4342phydbl t580 = t3 * t75;
4343phydbl t586 = t58 * t14;
4344phydbl t589 = t57 * t88;
4345phydbl t602 = -0.100000e6 * t367 - 0.1420e4 * t561 - 0.4325330800e13 * t510 * t68 - 0.1797236000e16 * t232 * t19 - 0.6812172380e16 * t114 * t18 - 0.1769179896e17 * t25 * u * T - 0.1230158720e18 * t213 * t9 + 0.1136992000e13 * t574 * t83 + 0.5357388956e15 * t577 * t18 - 0.1004312000e14 * t580 * t76 + 0.8983686054e15 * t91 * u * T - 0.2049036000e15 * t586 * t19 + 0.5490979267e14 * t589 * t89 - 0.9402891770e15 * t78 * t7 * t9 - 0.1136811000e13 * t311 * t83 - 0.5490960000e14 * t106 * t89 - 0.9402891530e15 * t162 * t7 * t9;
4346phydbl t644 = -0.2049024100e15 * t24 * t14 * t19 - 0.5357393770e15 * t25 * t13 * t18 - 0.8983686060e15 * t196 * u * T - 0.1004260240e14 * t224 * t76 + 0.1897544000e14 * A * t75 * t76 - 0.2089971420e16 * t58 * t13 * t18 - 0.5984000000e12 * t84 * t12 - 0.1907300810e15 * t64 * t196 - 0.5114985270e14 * t72 * t25 - 0.1614025000e14 * t90 * t24 - 0.1186717058e15 * t68 * t162 - 0.3719300000e13 * t77 * t34 - 0.6049800000e11 * t100 * B - 0.1186716997e15 * t68 * t78 + 0.3719150000e13 * t77 * t57 - 0.1614009620e14 * t90 * t58 + 0.1907300700e15 * t64 * t91;
4347phydbl t655 = t360 * t34;
4348phydbl t686 = -0.5983807300e12 * t84 * t3 + 0.5114970240e14 * t72 * t85 + 0.6059000000e11 * t100 * A - 0.1710641462e15 * t138 * t59 - 0.1710641438e15 * t138 * t360 - 0.6891165120e12 * t655 * u * T - 0.8770302200e12 * t366 * t7 * t9 - 0.6541040000e12 * t374 * t13 * t18 - 0.3577404000e12 * t360 * t14 * t19 - 0.1539200000e12 * t196 * t88 * t89 - 0.4698646953e13 * t138 * t65 - 0.4087803000e13 * t68 * t360 - 0.4698647004e13 * t138 * t366 - 0.5328500000e11 * t162 * t75 * t76 - 0.6280000000e11 * t84 * t24 - 0.2094778000e13 * t72 * t196 - 0.1159280000e11 * t100 * t34;
4349phydbl t723 = -0.8294300000e12 * t90 * t162 + 0.2583700000e12 * t77 * t85 - 0.6265560000e11 * t84 * t58 + 0.1149330000e11 * t100 * t57 - 0.4087804000e13 * t68 * t59 - 0.5763269898e13 * t64 * t374 - 0.8293904000e12 * t90 * t78 - 0.2582655100e12 * t77 * t25 - 0.1521060000e10 * t94 * t12 - 0.1510800000e10 * t94 * t3 + 0.85420000e8 * t97 * A + 0.2094757500e13 * t72 * t91 - 0.78510000e8 * t97 * B + 0.5763268400e13 * t64 * t69 - 0.3476645600e14 * t64 * t360 - 0.2192000000e12 * t84 * t34 - 0.1481620000e11 * t25 * t82 * t83;
4350phydbl t752 = A * t29;
4351phydbl t760 = -0.1101512460e14 * t72 * t162 - 0.1076151000e13 * t77 * t24 - 0.2323633800e14 * t68 * t196 - 0.3942769100e13 * t90 * t25 - 0.3179650000e11 * t100 * t12 - 0.2960324185e14 * t138 * t374 - 0.1101515600e14 * t72 * t78 + 0.2192784000e12 * t84 * t57 - 0.3476645322e14 * t64 * t59 + 0.3942680000e13 * t90 * t85 - 0.1076127000e13 * t77 * t58 + 0.2323633627e14 * t68 * t91 - 0.2880000000e10 * t303 * t31 - 0.3137962000e11 * t100 * t3 + 0.2840510000e10 * t752 * t31 + 0.2960324165e14 * t138 * t69 - 0.9682000000e10 * t196 * t75 * t76;
4352phydbl t765 = t360 * t24;
4353phydbl t814 = -0.9396930200e11 * t765 * u * T - 0.9611875000e11 * t366 * t13 * t18 - 0.5556330000e11 * t374 * t14 * t19 - 0.1234481500e12 * t655 * t7 * t9 - 0.2563440000e11 * t360 * t88 * t89 - 0.2994200000e10 * t162 * t82 * t83 + 0.1234481600e12 * t60 * t7 * t9 - 0.2563300000e11 * t59 * t88 * t89 + 0.5556248000e11 * t69 * t14 * t19 - 0.9396930200e11 * t561 * u * T + 0.9689500000e10 * t91 * t75 * t76 - 0.9611880000e11 * t65 * t13 * t18 - 0.3021580000e10 * t78 * t82 * t83 + 0.763720000e9 * t85 * t15 * t20 - 0.129241000e9 * t58 * t29 * t31 + 0.7383500e7 * t57 * t35 * t37;
4354phydbl t829 = t374 * t3;
4355phydbl t842 = t374 * A;
4356phydbl t853 = -0.5600000e7 * t3 * t16 * t21 - 0.3213600e7 * A * t40 * t42 - 0.5833333350e18 * t187 * t138 + 0.4304200000e13 * t77 * t166 + 0.1946921629e16 * t64 * t159 + 0.2559523820e18 * t190 * t138 - 0.3790140882e14 * t829 * t138 + 0.3511906000e17 * t181 * t68 + 0.2202988200e15 * t72 * t175 - 0.1468254070e18 * t187 * t64 - 0.3942732000e14 * t90 * t178 - 0.8132711000e15 * t68 * t257 + 0.8770302700e13 * t842 * t64 - 0.3839285591e18 * t210 * t138 + 0.1468253985e18 * t204 * t64 + 0.2559523810e18 * t166 * t138 + 0.1626542320e15 * t68 * t266;
4357phydbl t871 = t360 * t57;
4358phydbl t880 = t196 * t58;
4359phydbl t891 = -0.1652248000e15 * t72 * t240 + 0.1946921488e16 * t64 * t156 - 0.2433651484e16 * t64 * t145 + 0.6609041000e14 * t72 * t252 + 0.2781316600e15 * t64 * t197 - 0.2043651325e17 * t187 * t68 + 0.3594474817e16 * t181 * t72 + 0.6190476200e17 * t190 * t64 + 0.1137042247e15 * t871 * t138 - 0.3946636500e14 * t478 * t64 - 0.1769179894e18 * t178 * t138 + 0.5886927000e13 * t361 * t68 - 0.2274084525e15 * t880 * t138 - 0.9285714360e17 * t210 * t64 + 0.2043651805e17 * t204 * t68 + 0.1769179900e18 * t221 * t138 - 0.8845899000e17 * t249 * t138;
4360phydbl t898 = t162 * t85;
4361phydbl t901 = t196 * t57;
4362phydbl t928 = 0.8845899300e17 * t200 * t138 + 0.6190475974e17 * t166 * t64 + 0.2861967000e13 * t197 * t72 + 0.3183718369e15 * t898 * t138 + 0.1052436420e15 * t901 * t64 - 0.2354776200e14 * t300 * t68 + 0.2583300000e13 * t77 * t221 + 0.4399010000e14 * t72 * t207 - 0.3755200000e12 * t84 * t210 + 0.2509100000e12 * t84 * t166 + 0.5186945270e14 * t64 * t361 + 0.2542989379e17 * t193 * t138 - 0.2051769370e16 * t187 * t72 + 0.2289169200e15 * t68 * t159 + 0.2051768000e16 * t204 * t72 + 0.2289167900e15 * t68 * t156 - 0.1244097000e14 * t90 * t240;
4363phydbl t947 = t34 * t91;
4364phydbl t958 = t24 * t78;
4365phydbl t967 = 0.1466349000e14 * t72 * t266 - 0.7331650000e14 * t72 * t257 - 0.2583029000e13 * t77 * t178 + 0.1658907000e14 * t90 * t175 - 0.1841763540e15 * t481 * t64 + 0.5494474200e14 * t272 * t68 - 0.4100529010e17 * t178 * t64 - 0.6357473383e17 * t169 * t138 + 0.5638376416e15 * t138 * t947 + 0.3270242900e14 * t68 * t197 + 0.4976387700e13 * t90 * t252 + 0.4100529000e17 * t221 * t64 - 0.2861462400e15 * t68 * t145 - 0.9867158433e15 * t138 * t958 + 0.8476631585e17 * t175 * t138 + 0.1184059034e16 * t138 * t523 + 0.8359888510e16 * t166 * t68;
4366phydbl t978 = t65 * B;
4367phydbl t985 = B * t60;
4368phydbl t992 = t59 * t34;
4369phydbl t995 = t24 * t59;
4370phydbl t998 = t69 * t12;
4371phydbl t1001 = t34 * t69;
4372phydbl t1006 = 0.4698646863e14 * t138 * t842 - 0.1001659000e14 * t163 * t72 + 0.1077350000e13 * t266 * t90 + 0.5638376400e15 * t138 * t901 - 0.360000e6 * t880 + 0.10000e5 * t60 - 0.1357930100e13 * t978 * t64 + 0.9611860000e12 * t513 * t68 + 0.2050665000e12 * t150 * t90 + 0.1127631630e13 * t985 * t138 - 0.5000541000e12 * t507 * t72 + 0.2000230000e13 * t142 * t72 - 0.2036894700e14 * t992 * t64 - 0.4651480740e14 * t995 * t138 + 0.6789651000e13 * t998 * t64 + 0.2067324610e14 * t1001 * t138 + 0.1153425500e14 * t947 * t68;
4373phydbl t1008 = t91 * t24;
4374phydbl t1011 = t25 * t91;
4375phydbl t1014 = t12 * t65;
4376phydbl t1070 = 0.4073788600e14 * t1008 * t64 + 0.7442369200e14 * t1011 * t138 - 0.6201974310e13 * t1014 * t138 + 0.1809000000e11 * t85 * t82 * t83 * B + 0.7000817000e13 * t85 * t14 * t19 * t24 + 0.1435633000e13 * t85 * t88 * t89 * t34 + 0.2422191000e14 * t577 * t18 * t25 + 0.2034000000e12 * t85 * t75 * t76 * t12 - 0.54366000e8 * t3 * t35 * t37 * B - 0.4510900000e11 * t3 * t82 * t83 * t24 - 0.7466500000e10 * t3 * t15 * t20 * t34 - 0.2035185700e12 * t580 * t76 * t25 - 0.1040000000e10 * t3 * t29 * t31 * t12 - 0.4514750000e11 * t58 * t82 * t83 * t12 + 0.612330000e9 * t57 * t29 * t31 * B - 0.7000850000e13 * t586 * t19 * t25 - 0.3850000000e10 * t58 * t15 * t20 * B;
4377phydbl t1124 = 0.7537400000e10 * t57 * t15 * t20 * t12 - 0.3386100000e12 * t58 * t75 * t76 * t34 - 0.1794360000e13 * t58 * t88 * t89 * t24 + 0.5995720000e11 * t57 * t82 * t83 * t34 + 0.3388054000e12 * t57 * t75 * t76 * t24 + 0.1435490000e13 * t589 * t89 * t25 + 0.16000000e8 * A * t16 * t21 * B + 0.3773240000e10 * A * t15 * t20 * t24 + 0.692700000e9 * t752 * t31 * t34 + 0.1795620000e11 * t574 * t83 * t25 + 0.79693000e8 * A * t35 * t37 * t12 - 0.1971335000e14 * t289 * t107 - 0.2074777361e15 * t64 * t300 + 0.8241726800e14 * t297 * t68 - 0.2504208000e14 * t145 * t72 + 0.2274084510e15 * t1008 * t138 - 0.1841763400e15 * t958 * t64;
4378phydbl t1162 = 0.5386800000e13 * t263 * t90 - 0.7989000000e12 * t169 * t77 + 0.5641734828e16 * t193 * t64 + 0.7417430000e11 * t200 * t84 - 0.1137042238e15 * t381 * t119 + 0.8196118110e15 * t190 * t72 - 0.1647262473e15 * t187 * t90 - 0.6288580100e16 * t184 * t138 + 0.2008619000e14 * t181 * t77 - 0.5357392640e16 * t178 * t68 - 0.6579000000e12 * t311 * t127 + 0.2781316526e15 * t8 * t111 + 0.1880578242e17 * t175 * t64 - 0.1886574102e17 * t172 * t138 - 0.1410433708e17 * t169 * t64 + 0.8196108200e15 * t166 * t72 - 0.1229418200e16 * t210 * t72;
4379phydbl t1194 = 0.1886574129e17 * t207 * t138 + 0.1647291050e15 * t204 * t90 + 0.5357390500e16 * t221 * t68 - 0.1410433708e17 * t240 * t64 - 0.2678697000e16 * t249 * t68 + 0.5641735040e16 * t252 * t64 + 0.2678700000e16 * t200 * t68 + 0.3144290150e17 * t263 * t138 - 0.3144290124e17 * t257 * t138 + 0.6288580291e16 * t266 * t138 + 0.6609036000e14 * t285 * t553 + 0.6340000000e11 * t315 * t131 + 0.1000000e7 * t871 + 0.2300000e7 * t898 - 0.4000000e7 * t520 + 0.220000e6 * t162 * t91 - 0.140000e6 * t374 * t58;
4380phydbl t1224 = -0.40000e5 * t366 * t57 - 0.180000e6 * t360 * t85 + 0.1000e4 * t655 * t3 + 0.990e3 * t765 * A - 0.211100e6 * t196 * t78 - 0.30000e5 * t65 * t34 + 0.133900e6 * t69 * t24 + 0.20860e5 * t60 * t12 + 0.254000e6 * t59 * t25 - 0.1020e4 * t561 * B + 0.600000e6 * t995 - 0.20000e5 * t513 - 0.200000e6 * t1001 + 0.117000e6 * t1014 - 0.22790e5 * t985 - 0.28500e5 * t40 * t42 - 0.114000000e9 * t97;
4381phydbl t1235 = t162 * t78;
4382phydbl t1250 = t196 * t85;
4383phydbl t1259 = t366 * t3;
4384phydbl t1262 = -0.101e3 * t360 * t25 + 0.76e2 * t59 * t85 + 0.5703305000e14 * t898 * t64 - 0.7175350000e12 * t163 * t90 + 0.4667200000e13 * t272 * t72 - 0.8682763800e14 * t1235 * t138 - 0.4325349000e13 * t478 * t68 + 0.6776140000e11 * t266 * t77 - 0.2018495000e14 * t481 * t68 - 0.4073788100e14 * t880 * t64 + 0.1153425000e14 * t901 * t68 + 0.2050823000e12 * t197 * t90 + 0.7442369200e14 * t1250 * t138 - 0.2000230000e13 * t300 * t72 + 0.5000544000e12 * t361 * t72 - 0.6789650400e13 * t829 * t64 - 0.6201974000e13 * t1259 * t138;
4385phydbl t1277 = t360 * t58;
4386phydbl t1296 = 0.2036894600e14 * t871 * t64 + 0.2067324700e14 * t374 * t57 * t138 + 0.9611900000e12 * t842 * t68 + 0.1357930000e13 * t367 * t64 + 0.1127631640e13 * t655 * A * t138 - 0.4651480610e14 * t1277 * t138 - 0.6775000000e11 * t184 * t77 - 0.2018493300e14 * t958 * t68 - 0.4667170000e13 * t269 * t72 - 0.5703305700e14 * t520 * t64 - 0.7176804000e12 * t153 * t90 + 0.300000e6 * t978 - 0.10000e5 * t655 - 0.1900e4 * t765 - 0.170000e6 * t829 - 0.2747570000e15 * t90 - 0.3224206200e17 * t68;
4387phydbl t1314 = 0.1000000000e10 * t210 - 0.5246000e7 * t103 - 0.2222222269e18 * t64 - 0.100000000e9 * t200 + 0.400000000e9 * t249 - 0.3339948000e16 * t72 - 0.30000e5 * t1259 + 0.1000000000e10 * t221 - 0.200000000e9 * t252 - 0.200000000e9 * t169 - 0.100000000e9 * t193 + 0.270000000e9 * t240 + 0.100000000e9 * t257 - 0.100000000e9 * t263 - 0.210000000e9 * t207 + 0.40000000e8 * t172 + 0.20000000e8 * t266;
4388phydbl t1333 = 0.30000000e8 * t184 - 0.1897466160e14 * t77 - 0.1137580000e13 * t84 + 0.5000000e7 * t150 - 0.1000000e7 * t947 - 0.25000000e8 * t481 + 0.510000e6 * t1277 - 0.20000000e8 * t145 - 0.200000e6 * t478 + 0.1000000e7 * t901 + 0.20000000e8 * t163 - 0.130000000e9 * t156 - 0.700000e6 * t842 - 0.25000000e8 * t523 + 0.31000000e8 * t958 + 0.20000000e8 * t153 - 0.6034000000e11 * t100;
4389phydbl t1354 = 0.1000000e7 * t1250 - 0.2889000000e10 * t94 - 0.600000e6 * t1235 - 0.8333333300e18 * t138 + 0.700000e6 * t1011 - 0.351766e6 * t15 * t88 * t20 * t89 + 0.29000000e8 * t139 - 0.1000000e7 * t361 - 0.2000000e7 * t300 + 0.20000000e8 * t272 - 0.70000000e8 * t297 + 0.21000000e8 * t142 - 0.1000000e7 * t507 - 0.994000e6 * t992 - 0.130000e6 * t998 - 0.1000000000e10 * t34 - 0.3000000000e10 * t3;
4390*var = -0.1000000000e-18 * t2 * (t891 + t853 + t1296 + t81 + t1070 + t928 + t1314 + t148 + t760 + t203 + t814 + t1224 + t686 + t1354 + t1162 + t321 + t1006 + t559 + t530 + t967 + t260 + t397 + t1262 + t644 + t1333 + t1194 + t354 + t602 + t1124 + t723 + t490 + t444);
4391
4392}
4393
4394//////////////////////////////////////////////////////////////
4395//////////////////////////////////////////////////////////////
4396
4397int Sample_i_With_Proba_pi(phydbl *pi, int len)
4398{
4399  phydbl *cum_pi;
4400  int i;
4401  phydbl u;
4402
4403  cum_pi = (phydbl *)mCalloc(len,sizeof(phydbl));
4404 
4405  For(i,len) cum_pi[i] = pi[i];
4406  for(i=1;i<len;i++) cum_pi[i] += cum_pi[i-1];
4407
4408  if((cum_pi[i-1] > 1. + 1.E-10) || (cum_pi[i-1] < 1. - 1.E-10))
4409    {
4410      PhyML_Printf("\n== Sum of probabilities is different from 1.0.");
4411      PhyML_Printf("\n== Err. in file %s at line %d\n",__FILE__,__LINE__);
4412      Exit("\n");
4413    }
4414
4415  i = 0;
4416  u = Uni();
4417  For(i,len) if(cum_pi[i] > u) break;
4418
4419  if(i == len)
4420    {
4421      PhyML_Printf("\n== Len = %d",len);
4422      PhyML_Printf("\n== Err. in file %s at line %d\n",__FILE__,__LINE__);
4423      Exit("\n");
4424    }
4425  Free(cum_pi);
4426
4427  return(i);
4428}
4429
4430//////////////////////////////////////////////////////////////
4431//////////////////////////////////////////////////////////////
4432
4433// Return the value y such that Prob(x<y) = p
4434phydbl Quantile(phydbl *x, int len, phydbl p)
4435{
4436  phydbl *y,q;
4437  int i;
4438  int swap;
4439  phydbl buff;
4440
4441  y = (phydbl *)mCalloc(len,sizeof(phydbl));
4442  For(i,len) y[i] = x[i];
4443
4444  do
4445    {
4446      swap = NO;
4447      For(i,len-1) 
4448        {
4449          if(y[i+1] < y[i])
4450            {
4451              swap = YES;
4452
4453              buff = y[i+1];
4454              y[i+1] = y[i];
4455              y[i] = buff;
4456            }
4457        }
4458    }
4459  while(swap == YES);
4460 
4461  q = y[(int)((len-1)*p)];
4462
4463  Free(y);
4464
4465  return(q);
4466
4467}
4468
4469
4470//////////////////////////////////////////////////////////////
4471//////////////////////////////////////////////////////////////
4472
4473// Return p such that Prob(x<z) = p
4474phydbl Prob(phydbl *x, int len, phydbl z)
4475{
4476  int i;
4477  phydbl hit;
4478
4479  hit = 0.;
4480  For(i,len) if(x[i] < z) hit+=1.;
4481
4482  return(hit/(phydbl)len);
4483
4484}
4485
4486//////////////////////////////////////////////////////////////
4487//////////////////////////////////////////////////////////////
4488
4489// Return x  where mu is the first moment of the normal density
4490// and x is the value such that f(x;mu,sigma)=y
4491
4492phydbl Inverse_Truncated_Normal(phydbl y, phydbl mu, phydbl sigma, phydbl lim_inf, phydbl lim_sup)
4493{
4494  phydbl p_inf, p_sup;
4495 
4496  p_inf = Pnorm(lim_inf,mu,sigma);
4497  p_sup = Pnorm(lim_sup,mu,sigma);
4498
4499  /* return(mu + sigma * SQRT(-LOG( y * y * (p_sup - p_inf) * (p_sup - p_inf) * 2 * PI * sigma * sigma))); */
4500  return(mu + sigma * SQRT(-LOG( y * y * (p_sup - p_inf) * (p_sup - p_inf) * 2. * PI * sigma * sigma)));
4501}
4502
4503//////////////////////////////////////////////////////////////
4504//////////////////////////////////////////////////////////////
4505// Returns a vector with a permutation of all the integer from 0
4506// to len-1.
4507
4508int *Permutate(int len)
4509{
4510  int i,pos,tmp;
4511  int *x;
4512
4513  x = (int *)mCalloc(len,sizeof(int));
4514
4515  For(i,len) x[i] = i;
4516
4517  For(i,len)
4518    {
4519      pos = Rand_Int(0,len-1);
4520     
4521      tmp    = x[i];
4522      x[i]   = x[pos];
4523      x[pos] = tmp;
4524    }
4525
4526  return(x);
4527} 
4528 
4529//////////////////////////////////////////////////////////////
4530//////////////////////////////////////////////////////////////
4531// Returns the p-value for the Mantel test of correlation between
4532// matrices x and y.
4533
4534phydbl Mantel(phydbl *x, phydbl *y, int nrow, int ncol)
4535{ 
4536 
4537  phydbl obs_stat;  // Value of the statistic on the observed data
4538  phydbl mc_stat;   // Value of the statistics on the Monte Carlo generated data
4539  int N;
4540  phydbl sumx, sumy, sumxy, sumxx, sumyy;
4541  int i,j,k;
4542  int npermut;
4543  int *permut;
4544  phydbl p_val;
4545
4546  N = nrow*ncol;
4547
4548  sumx = .0;
4549  For(i,N) sumx += x[i];
4550
4551  sumy = .0;
4552  For(i,N) sumy += y[i];
4553
4554  sumxx = .0;
4555  For(i,N) sumxx += x[i]*x[i];
4556
4557  sumyy = .0;
4558  For(i,N) sumyy += y[i]*y[i];
4559
4560  sumxy = .0;
4561  For(i,N) sumxy += x[i]*y[i];
4562
4563  obs_stat = (N * sumxy - sumx * sumy) / (SQRT((N-1)*sumxx - (sumx/N)*(sumx/N)) * SQRT((N-1)*sumyy - (sumy/N)*(sumy/N)));
4564 
4565  npermut = 1000;
4566  p_val   = 0.0;
4567  For(k,npermut)
4568    {
4569      permut = Permutate(nrow);
4570
4571      sumxy = .0;
4572      For(i,nrow)
4573        {
4574          For(j,ncol)
4575            {
4576              sumxy += x[i*ncol+j] * y[permut[i]*ncol+permut[j]];
4577            }
4578        }
4579           
4580      mc_stat = (N * sumxy - sumx * sumy) / (SQRT((N-1)*sumxx - (sumx/N)*(sumx/N)) * SQRT((N-1)*sumyy - (sumy/N)*(sumy/N)));
4581
4582      Free(permut);
4583
4584      if(mc_stat > obs_stat) p_val += 1.;
4585    }
4586   
4587  return(p_val / (phydbl)npermut);
4588
4589}
4590
4591//////////////////////////////////////////////////////////////
4592//////////////////////////////////////////////////////////////
4593
4594phydbl Weighted_Mean(phydbl *x, phydbl *w, int l)
4595{
4596  int i;
4597  phydbl wm;
4598  wm = .0;
4599  For(i,l) wm += x[i]*w[i];
4600  return(wm);
4601}
4602
4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
4619
4620
Note: See TracBrowser for help on using the repository browser.