/********************************************************************************************************
 * QRNA - Comparative analysis of biological sequences 
 *         with pair hidden Markov models, pair stochastic context-free
 *        grammars, and probabilistic evolutionary  models.
 *       
 * Version 2.0.0 (JUN 2003)
 *
 * Copyright (C) 2000-2003 Howard Hughes Medical Institute/Washington University School of Medicine
 * All Rights Reserved
 * 
 *     This source code is distributed under the terms of the
 *     GNU General Public License. See the files COPYING and LICENSE
 *     for details.
 ***********************************************************************************************************/

/* othmodel.c
 *
 * E. Rivas 9 april 1999 [St. Louis]
 * 
 * Allocation, free'ing, initialization of the Othermodel
 * 
 */

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <ctype.h>
#include <limits.h>

#include "funcs.h"
#include "globals.h"
#include "squid.h"
#include "structs.h"

#ifdef MEMDEBUG
#include "dbmalloc.h"
#endif

static void     from_transfer_2_transitions(double **TA, double **TB, int dimA, int dimB, double *oth_trans, int verbose);
static double **OTHparam_to_transferA(struct othparam_s othparam, int dim);
static double **OTHparam_to_transferB(struct othparam_s othparam, int dim);
static void     OTHmodel_transition_probabilities_linear(struct othparam_s othparam, struct othparam_s othparam_zero, 
							 double tfactor, struct othmodel_s *oth, int pedantic, int verbose);
static double **OTH_transferA_at_infty(double **T, double **T_zero, int dim);
static double **OTH_transferB_at_infty(double **T, double **T_zero, int dim);
static double **OTH_transferA_rate(int dim);
static double **OTH_transferB_rate(int dim);
static double **OTH_transferA_Rdiag(int dim);
static double **OTH_transferB_Rdiag(int dim);


/* Function: AllocOTHModel()
 * Date:     ER,  Fri May 28 13:01:57 CDT 1999 CDT 1999  [St. Louis]
 *
 * Purpose:  Allocates memory for the transition and emission probs of the othmodel
 *
 * Args:     othmodel - othmodel structure
 *
 * Returns:  void
 *           allocates oth->t[], oth->em[], which must be free'd by caller.
 */
struct othmodel_s *
AllocOTHModel(void)
{
  struct othmodel_s *oth;    /* othmodel structure         */

  oth      = (struct othmodel_s *) MallocOrDie (sizeof(struct othmodel_s));
  oth->t   = (double *) MallocOrDie (sizeof(double) * OTRANS);
  oth->mem = (double *) MallocOrDie (sizeof(double) * 16);
  oth->xem = (double *) MallocOrDie (sizeof(double) * 4);
  oth->yem = (double *) MallocOrDie (sizeof(double) * 4);

  oth->FLN = AllocNullModel();
  oth->FJN = AllocNullModel();
  oth->FRN = AllocNullModel();
  
  PatternOTHModel(oth);
  
  return oth;
}

/* Function: CheckOTHProbs()
 * Date:     ER, Fri May 28 13:17:34 CDT 1999  [St. Louis]
 *
 * Purpose:  Verify that transition and emission prob's of a othmodel add up to one
 *
 * Args:     oth - the structure for an othmodel
 *
 * Returns:  void. 
 */
void
CheckOTHProbs(struct othmodel_s *oth)
{
  int    idx;               /* index for transition prob's      +*/
  int    st;                /* state we are at                  +*/
  double sum;

  /* check transition prob's add up to one
   */
  for (st = 0; st < OSTATES; st++) {
    sum = 0.0; 
    for (idx = IdxTransOTH[st]; idx < IdxTransOTH[st]+TransPerOTHState[st]; idx++)
      sum += oth->t[idx];
    
    if (sum > 2.0-accuracy || sum < accuracy) 
      Die ("CheckOTHProbs(); transition prob's sum for state %d(%s) is %f \n", st, ostNAME[st], sum);
  }
  
  /* check emission prob's add up to one
   */
  CheckSingleProb(oth->mem, 16);
  CheckSingleProb(oth->xem, 4);
  CheckSingleProb(oth->yem, 4);
}


/* Function: ConstructMemOTHProbs()
 * Date:     ER, Mon May 31 15:09:08 CDT 1999 [St. Louis]
 *
 * Purpose:  Given a PAMModel, marginalize to calculate
 *           a random model.
 *
 * Args:     pammodel  - 64x64 AAA..UUUxAAA..UUU joint prob matrix (prealloc)
 *           mem       - 4x4 A..UxA..U joint prob matrix (prealloc)           
 *
 * Returns:  (void)
 *           Fills in oth->mem. (already allocated)
 */
void
ConstructMemOTHProbs(double *mutpxy, double *mem)
{
  int x1;
  int x2;
  
  /* Zero null model
   */
  for (x1 = 0; x1 < 4; x1++)
    for (x2 = 0; x2 < 4; x2++) 
      mem[idx(x1,x2)] = mutpxy[idx(x1,x2)];

  CheckSingleProb(mem, 16);
}



/* Function: ConstructOTHModel()
 * Date:     ER, Fri May 28 12:07:32 CDT 1999  [St. Louis]
 *
 * Purpose:  Constructs a othmodel_s
 *
 * Args:     othparam - the list of parameters that define a othmodel           
 *
 * Returns:  (void)
 *           fills all prob's for othmodel, log2 form 
 *           (allc'ed here, freed by caller)
 */
void
ConstructOTHModel(double **pammodel_star, struct othparam_s othparam, struct othparam_s othparam_zero, struct othparam_s othparam_infty, 
		  double win, double win_zero, double win_infty, double tfactor, double *targetfreq, int changefreq, 
		  struct othmodel_s *oth, int pedantic, int verbose)
{
  double *mutpxy_oth;
  double *mut5pxy_oth;
  double  factor_star  = 0.01;
  double  factor_infty = 0.02;

  if (verbose) printf("Construct OTH Model at time = %.4f\n", tfactor);

  /* the oth model has a paramente tau that set the invers of the average length generated by those models
   * This is how I set them as a few percentages of the length under analysis. This parameter does not evolve
   */
  othparam.tau       = (win       > 1.0)? 1.0 / win       : 1.0;
  othparam_zero.tau  = (win_zero  > 1.0)? 1.0 / win_zero  : 1.0;
  othparam_infty.tau = (win_infty > 1.0)? 1.0 / win_infty : 1.0;

  if (factor_star > 1.0/win_zero) { factor_star = 1.0/win_zero; factor_infty = factor_star; }

  othparam.FLN.eta = (factor_star*win > 1+MARGIN)? 1.0 / (factor_star*win) : 1.0;
  othparam.FRN.eta = (factor_star*win > 1+MARGIN)? 1.0 / (factor_star*win) : 1.0;
  othparam.FJN.eta = (factor_star*win > 1+MARGIN)? 1.0 / (factor_star*win) : 1.0;

  othparam_infty.FLN.eta = (factor_infty*win_infty > 1+MARGIN)? 1.0 / (factor_infty*win_infty) : 1.0;
  othparam_infty.FRN.eta = (factor_infty*win_infty > 1+MARGIN)? 1.0 / (factor_infty*win_infty) : 1.0; 
  othparam_infty.FJN.eta = (factor_infty*win_infty > 1+MARGIN)? 1.0 / (factor_infty*win_infty) : 1.0;
  
