/*

PHYML :  a program that  computes maximum likelihood  phylogenies from
DNA or AA homologous sequences 

Copyright (C) Stephane Guindon. Oct 2003 onward

All parts of  the source except where indicated  are distributed under
the GNU public licence.  See http://www.opensource.org for details.

*/

#include "utilities.h"
#include "lk.h"
#include "optimiz.h"
#include "models.h"
#include "free.h"

/* int    LIM_SCALE; */
/* double LIM_SCALE_VAL; */
/* double MDBL_MAX; */
/* double MDBL_MIN; */

/*********************************************************/

void Init_Tips_At_One_Site_Nucleotides(char state, double **p_lk)
{
  switch(state){
  case 'A' : (*p_lk)[0]=1.; (*p_lk)[1]=(*p_lk)[2]=(*p_lk)[3]=.0;
    break;
  case 'C' : (*p_lk)[1]=1.; (*p_lk)[0]=(*p_lk)[2]=(*p_lk)[3]=.0;
    break;
  case 'G' : (*p_lk)[2]=1.; (*p_lk)[1]=(*p_lk)[0]=(*p_lk)[3]=.0;
    break;
  case 'T' : (*p_lk)[3]=1.; (*p_lk)[1]=(*p_lk)[2]=(*p_lk)[0]=.0;
    break;
  case 'U' : (*p_lk)[3]=1.; (*p_lk)[1]=(*p_lk)[2]=(*p_lk)[0]=.0;
    break;
  case 'M' : (*p_lk)[0]=(*p_lk)[1]=1.; (*p_lk)[2]=(*p_lk)[3]=.0;
    break;
  case 'R' : (*p_lk)[0]=(*p_lk)[2]=1.; (*p_lk)[1]=(*p_lk)[3]=.0;
    break;
  case 'W' : (*p_lk)[0]=(*p_lk)[3]=1.; (*p_lk)[1]=(*p_lk)[2]=.0;
    break;
  case 'S' : (*p_lk)[1]=(*p_lk)[2]=1.; (*p_lk)[0]=(*p_lk)[3]=.0;
    break;
  case 'Y' : (*p_lk)[1]=(*p_lk)[3]=1.; (*p_lk)[0]=(*p_lk)[2]=.0;
    break;
  case 'K' : (*p_lk)[2]=(*p_lk)[3]=1.; (*p_lk)[0]=(*p_lk)[1]=.0;
    break;
  case 'B' : (*p_lk)[1]=(*p_lk)[2]=(*p_lk)[3]=1.; (*p_lk)[0]=.0;
    break;
  case 'D' : (*p_lk)[0]=(*p_lk)[2]=(*p_lk)[3]=1.; (*p_lk)[1]=.0;
    break;
  case 'H' : (*p_lk)[0]=(*p_lk)[1]=(*p_lk)[3]=1.; (*p_lk)[2]=.0;
    break;
  case 'V' : (*p_lk)[0]=(*p_lk)[1]=(*p_lk)[2]=1.; (*p_lk)[3]=.0;
    break;
  case 'N' : case 'X' : case '?' : case 'O' : case '-' : 
    (*p_lk)[0]=(*p_lk)[1]=(*p_lk)[2]=(*p_lk)[3]=1.;break;
  default : 
    {
      printf("\n. Unknown character state : %c\n",state);
      Exit("\n. Init failed (check the data type)\n"); 
      break;
    }
  }
}

/*********************************************************/

void Init_Tips_At_One_Site_AA(char aa, double **p_lk)
{
  int i;

  For(i,20) (*p_lk)[i] = .0;

  switch(aa){
  case 'A' : (*p_lk)[0]= 1.; break;/* Alanine */
  case 'R' : (*p_lk)[1]= 1.; break;/* Arginine */
  case 'N' : (*p_lk)[2]= 1.; break;/* Asparagine */
  case 'D' : (*p_lk)[3]= 1.; break;/* Aspartic acid */
  case 'C' : (*p_lk)[4]= 1.; break;/* Cysteine */
  case 'Q' : (*p_lk)[5]= 1.; break;/* Glutamine */
  case 'E' : (*p_lk)[6]= 1.; break;/* Glutamic acid */ 
  case 'G' : (*p_lk)[7]= 1.; break;/* Glycine */
  case 'H' : (*p_lk)[8]= 1.; break;/* Histidine */ 
  case 'I' : (*p_lk)[9]= 1.; break;/* Isoleucine */
  case 'L' : (*p_lk)[10]=1.; break;/* Leucine */
  case 'K' : (*p_lk)[11]=1.; break;/* Lysine */
  case 'M' : (*p_lk)[12]=1.; break;/* Methionine */
  case 'F' : (*p_lk)[13]=1.; break;/* Phenylalanin */
  case 'P' : (*p_lk)[14]=1.; break;/* Proline */
  case 'S' : (*p_lk)[15]=1.; break;/* Serine */
  case 'T' : (*p_lk)[16]=1.; break;/* Threonine */
  case 'W' : (*p_lk)[17]=1.; break;/* Tryptophan */
  case 'Y' : (*p_lk)[18]=1.; break;/* Tyrosine */
  case 'V' : (*p_lk)[19]=1.; break;/* Valine */
    
  case 'B' : (*p_lk)[2]= 1.; break;/* Asparagine */
  case 'Z' : (*p_lk)[5]= 1.; break;/* Glutamine */

  case 'X' : case '?' : case '-' : For(i,20) (*p_lk)[i] = 1.; break;
  default : 
    {
      printf("\n. Unknown character state : %c\n",aa);
      Exit("\n. Init failed (check the data type)\n");  
      break;
    }
  }
}

/*********************************************************/

void Get_All_Partial_Lk(arbre *tree, edge *b_fcus, node *a, node *d)
{
  int i,j;
  double p1_lk1,p2_lk2;
  double ***p_lk,***p_lk_v1,***p_lk_v2;
  int catg,site;
  double ***Pij1,***Pij2;
  
  if(d->tax) return;
  else
    {
      int dir1,dir2;
      
      dir1=dir2=-1;
      For(i,3) if(d->v[i] != a) (dir1<0)?(dir1=i):(dir2=i);

      if(b_fcus->l < BL_MIN) b_fcus->l = BL_MIN;

      p_lk = 
	(d == b_fcus->left)?
	(b_fcus->p_lk_left):
	(b_fcus->p_lk_rght);
      
      p_lk_v1 = 
	(d == d->b[dir1]->left)?
	(d->b[dir1]->p_lk_rght):
	(d->b[dir1]->p_lk_left);
      
      p_lk_v2 = 
	(d == d->b[dir2]->left)?
	(d->b[dir2]->p_lk_rght):
	(d->b[dir2]->p_lk_left);
      
      Pij1 = d->b[dir1]->Pij_rr;
      Pij2 = d->b[dir2]->Pij_rr;
      
      For(catg,tree->mod->n_catg)
	{	  
	  For(site,tree->n_pattern)
	    {
	      For(i,tree->mod->ns) /*sort sum terms ? No global effect*/
		{
		  p1_lk1 = p2_lk2 = .0;
		  For(j,tree->mod->ns)
		    {
		      p1_lk1 += (Pij1[catg][i][j] * p_lk_v1[site][catg][j]);
		      p2_lk2 += (Pij2[catg][i][j] * p_lk_v2[site][catg][j]);
		    }

		  p_lk[site][catg][i] = p1_lk1*p2_lk2;

		  
		  if(p_lk[site][catg][i] < MDBL_MIN) 
		    {
		      printf("\nWARNING : scaling is required at site %d\n",site);
		      /* 	  printf("Alpha = %f\n",tree->mod->alpha); */
		      /* 	  Exit(""); */
		    }
		}
	    }
	}
   
    }
}

/*********************************************************/

void Get_All_Partial_Lk_Scale(arbre *tree, edge *b_fcus, node *a, node *d)
{
  int i,j;
  double p1_lk1,p2_lk2;
  double ***p_lk,***p_lk_v1,***p_lk_v2;
  int catg,site;
  double ***Pij1,***Pij2;
  double max_p_lk;
/*   double min_p_lk; */
  double sum_scale_d1,sum_scale_d2;
  double try;
  
  p1_lk1 = p2_lk2 = .0;
  if(d->tax) return;
  else
    {
      int dir1,dir2;
      
      dir1=dir2=-1;
      For(i,3) if(d->v[i] != a) (dir1<0)?(dir1=i):(dir2=i);

      if(b_fcus->l < BL_MIN) b_fcus->l = BL_MIN;

      p_lk = 
	(d == b_fcus->left)?
	(b_fcus->p_lk_left):
	(b_fcus->p_lk_rght);
      
      p_lk_v1 = 
	(d == d->b[dir1]->left)?
	(d->b[dir1]->p_lk_rght):
	(d->b[dir1]->p_lk_left);
      
      p_lk_v2 = 
	(d == d->b[dir2]->left)?
	(d->b[dir2]->p_lk_rght):
	(d->b[dir2]->p_lk_left);
      
      Pij1 = d->b[dir1]->Pij_rr;
      Pij2 = d->b[dir2]->Pij_rr;

      

      For(site,tree->n_pattern)
	{	  
	  sum_scale_d1 = sum_scale_d2 = .0;

	  (d == d->b[dir1]->left)?
	    (sum_scale_d1 = d->b[dir1]->sum_scale_f_rght[site]):
	    (sum_scale_d1 = d->b[dir1]->sum_scale_f_left[site]);
	  
	  (d == d->b[dir2]->left)?
	    (sum_scale_d2 = d->b[dir2]->sum_scale_f_rght[site]):
	    (sum_scale_d2 = d->b[dir2]->sum_scale_f_left[site]);

	  (d == b_fcus->left)?
	    (b_fcus->sum_scale_f_left[site] = sum_scale_d1 + sum_scale_d2):
	    (b_fcus->sum_scale_f_rght[site] = sum_scale_d1 + sum_scale_d2);
	
/* 	  min_p_lk = MDBL_MAX; */
	  max_p_lk = MDBL_MIN;
	  For(catg,tree->mod->n_catg)
	    {
	      For(i,tree->mod->ns) /*sort sum terms ? No global effect*/
		{
		  p1_lk1 = p2_lk2 = .0;
		  For(j,tree->mod->ns)
		    {
		      p1_lk1 += (Pij1[catg][i][j] * p_lk_v1[site][catg][j]);
		      p2_lk2 += (Pij2[catg][i][j] * p_lk_v2[site][catg][j]);
		    }
		  
		  try = p1_lk1*p2_lk2;
		  
		  p_lk[site][catg][i]=try;

		  if((p_lk[site][catg][i] > max_p_lk)) max_p_lk = p_lk[site][catg][i];

/* 		  if((p_lk[site][catg][i] < min_p_lk)) min_p_lk = p_lk[site][catg][i]; */
		}
	    }

	  
	  if(max_p_lk < LIM_SCALE_VAL)
	    {
	      For(catg,tree->mod->n_catg)
		{
		  For(i,tree->mod->ns)
		    {
		      p_lk[site][catg][i] /= max_p_lk;

		      if(p_lk[site][catg][i] > MDBL_MAX)
			{
			  Exit("\n. Numerical underflow ! (send me an e-mail : s.guindon@auckland.ac.nz)\n");
/*  			  p_lk[site][catg][i] = p_lk[site][catg-1][i] ; */
			}
		    }
		}

	      (d == b_fcus->left)?
		(b_fcus->sum_scale_f_left[site] += log(max_p_lk)):
		(b_fcus->sum_scale_f_rght[site] += log(max_p_lk));
	    }

	  if(max_p_lk > (1./LIM_SCALE_VAL))
	    {
	      For(catg,tree->mod->n_catg)
		{
		  For(i,tree->mod->ns)
		    {
		      p_lk[site][catg][i] /= max_p_lk;

		      if(p_lk[site][catg][i] < MDBL_MIN)
			{
			  Exit("\n. Numerical overflow ! (send me an e-mail : s.guindon@auckland.ac.nz)\n");
/*  			  p_lk[site][catg][i] = p_lk[site][catg-1][i] ; */
			}
		    }
		}

	      (d == b_fcus->left)?
		(b_fcus->sum_scale_f_left[site] += log(max_p_lk)):
		(b_fcus->sum_scale_f_rght[site] += log(max_p_lk));
	    }
	}
    }
}