  if (othparam.FLN.eta >= 1.0) othparam_infty.FLN.eta = othparam.FLN.eta;
  if (othparam.FRN.eta >= 1.0) othparam_infty.FRN.eta = othparam.FRN.eta;
  if (othparam.FJN.eta >= 1.0) othparam_infty.FJN.eta = othparam.FJN.eta;
  
  /* Check probs are larger than zero
   */
  CheckOTHParam(othparam);
  CheckOTHParam(othparam_zero);
  CheckOTHParam(othparam_infty);

  /* 
   * Define the OTH Transfer matrices as:    
   *
   *                                     M    X    Y    E
   *                                B | TBM  TBX  TBY  TBE |
   *                                  |                    |
   *                                M | TMM  TMX  TMY  TME |
   *                           TA =   |                    |      
   *                                X | TXM  TXX  TXY  TXE |
   *                                  |                    |
   *                                Y | TYM  TYX  TYY  TYE |
   *
   *
   *                                      B      FR
   *                                FL |  xi    1-xi |
   *                          TB =     |             |
   *                                E  | 1-eta   eta |
   *
   *
   *                                
   * TA,TB are matrices of conditional probabilities (rows add up to one).
   *
   * TA,TB correspond to a given evolutionary time (be that blosum62, or any other)                   
   *
   */
  /*OTHmodel_transition_probabilities_linear (othparam, othparam_zero, tfactor, oth, pedantic, verbose);*/
  OTHmodelTransitionProbabilities (othparam, othparam_zero, othparam_infty, tfactor, oth, pedantic, verbose);

  /* Calculate emission prob's: OTH->mem[], OTH->xem[], OTH->yem[]
   */
  ConstructTiedProbs(pammodel_star, tfactor, &mutpxy_oth, &mut5pxy_oth, targetfreq, changefreq, pedantic, verbose);  
  ConstructMemOTHProbs(mutpxy_oth, oth->mem);
  ConstructXemOTHProbs(oth->mem, oth->xem);
  ConstructYemOTHProbs(oth->mem, oth->yem);
  
  /* Construct flanking null models (already in log2 form)
   *
   * 
   */
  ConstructNullModel(pammodel_star, oth->FLN, othparam.FLN, othparam_zero.FLN, othparam_infty.FLN, tfactor, targetfreq, changefreq, verbose);
  ConstructNullModel(pammodel_star, oth->FJN, othparam.FJN, othparam_zero.FJN, othparam_infty.FJN, tfactor, targetfreq, changefreq, verbose);
  ConstructNullModel(pammodel_star, oth->FRN, othparam.FRN, othparam_zero.FRN, othparam_infty.FRN, tfactor, targetfreq, changefreq, verbose);

  /* check prob's add up to one
   */
  CheckOTHProbs(oth);
  
  /* convert to Log2 form
   */
  OTHToLog2(oth);

  if (verbose) PrintOTHTrProbs(oth);
  if (FALSE) printf("OTH model completed at time = %.4f\n", tfactor);

  /* free memory */
  free(mutpxy_oth);
  free(mut5pxy_oth);

}


/* Function: ConstructXemOTHProbs()
 * Date:     ER, Mon May 31 15:14:03  CDT 1999 [St. Louis]
 *
 * Purpose:  Given a mem[idx(4,4)] mutation probability distrubution, 
 *           marginalize to calculate xem[4].
 *
 * Args:    mem - 4x4 A..UxA..U joint prob matrix (prealloc)
 *          xem - 4 seqX emission prob (prealloc)
 *
 * Returns:  (void)
 *           Fills in oth->xem (already allocated)
 */
void
ConstructXemOTHProbs(double *mem, double *xem)
{
  int x;
  int y;

  /* Zero null model
   */
  for (x = 0; x < 4; x++)
    xem[x] = 0.0;

  /* Marginalize and average over Y positions
   */
  for (x = 0; x < 4; x++)
    for (y = 0; y < 4; y++)
      xem[x] += mem[idx(x,y)];

  CheckSingleProb(xem, 4);
}

/* Function: ConstructYemOTHProbs()
 * Date:     ER, Mon May 31 15:14:03  CDT 1999 [St. Louis]
 *
 * Purpose:  Given a mem[idx(4,4)] mutation probability distrubution, 
 *           marginalize to calculate yem[4].
 *
 * Args:    mem - 4x4 A..UxA..U joint prob matrix (prealloc)
 *          yem - 4 seqY emission prob (prealloc)
 *
 * Returns:  (void)
 *           Fills in oth->yem (already allocated)
 */
void
ConstructYemOTHProbs(double *mem, double *yem)
{
  int x;
  int y;

  /* Zero null model
   */
  for (x = 0; x < 4; x++)
    yem[x] = 0.0;

  /* Marginalize and average over Y positions
   */
  for (x = 0; x < 4; x++)
    for (y = 0; y < 4; y++)
      yem[x] += mem[idx(y,x)];

  CheckSingleProb(yem, 4);
}


void
FreeOTHModel(struct othmodel_s *oth)
{
  FreeNullModel(oth->FLN);
  FreeNullModel(oth->FJN);
  FreeNullModel(oth->FRN);

  free(oth->t);
  free(oth->mem);
  free(oth->xem);
  free(oth->yem);

  free(oth);
}


/* Function: OTHToLog2()
 * Date:     ER, Fri May 28 15:03:30 CDT 1999 [St. Louis]
 *
 * Purpose:  Converts transition and emission prob's of a othmodel to log2 form
 *
 * Args:     oth - the structure for an othmodel
 *
 * Returns:  void. 
 */
void
OTHToLog2(struct othmodel_s *oth)
{
  int idx;               /* index for transition prob's      +*/
  int sym, symx, symy;   /* symbols for emission prob's      +*/

  /* transition prob's 
   */
  for (idx = 0; idx < OTRANS; idx++) 
    oth->t[idx] = LOG2(oth->t[idx]);
  
  /* emission prob's 
   */
  for (symx = 0; symx < 4; symx++)
    for (symy = 0; symy < 4; symy++)
      oth->mem[idx(symx,symy)] = LOG2(oth->mem[idx(symx,symy)]);

  for (sym = 0; sym < 4; sym++) {
      oth->xem[sym] = LOG2(oth->xem[sym]);
      oth->yem[sym] = LOG2(oth->yem[sym]);
  }
}

/* Function: OTHLog2ToOdds()
 * Date:     ER, Fri Jun  4 11:19:49 CDT 1999 [St. Louis]
 *
 * Purpose:  Converts transition and emission prob's of a othmodel
 *           from log2 to log2odds form
 *
 * Args:     oth - the structure for an othmodel
 *
 * Returns:  void. 
 */