/*********************************************************/

void Post_Order_Lk(node *pere, node *fils, arbre *tree)
{
  int i,dir1,dir2,dir3;

  dir1 = dir2 = dir3 = -1;

  if(fils->tax) return;
  else
    {
      For(i,3)
	{
	  if(fils->v[i] != pere)
	    {
	      Post_Order_Lk(fils,fils->v[i],tree);
	      if(dir1 < 0) dir1 = i;
	      else dir2 = i;
	    }
	  else dir3 = i;
	}

      (tree->n_otu > LIM_SCALE)?
	(Get_All_Partial_Lk_Scale(tree,fils->b[dir3],pere,fils)):
	(Get_All_Partial_Lk(tree,fils->b[dir3],pere,fils));
    }
}

/*********************************************************/

void Pre_Order_Lk(node *pere, node *fils, arbre *tree)
{
  int i,j,dir1,dir2;

  dir1 = dir2 = -1;
  
  if(fils->tax) return;
  else
    {
      For(i,3)
	{
	  if(fils->v[i] != pere)
	    {
	      For(j,3)
		{
		  if(j != i)
		    {
		      if(dir1 < 0) dir1 = j;
		      else dir2 = j;
		    }
		}
	      
	      (tree->n_otu > LIM_SCALE)?
	      (Get_All_Partial_Lk_Scale(tree,fils->b[i],fils->v[i],fils)):
	      (Get_All_Partial_Lk(tree,fils->b[i],fils->v[i],fils));
	      dir1 = dir2 = -1;
	      Pre_Order_Lk(fils,fils->v[i],tree);
	    }
	}
    }
}

/*********************************************************/

void Lk(arbre *tree,allseq *alldata)
{
  int br,site,catg;
  double len;

  Set_Model_Parameters(tree);
  
  For(br,2*tree->n_otu-3) 
    {
      For(site,tree->n_pattern)
	{
	  tree->t_edges[br]->sum_scale_f_rght[site] = .0;
	  tree->t_edges[br]->sum_scale_f_left[site] = .0;
	}

      
      if(tree->t_edges[br]->l < BL_MIN) tree->t_edges[br]->l = BL_MIN;

      if(tree->t_edges[br]->l > BL_MAX) tree->t_edges[br]->l = BL_MAX;



      For(catg,tree->mod->n_catg)
	{
	  len = tree->t_edges[br]->l*tree->mod->rr[catg];
	  if(len < BL_MIN) len = BL_MIN;

	  PMat(len,
	       tree->mod,
	       &tree->t_edges[br]->Pij_rr[catg]);
	  
	}
    }

  Post_Order_Lk(tree->noeud[0],tree->noeud[0]->v[0],tree);
  if(tree->both_sides)
    Pre_Order_Lk(tree->noeud[0],
		  tree->noeud[0]->v[0],
		  tree);

  tree->tot_loglk = .0;    
  tree->curr_catg =  0;
  tree->curr_site =  0;

  For(site,tree->n_pattern)
    {
      tree->tot_loglk_sorted[site] = .0;
      tree->site_lk[site]          = .0;
      tree->curr_site              = site;
      Site_Lk(tree,alldata);
    }

  qksort(tree->tot_loglk_sorted, 0, tree->n_pattern-1);
/*   qsort(tree->tot_loglk_sorted,tree->n_pattern,sizeof(double),Sort_Double_Decrease); */

  tree->tot_loglk = .0;
  For(site, tree->n_pattern)
    {
      if(tree->tot_loglk_sorted[site] < .0) /* WARNING : change cautiously */
	tree->tot_loglk += tree->tot_loglk_sorted[site];
    }


  For(br,2*tree->n_otu-3)
    {
      if(tree->t_edges[br]->get_p_lk_left) tree->t_edges[br]->ud_p_lk_left = 1;
      if(tree->t_edges[br]->get_p_lk_rght) tree->t_edges[br]->ud_p_lk_rght = 1;
    }
}

/*********************************************************/

void Site_Lk(arbre *tree, allseq *alldata)
{
  int j,k,l,m;
  double *site_dlk=NULL, *site_d2lk=NULL;
  double log_site_lk,site_lk,site_lk_previous,aux;
  int left;
  edge *eroot;
  int is_ambigu;
  int state_root, state_elsewhere, site = tree->curr_site;


  if(alldata->wght[site] < MDBL_MIN) 
    {
      tree->tot_loglk_sorted[tree->curr_site] = 1.; /* WARNING : change cautiously */ 
      return;
    }


  if(tree->mod->s_opt->opt_bl)
    {
      site_dlk = (double *)mCalloc(2*tree->n_otu-3,sizeof(double));
      site_d2lk = (double *)mCalloc(2*tree->n_otu-3,sizeof(double));
    }
  

  eroot = tree->noeud[0]->b[0];
  (eroot->rght->tax)?(left=1):(left=0);
  
/*   state = tree->data->invar[site]; */
  is_ambigu = alldata->ambigu[site];
  
  state_root = -1;
  state_root = Assign_State(alldata->c_seq[eroot->rght->num]->state + site,
			    tree->mod->datatype,
			    tree->mod->stepsize);

  state_elsewhere = -1;
  state_elsewhere = tree->data->invar[site];

  /**/
/*    is_ambigu = 1; */
  /**/
  

  if(tree->mod->s_opt->opt_bl)
    For(j,2*tree->n_otu-3) site_dlk[j] = site_d2lk[j] = 0.0;

  log_site_lk = site_lk = .0;      
  site_lk_previous = .0;

  For(j,tree->mod->n_catg)
    {
      if(is_ambigu)
	{
	  For(k,tree->mod->ns) /*sort sum terms ? No global effect*/
	    {
	      For(l,tree->mod->ns)
		{
		  site_lk += 
		    tree->mod->r_proba[j] *
		    tree->mod->pi[k] *
		    eroot->p_lk_left[site][j][k] *
		    eroot->Pij_rr[j][k][l] *
		    eroot->p_lk_rght[site][j][l];
		}
	    }
	}
      else
	{
	  For(k,tree->mod->ns) /*sort sum terms ? No global effect*/
	    {
	      site_lk +=
		tree->mod->r_proba[j] *
		tree->mod->pi[k] * 
		eroot->p_lk_left[site][j][k] *
		eroot->Pij_rr[j][k][state_root];	    
	    }
	}

      tree->log_site_lk_cat[j][tree->curr_site] = (site_lk/tree->mod->r_proba[j] - site_lk_previous);
      site_lk_previous = site_lk/tree->mod->r_proba[j];
      
      if(tree->mod->s_opt->opt_bl)
	{
	  For(k,2*tree->n_otu-3)
	    {  
	      tree->t_edges[k]->site_dlk_rr[j] = .0;
	      tree->t_edges[k]->site_d2lk_rr[j] = .0;

	      For(l,tree->mod->ns) /*sort sum terms ? No global effect*/
		{
		  For(m,tree->mod->ns)
		    {
		      tree->t_edges[k]->site_dlk_rr[j] += 
			tree->mod->pi[l] * 
			tree->t_edges[k]->p_lk_left[site][j][l]*
			tree->t_edges[k]->p_lk_rght[site][j][m]*
			tree->t_edges[k]->dPij_rr[j][l][m];
		      

		      tree->t_edges[k]->site_d2lk_rr[j] += 
			tree->mod->pi[l] * 
			tree->t_edges[k]->p_lk_left[site][j][l]*
			tree->t_edges[k]->p_lk_rght[site][j][m]*
			tree->t_edges[k]->d2Pij_rr[j][l][m];
		    }
		}

	      site_dlk[k]  += tree->t_edges[k]->site_dlk_rr[j]*
		              tree->mod->r_proba[j];
	      
	      site_d2lk[k] += tree->t_edges[k]->site_d2lk_rr[j]*
		              tree->mod->r_proba[j];
	    }
	}   
    }
  


  /* code 2.3 begin*/

  if (!tree->mod->invar)
    {
      log_site_lk += log(site_lk) 
	+ eroot->sum_scale_f_left[site] + eroot->sum_scale_f_rght[site];
    }
  else
    {
      if ((double)tree->data->invar[site] > -0.5)
	{
	  if (!(eroot->sum_scale_f_left[site] + eroot->sum_scale_f_rght[site]==0.0))
	    site_lk *= exp(eroot->sum_scale_f_left[site] + eroot->sum_scale_f_rght[site]);
	  
	  log_site_lk = log(site_lk*(1.0-tree->mod->pinvar) + tree->mod->pinvar*tree->mod->pi[state_elsewhere]);
	}
      else
	{
	  log_site_lk = log(site_lk*(1.0-tree->mod->pinvar))
	    + eroot->sum_scale_f_left[site] + eroot->sum_scale_f_rght[site];
	}
    }

  For(j,tree->mod->n_catg)
    tree->log_site_lk_cat[j][tree->curr_site] = log(tree->log_site_lk_cat[j][tree->curr_site]) +
    + eroot->sum_scale_f_left[site] + eroot->sum_scale_f_rght[site];


  /* code 2.3 end*/
  
  if(log_site_lk < -MDBL_MAX)
    {
      printf("%d %E %f %f %f %f\n",
	     site,
	     log_site_lk,
	     tree->mod->alpha,
	     eroot->sum_scale_f_left[site],
	     eroot->sum_scale_f_rght[site],
	     tree->mod->pinvar);
      Exit("\nlog_site_lk < -MDBL_MAX\n");
    }


  tree->site_lk[site] = log_site_lk;
  
  
  if(tree->mod->s_opt->opt_bl)
    {
      For(k,2*tree->n_otu-3)
	{
	  aux = exp(tree->t_edges[k]->sum_scale_f_rght[site]+
		    tree->t_edges[k]->sum_scale_f_left[site]);
	  site_dlk[k]  *= aux;
	  site_d2lk[k] *= aux;
	  
	  tree->t_edges[k]->site_dlk = site_dlk[k];
	  tree->t_edges[k]->site_d2lk = site_d2lk[k];	  
	}
    }
  
/*   tree->tot_loglk += alldata->wght[site]*log_site_lk; */
  tree->tot_loglk_sorted[site] = alldata->wght[site]*log_site_lk;


  if((tree->mod->s_opt->opt_bl) &&
     (fabs(site_lk = exp(log_site_lk)) > sqrt(MDBL_MIN)))
    {
      For(k,2*tree->n_otu-3)
	{
	  aux = site_dlk[k] / site_lk;
	  tree->tot_dloglk[k]  += alldata->wght[site] 
	                       *  aux;
	  tree->tot_d2loglk[k] += alldata->wght[site]
	                       * (site_d2lk[k]/site_lk
			       -  aux*aux);
	}
    }

  if(tree->mod->s_opt->opt_bl)
    {
      Free(site_dlk);
      Free(site_d2lk);
    }
}

/*********************************************************/