void
OTHLog2ToOdds(struct othmodel_s *oth, struct nullmodel_s *null)
{
  int tr;                /* index for transitions            +*/
  int sym, symx, symy;   /* symbols for emission prob's      +*/

  NullLog2ToOdds(oth->FLN, null);
  NullLog2ToOdds(oth->FJN, null);
  NullLog2ToOdds(oth->FRN, null);

  /* transition prob's 
   */
  for (tr = 0; tr < OTRANS; tr++) 
    switch (tr) {
      /* transitions to M, divide by (1-\eta)^2  */
    case TBM: oth->t[tr] -= 2. * null->meta;  break;
    case TMM: oth->t[tr] -= 2. * null->meta;  break;
    case TXM: oth->t[tr] -= 2. * null->meta;  break;
    case TYM: oth->t[tr] -= 2. * null->meta;  break;
      /* transitions to X, divide by (1-\eta)    */
    case TBX: oth->t[tr] -= 1. * null->meta;  break;
    case TMX: oth->t[tr] -= 1. * null->meta;  break;
    case TXX: oth->t[tr] -= 1. * null->meta;  break;
    case TYX: oth->t[tr] -= 1. * null->meta;  break;
      /* transitions to Y, divide by (1-\eta)    */
    case TBY: oth->t[tr] -= 1. * null->meta;  break;
    case TMY: oth->t[tr] -= 1. * null->meta;  break;
    case TXY: oth->t[tr] -= 1. * null->meta;  break;
    case TYY: oth->t[tr] -= 1. * null->meta;  break;
    }
  
  /* emission prob's 
   */
  for (symx = 0; symx < 4; symx++)
    for (symy = 0; symy < 4; symy++)
      oth->mem[idx(symx,symy)] -= (null->xem[symx] + null->yem[symy]);
  
  for (sym = 0; sym < 4; sym++) {
    oth->xem[sym] -= null->xem[sym];
    oth->yem[sym] -= null->yem[sym];
  }
}

void     
PatternOTHModel(struct othmodel_s *oth)
{
  int idx;
  int sym;

  PatternNullModel(oth->FLN);
  PatternNullModel(oth->FJN);
  PatternNullModel(oth->FRN);

  /* Initialize all prob's to zero
   */
  for (idx = 0; idx < OTRANS; idx++)
    oth->t[idx] = 0.0;

  for (sym = 0; sym < 16; sym++)
    oth->mem[sym] = 0.0;
  
  for (sym = 0; sym < 4; sym++) {
    oth->xem[sym] = 0.0;
    oth->yem[sym] = 0.0;
  }

}

/* Function: PrintMutProbs()
 * Date:     ER, Mon Aug  2 20:48:07 CDT 1999 [St. Louis]
 *
 * Purpose:  Print a mut probs model
 *
 * Args:     mutpxy[4][4]
 *           pnull[4]  (in log2 form)
 *
 * Returns:  void. prints stuff.
 */
void
PrintMutProbs(double *mutpxy, double *pnull)
{
  int      x;
  double   nullp;
  double   info = 0.0;
  double   expect = 0.0;

  printf("Mutation probabilities\n");
  for (x = 0; x < 16; x++) {
    nullp  = EXP2(pnull[x/4]) * EXP2(pnull[x%4]);
    
    if (x%4 == 0) printf("\n");
    printf("%12f ",  mutpxy[x]);

    if (mutpxy[x] > 0.) {
      info   += mutpxy[x]   * (LOG2(mutpxy[x]) - nullp);
      expect += EXP2(nullp) * (LOG2(mutpxy[x]) - nullp);
    }
    else if (mutpxy[x] > 0.) Die ("mutation probs have to be larger than zero, dear");

  }
  printf("\ninfo content per mutation: %f bits\n", info);
  printf("expectation per mutation:  %f bits\n", expect);
}

void
PrintMut5Probs(double *mut5pxy, double *pnull)
{
  int      x;
  double   nullp;
  double   info = 0.0;
  double   expect = 0.0;
  
  printf("Mutation probabilities\n");
  for (x = 0; x < 25; x++) {
    nullp  = (x/5<4)? EXP2(pnull[x/4]) : INDL;
    nullp *= (x%5<4)? EXP2(pnull[x%4]) : INDL;
    
    if (x%5 == 0) printf("\n");
    printf("%12f ",  mut5pxy[x]);
    
    if (mut5pxy[x] > 0.) {
      info   += mut5pxy[x]  * (LOG2(mut5pxy[x]) - nullp);
      expect += EXP2(nullp) * (LOG2(mut5pxy[x]) - nullp);
    }
    else if (mut5pxy[x] > 0.) Die ("mutation probs have to be larger than zero, dear");

  }
  printf("\ninfo content per mutation: %f bits\n", info);
  printf("expectation per mutation:  %f bits\n", expect);
}

/* Function: PrintOTHModel()
 * Date:     ER, Thu May 27 13:41:09 CDT 1999 [St. Louis]
 *
 * Purpose:  Print a oth model
 *
 * Args:     othmodel -- the othmodel prob's, in log2 form
 *
 * Returns:  void. prints transition and emission probs for oth model, in [0,1] form.
 */
void
PrintOTHModel(struct othmodel_s *oth)
{
  int sym, symx, symy;   /* symbols for emission prob's      +*/
  int idx;               /* index for transition prob's      +*/

  printf("\nOTH MODEL -- Flanking Left Model\n");
  PrintNullModel(oth->FLN);

  printf("\nOTH MODEL -- Flanking Middle Model\n");
  PrintNullModel(oth->FJN);

  printf("\nOTH MODEL -- Flanking Right Model\n");
  PrintNullModel(oth->FRN);

  printf("\nOTH MODEL -- Transition probabilities\n");
  for (idx = 0; idx < OTRANS; idx++)
    printf("t[%s]\t\t = %f\n", otrNAME[idx], EXP2(oth->t[idx])); 

  printf("\nOTH MODEL -- Emission probabilities\n");
  for (symx = 0; symx < 4; symx++)
    for (symy = 0; symy < 4; symy++)
      printf("P^M(%d,%d) \t= %f\n", symx, symy, EXP2(oth->mem[idx(symx,symy)]));
  for (sym = 0; sym < 4; sym++) 
    printf("P^X(%d) \t\t= %f\n", sym, EXP2(oth->xem[sym]));
  for (sym = 0; sym < 4; sym++) 
    printf("P^Y(%d) \t\t= %f\n", sym, EXP2(oth->yem[sym]));
}

/* Function: PrintOTHTrProbs()
 * Date:     ER, Tue Nov 23 17:57:48 CST 1999 [St. Louis]
 *
 * Purpose:  Print a oth model transition probabilities
 *
 * Args:     othmodel -- the othmodel prob's, in log2 form
 *
 * Returns:  void. prints transition and emission probs for oth model, in [0,1] form.
 */
void
PrintOTHTrProbs(struct othmodel_s *oth) 
{
  int    idx;               /* index for transition prob's      +*/
  double tr;

  printf("\nFlanking Left Model   - eta_L \t = %f\n", EXP2(oth->FLN->eta));
  
  printf("Flanking Middle Model - eta_J \t = %f\n", EXP2(oth->FJN->eta));
  
  printf("Flanking Right Model  - eta_R \t = %f\n", EXP2(oth->FRN->eta));
  
  printf("\nOTH MODEL -- Transition probabilities\n");
  for (idx = 0; idx < OTRANS; idx++) {
    tr = EXP2(oth->t[idx]);
    if (tr <= 1.0)
      printf("t[%5s]\t = %f\n", otrNAME[idx], EXP2(oth->t[idx])); 
    else if (tr > 1.0) 
      Die ("tr prob larger than 1.0 at %s\n", otrNAME[idx]);
  }
}
  
/* Function: CheckOTHParam()
 * Date:     ER, Thu Apr 20 11:01:39 CDT 2000 [St. Louis]
 *
 * Purpose:  from the othparam structure, make sure all probs are positive.
 *
 * Args:     oth_trans -- transition probabilities of the OTH model
 *
 * Returns:  void. 
 */
void     
CheckOTHParam(struct othparam_s param)
{
  double             tr;              /* transition prob's                           +*/
  int                idx;             /* index for transition prob's                 +*/

  /* Calculate transition prob's: oth.t[]
   */
  for (idx = 0; idx < OTRANS; idx++) {
    switch (idx) {
    case TFLB:  tr = param.xi;                                                                            break;
    case TFLFR: tr = 1.0 - param.xi;                                                                      break;
    case TBM:   if ((tr = 1.0 - 2.0*param.kappa) < 0.) Die("TBM = %.2f", tr);                             break;
    case TBX:   tr = param.kappa;                                                                         break;
    case TBY:   tr = param.kappa;                                                                         break;
    case TMM:   if ((tr = 1.0 - 2.0*param.delta)*(1.0-param.tau) < 0.) Die("TMM = %.2f", tr);             break;
    case TMX:   tr = param.delta*(1.0-param.tau);                                                         break;
    case TMY:   tr = param.delta*(1.0-param.tau);                                                         break;
    case TME:   tr = param.tau;                                                                           break;
    case TXM:   if ((tr = 1.0 - param.epsilon - param.gamma)*(1.0-param.tau) < 0.) Die("TXM = %.2f", tr); break;
    case TXX:   tr = param.epsilon*(1.0-param.tau);                                                       break;
    case TXY:   tr = param.gamma*(1.0-param.tau);                                                         break;
    case TXE:   tr = param.tau;                                                                           break;
    case TYM:   if ((tr = 1.0 - param.epsilon - param.gamma)*(1.0-param.tau) < 0.) Die("TYM = %.2f", tr); break;
    case TYX:   tr = param.gamma*(1.0-param.tau);                                                         break;
    case TYY:   tr = param.epsilon*(1.0-param.tau);                                                       break;
    case TYE:   tr = param.tau;                                                                           break;
    case TEFJ:  tr = 1.0 - param.eta;                                                                     break;
    case TEFR:  tr = param.eta;                                                                           break;
    case TFJB:  tr = 1.0;                                                                                 break;
    case TFRFR: tr = 1.0;                                                                                 break;
    default:   Die("transition (%d) does not exits", idx);
    }

   if (tr > 1.0 || tr < 0.0) Die ("CheckOTHParam(): transition %s in OTH model is wrong", otrNAME[idx]);
   else if (FALSE) printf("%s = %f\n", otrNAME[idx], tr);
  }
 
}

/* Function: from_transfer_2_transitions()
 * Date:     ER, Thu Apr 20 11:01:39 CDT 2000 [St. Louis]
 *
 * Purpose:  Reverse of fill_OTH_transfer(). 
 *           Given the transfer matrix for OTH, recalculate the transition probabilities.
 *
 * Args:     T         -- transfer matrix for the OTH model 
 *           dim       -- dimension. T(dim x dim)
 *           oth_trans -- transition probabilities of the OTH model
 *
 * Returns:  void. oth_trans are reasigned.
 */
void
from_transfer_2_transitions(double **TA, double **TB, int dimA, int dimB, double *oth_trans, int verbose)
{

  int    st1, st2, tr;
  int    row, col;
  int    idx, ntrans;

  if (verbose) {
    printf("TA(r) - OTH transfer matrix\n");
    for (row = 0; row < dimA; row++) {
      for (col = 0; col < dimA; col++) {
	printf("%.4f ", TA[row][col]);
      }
      printf("\n");
    }
    printf("TB(r) - OTH transfer matrix\n");
    for (row = 0; row < dimB; row++) {
      for (col = 0; col < dimB; col++) {
	printf("%.4f ", TB[row][col]);
      }
      printf("\n");
    }
  }
  
  /* TRANSITIONS using TB
   */
  oth_trans[TFLB]  = TB[0][0];
  oth_trans[TFLFR] = TB[0][1];
  oth_trans[TEFJ]  = TB[1][0];
  oth_trans[TEFR]  = TB[1][1];
  oth_trans[TFJB]  = 1.0;
  oth_trans[TFRFR] = 1.0;
  
  /* USING TA
   */
  for (st1 = stB, row = 0; st1 < stE; st1++, row++) {
    idx    = IdxTransOTH[st1];      /* starting index for transitions for state st1 */
    ntrans = TransPerOTHState[st1]; /* number of non-null transitions for state st1 */
    
    /*initialize counter for non-null transitions of st1 state 
     */
    tr = idx;
    
    for (st2 = stM, col = 0; st2 <= stE; st2++, col++) 
      {
	if (col > dimA || row > dimA) 
	  Die("OTH transfer matrix badly dimensioned, state %s --> %s", ostNAME[st1], ostNAME[st2]);
	
	if (tr - idx > ntrans) 
	  Die("OTH transition off limits, tr %s", otrNAME[tr]);
	
	if (OConnects[st1][st2]) {
	  oth_trans[tr] = TA[row][col];
	  tr ++;
	}
      }
  }


  /* Print transition prob's: oth.t[]
   */
  for (tr = 0; tr < OTRANS; tr++) { 
    if (oth_trans[tr] > 1.0+MARGIN || oth_trans[tr] < -MARGIN) Die ("transition %s in OTH model is wrong (%f)", otrNAME[idx], oth_trans[tr]);
    if (verbose) printf ("%s = %f\n", otrNAME[tr], oth_trans[tr]);
  }

}

/* Function: OTHmodelTransitionProbabilities()
 * Date:     ER, Tue Aug 13 17:37:45 CDT 2002  [St. Louis]
 *
 * Purpose:  Constructs a othmodel_s
 *
 * Args:     othparam - the list of parameters that define a othmodel           
 *
 * Returns:  (void)
 *           fills all prob's for othmodel, log2 form 
 *           (allc'ed here, freed by caller)
 */