double Lk_At_Given_Edge(arbre *tree, edge *b_fcus)
{
  int site,catg,k,l,edge_num, ns = tree->mod->ns;
  double site_lk,log_site_lk,site_dlk,site_d2lk,aux;

  edge_num = b_fcus->num;
  tree->tot_loglk = log_site_lk = .0;
  tree->tot_dloglk[edge_num] = tree->tot_d2loglk[edge_num] = .0;
  tree->n_pattern = tree->data->crunch_len/tree->mod->stepsize;


  if(b_fcus->l < BL_MIN) b_fcus->l = BL_MIN;
  if(b_fcus->l > BL_MAX) b_fcus->l = BL_MAX;
  
  For(catg,tree->mod->n_catg)
    {
      aux = b_fcus->l*tree->mod->rr[catg];
      if(aux < BL_MIN) aux = BL_MIN;
      PMat(aux, tree->mod,&b_fcus->Pij_rr[catg]);
    }


  if((tree->mod->s_opt->opt_bl) && (tree->mod->datatype == NT))
    {
      For(catg,tree->mod->n_catg)
	{
	  dPMat(tree->t_edges[edge_num]->l,
		tree->mod->rr[catg],
		tree->mod,
		&b_fcus->dPij_rr[catg]);
	  d2PMat(tree->t_edges[edge_num]->l,
		 tree->mod->rr[catg],
		 tree->mod,
		 &b_fcus->d2Pij_rr[catg]);
	}
    }


  For(site,tree->data->crunch_len)
    {
      if(tree->data->wght[site])
	{
	  log_site_lk = site_lk = .0;
	  /* see equation (2) in phyml_tech_doc.pdf */
	  For(catg,tree->mod->n_catg)
	    {
	      For(k,ns) /*sort sum terms ? No global effect*/
		{
		  For(l,ns)
		    {
		      site_lk += 
			tree->mod->r_proba[catg] *
			tree->mod->pi[k] * 
			b_fcus->p_lk_left[site][catg][k] *
			b_fcus->p_lk_rght[site][catg][l] *
			b_fcus->Pij_rr[catg][k][l];
		    }
		}
	    }

	  /* code 2.3 begin*//* see equations in phyml_tech_doc.pdf */
	  /* compute log_site_lk */
	  if (!tree->mod->invar)
	    {
	      log_site_lk += log(site_lk) 
		+ b_fcus->sum_scale_f_left[site] + b_fcus->sum_scale_f_rght[site];
	    }
	  else
	    {
	      if ((double)tree->data->invar[site] > -0.5)
		{
		  if (!(b_fcus->sum_scale_f_left[site] + b_fcus->sum_scale_f_rght[site]==0.0))
		    site_lk *= exp(b_fcus->sum_scale_f_left[site] + b_fcus->sum_scale_f_rght[site]);
		  
		  log_site_lk = log(site_lk*(1.0-tree->mod->pinvar) + tree->mod->pinvar*tree->mod->pi[tree->data->invar[site]]);
		}
	      else
		{
		  log_site_lk = log(site_lk*(1.0-tree->mod->pinvar)) 
		    + b_fcus->sum_scale_f_left[site] + b_fcus->sum_scale_f_rght[site];
		}
	    }
	  /* code 2.3 end*/

	  if(log_site_lk < -MDBL_MAX) Exit("\nlog_site_lk < -MDBL_MAX\n");

	  tree->site_lk[site] = log_site_lk;

	  /*tree->tot_loglk += *//* old code */
	  tree->tot_loglk_sorted[site] = /* code 2.3 */
	    tree->data->wght[site]*log_site_lk;
	}
      else tree->tot_loglk_sorted[site] = 1.; /* WARNING : change cautiously */
    }

  /* code 2.3 begin*/
  /* sort and add numbers from smallest to biggest */

  qksort(tree->tot_loglk_sorted, 0, tree->n_pattern-1);
/*   qsort(tree->tot_loglk_sorted,tree->n_pattern,sizeof(double),Sort_Double_Decrease); */

  tree->tot_loglk = .0;
  For(k, tree->data->crunch_len) 
    if(tree->tot_loglk_sorted[k] < .0) /* WARNING : change cautiously */
      tree->tot_loglk += tree->tot_loglk_sorted[k];
  /* code 2.3 end*/
  
  if((tree->mod->s_opt->opt_bl) && (tree->mod->datatype == NT))
    {
      For(site,tree->n_pattern)
	{
	  if(tree->data->wght[site])
	    {
	      site_dlk = site_d2lk = .0;      
	      b_fcus->site_dlk = b_fcus->site_d2lk = .0; 
	      
	      For(catg,tree->mod->n_catg)
		{
		  For(k,ns) /*sort sum terms ? No global effect*/
		    {
		      For(l,ns)
			{
			  aux = tree->mod->r_proba[catg] *
			    tree->mod->pi[k] *
			    b_fcus->p_lk_left[site][catg][k];
			  
			  site_dlk +=
			    aux *
			    b_fcus->p_lk_rght[site][catg][l] *
			    b_fcus->dPij_rr[catg][k][l];
			  
			  site_d2lk +=
			    aux *
			    b_fcus->p_lk_rght[site][catg][l] *
			    b_fcus->d2Pij_rr[catg][k][l];
			}
		    }
		}

	      if(tree->n_otu > LIM_SCALE)
		{
		  aux = exp(b_fcus->sum_scale_f_rght[site]+
			    b_fcus->sum_scale_f_left[site]);
		  site_dlk  *= aux;
		  site_d2lk *= aux;
		}

	      b_fcus->site_dlk = site_dlk;
	      b_fcus->site_d2lk = site_d2lk;

	      if(fabs(exp(log_site_lk)) > sqrt(MDBL_MIN))
		{
		  aux = site_dlk / tree->site_lk[site];
		  tree->tot_dloglk[edge_num]  += tree->data->wght[site] 
		                              * aux;
		  tree->tot_d2loglk[edge_num] += tree->data->wght[site] 
		                              * (site_d2lk/tree->site_lk[site] 
					      - aux*aux);
		}
	    }
	}
    }

  return tree->tot_loglk;
}
  
/*********************************************************/

void Update_P(arbre *tree, int t_edge_num)
{
  int i;
  double len;

  len = -1.0;
  For(i,tree->mod->n_catg)
    {
      tree->curr_catg = i;
      len = tree->t_edges[t_edge_num]->l*tree->mod->rr[i];
      if(len < BL_MIN) len = BL_MIN;
      tree->mod->update_eigen = 0;
      PMat(len,tree->mod,&tree->t_edges[t_edge_num]->Pij_rr[i]);
/*        Derivatives(tree->t_edges[t_edge_num],tree);    */
    }
}