void
OTHmodelTransitionProbabilities(struct othparam_s othparam, struct othparam_s othparam_zero, struct othparam_s othparam_infty, 
				  double tfactor, struct othmodel_s *oth, int pedantic, int verbose)
{
  double            **TA, **TA_zero, **TA_infty;     /* transfer matrices at two evolutionary times +*/
  double            **TB, **TB_zero, **TB_infty;     /* transfer matrices at two evolutionary times +*/
  double            **RA_diag;                       /* transfer matrices at two evolutionary times +*/
  double            **RB_diag;                       /* transfer matrices at two evolutionary times +*/
  int                 dimA;
  int                 dimB;
  int                 i;
  int                 row, col;

  
  dimA = stE - stB; 
  dimB = 2; 
 
  /* allocate Rate matrices
   */
  RA_diag = (double **) MallocOrDie (sizeof(double *) * dimA);
  RB_diag = (double **) MallocOrDie (sizeof(double *) * dimB);

  /* SCALE the transition probabilities with the evolutionary factor.
   *       [This is basically a way of making gaps "evolve".]
   *
   *                                
   * You have to define T_0 the transfer matrix at "time zero".
   * We'll assume no gaps at time zero, and is not singular (ie invertible)
   *
   *     for instance:              1.0    0.0  0.0  0.0
   *
   *                             1.0-tau   0.0  0.0  tau
   *                TA_zero =   
   *                             1.0-TXX   TXX  0.0  0.0
   *
   *                             1.0-TYY   0.0  TYY  0.0
   *
   *
   *
   *                            1.0  0.0
   *                TB_zero =  
   *                            0.0  1.0
   *
   * Method: (13AUG 02)
   *
   *                    q^i(t) = q^i_0 + r^i [ exp{tA^i} - I ]  ---   A(nxn), q(1xn), q_0(1xn), r(1xn)
   *
   *
   *              | q^1 |                           | q^1_o |                     |  0  |                           | 1 |
   *              |  .  |                           |   .   |                     |  0  |                           | 1 |
   *              |  .  |                           |   .   |                     |  0  |                           | 1 |
   *              |  .  |                           |   .   |                     |  0  |                           | 1 |
   *        Q^* = | q^i |                     Q_0 = | q^i_o |               R^i = |  0  |          A^i = 1/t* log [ | 1 | q^fix + Diag(R^diag) ]
   *              |  .  |                           |   .   |                     | r^i |                           | 1 |
   *              |  .  |                           |   .   |                     |  0  |                           | 1 |
   *              |  .  |                           |   .   |                     |  0  |                           | 1 |
   *              | q^n |                           | q^n_o |                     |  0  |                           | 1 |
   *
   *
   *
   *           THEN,      Q(t)  =  Q_0  + Sum_i R^i [ exp(tA^i) - I ]
   *
   *           (as a side)
   *           This is the original idea that never got to work (5AUG02)
   *
   *                   Using TA and TA_zero we can extrapolate and calculate TA(r) at any other time  
   *                                
   *                   Rescale : TA(r) = TA_zero + R * exp{r * log[I + R^{-1}*(TA-TA_zero)] }                               
   *                                
   * Redefine : TBB = T(0,0), TBM = T(0,1), ...                               
   *                                
   *             
   */
  TA        = OTHparam_to_transferA(othparam,       dimA);
  TA_zero   = OTHparam_to_transferA(othparam_zero,  dimA);
  TA_infty  = OTHparam_to_transferA(othparam_infty, dimA);

  if (verbose) {
    printf("TA* - OTH transfer matrix\n");
    for (row = 0; row < dimA; row++) {
      for (col = 0; col < dimA; col++) {
	printf("%.4f ", TA[row][col]);
      }
      printf("\n");
    }
    printf("TAzero - OTH transfer matrix\n");
    for (row = 0; row < dimA; row++) {
      for (col = 0; col < dimA; col++) {
	printf("%.4f ", TA_zero[row][col]);
      }
      printf("\n");
    }
    printf("TA_infty - OTH transfer matrix\n");
    for (row = 0; row < dimA; row++) {
      for (col = 0; col < dimA; col++) {
	printf("%.4f ", TA_infty[row][col]);
      }
      printf("\n");
    }
  }
  
  /* calculate: TA(tfactor) 
   */
  for (i = 0; i < dimA; i++) {
    RA_diag[i] = TransitionsExpVector(TA[i], TA_zero[i], TA_infty[i], dimA);
    TransitionsEvolved(stdout, TA[i], TA_zero[i], TA_infty[i], RA_diag[i], dimA, tfactor, FALSE, FALSE); 
  }
  if (verbose) {
    printf("TA(t=%f) - OTH transfer matrix\n", tfactor);
    for (row = 0; row < dimA; row++) {
      for (col = 0; col < dimA; col++) {
	printf("%.4f ", TA[row][col]);
      }
      printf("\n");
    }
  }
  
  /* For TB.
   *                                
   *            
   *                                
   *             
   */
  TB        = OTHparam_to_transferB(othparam,       dimB);
  TB_zero   = OTHparam_to_transferB(othparam_zero,  dimB);
  TB_infty  = OTHparam_to_transferB(othparam_infty, dimB);

  if (verbose) {
    printf("TB* - OTH transfer matrix\n");
    for (row = 0; row < dimB; row++) {
      for (col = 0; col < dimB; col++) {
	printf("%.4f ", TB[row][col]);
      }
      printf("\n");
    }
    printf("TB_zero - OTH transfer matrix\n");
    for (row = 0; row < dimB; row++) {
      for (col = 0; col < dimB; col++) {
	printf("%.4f ", TB_zero[row][col]);
      }
      printf("\n");
    }
    printf("TB_infty - OTH transfer matrix\n");
    for (row = 0; row < dimB; row++) {
      for (col = 0; col < dimB; col++) {
	printf("%.4f ", TB_infty[row][col]);
      }
      printf("\n");
    }
  }
  
  /* calculate: TB(tfactor) 
   */
  for (i = 0; i < dimB; i++) {
    RB_diag[i] = TransitionsExpVector(TB[i], TB_zero[i], TB_infty[i], dimB);
    TransitionsEvolved(stdout, TB[i], TB_zero[i], TB_infty[i], RB_diag[i], dimB, tfactor, FALSE, FALSE); 
  }
  
  if (verbose) {
    printf("TB(t=%f) - OTH transfer matrix\n", tfactor);
    for (row = 0; row < dimB; row++) {
      for (col = 0; col < dimB; col++) {
	printf("%.4f ", TB[row][col]);
      }
      printf("\n");
    }
  }

  /* Calculate transition probabilities from T 
   */
  from_transfer_2_transitions(TA, TB, dimA, dimB, oth->t, verbose);  
  
  free(TA[0]);
  free(TB[0]);
  free(TA_zero[0]);
  free(TB_zero[0]);
  free(TA_infty[0]);
  free(TB_infty[0]);
  for (i = 0; i < dimA; i++) free(RA_diag[i]);
  for (i = 0; i < dimB; i++) free(RB_diag[i]);

  free(TA);
  free(TB);
  free(TA_zero);
  free(TB_zero);
  free(TA_infty);
  free(TB_infty);
  free(RA_diag);
  free(RB_diag);

}