/*********************************************************/

double Return_Lk(arbre *tree)
{
  Lk(tree,tree->data);
  return tree->tot_loglk;
}

/*********************************************************/

double Return_Abs_Lk(arbre *tree)
{
  Lk(tree,tree->data);
  return fabs(tree->tot_loglk);
}

/*********************************************************/

matrix *ML_Dist(allseq *data, model *mod)
{
  int j,k,l;
  double init;
  int n_catg;
  double d_max;
  matrix *mat;
  allseq *twodata,*tmpdata;

  tmpdata = (allseq *)mCalloc(1,sizeof(allseq));
  tmpdata->n_otu=2;
  tmpdata->c_seq = (seq **)mCalloc(2,sizeof(seq *));
  tmpdata->b_frq = (double *)mCalloc(mod->ns,sizeof(double));
  tmpdata->ambigu = (int *)mCalloc(data->crunch_len,sizeof(int));

  tmpdata->crunch_len = tmpdata->init_len = data->crunch_len;


  mat = 
    (mod->datatype == NT) ?
    ((mod->whichmodel < 10)?(K2P_dist(data,2000)):(JC69_Dist(data,mod))):
    (JC69_Dist(data,mod));

  n_catg = -1;

 
  For(j,data->n_otu-1)
    {
      tmpdata->c_seq[0]=data->c_seq[j];
      tmpdata->c_seq[0]->name=data->c_seq[j]->name;
      tmpdata->wght = data->wght;

      for(k=j+1;k<data->n_otu;k++)
	{
	  tmpdata->c_seq[1]=data->c_seq[k];
	  tmpdata->c_seq[1]->name=data->c_seq[k]->name;

	  twodata = Compact_CSeq(tmpdata,mod);
	  For(l,mod->ns) twodata->b_frq[l]=data->b_frq[l];

	  Check_Ambiguities(twodata,mod->datatype,1);

	  Hide_Ambiguities(twodata);	  

	  init = mat->dist[j][k];
	  if((init == DIST_MAX) || (init < .0)) init = 0.1;


	  n_catg = mod->n_catg;
	  mod->n_catg = 1;


/* BRENT */
	  d_max = Optimize_Dist(mod,init,twodata);

/* 	  d_max = init; */

/* NEWTON-RAPHSON */
/* 	  if(d_max < .0) */
/* 	    { */
/* 	      d_max =  Optimize_One_Dist(twodata,0,1,init,mod); */
/* 	      d_max = init; */

/* 	    } */

	  mod->n_catg = n_catg;


	  if(d_max >= DIST_MAX) 
	    {
	      printf("\n. Large distance encountered between %s and %s sequences\n",
		     tmpdata->c_seq[1]->name,
		     tmpdata->c_seq[0]->name);
	      d_max = DIST_MAX;
	    }

	  mat->dist[j][k] = d_max;
	  mat->dist[k][j] = mat->dist[j][k];
	  Free_Cseq(twodata);
	}
    }
 

  Free(tmpdata->ambigu);
  Free(tmpdata->b_frq);
  Free(tmpdata->c_seq);
  free(tmpdata);

  return mat;
}

/*********************************************************/

double Lk_Given_Two_Seq(allseq *data, int numseq1, int numseq2, double dist, model *mod,
			double *loglk, double *dloglk, double *d2loglk)
{
  seq *seq1,*seq2;
  double site_lk,site_dlk,site_d2lk,log_site_lk;
  int i,j,k,l;
  double **p_lk_l,**p_lk_r;
  double len;

  DiscreteGamma (mod->r_proba, mod->rr, mod->alpha,
		 mod->alpha,mod->n_catg,0);



  seq1 = data->c_seq[numseq1];
  seq2 = data->c_seq[numseq2];

  p_lk_l = (double **)mCalloc(data->c_seq[0]->len,sizeof(double *));
  p_lk_r = (double **)mCalloc(data->c_seq[0]->len,sizeof(double *));

  For(i,data->c_seq[0]->len)
    {
      p_lk_l[i] = (double *)mCalloc(mod->ns,sizeof(double));
      p_lk_r[i] = (double *)mCalloc(mod->ns,sizeof(double));
    }


  if(dist < BL_MIN) dist = BL_START;

  For(i,mod->n_catg) 
    {
      len = dist*mod->rr[i];
      if(len < BL_MIN) len = BL_MIN;
      PMat(len,mod,&(mod->Pij_rr[i]));        
    }


  if(mod->datatype == NT)
    {
      For(i,mod->n_catg) 
	{
	  dPMat(dist,mod->rr[i],mod,&(mod->dPij_rr[i]));      
	  d2PMat(dist,mod->rr[i],mod,&(mod->d2Pij_rr[i]));      
	}

      For(i,data->c_seq[0]->len)
	{
	  Init_Tips_At_One_Site_Nucleotides(seq1->state[i],
					    &p_lk_l[i]);
	  Init_Tips_At_One_Site_Nucleotides(seq2->state[i],
					    &p_lk_r[i]);
	}
    }
  else
    {
      For(i,data->c_seq[0]->len)
	{
	  Init_Tips_At_One_Site_AA(seq1->state[i],
				   &p_lk_l[i]);
	  Init_Tips_At_One_Site_AA(seq2->state[i],
				   &p_lk_r[i]);
	}
    }
    

  site_lk = site_dlk = site_d2lk = .0;
  *loglk = *dloglk = *d2loglk = 0;

  For(i,data->c_seq[0]->len)
    {
      if(data->wght[i])
	{
	  site_lk = log_site_lk = .0;
	  if(!data->ambigu[i])
	    {
	      For(k,mod->ns) {if(p_lk_l[i][k] > .0001) break;}
	      For(l,mod->ns) {if(p_lk_r[i][l] > .0001) break;}
	      For(j,mod->n_catg)
		{
		  site_lk +=
		    mod->r_proba[j] *
		    mod->pi[k] *
		    p_lk_l[i][k] *
		    mod->Pij_rr[j][k][l] *
		    p_lk_r[i][l];
		}
	    }
	  else
	    {
	      For(j,mod->n_catg)
		{
		  For(k,mod->ns) /*sort sum terms ? No global effect*/
		    {
		      For(l,mod->ns)
			{
			  site_lk += 
			    mod->r_proba[j] *
			    mod->pi[k] * 
			    p_lk_l[i][k] *
			    mod->Pij_rr[j][k][l] *
			    p_lk_r[i][l]; 
			}
		    }
		}
	    }

/* 	  printf("'%c' '%c' -> %f\n",seq1->state[i],seq2->state[i],site_lk); */

	  if(site_lk <= .0) 
	    {
	      printf("'%c' '%c'\n",seq1->state[i],seq2->state[i]);
	      Exit("\n. Err: site lk <= 0\n");
	    }

	  log_site_lk += log(site_lk);

	  *loglk   += data->wght[i] * log_site_lk;/* sort sum terms ? No global effect*/
	}
    }

  For(i,data->c_seq[0]->len)
    {
      Free(p_lk_l[i]);
      Free(p_lk_r[i]);
    }
  Free(p_lk_l); Free(p_lk_r);
  return *loglk;
}