void
OTHmodel_transition_probabilities_linear(struct othparam_s othparam, struct othparam_s othparam_zero, 
					 double tfactor, struct othmodel_s *oth, int pedantic, int verbose)
{
  double            **TA, **TA_zero, **TA_rate;     /* transfer matrices at two evolutionary times +*/
  double            **TB, **TB_zero, **TB_rate;     /* transfer matrices at two evolutionary times +*/
  double            **RA_fix, **RA_diag;            /* transfer matrices at two evolutionary times +*/
  double            **RB_fix, **RB_diag;            /* transfer matrices at two evolutionary times +*/
  int                 dimA;
  int                 dimB;
  int                 i;

  
  dimA = stE - stB; 
  dimB = 2; 
  
  /* allocate Rate matrices
   */
  RA_fix = (double **) MallocOrDie (sizeof(double *) * dimA);
  RB_fix = (double **) MallocOrDie (sizeof(double *) * dimB);

 /* SCALE the transition probabilities with the evolutionary factor.
   *       [This is basically a way of making gaps "evolve".]
   *
   *                                
   * You have to define T_0 the transfer matrix at "time zero".
   * We'll assume no gaps at time zero, and is not singular (ie invertible)
   *
   *     for instance:            1.0  0.0  0.0  0.0
   *
   *                             1.0   0.0  0.0  0.0
   *                TA_zero =   
   *                            1-TXX  TXX  0.0  0.0
   *
   *                            1-TYY  0.0  TYY  0.0
   *
   *
   *
   *                        1.0  0.0
   *                TB_zero =  
   *                        0.0  1.0
   *
   * Method: (13AUG 02)
   *
   *                    q^i(t) = q^i_0 + r^i [ exp{tA^i} - I ]  ---   A(nxn), q(1xn), q_0(1xn), r(1xn)
   *
   *
   *              | q^1 |                           | q^1_o |                     |  0  |                               | 1 |
   *              |  .  |                           |   .   |                     |  0  |                               | 1 |
   *              |  .  |                           |   .   |                     |  0  |                               | 1 |
   *              |  .  |                           |   .   |                     |  0  |                               | 1 |
   *        Q^* = | q^i |                     Q_0 = | q^i_o |               R^i = |  0  |          A^i = 1/t* log [ I + | 1 | q^fix + Diag(R^diag) ]
   *              |  .  |                           |   .   |                     | r^i |                               | 1 |
   *              |  .  |                           |   .   |                     |  0  |                               | 1 |
   *              |  .  |                           |   .   |                     |  0  |                               | 1 |
   *              | q^n |                           | q^n_o |                     |  0  |                               | 1 |
   *
   *
   *
   *           THEN,      Q(t)  =  Q_0  + Sum_i R^i [ exp(tA^i) - I ]
   *
   *           (as a side)
   *           This is the original idea that never got to work (5AUG02)
   *
   *                   Using TA and TA_zero we can extrapolate and calculate TA(r) at any other time  
   *                                
   *                   Rescale : TA(r) = TA_zero + R * exp{r * log[I + R^{-1}*(TA-TA_zero)] }                               
   *                                
   * Redefine : TBB = T(0,0), TBM = T(0,1), ...                               
   *                                
   *             
   */
  TA       = OTHparam_to_transferA(othparam,      dimA);
  TA_zero  = OTHparam_to_transferA(othparam_zero, dimA);
  RA_diag  = OTH_transferA_Rdiag(dimA);
  TA_rate  = OTH_transferA_rate(dimA);

  /* calculate: TA(tfactor) 
   */
  for (i = 0; i < dimA; i++) {
    RA_fix[i] = TransitionsFixVector(TA[i], TA_zero[i], TA_rate[i], RA_diag[i], dimA);  
    TransitionsEvolvedLinear(stdout, TA[i], TA_zero[i],TA_rate[i], RA_diag[i],  RA_fix[i], dimA, tfactor, FALSE, FALSE); 
  }
  
  /* For TB.
   *                                
   *            
   *                                
   *             
   */
  TB       = OTHparam_to_transferB(othparam,      dimB);
  TB_zero  = OTHparam_to_transferB(othparam_zero, dimB);
  RB_diag  = OTH_transferB_Rdiag(dimB);
  TB_rate  = OTH_transferB_rate(dimB);

  /* calculate: TB(tfactor) 
   */
  for (i = 0; i < dimB; i++) {
    RB_fix[i] = TransitionsFixVector(TB[i], TB_zero[i], TB_rate[i], RB_diag[i], dimB); 
    TransitionsEvolvedLinear(stdout, TB[i], TB_zero[i], TB_rate[i], RB_diag[i], RB_fix[i], dimB, tfactor, FALSE, FALSE); 
  }
  
  /* Calculate transition probabilities from T 
   */
  from_transfer_2_transitions(TA, TB, dimA, dimB, oth->t, FALSE);  
  
  free(TA_rate[0]);
  free(TB_rate[0]);
  free(RA_diag[0]);
  free(RB_diag[0]);
  free(TA[0]);
  free(TB[0]);
  free(TA_zero[0]);
  free(TB_zero[0]);
  for (i = 0; i < dimA; i++) free(RA_fix[i]);
  for (i = 0; i < dimB; i++) free(RB_fix[i]);

  free(RA_fix);
  free(RB_fix);
  free(RA_diag);
  free(RB_diag);
  free(TA);
  free(TB);
  free(TA_rate);
  free(TB_rate);
  free(TA_zero);
  free(TB_zero);

}

/* Function: OTHparam_to_transferA()
 * Date:     ER, Fri Aug  2 10:35:42 CDT 2002 [St. Louis]
 *
 * Purpose:  Fill transfer matrix TA for OTH model from structure OTHparam_s
 *
 * Args:     OTHparam_s OTHparam
 *
 * Returns:  TA, transsfer matrices TA is allocated here. Freed by caller.
 */
double **
OTHparam_to_transferA(struct othparam_s othparam, int dim)
{  
  double **TA;
  int      row, col;
  int      st1, st2;

  /* allocate TA
   */
  TA     = (double **) MallocOrDie (sizeof(double *) * dim      );
  TA[0]  = (double  *) MallocOrDie (sizeof(double  ) * dim * dim);

  for (row = 1; row < dim; row++)
    TA[row] = TA[0] + row*dim;

  /* fill TA.
   * using the structure OTHparam_s
   */
  for (st1 = stB, row = 0; st1 < stE; st1++, row++)
    for (st2 = stM, col = 0; st2 <= stE; st2++, col++)
      {
        if (col > dim || row > dim)
          Die("OTH transfer TA matrix badly dimensioned");
 	
	if     (st1 == stB  && st2 == stM)  TA[row][col] = 1.0 - 2. * othparam.kappa;
        else if(st1 == stB  && st2 == stX)  TA[row][col] = othparam.kappa;
        else if(st1 == stB  && st2 == stY)  TA[row][col] = othparam.kappa;
        else if(st1 == stB  && st2 == stE)  TA[row][col] = 0.0;
	
        else if(st1 == stM  && st2 == stM)  TA[row][col] = (1.0 - 2. * othparam.delta) * (1.0 - othparam.tau);
        else if(st1 == stM  && st2 == stX)  TA[row][col] = othparam.delta * (1.0 - othparam.tau);
        else if(st1 == stM  && st2 == stY)  TA[row][col] = othparam.delta * (1.0 - othparam.tau);
        else if(st1 == stM  && st2 == stE)  TA[row][col] = othparam.tau;
	
        else if(st1 == stX  && st2 == stM)  TA[row][col] = (1.0 - othparam.gamma - othparam.epsilon) * (1.0 - othparam.tau);
        else if(st1 == stX  && st2 == stX)  TA[row][col] = othparam.epsilon * (1.0 - othparam.tau); 
        else if(st1 == stX  && st2 == stY)  TA[row][col] = othparam.gamma * (1.0 - othparam.tau); 
        else if(st1 == stX  && st2 == stE)  TA[row][col] = othparam.tau; 
	
        else if(st1 == stY  && st2 == stM)  TA[row][col] = (1.0 - othparam.gamma - othparam.epsilon) * (1.0 - othparam.tau); 
        else if(st1 == stY  && st2 == stX)  TA[row][col] = othparam.gamma * (1.0 - othparam.tau); 
        else if(st1 == stY  && st2 == stY)  TA[row][col] = othparam.epsilon * (1.0 - othparam.tau); 
	else if(st1 == stY  && st2 == stE)  TA[row][col] = othparam.tau;
	
      }

  if (FALSE) {
    printf("TA - OTH transfer matrix\n");
    for (row = 0; row < dim; row++) {
      for (col = 0; col < dim; col++) {
	printf("%.4f ", TA[row][col]);
      }
      printf("\n");
    }
  }
  
  /* Check they are conditional probabilities
   */
  for (row = 0; row < dim; row++) {
    CheckSingleProb(TA[row], dim);
  }

  return TA;
}