/*********************************************************/

double ***Get_Partial_Lk_Struct(arbre *tree, int len, int n_catg)
{
  double ***p_lk;
  int j,k;

  p_lk = (double ***)mCalloc(len,sizeof(double **)); 
  For(j,len)
    {
      p_lk[j] = (double **)mCalloc((int)n_catg,sizeof(double *));
      For(k,n_catg) p_lk[j][k] = (double *)mCalloc(tree->mod->ns,sizeof(double ));
    }
  return p_lk;
}

/*********************************************************/

void Unconstraint_Lk(arbre *tree)
{
  int i;

  tree->unconstraint_lk = .0;

  For(i,tree->data->crunch_len)
    {
      tree->unconstraint_lk += 
	tree->data->wght[i]*log(tree->data->wght[i]);
    }
  tree->unconstraint_lk -= 
    tree->data->init_len*log(tree->data->init_len);
}

/*********************************************************/

void Update_P_Lk(arbre *tree, edge *b_fcus, node *n)
{
/*  
           |
	   |<- b_cus
	   |
	   n
          / \
       	 /   \
       	/     \
*/

  int k,l;
  int site, catg;
  double ***p_lk, ***p_lk_v1, ***p_lk_v2;
  double **Pij1, **Pij2;
  double *n_scale_f, *d1_scale_f, *d2_scale_f;
  double p1_lk1,p2_lk2;
  double max_p_lk;
  edge *b1, *b2;

  
  b1 = b2  = NULL;
  p_lk = p_lk_v1 = p_lk_v2 = NULL;
  max_p_lk = MDBL_MIN;


  if(n == b_fcus->left)
    {
/*       if(b_fcus->ud_p_lk_left) { printf("This p_lk is up to date\n"); return;} */
      p_lk = b_fcus->p_lk_left;
      
      p_lk_v1 = 
      (n == n->b[b_fcus->l_v1]->left)?
      (n->b[b_fcus->l_v1]->p_lk_rght):
      (n->b[b_fcus->l_v1]->p_lk_left);

      p_lk_v2 = 
      (n == n->b[b_fcus->l_v2]->left)?
      (n->b[b_fcus->l_v2]->p_lk_rght):
      (n->b[b_fcus->l_v2]->p_lk_left);


      n_scale_f = b_fcus->sum_scale_f_left;

      d1_scale_f = 
      (n == n->b[b_fcus->l_v1]->left)?
      (n->b[b_fcus->l_v1]->sum_scale_f_rght):
      (n->b[b_fcus->l_v1]->sum_scale_f_left);

      d2_scale_f = 
      (n == n->b[b_fcus->l_v2]->left)?
      (n->b[b_fcus->l_v2]->sum_scale_f_rght):
      (n->b[b_fcus->l_v2]->sum_scale_f_left);
    
      b_fcus->get_p_lk_left = 1;
      b_fcus->ud_p_lk_left  = 1;
    }

  else
    {
      p_lk = b_fcus->p_lk_rght;
      
      p_lk_v1 = 
      (n == n->b[b_fcus->r_v1]->left)?
      (n->b[b_fcus->r_v1]->p_lk_rght):
      (n->b[b_fcus->r_v1]->p_lk_left);

      p_lk_v2 = 
      (n == n->b[b_fcus->r_v2]->left)?
      (n->b[b_fcus->r_v2]->p_lk_rght):
      (n->b[b_fcus->r_v2]->p_lk_left);

      n_scale_f = b_fcus->sum_scale_f_rght;

      d1_scale_f = 
      (n == n->b[b_fcus->r_v1]->left)?
      (n->b[b_fcus->r_v1]->sum_scale_f_rght):
      (n->b[b_fcus->r_v1]->sum_scale_f_left);

      d2_scale_f = 
      (n == n->b[b_fcus->r_v2]->left)?
      (n->b[b_fcus->r_v2]->sum_scale_f_rght):
      (n->b[b_fcus->r_v2]->sum_scale_f_left);

      b_fcus->get_p_lk_rght = 1;
      b_fcus->ud_p_lk_rght  = 1;
    }

  if(b_fcus->l < BL_MIN) b_fcus->l = BL_MIN;
  
 

  if(n == b_fcus->left) 
    {
      b1 = n->b[b_fcus->l_v1];
      b2 = n->b[b_fcus->l_v2];
    }
  else
    {
      b1 = n->b[b_fcus->r_v1];
      b2 = n->b[b_fcus->r_v2];
    }


  if(tree->n_otu <= LIM_SCALE)
    {
      /* NO SCALE */

      For(site,tree->n_pattern)
	{
	  if(tree->data->wght[site])
	    {
	      For(catg,tree->mod->n_catg)
		{
		  
		  Pij1 = b1->Pij_rr[catg];
		  Pij2 = b2->Pij_rr[catg];
		  
		  
		  For(k,tree->mod->ns) /*sort sum terms ? No global effect*/
		    {
		      p1_lk1 = p2_lk2 = .0;
		      
		      For(l,tree->mod->ns)
			{
			  p1_lk1 += Pij1[k][l] * p_lk_v1[site][catg][l];
			  p2_lk2 += Pij2[k][l] * p_lk_v2[site][catg][l];
			}
		      p_lk[site][catg][k] = p1_lk1 * p2_lk2;
		    }
		}
	    }
	}
    }
  else
    {
      /* SCALE */

      For(site,tree->n_pattern)
	{
	  if(tree->data->wght[site])
	    {
	      For(catg,tree->mod->n_catg)
		{
		  
		  Pij1 = b1->Pij_rr[catg];
		  Pij2 = b2->Pij_rr[catg];
		  
		  if(!catg) 
		    {
		      n_scale_f[site] = d1_scale_f[site] + d2_scale_f[site];
		      max_p_lk = -MDBL_MAX;
		    }
		  
		  For(k,tree->mod->ns) /*sort sum terms ? No global effect*/
		    {
		      p_lk[site][catg][k] = .0;
		      p1_lk1 = p2_lk2     = .0;
		      		      
		      For(l,tree->mod->ns)
			{
			  p1_lk1 += Pij1[k][l] * p_lk_v1[site][catg][l];
			  p2_lk2 += Pij2[k][l] * p_lk_v2[site][catg][l];
			}

		      p_lk[site][catg][k] = p1_lk1 * p2_lk2;
		      

		      if((p_lk[site][catg][k] > max_p_lk)) max_p_lk = p_lk[site][catg][k];
		      
		    }
		}
	         
	      if(max_p_lk < LIM_SCALE_VAL)
		{
		  For(catg,tree->mod->n_catg)
		    {
		      For(k,tree->mod->ns) 
			{
			  p_lk[site][catg][k] /= max_p_lk;
			  
			  if(p_lk[site][catg][k] > MDBL_MAX)
			    {
			      Exit("\n. Numerical overflow ! (send me an e-mail : s.guindon@auckland.ac.nz)\n");
			    }			  
			}
		    }
		  n_scale_f[site] += log(max_p_lk);
		}
	      
	      if(max_p_lk > (1./LIM_SCALE_VAL))
		{
		  For(catg,tree->mod->n_catg)
		    {
		      For(k,tree->mod->ns) 
			{
			  p_lk[site][catg][k] /= max_p_lk;
			  if(p_lk[site][catg][k] < MDBL_MIN)
			    {
			      printf("\n. Numerical underflow ! (send me an e-mail : s.guindon@auckland.ac.nz)\n");
			    }			  
			}
		    }
		  n_scale_f[site] += log(max_p_lk);
		}
	    }
	}
    }
}

/*********************************************************/

void Make_Tree_4_Lk(arbre *tree, allseq *alldata, int n_site)
{
  int i;

  if(!tree->tot_loglk_sorted) tree->tot_loglk_sorted = (double *)mCalloc(tree->n_pattern, sizeof(double));
  if(!tree->tot_dloglk)       tree->tot_dloglk       = (double *)mCalloc(2*tree->n_otu-3,sizeof(double));
  if(!tree->tot_d2loglk)      tree->tot_d2loglk      = (double *)mCalloc(2*tree->n_otu-3,sizeof(double));
  if(!tree->site_lk)          tree->site_lk          = (double *)mCalloc(alldata->crunch_len,sizeof(double));
  if(!tree->log_site_lk_cat)      
    {
      tree->log_site_lk_cat      = (double **)mCalloc(tree->mod->n_catg,sizeof(double *));
      For(i,tree->mod->n_catg)
	tree->log_site_lk_cat[i] = (double *)mCalloc(alldata->crunch_len,sizeof(double));
    }

  tree->root = tree->noeud[0];
 
  For(i,2*tree->n_otu-3)
    {
      Make_Edge_Lk(tree->t_edges[i]->left,
		   tree->t_edges[i]->rght,
		   tree);
    }

  For(i,2*tree->n_otu-2)
    Make_Node_Lk(tree->noeud[i]);

  Alloc_All_P_Lk(tree);
/*   Make_P_Lk_Struct(tree);   */

  Init_P_Lk_Tips(tree);
}

/*********************************************************/

void Init_P_Lk_Tips(arbre *tree)
{
  int curr_site,i,j,k;
  

  Fors(curr_site,tree->data->crunch_len,tree->mod->stepsize)
    {
      For(i,tree->n_otu)
	{
	  if (tree->mod->datatype == NT)
	    {
		Init_Tips_At_One_Site_Nucleotides(tree->data->c_seq[i]->state[curr_site],
						  &tree->noeud[i]->b[0]->p_lk_rght[curr_site][0]);
                
	    }
	  else
	    Init_Tips_At_One_Site_AA(tree->data->c_seq[i]->state[curr_site],
				     &tree->noeud[i]->b[0]->p_lk_rght[curr_site][0]);
	  


	  if((tree->noeud[i]->b[0]->p_lk_rght) && (tree->noeud[i]->b[0]->get_p_lk_rght))
	    {
	      for(j=1;j<tree->mod->n_catg;j++)
		{
		  For(k,tree->mod->ns)
		    {
		      tree->noeud[i]->b[0]->p_lk_rght[curr_site][j][k]=
		      tree->noeud[i]->b[0]->p_lk_rght[curr_site][0][k];
		    }
		}
	    }
	  else
	    {
	      for(j=1;j<tree->mod->n_catg;j++)
		For(k,tree->mod->ns)
		  tree->noeud[i]->b[0]->p_lk_rght[curr_site][j][k]=
		  tree->noeud[i]->b[0]->p_lk_rght[curr_site][0][k];
	    }
	}
    }
}

/*********************************************************/