/* Function: OTHparam_to_transferB()
 * Date:     ER, Fri Aug  2 10:35:42 CDT 2002 [St. Louis]
 *
 * Purpose:  Fill transfer matrix TB for OTH model from structure OTHparam_s
 *
 * Args:     OTHparam_s OTHparam
 *
 * Returns:  TB, transsfer matrices TB is allocated here. Freed by caller.
 */
double **
OTHparam_to_transferB(struct othparam_s othparam, int dim)
{  
  double **TB;
  int      row, col;

  /* allocate TB
   */
  TB     = (double **) MallocOrDie (sizeof(double *) * dim      );
  TB[0]  = (double  *) MallocOrDie (sizeof(double  ) * dim * dim);

  for (row = 1; row < dim; row++)
    TB[row] = TB[0] + row*dim;

  /* fill TB.
   * this is done totally ad hoc, just assuming no gaps at zero evolutionary distance,
   * and that the matrix is not singular (ie invertible)
   */
  for (row = 0; row < dim; row++)
    for (col = 0; col < dim; col++)
      {
        if (col > dim || row > dim)
          Die("OTH transfer TB matrix badly dimensioned");
	
	if     (row == 0  && col == 0)  TB[row][col] = othparam.xi;
        else if(row == 0  && col == 1)  TB[row][col] = 1.0 - othparam.xi;
	
        else if(row == 1  && col == 0)  TB[row][col] = 1.0 - othparam.eta;
        else if(row == 1  && col == 1)  TB[row][col] = othparam.eta;
	
      }

  if (FALSE) {
    printf("TB - OTH transfer matrix\n");
    for (row = 0; row < dim; row++) {
      for (col = 0; col < dim; col++) {
	printf("%.4f ", TB[row][col]);
      }
      printf("\n");
    }
  }

  /* Check they are conditional probabilities
   */
  for (row = 0; row < dim; row++) 
    CheckSingleProb(TB[row], dim);
  
  return TB;
}




/* Function: OTH_transferA_at_infty()
 * Date:     ER, Wed Aug  7 10:43:39 CDT 2002 [St. Louis]
 *
 * Purpose:  Fill TA_infty the transfer matrix for the OTH model at infty evolutionary distance
 *
 * Args:     TA_infty -- transfer matrix for the OTH model at fixation
 *
 *                                M      X      Y     E
 *
 *                         B     1/3    1/3    1/3    0
 *                    
 *                         M     1/4    1/4    1/4   1/4
 *           TA_infty  =   
 *                         X     1/4    1/4    1/4   1/4
 *                  
 *                         Y     1/4    1/4    1/4   1/4
 *
 *
 *
 * Returns:  TA_infty is allocated and filled here. TA_infty freed by caller.
 */
double **
OTH_transferA_at_infty(double **TA, double **TA_zero, int dim)
{
  double **TA_infty;
  int      row, col;
  int      st1, st2;

  /* allocate TA_infty
   */
  TA_infty    = (double **) MallocOrDie (sizeof(double *) * dim      );
  TA_infty[0] = (double  *) MallocOrDie (sizeof(double  ) * dim * dim);

  for (row = 1; row < dim; row++)
    TA_infty[row] = TA_infty[0] + row*dim;

  /* fill TA_infty.
   * this is done totally ad hoc, just assuming all transitons are equivalente at fixation,
   * 
   */
  for (st1 = stB, row = 0; st1 < stE; st1++, row++)
    for (st2 = stM, col = 0; st2 <= stE; st2++, col++)
      {
        if (col > dim || row > dim)
          Die("OTH transfer TA_infty matrix badly dimensioned");
	
	if     (st1 == stB  && st2 == stM)  TA_infty[row][col] = 1./3.;
        else if(st1 == stB  && st2 == stX)  TA_infty[row][col] = 1./3.;
        else if(st1 == stB  && st2 == stY)  TA_infty[row][col] = 1./3.;
        else if(st1 == stB  && st2 == stE)  TA_infty[row][col] = 0.0;
	
        else if(st1 == stM  && st2 == stM)  TA_infty[row][col] = 0.25;
        else if(st1 == stM  && st2 == stX)  TA_infty[row][col] = 0.25;
        else if(st1 == stM  && st2 == stY)  TA_infty[row][col] = 0.25;
        else if(st1 == stM  && st2 == stE)  TA_infty[row][col] = 0.25;
	
        else if(st1 == stX  && st2 == stM)  TA_infty[row][col] = 0.25;
        else if(st1 == stX  && st2 == stX)  TA_infty[row][col] = 0.25; 
        else if(st1 == stX  && st2 == stY)  TA_infty[row][col] = 0.25; 
        else if(st1 == stX  && st2 == stE)  TA_infty[row][col] = 0.25; 
	
        else if(st1 == stY  && st2 == stM)  TA_infty[row][col] = 0.25; 
        else if(st1 == stY  && st2 == stX)  TA_infty[row][col] = 0.25; 
        else if(st1 == stY  && st2 == stY)  TA_infty[row][col] = 0.25; 
	else if(st1 == stY  && st2 == stE)  TA_infty[row][col] = 0.25;
	
      }

   /* Check they are conditional probabilities
   */
  for (row = 0; row < dim; row++) {
    CheckSingleProb(TA_infty[row], col);
  }

  if (FALSE) {
    printf("TA_infty - OTH transfer matrix\n");
    for (row = 0; row < dim; row++) {
      for (col = 0; col < dim; col++) {
	printf("%.4f ", TA_infty[row][col]);
      }
      printf("\n");
    }
  }
  
  return TA_infty;
}

/* Function: OTH_transferB_at_infty()
 * Date:     ER, Wed Aug  7 10:43:25 CDT 2002 [St. Louis]
 *
 * Purpose:  Fill TB_infty the transfer matrix for the OTH model at fixation
 *
 * Args:     TB_infty -- transfer matrix for the OTH model at fixation
 *
 *
 *                            B    FR
 *                    
 *                       FL  1/2   1/2      
 *           TB_infty =   
 *                       E   1/2   1/2  
 *              
 *
 *
 * Returns:  TB_infty is allocated and filled here. T_0 freed by caller.
 */
double **
OTH_transferB_at_infty(double **TB, double **TB_zero, int dim)
{
  double **TB_infty;
  int      row, col;

  /* allocate TB_infty
   */
  TB_infty    = (double **) MallocOrDie (sizeof(double *) * dim      );
  TB_infty[0] = (double  *) MallocOrDie (sizeof(double  ) * dim * dim);

  for (row = 1; row < dim; row++)
    TB_infty[row] = TB_infty[0] + row*dim;

  /* fill TB_infty.
   * this is done totally ad hoc, just assuming all transitons are equivalente at fixation,
   * 
   */
  for (row = 0; row < dim; row++)
    for (col = 0; col < dim; col++)
      TB_infty[row][col] = 1./(float)dim;

   /* Check they are conditional probabilities
   */
  for (row = 0; row < dim; row++) {
    CheckSingleProb(TB_infty[row], dim);
  }

  if (FALSE) {
    printf("TB_infty - OTH transfer matrix\n");
    for (row = 0; row < dim; row++) {
      for (col = 0; col < dim; col++) {
	printf("%.4f ", TB_infty[row][col]);
      }
      printf("\n");
    }
  }
  
  return TB_infty;
}



/* Function: OTH_transferA_Rdiag()
 * Date:     ER, Fri Aug  9 16:15:22 CDT 2002 [St. Louis]
 *
 * Purpose:  Fill R_diag of the transfer matrix for the OTH model
 *
 * Args:     Rdiag -- 
 *
 *
 * Returns:  R_diag is allocated and filled here. R-diag freed by caller.
 */
double **
OTH_transferA_Rdiag(int dim)
{
  double **R_diag;
  int      row, col;

  /* allocate R_diag
   */
  R_diag    = (double **) MallocOrDie (sizeof(double *) * dim      );
  R_diag[0] = (double  *) MallocOrDie (sizeof(double  ) * dim * dim);

  for (row = 1; row < dim; row++)
    R_diag[row] = R_diag[0] + row*dim;

  /* fill R_diag.
   * 
   */
    for (row = 0; row < dim; row++) 
      for (col = 0; col < dim; col++)  
	R_diag[row][col] = 0.0;
      
  if (FALSE) {
    printf("RA_diag - OTH transfer matrix\n");
    for (row = 0; row < dim; row++) {
      for (col = 0; col < dim; col++) {
	printf("%.4f ", R_diag[row][col]);
      }
      printf("\n");
    }
  }
  
  return R_diag;
}

double **
OTH_transferB_Rdiag(int dim)
{
  double **R_diag;
  int      row, col;

  /* allocate R_diag
   */
  R_diag    = (double **) MallocOrDie (sizeof(double *) * dim      );
  R_diag[0] = (double  *) MallocOrDie (sizeof(double  ) * dim * dim);

  for (row = 1; row < dim; row++)
    R_diag[row] = R_diag[0] + row*dim;

  /* fill R_diag.
   * 
   */
    for (row = 0; row < dim; row++) 
      for (col = 0; col < dim; col++)  
	R_diag[row][col] = 0.0;
      
  if (FALSE) {
    printf("RB_diag - OTH transfer matrix\n");
    for (row = 0; row < dim; row++) {
      for (col = 0; col < dim; col++) {
	printf("%.4f ", R_diag[row][col]);
      }
      printf("\n");
    }
  }
  
  return R_diag;
}

/* Function: OTH_transferA_rate()
 * Date:     ER, Fri Aug  9 17:07:41 CDT 2002 [St. Louis]
 *
 * Purpose:  Fill R of the transfer matrix for the OTH model
 *
 * Args:     R -- 
 *
 *
 * Returns:  R is allocated and filled here. R freed by caller.
 */
double **
OTH_transferA_rate(int dim)
{
  double **R;
  int      row, col;
  int      st1, st2;

  /* allocate T_rate
   */
  R    = (double **) MallocOrDie (sizeof(double *) * dim      );
  R[0] = (double  *) MallocOrDie (sizeof(double  ) * dim * dim);

  for (row = 1; row < dim; row++)
    R[row] = R[0] + row*dim;

  /* fill T_rate.
   * 
   */
  for (st1 = stB, row = 0; st1 < stE; st1++, row++)
    for (st2 = stM, col = 0; st2 <= stE; st2++, col++)
      {
        if (col > dim || row > dim)
          Die("OTH transfer TA_rate matrix badly dimensioned");
	
	if     (st1 == stB  && st2 == stM)  R[row][col] = 0.8;
        else if(st1 == stB  && st2 == stX)  R[row][col] = 0.1;
        else if(st1 == stB  && st2 == stY)  R[row][col] = 0.1;
        else if(st1 == stB  && st2 == stE)  R[row][col] = 0.0;
	
        else if(st1 == stM  && st2 == stM)  R[row][col] = 0.7;
        else if(st1 == stM  && st2 == stX)  R[row][col] = 0.1;
        else if(st1 == stM  && st2 == stY)  R[row][col] = 0.1;
        else if(st1 == stM  && st2 == stE)  R[row][col] = 0.1;
	
        else if(st1 == stX  && st2 == stM)  R[row][col] = 0.4;
        else if(st1 == stX  && st2 == stX)  R[row][col] = 0.4; 
        else if(st1 == stX  && st2 == stY)  R[row][col] = 0.1; 
        else if(st1 == stX  && st2 == stE)  R[row][col] = 0.1; 
	
        else if(st1 == stY  && st2 == stM)  R[row][col] = 0.4; 
        else if(st1 == stY  && st2 == stX)  R[row][col] = 0.1; 
        else if(st1 == stY  && st2 == stY)  R[row][col] = 0.4; 
	else if(st1 == stY  && st2 == stE)  R[row][col] = 0.0;
	
      }

  if (FALSE) {
    printf("TA_rate - OTH transfer matrix\n");
    for (row = 0; row < dim; row++) {
      for (col = 0; col < dim; col++) {
	printf("%.4f ", R[row][col]);
      }
      printf("\n");
    }
  }
  
  return R;
}

double **
OTH_transferB_rate(int dim)
{
  double **R;
  int      row, col;

  /* allocate T_rate
   */
  R    = (double **) MallocOrDie (sizeof(double *) * dim      );
  R[0] = (double  *) MallocOrDie (sizeof(double  ) * dim * dim);

  for (row = 1; row < dim; row++)
    R[row] = R[0] + row*dim;

  /* fill T_rate.
   * 
   */
    for (row = 0; row < dim; row++) 
      for (col = 0; col < dim; col++)  
	R[row][col] = 0.5;
      
  if (FALSE) {
    printf("TB_rate - OTH transfer matrix\n");
    for (row = 0; row < dim; row++) {
      for (col = 0; col < dim; col++) {
	printf("%.4f ", R[row][col]);
      }
      printf("\n");
    }
  }
  
  return R;
}
