source: branches/lib/GDE/PHYLIP/dnamlk.c

Last change on this file was 19480, checked in by westram, 2 years ago
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 67.0 KB
Line 
1#include "phylip.h"
2#include "seq.h"
3
4/* version 3.6. (c) Copyright 1986-2002 by the University of Washington
5  and by Joseph Felsenstein.  Written by Joseph Felsenstein.  Permission is
6  granted to copy and use this program provided no fee is charged for it
7  and provided that this copyright notice is not removed. */
8
9#define epsilon         0.0001   /* used in makenewv, getthree, update */
10#define over            60
11
12typedef struct valrec {
13  double rat, ratxi, ratxv, orig_zz, z1, y1, z1zz, z1yy, xiz1,
14         xiy1xv;
15  double *ww, *zz, *wwzz, *vvzz; 
16} valrec;
17
18typedef double contribarr[maxcategs];
19
20extern sequence y;
21valrec ***tbl;
22
23#ifndef OLDC
24/* function prototypes */
25void   getoptions(void);
26void   allocrest(void);
27void   doinit(void);
28void   inputoptions(void);
29void   makeweights(void);
30void   getinput(void);
31void   inittable_for_usertree (FILE *);
32void   inittable(void);
33void   exmake(double, long);
34void   alloc_nvd(long, nuview_data *);
35void   free_nvd(nuview_data *);
36void   nuview(node *);
37double evaluate(node *);
38void   getthree(node *p, double thigh, double tlow);
39void   makenewv(node *);
40void   update(node *);
41void   smooth(node *);
42void   restoradd(node *, node *, node *, double);
43void   dnamlk_add(node *, node *, node *);
44void   dnamlk_re_move(node **, node **, boolean);
45void   tryadd(node *, node **, node **);
46void   addpreorder(node *, node *, node *, boolean, boolean);
47void   tryrearr(node *, boolean *);
48void   repreorder(node *, boolean *);
49void   rearrange(node **);
50void   initdnamlnode(node **, node **, node *, long, long, long *, long *,
51                initops, pointarray, pointarray, Char *, Char *, FILE *);
52void   tymetrav(node *, double *);
53void   dnamlk_coordinates(node *, long *);
54void   dnamlk_drawline(long, double);
55void   dnamlk_printree(void);
56void   describe(node *);
57void   reconstr(node *, long);
58void   rectrav(node *, long, long);
59void   summarize(void);
60void   dnamlk_treeout(node *);
61void   nodeinit(node *);
62void   initrav(node *);
63void   travinit(node *);
64void   travsp(node *);
65void   treevaluate(void);
66void   maketree(void);
67void reallocsites(void);
68void save_tree_tyme(tree* save_tree, double tymes[]);
69void restore_saved_tyme(tree *load_tree, double tymes[]);
70/* function prototypes */
71#endif
72
73
74Char infilename[FNMLNGTH], outfilename[FNMLNGTH], intreename[FNMLNGTH], outtreename[FNMLNGTH],
75     catfilename[FNMLNGTH], weightfilename[FNMLNGTH];
76double *rrate;
77long sites, weightsum, categs, datasets, ith, njumble, jumb;
78/*  sites = number of sites in actual sequences
79  numtrees = number of user-defined trees */
80long inseed, inseed0, mx, mx0, mx1;
81boolean freqsfrom, global, global2=0, jumble, lngths, trout, usertree, weights, 
82          rctgry, ctgry, ttr, auto_, progress, mulsets, firstset, hypstate, 
83          reconsider, smoothit, polishing, justwts, gama, invar;
84tree curtree, bestree, bestree2, priortree;
85node *qwhere, *grbg;
86double *tymes;
87double xi, xv, ttratio, ttratio0, freqa, freqc, freqg, freqt, freqr,
88              freqy, freqar, freqcy, freqgr, freqty, fracchange,
89              cv, alpha, lambda, lambda1, invarfrac;
90long *enterorder;
91steptr aliasweight;
92double *rate;
93double **term, **slopeterm, **curveterm;
94longer seed;
95double *probcat;
96contribarr *contribution;
97char *progname;
98long rcategs, nonodes2;
99long **mp;
100char basechar[16]="acmgrsvtwyhkdbn";
101
102
103/* Local variables for maketree, propagated globally for C version: */
104long    maxwhich, col;
105double  global_like, bestyet, tdelta, lnlike, slope, curv, maxlogl;
106boolean lastsp, smoothed, succeeded;
107double  *l0gl;
108double  x[3], lnl[3];
109double  expon1i[maxcategs], expon1v[maxcategs],
110        expon2i[maxcategs], expon2v[maxcategs];
111node   *there;
112double  **l0gf;
113Char global_ch, ch2;
114
115
116void save_tree_tyme(tree* save_tree, double local_tymes[])
117{
118  int i;
119  for ( i = spp ; i < nonodes ; i++) {
120    local_tymes[i - spp] = save_tree->nodep[i]->tyme;
121  }
122}
123
124void restore_saved_tyme(tree *load_tree, double local_tymes[])
125{
126  int i;
127  for ( i = spp ; i < nonodes ; i++) {
128    load_tree->nodep[i]->tyme = local_tymes[i - spp];
129  }
130}
131
132void getoptions()
133{
134  /* interactively set options */
135  long i, loopcount, loopcount2;
136  Char ch;
137  boolean done;
138  boolean didchangecat, didchangercat;
139  double probsum;
140
141  fprintf(outfile, "\nNucleic acid sequence\n");
142  fprintf(outfile, "   Maximum Likelihood method with molecular ");
143  fprintf(outfile, "clock, version %s\n\n", VERSION);
144  putchar('\n');
145  auto_ = false;
146  ctgry = false;
147  didchangecat = false;
148  rctgry = false;
149  didchangercat = false;
150  categs = 1;
151  rcategs = 1;
152  freqsfrom = true;
153  gama = false;
154  invar = false;
155  global = false;
156  hypstate = false;
157  jumble = false;
158  njumble = 1;
159  lambda = 1.0;
160  lambda1 = 0.0;
161  lngths = false;
162  trout = true;
163  ttratio = 2.0;
164  ttr = false;
165  usertree = false;
166  weights = false;
167  printdata = false;
168  progress = true;
169  treeprint = true;
170  interleaved = true;
171  loopcount = 0;
172  do {
173    cleerhome();
174    printf("\nNucleic acid sequence\n");
175    printf("   Maximum Likelihood method with molecular clock, version %s\n\n",
176           VERSION);
177    printf("Settings for this run:\n");
178    printf("  U                 Search for best tree?");
179    if (usertree)
180     printf("  No, use user trees in input file\n");
181    else
182      printf("  Yes\n");
183    if (usertree) {
184      printf("  L           Use lengths from user tree?");
185      if (lngths)
186        printf("  Yes\n");
187      else
188        printf("  No\n");
189    }
190    printf("  T        Transition/transversion ratio:");
191    if (!ttr)
192      printf("  2.0\n");
193    else
194      printf("  %8.4f\n", ttratio);
195    printf("  F       Use empirical base frequencies?");
196    if (freqsfrom)
197      printf("  Yes\n");
198    else
199      printf("  No\n");
200    printf("  C   One category of substitution rates?");
201    if (!ctgry)
202      printf("  Yes\n");
203    else
204      printf("  %ld categories\n", categs);
205    printf("  R           Rate variation among sites?");
206    if (!rctgry)
207      printf("  constant rate\n");
208    else {
209      if (gama)
210        printf("  Gamma distributed rates\n");
211      else {
212        if (invar)
213          printf("  Gamma+Invariant sites\n");
214        else
215          printf("  user-defined HMM of rates\n");
216      }
217      printf("  A   Rates at adjacent sites correlated?");
218      if (!auto_)
219        printf("  No, they are independent\n");
220      else
221        printf("  Yes, mean block length =%6.1f\n", 1.0 / lambda);
222    }
223    if (!usertree) {
224      printf("  G                Global rearrangements?");
225      if (global)
226        printf("  Yes\n");
227      else
228        printf("  No\n");
229    }
230    printf("  W                       Sites weighted?  %s\n",
231           (weights ? "Yes" : "No"));
232    if (!usertree) {
233      printf("  J   Randomize input order of sequences?");
234      if (jumble)
235        printf("  Yes (seed = %8ld, %3ld times)\n", inseed0, njumble);
236      else
237        printf("  No. Use input order\n");
238    }
239    printf("  M           Analyze multiple data sets?");
240    if (mulsets)
241      printf("  Yes, %2ld %s\n", datasets,
242               (justwts ? "sets of weights" : "data sets"));
243    else
244      printf("  No\n");
245    printf("  I          Input sequences interleaved?");
246    if (interleaved)
247      printf("  Yes\n");
248    else
249      printf("  No, sequential\n");
250    printf("  0   Terminal type (IBM PC, ANSI, none)?");
251    if (ibmpc)
252      printf("  IBM PC\n");
253    if (ansi)
254      printf("  ANSI\n");
255    if (!(ibmpc || ansi))
256      printf("  (none)\n");
257    printf("  1    Print out the data at start of run");
258    if (printdata)
259      printf("  Yes\n");
260    else
261      printf("  No\n");
262    printf("  2  Print indications of progress of run");
263    if (progress)
264      printf("  Yes\n");
265    else
266      printf("  No\n");
267    printf("  3                        Print out tree");
268    if (treeprint)
269      printf("  Yes\n");
270    else
271      printf("  No\n");
272    printf("  4       Write out trees onto tree file?");
273    if (trout)
274      printf("  Yes\n");
275    else
276      printf("  No\n");
277    printf("  5   Reconstruct hypothetical sequences?  %s\n",
278           (hypstate ? "Yes" : "No"));
279    printf("\nAre these settings correct? (type Y or the letter for one to change)\n");
280#ifdef WIN32
281    phyFillScreenColor();
282#endif
283    scanf("%c%*[^\n]", &ch);
284    getchar();
285    if (ch == '\n')
286      ch = ' ';
287    uppercase(&ch);
288    done = (ch == 'Y');
289    if (!done) {
290      uppercase(&ch);
291      if (strchr("JUCRAFWGLTMI012345", ch) != NULL){
292        switch (ch) {
293
294        case 'C':
295          ctgry = !ctgry;
296          if (ctgry) {
297            printf("\nSitewise user-assigned categories:\n\n");
298            initcatn(&categs);
299            if (rate){
300              free(rate);
301            }
302            rate    = (double *) Malloc( categs * sizeof(double));
303            didchangecat = true;
304            initcategs(categs, rate);
305          }
306          break;
307
308        case 'R':
309          if (!rctgry) {
310            rctgry = true;
311            gama = true;
312          } else {
313            if (gama) {
314              gama = false;
315              invar = true;
316            } else {
317              if (invar)
318                invar = false;
319              else
320                rctgry = false;
321            }
322          }
323          break;
324
325        case 'A':
326          auto_ = !auto_;
327          if (auto_) {
328            initlambda(&lambda);
329            lambda1 = 1.0 - lambda;
330          }
331          break;
332
333        case 'F':
334          freqsfrom = !freqsfrom;
335          if (!freqsfrom)
336            initfreqs(&freqa, &freqc, &freqg, &freqt);
337          break;
338
339        case 'G':
340          global = !global;
341          break;
342
343        case 'W':
344          weights = !weights;
345          break;
346
347        case 'J':
348          jumble = !jumble;
349          if (jumble)
350            initjumble(&inseed, &inseed0, seed, &njumble);
351          else njumble = 1;
352          break;
353
354        case 'L':
355          lngths = !lngths;
356          break;
357
358        case 'T':
359          ttr = !ttr;
360          if (ttr)
361            initratio(&ttratio);
362          break;
363
364        case 'U':
365          usertree = !usertree;
366          break;
367
368        case 'M':
369          mulsets = !mulsets;
370          if (mulsets) {
371            printf("Multiple data sets or multiple weights?");
372            loopcount2 = 0;
373            do {
374              printf(" (type D or W)\n");
375#ifdef WIN32
376              phyFillScreenColor();
377#endif
378              scanf("%c%*[^\n]", &ch2);
379              getchar();
380              if (ch2 == '\n')
381                ch2 = ' ';
382              uppercase(&ch2);
383              countup(&loopcount2, 10);
384            } while ((ch2 != 'W') && (ch2 != 'D'));
385            justwts = (ch2 == 'W');
386            if (justwts)
387              justweights(&datasets);
388            else
389              initdatasets(&datasets);
390            if (!jumble) {
391              jumble = true;
392              initjumble(&inseed, &inseed0, seed, &njumble);
393            }
394          }
395          break;
396
397        case 'I':
398          interleaved = !interleaved;
399          break;
400
401        case '0':
402          initterminal(&ibmpc, &ansi);
403          break;
404
405        case '1':
406          printdata = !printdata;
407          break;
408
409        case '2':
410          progress = !progress;
411          break;
412
413        case '3':
414          treeprint = !treeprint;
415          break;
416
417        case '4':
418          trout = !trout;
419          break;
420
421        case '5':
422          hypstate = !hypstate;
423          break;
424        }
425      } else
426        printf("Not a possible option!\n");
427    }
428    countup(&loopcount, 100);
429  } while (!done);
430  if (gama || invar) {
431    loopcount = 0;
432    do {
433      printf(
434"\nCoefficient of variation of substitution rate among sites (must be positive)\n");
435      printf(
436  " In gamma distribution parameters, this is 1/(square root of alpha)\n");
437#ifdef WIN32
438      phyFillScreenColor();
439#endif
440      scanf("%lf%*[^\n]", &cv);
441      getchar();
442      countup(&loopcount, 10);
443    } while (cv <= 0.0);
444    alpha = 1.0 / (cv * cv);
445  }
446  if (!rctgry)
447    auto_ = false;
448  if (rctgry) {
449    printf("\nRates in HMM");
450    if (invar)
451      printf(" (including one for invariant sites)");
452    printf(":\n");
453    initcatn(&rcategs);
454    if (probcat){
455      free(probcat);
456      free(rrate);
457    }
458    probcat = (double *) Malloc(rcategs * sizeof(double));
459    rrate   = (double *) Malloc(rcategs * sizeof(double));
460    didchangercat = true;
461    if (gama)
462      initgammacat(rcategs, alpha, rrate, probcat); 
463    else {
464      if (invar) {
465        loopcount = 0;
466        do {
467          printf("Fraction of invariant sites?\n");
468          scanf("%lf%*[^\n]", &invarfrac);
469          getchar();
470          countup(&loopcount, 10);
471        } while ((invarfrac <= 0.0) || (invarfrac >= 1.0));
472        initgammacat(rcategs-1, alpha, rrate, probcat); 
473        for (i = 0; i < rcategs-1; i++)
474          probcat[i] = probcat[i]*(1.0-invarfrac);
475        probcat[rcategs-1] = invarfrac;
476        rrate[rcategs-1] = 0.0;
477      } else {
478        initcategs(rcategs, rrate);
479        initprobcat(rcategs, &probsum, probcat);
480      }
481    }
482  }
483  if (!didchangercat){
484    rrate      = Malloc( rcategs*sizeof(double));
485    probcat    = Malloc( rcategs*sizeof(double));
486    rrate[0]   = 1.0;
487    probcat[0] = 1.0;
488  }
489  if (!didchangecat){
490    rate       = Malloc( categs*sizeof(double));
491    rate[0]    = 1.0;
492  }
493}  /* getoptions */
494
495void reallocsites(void) 
496{
497  long i;
498
499  for (i = 0; i < spp; i++) {
500    free(y[i]);
501    y[i] = (char *)Malloc(sites * sizeof(char));
502  }
503  free(weight);
504  free(category);
505  free(alias);
506  free(aliasweight);
507  free(ally);
508  free(location);
509 
510  weight      = (long *)Malloc(sites*sizeof(long));
511  category    = (long *)Malloc(sites*sizeof(long));
512  alias       = (long *)Malloc(sites*sizeof(long));
513  aliasweight = (long *)Malloc(sites*sizeof(long));
514  ally        = (long *)Malloc(sites*sizeof(long));
515  location    = (long *)Malloc(sites*sizeof(long));
516}
517
518void allocrest()
519{
520  long i;
521
522  y     = (Char **)Malloc(spp*sizeof(Char *));
523  nayme  = (naym *)Malloc(spp*sizeof(naym));
524  for (i = 0; i < spp; i++)
525    y[i] = (char *)Malloc(sites * sizeof(char));
526  enterorder  = (long *)Malloc(spp*sizeof(long));
527  weight      = (long *)Malloc(sites*sizeof(long));
528  category    = (long *)Malloc(sites*sizeof(long));
529  alias       = (long *)Malloc(sites*sizeof(long));
530  aliasweight = (long *)Malloc(sites*sizeof(long));
531  ally        = (long *)Malloc(sites*sizeof(long));
532  location    = (long *)Malloc(sites*sizeof(long));
533  tymes       = (double *)Malloc((nonodes - spp) * sizeof(double));
534}  /* allocrest */
535
536
537void doinit()
538{
539  /* initializes variables */
540
541  inputnumbers(&spp, &sites, &nonodes, 1);
542  getoptions();
543  if (printdata)
544    fprintf(outfile, "%2ld species, %3ld  sites\n", spp, sites);
545  alloctree(&curtree.nodep, nonodes, usertree);
546  allocrest();
547  if (usertree)
548    return;
549  alloctree(&bestree.nodep, nonodes, 0);
550  if (njumble <= 1)
551    return;
552  alloctree(&bestree2.nodep, nonodes, 0);
553}  /* doinit */
554
555
556void inputoptions()
557{
558  long i;
559
560  if (!firstset && !justwts) {
561    samenumsp(&sites, ith);
562    reallocsites();
563  }
564
565  for (i = 0; i < sites; i++)
566    category[i] = 1;
567  for (i = 0; i < sites; i++)
568    weight[i] = 1;
569 
570  if (justwts || weights)
571    inputweights(sites, weight, &weights);
572  weightsum = 0;
573  for (i = 0; i < sites; i++)
574    weightsum += weight[i];
575  if (ctgry && categs > 1) {
576    inputcategs(0, sites, category, categs, "DnaMLK");
577    if (printdata)
578      printcategs(outfile, sites, category, "Site categories");
579  }
580  if (weights && printdata)
581    printweights(outfile, 0, sites, weight, "Sites");
582}  /* inputoptions */
583
584
585void makeweights()
586{
587  /* make up weights vector to avoid duplicate computations */
588  long i;
589
590   for (i = 1; i <= sites; i++) {
591    alias[i - 1] = i;
592    ally[i - 1] = 0;
593    aliasweight[i - 1] = weight[i - 1];
594    location[i - 1] = 0;
595  }
596  sitesort2(sites, aliasweight);
597  sitecombine2(sites, aliasweight);
598  sitescrunch2(sites, 1, 2, aliasweight);
599  for (i = 1; i <= sites; i++) {
600    if (aliasweight[i - 1] > 0)
601      endsite = i;
602  }
603  for (i = 1; i <= endsite; i++) {
604    ally[alias[i - 1] - 1] = alias[i - 1];
605    location[alias[i - 1] - 1] = i;
606  }
607  contribution = (contribarr *) Malloc( endsite*sizeof(contribarr));
608}  /* makeweights */
609
610
611void getinput()
612{
613 
614  /* reads the input data */
615  inputoptions();
616  if (!freqsfrom)
617    getbasefreqs(freqa, freqc, freqg, freqt, &freqr, &freqy, &freqar, &freqcy,
618                   &freqgr, &freqty, &ttratio, &xi, &xv, &fracchange,
619                   freqsfrom, true);
620  if (!justwts || firstset)
621    inputdata(sites);
622  makeweights();
623  setuptree2(curtree);
624  if (!usertree) {
625    setuptree2(bestree);
626    if (njumble > 1)
627      setuptree2(bestree2);
628  }
629  allocx(nonodes, rcategs, curtree.nodep, usertree);
630  if (!usertree) {
631    allocx(nonodes, rcategs, bestree.nodep, 0);
632    if (njumble > 1)
633      allocx(nonodes, rcategs, bestree2.nodep, 0);
634  }
635  makevalues2(rcategs, curtree.nodep, endsite, spp, y, alias);
636  if (freqsfrom) {
637    empiricalfreqs(&freqa, &freqc, &freqg, &freqt, aliasweight, curtree.nodep);
638    getbasefreqs(freqa, freqc, freqg, freqt, &freqr, &freqy, &freqar, &freqcy,
639                   &freqgr, &freqty, &ttratio, &xi, &xv, &fracchange,
640                   freqsfrom, true);
641  }
642  if (!justwts || firstset)
643    fprintf(outfile, "\nTransition/transversion ratio = %10.6f\n\n", ttratio);
644}  /* getinput */
645
646
647void inittable_for_usertree (FILE *fp_intree)
648{
649  /* If there's a user tree, then the ww/zz/wwzz/vvzz elements need
650     to be allocated appropriately. */
651  long num_comma;
652  long i, j;
653
654  /* First, figure out the largest possible furcation, i.e. the number
655     of commas plus one */
656  countcomma (&fp_intree, &num_comma);
657  num_comma++;
658 
659  for (i = 0; i < rcategs; i++) {
660    for (j = 0; j < categs; j++) {
661      /* Free the stuff allocated assuming bifurcations */
662      free (tbl[i][j]->ww);
663      free (tbl[i][j]->zz);
664      free (tbl[i][j]->wwzz);
665      free (tbl[i][j]->vvzz);
666
667      /* Then allocate for worst-case multifurcations */
668      tbl[i][j]->ww   = (double *) Malloc( num_comma * sizeof (double));
669      tbl[i][j]->zz   = (double *) Malloc( num_comma * sizeof (double));
670      tbl[i][j]->wwzz = (double *) Malloc( num_comma * sizeof (double));
671      tbl[i][j]->vvzz = (double *) Malloc( num_comma * sizeof (double));
672    }
673  }
674}  /* inittable_for_usertree */
675
676
677void inittable()
678{
679  /* Define a lookup table. Precompute values and print them out in tables */
680  long i, j;
681  double sumrates;
682 
683  tbl = (valrec ***) Malloc( rcategs * sizeof(valrec **));
684  for (i = 0; i < rcategs; i++) {
685    tbl[i] = (valrec **) Malloc( categs*sizeof(valrec *));
686    for (j = 0; j < categs; j++)
687      tbl[i][j] = (valrec *) Malloc( sizeof(valrec));
688  }
689
690  for (i = 0; i < rcategs; i++) {
691    for (j = 0; j < categs; j++) {
692      tbl[i][j]->rat = rrate[i]*rate[j];
693      tbl[i][j]->ratxi = tbl[i][j]->rat * xi;
694      tbl[i][j]->ratxv = tbl[i][j]->rat * xv;
695
696      /* Allocate assuming bifurcations, will be changed later if
697         necessary (i.e. there's a user tree) */
698      tbl[i][j]->ww   = (double *) Malloc( 2 * sizeof (double));
699      tbl[i][j]->zz   = (double *) Malloc( 2 * sizeof (double));
700      tbl[i][j]->wwzz = (double *) Malloc( 2 * sizeof (double));
701      tbl[i][j]->vvzz = (double *) Malloc( 2 * sizeof (double));
702    }
703  }
704  sumrates = 0.0;
705  for (i = 0; i < endsite; i++) {
706    for (j = 0; j < rcategs; j++)
707      sumrates += aliasweight[i] * probcat[j] 
708        * tbl[j][category[alias[i] - 1] - 1]->rat;
709  }
710  sumrates /= (double)sites;
711  for (i = 0; i < rcategs; i++)
712    for (j = 0; j < categs; j++) {
713      tbl[i][j]->rat /= sumrates;
714      tbl[i][j]->ratxi /= sumrates;
715      tbl[i][j]->ratxv /= sumrates;
716    }
717  if (gama || invar) {
718    fprintf(outfile, "\nDiscrete approximation to gamma distributed rates\n");
719    fprintf(outfile,
720    " Coefficient of variation of rates = %f  (alpha = %f)\n", cv, alpha);
721  }
722  if (rcategs > 1) {
723    fprintf(outfile, "\nState in HMM    Rate of change    Probability\n\n");
724    for (i = 0; i < rcategs; i++)
725      if (probcat[i] < 0.0001)
726        fprintf(outfile, "%9ld%16.3f%20.6f\n", i+1, rrate[i], probcat[i]);
727      else if (probcat[i] < 0.001)
728          fprintf(outfile, "%9ld%16.3f%19.5f\n", i+1, rrate[i], probcat[i]);
729        else if (probcat[i] < 0.01)
730            fprintf(outfile, "%9ld%16.3f%18.4f\n", i+1, rrate[i], probcat[i]);
731          else
732            fprintf(outfile, "%9ld%16.3f%17.3f\n", i+1, rrate[i], probcat[i]);
733    putc('\n', outfile);
734    if (auto_) {
735      fprintf(outfile,
736     "Expected length of a patch of sites having the same rate = %8.3f\n",
737             1/lambda);
738      putc('\n', outfile);
739    }
740  }
741  if (categs > 1) {
742    fprintf(outfile, "\nSite category   Rate of change\n\n");
743    for (i = 0; i < categs; i++)
744      fprintf(outfile, "%9ld%16.3f\n", i+1, rate[i]);
745    fprintf(outfile, "\n\n");
746  }
747}  /* inittable */
748
749
750void exmake(double lz, long n)
751{
752  /* pretabulate tables of exponentials so need not do for each site */
753  long i;
754  double rat;
755
756  for (i = 0; i < categs; i++) {
757    rat = rate[i];
758    switch (n) {
759
760    case 1:
761      expon1i[i] = exp(rat * xi * lz);
762      expon1v[i] = exp(rat * xv * lz);
763      break;
764
765    case 2:
766      expon2i[i] = exp(rat * xi * lz);
767      expon2v[i] = exp(rat * xv * lz);
768      break;
769    }
770  }
771}  /* exmake */
772
773
774void alloc_nvd(long num_sibs, nuview_data *local_nvd)
775{
776  /* Allocate blocks of memory appropriate for the number of siblings
777     a given node has */
778  local_nvd->yy     = (double *) Malloc( num_sibs * sizeof (double));
779  local_nvd->wwzz   = (double *) Malloc( num_sibs * sizeof (double));
780  local_nvd->vvzz   = (double *) Malloc( num_sibs * sizeof (double));
781  local_nvd->vzsumr = (double *) Malloc( num_sibs * sizeof (double));
782  local_nvd->vzsumy = (double *) Malloc( num_sibs * sizeof (double));
783  local_nvd->sum    = (double *) Malloc( num_sibs * sizeof (double));
784  local_nvd->sumr   = (double *) Malloc( num_sibs * sizeof (double));
785  local_nvd->sumy   = (double *) Malloc( num_sibs * sizeof (double));
786  local_nvd->xx     = (sitelike *) Malloc( num_sibs * sizeof (sitelike));
787}  /* alloc_nvd */
788
789
790void free_nvd(nuview_data *local_nvd)
791{
792  /* The natural complement to the alloc version */
793  free (local_nvd->yy);
794  free (local_nvd->wwzz);
795  free (local_nvd->vvzz);
796  free (local_nvd->vzsumr);
797  free (local_nvd->vzsumy);
798  free (local_nvd->sum);
799  free (local_nvd->sumr);
800  free (local_nvd->sumy);
801  free (local_nvd->xx);
802}  /* free_nvd */
803
804
805void nuview(node *p)
806/* current (modified dnaml) nuview */
807{
808  long i, j, k, num_sibs, sib_index;
809  nuview_data *local_nvd;
810  node *sib_ptr, *sib_back_ptr;
811  sitelike p_xx;
812  double lw;
813
814  /* Figure out how many siblings the current node has */
815  num_sibs    = count_sibs (p);
816  /* Recursive calls, should be called for all children */
817  sib_ptr = p;
818  for (i=0 ; i < num_sibs; i++) {
819    sib_ptr      = sib_ptr->next;
820    sib_back_ptr = sib_ptr->back;
821
822    if (!(sib_back_ptr == NULL))
823      if (!sib_back_ptr->tip && !sib_back_ptr->initialized)
824        nuview (sib_back_ptr);
825  }
826  /* Allocate the structure and blocks therein for variables used in
827     this function */
828  local_nvd = (nuview_data *) Malloc( sizeof (nuview_data));
829  alloc_nvd (num_sibs, local_nvd);
830
831  /* Loop 1: makes assignments to tbl based on some combination of
832     what's already in tbl and the children's value of v */
833  sib_ptr = p;
834  for (sib_index=0; sib_index < num_sibs; sib_index++) {
835    sib_ptr      = sib_ptr->next;
836    sib_back_ptr = sib_ptr->back;
837   
838    if (sib_back_ptr != NULL)
839      lw =  -fabs(p->tyme - sib_back_ptr->tyme);
840    else
841      lw = 0.0;
842
843    for (i = 0; i < rcategs; i++)
844      for (j = 0; j < categs; j++) {
845        tbl[i][j]->ww[sib_index]   = exp(tbl[i][j]->ratxi * lw);
846        tbl[i][j]->zz[sib_index]   = exp(tbl[i][j]->ratxv * lw);
847        tbl[i][j]->wwzz[sib_index] = tbl[i][j]->ww[sib_index] * tbl[i][j]->zz[sib_index];
848        tbl[i][j]->vvzz[sib_index] = (1.0 - tbl[i][j]->ww[sib_index]) *
849          tbl[i][j]->zz[sib_index];
850      }
851  }
852
853  /* Loop 2: */
854  for (i = 0; i < endsite; i++) {
855    k = category[alias[i]-1] - 1;
856    for (j = 0; j < rcategs; j++) {
857
858      /* Loop 2.1 */
859      sib_ptr = p;
860      for (sib_index=0; sib_index < num_sibs; sib_index++) {
861        sib_ptr         = sib_ptr->next;
862        sib_back_ptr    = sib_ptr->back;
863
864        local_nvd->wwzz[sib_index] = tbl[j][k]->wwzz[sib_index];
865        local_nvd->vvzz[sib_index] = tbl[j][k]->vvzz[sib_index];
866        local_nvd->yy[sib_index]   = 1.0 - tbl[j][k]->zz[sib_index];
867        if (sib_back_ptr != NULL)
868          memcpy(local_nvd->xx[sib_index],
869               sib_back_ptr->x[i][j],
870               sizeof(sitelike));
871        else {
872          local_nvd->xx[sib_index][0] = 1.0;
873          local_nvd->xx[sib_index][(long)C - (long)A] = 1.0;
874          local_nvd->xx[sib_index][(long)G - (long)A] = 1.0;
875          local_nvd->xx[sib_index][(long)T - (long)A] = 1.0;
876        }
877      }
878
879      /* Loop 2.2 */
880      for (sib_index=0; sib_index < num_sibs; sib_index++) {
881        local_nvd->sum[sib_index] =
882          local_nvd->yy[sib_index] *
883          (freqa * local_nvd->xx[sib_index][(long)A] +
884           freqc * local_nvd->xx[sib_index][(long)C] +
885           freqg * local_nvd->xx[sib_index][(long)G] +
886           freqt * local_nvd->xx[sib_index][(long)T]);
887        local_nvd->sumr[sib_index] =
888          freqar * local_nvd->xx[sib_index][(long)A] +
889          freqgr * local_nvd->xx[sib_index][(long)G];
890        local_nvd->sumy[sib_index] =
891          freqcy * local_nvd->xx[sib_index][(long)C] +
892          freqty * local_nvd->xx[sib_index][(long)T];
893        local_nvd->vzsumr[sib_index] =
894          local_nvd->vvzz[sib_index] * local_nvd->sumr[sib_index];
895        local_nvd->vzsumy[sib_index] =
896          local_nvd->vvzz[sib_index] * local_nvd->sumy[sib_index];
897      }
898
899      /* Initialize to one, multiply incremental values for every
900         sibling a node has */
901      p_xx[(long)A] = 1 ;
902      p_xx[(long)C] = 1 ; 
903      p_xx[(long)G] = 1 ;
904      p_xx[(long)T] = 1 ;
905
906      for (sib_index=0; sib_index < num_sibs; sib_index++) {
907        p_xx[(long)A] *=
908          local_nvd->sum[sib_index] +
909          local_nvd->wwzz[sib_index] *
910          local_nvd->xx[sib_index][(long)A] +
911          local_nvd->vzsumr[sib_index];
912        p_xx[(long)C] *=
913          local_nvd->sum[sib_index] +
914          local_nvd->wwzz[sib_index] *
915          local_nvd->xx[sib_index][(long)C] +
916          local_nvd->vzsumy[sib_index];
917        p_xx[(long)G] *=
918          local_nvd->sum[sib_index] +
919          local_nvd->wwzz[sib_index] *
920          local_nvd->xx[sib_index][(long)G] +
921          local_nvd->vzsumr[sib_index];
922        p_xx[(long)T] *=
923          local_nvd->sum[sib_index] +
924          local_nvd->wwzz[sib_index] *
925          local_nvd->xx[sib_index][(long)T] +
926          local_nvd->vzsumy[sib_index];
927      }
928
929      /* And the final point of this whole function: */
930      memcpy(p->x[i][j], p_xx, sizeof(sitelike));
931    }
932  }
933
934  p->initialized = true;
935
936  free_nvd (local_nvd);
937  free (local_nvd);
938}  /* nuview */
939
940
941double evaluate(node *p)
942{
943  contribarr tterm;
944  static contribarr like, nulike, clai;
945  double sum, sum2, sumc=0, local_y, lz, y1, z1zz, z1yy,
946                prod12, prod1, prod2, prod3, sumterm, lterm;
947  long i, j, k, lai;
948  node *q, *r;
949  sitelike x1, x2;
950  sum = 0.0;
951
952  if (p == curtree.root && (count_sibs(p) == 2)) {
953    r = p->next->back;
954    q = p->next->next->back;
955    local_y = r->tyme + q->tyme - 2 * p->tyme;
956    if (!r->tip && !r->initialized) nuview (r);
957    if (!q->tip && !q->initialized) nuview (q);
958  } else if (p == curtree.root) {
959    /* the next two lines copy tyme and x to p->next.  Normally they are
960       not initialized for an internal node. */
961/* assumes bifurcation */
962    p->next->tyme = p->tyme;
963    nuview(p->next);
964    r = p->next;
965    q = p->next->back;
966    local_y = fabs(p->next->tyme - q->tyme);
967  } else {
968    r = p;
969    q = p->back;
970    if (!r->tip && !r->initialized) nuview (r);
971    if (!q->tip && !q->initialized) nuview (q);
972    local_y = fabs(r->tyme - q->tyme);
973  }
974
975  lz = -local_y;
976  for (i = 0; i < rcategs; i++)
977    for (j = 0; j < categs; j++) {
978    tbl[i][j]->orig_zz = exp(tbl[i][j]->ratxi * lz);
979    tbl[i][j]->z1 = exp(tbl[i][j]->ratxv * lz);
980    tbl[i][j]->z1zz = tbl[i][j]->z1 * tbl[i][j]->orig_zz;
981    tbl[i][j]->z1yy = tbl[i][j]->z1 - tbl[i][j]->z1zz;
982  }
983  for (i = 0; i < endsite; i++) {
984    k = category[alias[i]-1] - 1;
985    for (j = 0; j < rcategs; j++) {
986      if (local_y > 0.0) {
987        y1 = 1.0 - tbl[j][k]->z1;
988        z1zz = tbl[j][k]->z1zz;
989        z1yy = tbl[j][k]->z1yy;
990      } else {
991        y1 = 0.0;
992        z1zz = 1.0;
993        z1yy = 0.0;
994      }
995      memcpy(x1, r->x[i][j], sizeof(sitelike));
996      prod1 = freqa * x1[0] + freqc * x1[(long)C - (long)A] +
997             freqg * x1[(long)G - (long)A] + freqt * x1[(long)T - (long)A];
998      memcpy(x2, q->x[i][j], sizeof(sitelike));
999      prod2 = freqa * x2[0] + freqc * x2[(long)C - (long)A] +
1000             freqg * x2[(long)G - (long)A] + freqt * x2[(long)T - (long)A];
1001      prod3 = (x1[0] * freqa + x1[(long)G - (long)A] * freqg) *
1002              (x2[0] * freqar + x2[(long)G - (long)A] * freqgr) +
1003          (x1[(long)C - (long)A] * freqc + x1[(long)T - (long)A] * freqt) *
1004         (x2[(long)C - (long)A] * freqcy + x2[(long)T - (long)A] * freqty);
1005      prod12 = freqa * x1[0] * x2[0] +
1006               freqc * x1[(long)C - (long)A] * x2[(long)C - (long)A] +
1007               freqg * x1[(long)G - (long)A] * x2[(long)G - (long)A] +
1008               freqt * x1[(long)T - (long)A] * x2[(long)T - (long)A];
1009      tterm[j] = z1zz * prod12 + z1yy * prod3 + y1 * prod1 * prod2;
1010    }
1011    sumterm = 0.0;
1012    for (j = 0; j < rcategs; j++)
1013      sumterm += probcat[j] * tterm[j];
1014    lterm = log(sumterm);
1015    for (j = 0; j < rcategs; j++)
1016      clai[j] = tterm[j] / sumterm;
1017    memcpy(contribution[i], clai, sizeof(contribarr));
1018    if (!auto_ && usertree)
1019      l0gf[which - 1][i] = lterm;
1020    sum += aliasweight[i] * lterm;
1021  }
1022  if (auto_) {
1023    for (j = 0; j < rcategs; j++)
1024      like[j] = 1.0;
1025    for (i = 0; i < sites; i++) {
1026      if ((ally[i] > 0) && (location[ally[i]-1] > 0)) {
1027        sumc = 0.0;
1028        for (k = 0; k < rcategs; k++)
1029          sumc += probcat[k] * like[k];
1030        sumc *= lambda;
1031        lai = location[ally[i] - 1];
1032        memcpy(clai, contribution[lai - 1], sizeof(contribarr));
1033        for (j = 0; j < rcategs; j++)
1034          nulike[j] = ((1.0 - lambda) * like[j] + sumc) * clai[j];
1035      } else {
1036        for (j = 0; j < rcategs; j++)
1037          nulike[j] = ((1.0 - lambda) * like[j] + sumc);
1038      }
1039      memcpy(like, nulike, sizeof(contribarr));
1040    }
1041    sum2 = 0.0;
1042    for (i = 0; i < rcategs; i++)
1043      sum2 += probcat[i] * like[i];
1044    sum += log(sum2);
1045  }
1046  curtree.likelihood = sum;
1047  if (auto_ || !usertree)
1048    return sum;
1049  l0gl[which - 1] = sum;
1050  if (which == 1) {
1051    maxwhich = 1;
1052    maxlogl = sum;
1053    return sum;
1054  }
1055  if (sum > maxlogl) {
1056    maxwhich = which;
1057    maxlogl = sum;
1058  }
1059  return sum;
1060}  /* evaluate */
1061
1062
1063void getthree(node *p, double thigh, double tlow)
1064{
1065  /* compute likelihood at a new triple of points */
1066  int i;
1067  double tt = p->tyme;
1068  double td = fabs(tdelta);
1069
1070  x[0] = tt - td;
1071  x[1] = tt;
1072  x[2] = tt + td;
1073
1074  if ( x[0] < tlow + epsilon ) {
1075    x[0] = tlow + epsilon;
1076    x[1] = ( x[0] + x[2] ) / 2;
1077  }
1078
1079  if ( x[2] > thigh - epsilon ) {
1080    x[2] = thigh - epsilon;
1081    x[1] = ( x[0] + x[2] ) / 2;
1082  }
1083 
1084  for ( i = 0 ; i < 3 ; i++ ) {
1085    p->tyme = x[i];
1086    nuview(p);
1087    lnl[i] = evaluate(p);
1088  }
1089}  /* getthree */
1090
1091
1092void makenewv(node *p)
1093{
1094  /* improve a node time */
1095  long it, imin, imax, i, num_sibs;
1096  double tt, tfactor, tlow, thigh, oldlike, oldx, ymin, ymax, s32, s21, yold;
1097  boolean done, already;
1098  node *s, *sdown, *sib_ptr, *sib_back_ptr;
1099
1100  s = curtree.nodep[p->index - 1];
1101  oldx = s->tyme;
1102  oldlike = curtree.likelihood;
1103  sdown = s->back;
1104  if (s == curtree.root)
1105    tlow = -10.0;
1106  else
1107    tlow = sdown->tyme;
1108
1109  sib_ptr = s;
1110  num_sibs = count_sibs(p);
1111
1112  thigh = s->next->back->tyme;
1113  for (i=0 ; i < num_sibs; i++) {
1114    sib_ptr      = sib_ptr->next;
1115    sib_back_ptr = sib_ptr->back;
1116      if (sib_back_ptr->tyme < thigh)
1117        thigh = sib_back_ptr->tyme;
1118  }
1119  done = (thigh - tlow < 4.0*epsilon);
1120  it = 1;
1121  if (s != curtree.root)
1122    tdelta = (thigh - tlow) / 10.0;
1123  else
1124    tdelta = (thigh - s->tyme) / 5.0;
1125  tfactor = 1.0;
1126  if (!done)
1127    getthree(s, thigh, tlow);
1128  while (it < iterations && !done) {
1129    ymax = lnl[0];
1130    imax = 1;
1131    for (i = 2; i <= 3; i++) {
1132      if (lnl[i - 1] > ymax) {
1133        ymax = lnl[i - 1];
1134        imax = i;
1135      }
1136    }
1137    if (imax != 2) {
1138      ymax = x[1];
1139      x[1] = x[imax - 1];
1140      x[imax - 1] = ymax;
1141      ymax = lnl[1];
1142      lnl[1] = lnl[imax - 1];
1143      lnl[imax - 1] = ymax;
1144    }
1145    tt = x[1];
1146    yold = tt;
1147    s32 = (lnl[2] - lnl[1]) / (x[2] - x[1]);
1148    s21 = (lnl[1] - lnl[0]) / (x[1] - x[0]);
1149    if (fabs(x[2] - x[0]) > epsilon)
1150      curv = (s32 - s21) / ((x[2] - x[0]) / 2);
1151    else
1152      curv = 0.0;
1153    slope = (s32 + s21) / 2 - curv * (x[2] - 2 * x[1] + x[0]) / 4;
1154    if (curv >= 0.0) {
1155      if (slope < 0)
1156        tdelta = -fabs(tdelta);
1157      else
1158        tdelta = fabs(tdelta);
1159    } else
1160      tdelta = -(tfactor * slope / curv);
1161    if (tt + tdelta <= tlow + epsilon)
1162      tdelta = tlow + epsilon - tt;
1163    if (tt + tdelta >= thigh - epsilon)
1164      tdelta = thigh - epsilon - tt;
1165    tt += tdelta;
1166    done = (fabs(yold - tt) < epsilon || fabs(tdelta) < epsilon);
1167    s->tyme = tt;
1168    nuview(s);
1169    lnlike = evaluate(s);
1170    ymin = lnl[0];
1171    imin = 1;
1172    for (i = 2; i <= 3; i++) {
1173      if (lnl[i - 1] < ymin) {
1174        ymin = lnl[i - 1];
1175        imin = i;
1176      }
1177    }
1178    already = (tt == x[0]) || (tt == x[1]) || (tt == x[2]);
1179    if (!already && ymin < lnlike) {
1180      x[imin - 1] = tt;
1181      lnl[imin - 1] = lnlike;
1182    }
1183    if (already || lnlike < oldlike) {
1184      tt = oldx;
1185      s->tyme = oldx;
1186      x[1] = oldx;
1187      lnl[1] = oldlike;
1188      tfactor /= 2;
1189      tdelta /= 2;
1190      curtree.likelihood = oldlike;
1191      lnlike = oldlike;
1192    } else
1193      tfactor = 1.0;
1194
1195    if (!done) {
1196      sib_ptr = p;
1197      num_sibs = count_sibs(p);
1198      p->tyme = tt;
1199      for (i=0 ; i < num_sibs; i++) {
1200        sib_ptr      = sib_ptr->next;
1201        sib_ptr->tyme = tt;
1202      }
1203 
1204      sib_ptr = p;
1205      nuview(p);
1206      for (i=0 ; i < num_sibs; i++) {
1207        sib_ptr      = sib_ptr->next;
1208        nuview(sib_ptr);
1209      }
1210    }
1211   
1212    it++;
1213  }
1214  sib_ptr = p;
1215  for (i=0 ; i < num_sibs; i++) {
1216    sib_ptr      = sib_ptr->next;
1217    inittrav (sib_ptr);
1218  }
1219  smoothed = smoothed && done;
1220}  /* makenewv */
1221
1222
1223void update(node *p)
1224{
1225  node *sib_ptr, *sib_back_ptr;
1226  long i, num_sibs;
1227 
1228  /* improve time and recompute views at a node */
1229  if (p == NULL)
1230    return;
1231  if (p->back != NULL) {
1232    if (!p->back->tip && !p->back->initialized)
1233      nuview(p->back);
1234  }
1235
1236  sib_ptr = p;
1237  num_sibs = count_sibs(p);
1238  for (i=0 ; i < num_sibs; i++) {
1239    sib_ptr      = sib_ptr->next;
1240    sib_back_ptr = sib_ptr->back;
1241    if (sib_back_ptr != NULL) {
1242      if (!sib_back_ptr->tip && !sib_back_ptr->initialized)
1243        nuview(sib_back_ptr);
1244    }
1245  }
1246
1247  if ((!usertree) || (usertree && !lngths) || p->iter) {
1248    makenewv(p);
1249    return;
1250  }
1251  nuview(p);
1252
1253  sib_ptr = p;
1254  num_sibs = count_sibs(p);
1255  for (i=0 ; i < num_sibs; i++) {
1256    sib_ptr      = sib_ptr->next;
1257    nuview(sib_ptr); 
1258  }
1259}  /* update */
1260
1261
1262void smooth(node *p)
1263{
1264  node *sib_ptr;
1265  long i, num_sibs;
1266
1267  if (p == NULL)
1268    return;
1269  if (p->tip)
1270    return;
1271
1272  update(p);
1273
1274  smoothed = false;
1275  sib_ptr = p;
1276  num_sibs = count_sibs(p);
1277  for (i=0; i < num_sibs; i++) {
1278    sib_ptr = sib_ptr->next;
1279    if (polishing || (smoothit && !smoothed)) {
1280      smooth(sib_ptr->back);
1281      p->initialized = false;
1282      sib_ptr->initialized = false;
1283    }
1284    update(p); 
1285  }
1286}  /* smooth */
1287
1288
1289void restoradd(node *below, node *newtip, node *newfork, double prevtyme)
1290{
1291/* restore "new" tip and fork to place "below".  restore tymes */
1292/* assumes bifurcation */
1293  hookup(newfork, below->back);
1294  hookup(newfork->next, below);
1295  hookup(newtip, newfork->next->next);
1296  curtree.nodep[newfork->index-1] = newfork;
1297  newfork->tyme = prevtyme;
1298/* assumes bifurcations */
1299  newfork->next->tyme = prevtyme;
1300  newfork->next->next->tyme = prevtyme;
1301} /* restoradd */
1302
1303
1304void dnamlk_add(node *below, node *newtip, node *newfork)
1305{
1306  /* inserts the nodes newfork and its descendant, newtip, into the tree. */
1307  long i;
1308  boolean done;
1309  node *p;
1310
1311  below = curtree.nodep[below->index - 1];
1312  newfork = curtree.nodep[newfork->index-1];
1313  newtip = curtree.nodep[newtip->index-1];
1314  if (below->back != NULL)
1315    below->back->back = newfork;
1316  newfork->back = below->back;
1317  below->back = newfork->next->next;
1318  newfork->next->next->back = below;
1319  newfork->next->back = newtip;
1320  newtip->back = newfork->next;
1321  if (newtip->tyme < below->tyme)
1322    p = newtip;
1323  else p = below;
1324  newfork->tyme = p->tyme;
1325  if (curtree.root == below)
1326    curtree.root = newfork;
1327  if (newfork->back != NULL) {
1328    if (p->tyme > newfork->back->tyme)
1329      newfork->tyme = (p->tyme + newfork->back->tyme) / 2.0;
1330    else newfork->tyme = p->tyme - epsilon;
1331    newfork->next->tyme = newfork->tyme;
1332    newfork->next->next->tyme = newfork->tyme;
1333    do {
1334      p = curtree.nodep[p->back->index - 1];
1335      done = (p == curtree.root);
1336      if (!done)
1337        done = (curtree.nodep[p->back->index - 1]->tyme < p->tyme - epsilon);
1338      if (!done) {
1339        curtree.nodep[p->back->index - 1]->tyme = p->tyme - epsilon;
1340        curtree.nodep[p->back->index - 1]->next->tyme = p->tyme - epsilon;
1341        curtree.nodep[p->back->index - 1]->next->next->tyme = p->tyme - epsilon;
1342      }
1343    } while (!done);
1344  } else {
1345      newfork->tyme = newfork->tyme - 2*epsilon;
1346      newfork->next->tyme = newfork->tyme;
1347      newfork->next->next->tyme = newfork->tyme;
1348    }
1349  inittrav(newtip);
1350  inittrav(newtip->back);
1351  smoothed = false;
1352  i = 1;
1353  while (i < smoothings && !smoothed) {
1354    smoothed = true;
1355    smooth(newfork);
1356    smooth(newfork->back);
1357    i++;
1358  }
1359}  /* dnamlk_add */
1360
1361
1362void dnamlk_re_move(node **item, node **fork, boolean tempadd)
1363{
1364  /* removes nodes item and its ancestor, fork, from the tree.
1365    the new descendant of fork's ancestor is made to be
1366    fork's second descendant (other than item).  Also
1367    returns pointers to the deleted nodes, item and fork */
1368  node *p, *q;
1369  long i;
1370
1371  if ((*item)->back == NULL) {
1372    *fork = NULL;
1373    return;
1374  }
1375  *item = curtree.nodep[(*item)->index-1];
1376  *fork = curtree.nodep[(*item)->back->index - 1];
1377  if (curtree.root == *fork) {
1378    if (*item == (*fork)->next->back)
1379      curtree.root = (*fork)->next->next->back;
1380    else
1381      curtree.root = (*fork)->next->back;
1382  }
1383  p = (*item)->back->next->back;
1384  q = (*item)->back->next->next->back;
1385/* debug replace by hookup calls?  Does that have NULL protection? */
1386  if (p != NULL)
1387    p->back = q;
1388  if (q != NULL)
1389    q->back = p;
1390  (*fork)->back = NULL;
1391  p = (*fork)->next;
1392  while (p != *fork) {
1393    p->back = NULL;
1394    p = p->next;
1395  }
1396  (*item)->back = NULL;
1397  inittrav(p);
1398  inittrav(q);
1399  if (tempadd)
1400    return;
1401  i = 1;
1402  while (i <= smoothings) {
1403    smooth(q);
1404    if (smoothit)
1405      smooth(q->back);
1406    i++;
1407  }
1408}  /* dnamlk_re_move */
1409
1410
1411void tryadd(node *p, node **item, node **nufork)
1412{  /* temporarily adds one fork and one tip to the tree.
1413    if the location where they are added yields greater
1414    likelihood than other locations tested up to that
1415    time, then keeps that location as there */
1416
1417  dnamlk_add(p, *item, *nufork);
1418  global_like = evaluate(p);
1419  if (lastsp) {
1420      if (global_like >= bestree.likelihood || bestree.likelihood == UNDEFINED) {
1421            copy_(&curtree, &bestree, nonodes, rcategs);
1422            if (global2) 
1423                save_tree_tyme(&curtree,tymes);
1424      }
1425  }
1426  if (global_like > bestyet || bestyet == UNDEFINED) {
1427    bestyet = global_like;
1428    there = p;
1429  }
1430  dnamlk_re_move(item, nufork, true);
1431  if ( global2 ) {
1432      restore_saved_tyme(&curtree,tymes);
1433  }
1434}  /* tryadd */
1435
1436
1437void addpreorder(node *p, node *item_, node *nufork_, boolean contin,
1438                        boolean continagain)
1439{
1440  /* traverses a binary tree, calling function tryadd
1441    at a node before calling tryadd at its descendants */
1442  node *item, *nufork;
1443
1444  item = item_;
1445  nufork = nufork_;
1446  if (p == NULL)
1447    return;
1448  tryadd(p, &item, &nufork);
1449  contin = continagain;
1450  if ((!p->tip) && contin) {
1451    addpreorder(p->next->back, item, nufork, contin, continagain);
1452    addpreorder(p->next->next->back, item, nufork, contin, continagain);
1453  }
1454}  /* addpreorder */
1455
1456
1457void tryrearr(node *p, boolean *success)
1458{
1459  /* evaluates one rearrangement of the tree.
1460    if the new tree has greater likelihood than the old
1461    one sets success = TRUE and keeps the new tree.
1462    otherwise, restores the old tree */
1463  node *frombelow, *whereto, *forknode;
1464  double oldlike, prevtyme;
1465  boolean wasonleft;
1466
1467  if (p == curtree.root)
1468    return;
1469  forknode = curtree.nodep[p->back->index - 1];
1470  if (forknode == curtree.root)
1471    return;
1472  oldlike = bestyet;
1473  prevtyme = forknode->tyme;
1474/* the following statement presumes bifurcating tree */
1475  if (forknode->next->back == p) {
1476    frombelow = forknode->next->next->back;
1477    wasonleft = true;
1478  }
1479  else {
1480    frombelow = forknode->next->back;
1481    wasonleft = false;
1482  }
1483  whereto = curtree.nodep[forknode->back->index - 1];
1484  dnamlk_re_move(&p, &forknode, true);
1485  dnamlk_add(whereto, p, forknode);
1486  global_like = evaluate(p);
1487  if (global_like <= oldlike && oldlike != UNDEFINED) {
1488    dnamlk_re_move(&p, &forknode, true);
1489    restoradd(frombelow, p, forknode, prevtyme);
1490    if (wasonleft && (forknode->next->next->back == p)) {
1491       hookup (forknode->next->back, forknode->next->next);
1492       hookup (forknode->next, p);
1493    }
1494    curtree.likelihood = oldlike;
1495    inittrav(forknode);
1496    inittrav(forknode->next);
1497    inittrav(forknode->next->next);
1498  } else {
1499    (*success) = true;
1500    bestyet = global_like;
1501  }
1502}  /* tryrearr */
1503
1504
1505void repreorder(node *p, boolean *success)
1506{
1507  /* traverses a binary tree, calling function tryrearr
1508    at a node before calling tryrearr at its descendants */
1509  if (p == NULL)
1510    return;
1511  tryrearr(p, success);
1512  if (p->tip)
1513    return;
1514  if (!(*success))
1515    repreorder(p->next->back, success);
1516  if (!(*success))
1517    repreorder(p->next->next->back, success);
1518}  /* repreorder */
1519
1520
1521void rearrange(node **r)
1522{
1523  /* traverses the tree (preorder), finding any local
1524    rearrangement which increases the likelihood.
1525    if traversal succeeds in increasing the tree's
1526    likelihood, function rearrange runs traversal again */
1527  boolean success;
1528  success = true;
1529  while (success) {
1530    success = false;
1531    repreorder(*r, &success);
1532  }
1533}  /* rearrange */
1534
1535
1536void initdnamlnode(node **p, node **local_grbg, node *UNUSED_q, long UNUSED_len, long nodei,
1537                     long *UNUSED_ntips, long *parens, initops whichinit,
1538                     pointarray UNUSED_treenode, pointarray nodep, Char *str, Char *ch,
1539                     FILE *fp_intree)
1540{
1541    (void)UNUSED_q;
1542    (void)UNUSED_len;
1543    (void)UNUSED_ntips;
1544    (void)UNUSED_treenode;
1545
1546  /* initializes a node */
1547  boolean minusread;
1548  double valyew, divisor;
1549
1550  switch (whichinit) {
1551  case bottom:
1552    gnu(local_grbg, p);
1553    (*p)->index = nodei;
1554    (*p)->tip = false;
1555    malloc_pheno((*p), endsite, rcategs);
1556    nodep[(*p)->index - 1] = (*p);
1557    break;
1558  case nonbottom:
1559    gnu(local_grbg, p);
1560    malloc_pheno(*p, endsite, rcategs);
1561    (*p)->index = nodei;
1562    break;
1563  case tip:
1564    match_names_to_data (str, nodep, p, spp);
1565    break;
1566  case iter:
1567    (*p)->initialized = false;
1568    (*p)->v = initialv;
1569    (*p)->iter = true;
1570    if ((*p)->back != NULL)
1571      (*p)->back->iter = true;
1572    break;
1573  case length:
1574    processlength(&valyew, &divisor, ch, &minusread, fp_intree, parens);
1575    (*p)->v = valyew / divisor / fracchange;
1576    (*p)->iter = false;
1577    if ((*p)->back != NULL) {
1578      (*p)->back->v = (*p)->v;
1579      (*p)->back->iter = false;
1580    }
1581    break;
1582  case hslength:
1583    break;
1584  case hsnolength:
1585    break;
1586  case treewt:
1587    break;
1588  case unittrwt:
1589    curtree.nodep[spp]->iter = false; 
1590    break;
1591  }
1592} /* initdnamlnode */
1593
1594
1595void tymetrav(node *p, double *local_x)
1596{
1597  /* set up times of nodes */
1598  node *sib_ptr, *q;
1599  long i, num_sibs;
1600  double xmax;
1601
1602  xmax = 0.0;
1603  if (!p->tip) {
1604    sib_ptr  = p;
1605    num_sibs = count_sibs(p);
1606    for (i=0; i < num_sibs; i++) {
1607      sib_ptr = sib_ptr->next;
1608      tymetrav(sib_ptr->back, local_x);
1609      if (xmax > (*local_x))
1610        xmax = (*local_x);
1611    }
1612  } else
1613    (*local_x)     = 0.0;
1614  p->tyme  = xmax;
1615  if (!p->tip) {
1616    q = p;
1617    while (q->next != p) {
1618      q = q->next;
1619      q->tyme = p->tyme;
1620    }
1621  }
1622  (*local_x) = p->tyme - p->v;
1623}  /* tymetrav */
1624
1625
1626void dnamlk_coordinates(node *p, long *tipy)
1627{
1628  /* establishes coordinates of nodes */
1629  node *q, *first, *last, *pp1 =NULL, *pp2 =NULL;
1630  long num_sibs, p1, p2, i;
1631
1632  if (p->tip) {
1633    p->xcoord = 0;
1634    p->ycoord = (*tipy);
1635    p->ymin   = (*tipy);
1636    p->ymax   = (*tipy);
1637    (*tipy)  += down;
1638    return;
1639  }
1640  q = p->next;
1641  do {
1642    dnamlk_coordinates(q->back, tipy);
1643    q = q->next;
1644  } while (p != q);
1645  num_sibs = count_sibs(p);
1646  p1 = (long)((num_sibs+1)/2.0);
1647  p2 = (long)((num_sibs+2)/2.0);
1648  i = 1;
1649  q = p->next;
1650  first  = q->back;
1651  do {
1652    if (i == p1) pp1 = q->back;
1653    if (i == p2) pp2 = q->back;
1654    last = q->back;
1655    q = q->next;
1656    i++;
1657  } while (q != p);
1658  p->xcoord = (long)(0.5 - over * p->tyme);
1659  p->ycoord = (pp1->ycoord + pp2->ycoord) / 2;
1660  p->ymin = first->ymin;
1661  p->ymax = last->ymax;
1662}  /* dnamlk_coordinates */
1663
1664
1665void dnamlk_drawline(long i, double scale)
1666{
1667  /* draws one row of the tree diagram by moving up tree */
1668  node *p, *q, *r, *first =NULL, *last =NULL;
1669  long n, j;
1670  boolean extra, done;
1671
1672  p = curtree.root;
1673  q = curtree.root;
1674  extra = false;
1675  if ((long)(p->ycoord) == i) {
1676    if (p->index - spp >= 10)
1677      fprintf(outfile, "-%2ld", p->index - spp);
1678    else
1679      fprintf(outfile, "--%ld", p->index - spp);
1680    extra = true;
1681  } else
1682    fprintf(outfile, "  ");
1683  do {
1684    if (!p->tip) {
1685      r = p->next;
1686      done = false;
1687      do {
1688        if (i >= r->back->ymin && i <= r->back->ymax) {
1689          q = r->back;
1690          done = true;
1691        }
1692        r = r->next;
1693      } while (!(done || r == p));
1694      first = p->next->back;
1695      r = p->next;
1696      while (r->next != p)
1697        r = r->next;
1698      last = r->back;
1699    }
1700    done = (p == q);
1701    n = (long)(scale * ((long)(p->xcoord) - (long)(q->xcoord)) + 0.5);
1702    if (n < 3 && !q->tip)
1703      n = 3;
1704    if (extra) {
1705      n--;
1706      extra = false;
1707    }
1708    if ((long)(q->ycoord) == i && !done) {
1709      if (p->ycoord != q->ycoord)
1710        putc('+', outfile);
1711      else
1712        putc('-', outfile);
1713      if (!q->tip) {
1714        for (j = 1; j <= n - 2; j++)
1715          putc('-', outfile);
1716        if (q->index - spp >= 10)
1717          fprintf(outfile, "%2ld", q->index - spp);
1718        else
1719          fprintf(outfile, "-%ld", q->index - spp);
1720        extra = true;
1721      } else {
1722        for (j = 1; j < n; j++)
1723          putc('-', outfile);
1724      }
1725    } else if (!p->tip) {
1726      if ((long)(last->ycoord) > i && (long)(first->ycoord) < i && 
1727           i != (long)(p->ycoord)) {
1728        putc('!', outfile);
1729        for (j = 1; j < n; j++)
1730          putc(' ', outfile);
1731      } else {
1732        for (j = 1; j <= n; j++)
1733          putc(' ', outfile);
1734      }
1735    } else {
1736      for (j = 1; j <= n; j++)
1737        putc(' ', outfile);
1738    }
1739    if (p != q)
1740      p = q;
1741  } while (!done);
1742  if ((long)(p->ycoord) == i && p->tip) {
1743    for (j = 0; j < nmlngth; j++)
1744      putc(nayme[p->index - 1][j], outfile);
1745  }
1746  putc('\n', outfile);
1747}  /* dnamlk_drawline */
1748
1749
1750void dnamlk_printree()
1751{
1752 /* prints out diagram of the tree */
1753  long tipy;
1754  double scale;
1755  long i;
1756  node *p;
1757
1758  if (!treeprint)
1759    return;
1760  putc('\n', outfile);
1761  tipy = 1;
1762  dnamlk_coordinates(curtree.root, &tipy);
1763  p = curtree.root;
1764  while (!p->tip)
1765    p = p->next->back;
1766  scale = 1.0 / (long)(p->tyme - curtree.root->tyme + 1.000);
1767  putc('\n', outfile);
1768  for (i = 1; i <= tipy - down; i++)
1769    dnamlk_drawline(i, scale);
1770  putc('\n', outfile);
1771}  /* dnamlk_printree */
1772
1773
1774void describe(node *p)
1775{
1776  long i, num_sibs;
1777  node *sib_ptr, *sib_back_ptr;
1778  double v;
1779
1780  if (p == curtree.root)
1781    fprintf(outfile, " root         ");
1782  else
1783    fprintf(outfile, "%4ld          ", p->back->index - spp);
1784  if (p->tip) {
1785    for (i = 0; i < nmlngth; i++)
1786      putc(nayme[p->index - 1][i], outfile);
1787  } else
1788    fprintf(outfile, "%4ld      ", p->index - spp);
1789  if (p != curtree.root) {
1790    fprintf(outfile, "%11.5f", fracchange * (p->tyme - curtree.root->tyme));
1791    v = fracchange * (p->tyme - curtree.nodep[p->back->index - 1]->tyme);
1792    fprintf(outfile, "%13.5f", v);
1793  }
1794  putc('\n', outfile);
1795  if (!p->tip) {
1796
1797    sib_ptr = p;
1798    num_sibs = count_sibs(p);
1799    for (i=0 ; i < num_sibs; i++) {
1800      sib_ptr      = sib_ptr->next;
1801      sib_back_ptr = sib_ptr->back;
1802      describe(sib_back_ptr);
1803    }
1804  }
1805}  /* describe */
1806
1807
1808void reconstr(node *p, long n)
1809{
1810  /* reconstruct and print out base at site n+1 at node p */
1811  long i, j, k, m, first, second, num_sibs;
1812  double f, sum, xx[4];
1813  node *q;
1814
1815  if ((ally[n] == 0) || (location[ally[n]-1] == 0))
1816    putc('.', outfile);
1817  else {
1818    j = location[ally[n]-1] - 1;
1819    for (i = 0; i < 4; i++) {
1820      f = p->x[j][mx-1][i];
1821      num_sibs = count_sibs(p);
1822      q = p;
1823      for (k = 0; k < num_sibs; k++) {
1824        q = q->next;
1825        f *= q->x[j][mx-1][i];
1826      }
1827      f = sqrt(f);
1828      xx[i] = f;
1829    }
1830    xx[0] *= freqa;
1831    xx[1] *= freqc;
1832    xx[2] *= freqg;
1833    xx[3] *= freqt;
1834    sum = xx[0]+xx[1]+xx[2]+xx[3];
1835    for (i = 0; i < 4; i++)
1836      xx[i] /= sum;
1837    first = 0;
1838    for (i = 1; i < 4; i++)
1839      if (xx [i] > xx[first])
1840        first = i;
1841    if (first == 0)
1842      second = 1;
1843    else
1844      second = 0;
1845    for (i = 0; i < 4; i++)
1846      if ((i != first) && (xx[i] > xx[second]))
1847        second = i;
1848    m = 1 << first;
1849    if (xx[first] < 0.4999995)
1850      m = m + (1 << second);
1851    if (xx[first] > 0.95)
1852      putc(toupper(basechar[m - 1]), outfile);
1853    else
1854      putc(basechar[m - 1], outfile);
1855    if (rctgry && rcategs > 1)
1856      mx = mp[n][mx - 1];   
1857    else
1858      mx = 1;
1859  }
1860} /* reconstr */
1861
1862
1863void rectrav(node *p, long m, long n)
1864{
1865  /* print out segment of reconstructed sequence for one branch */
1866  long num_sibs, i;
1867  node *sib_ptr;
1868
1869  putc(' ', outfile);
1870  if (p->tip) {
1871    for (i = 0; i < nmlngth; i++)
1872      putc(nayme[p->index-1][i], outfile);
1873  } else
1874    fprintf(outfile, "%4ld      ", p->index - spp);
1875  fprintf(outfile, "  ");
1876  mx = mx0;
1877  for (i = m; i <= n; i++) {
1878    if ((i % 10 == 0) && (i != m))
1879      putc(' ', outfile);
1880    if (p->tip)
1881      putc(y[p->index-1][i], outfile);
1882    else
1883      reconstr(p, i);
1884  }
1885  putc('\n', outfile);
1886  if (!p->tip) {
1887    num_sibs = count_sibs(p);
1888    sib_ptr = p;
1889    for (i = 0; i < num_sibs; i++) {
1890      sib_ptr = sib_ptr->next;
1891      rectrav(sib_ptr->back, m, n);
1892    }
1893  }
1894  mx1 = mx;
1895}  /* rectrav */
1896
1897
1898void summarize()
1899{
1900  long i, j, k, mm;
1901  double mode, sum;
1902  double like[maxcategs], nulike[maxcategs];
1903  double **marginal;
1904
1905  mp = (long **)Malloc(sites * sizeof(long *));
1906  for (i = 0; i <= sites-1; ++i)
1907    mp[i] = (long *)Malloc(sizeof(long)*rcategs);
1908  fprintf(outfile, "\nLn Likelihood = %11.5f\n\n", curtree.likelihood);
1909  fprintf(outfile, " Ancestor      Node      Node Height     Length\n");
1910  fprintf(outfile, " --------      ----      ---- ------     ------\n");
1911  describe(curtree.root);
1912  putc('\n', outfile);
1913  if (rctgry && rcategs > 1) {
1914    for (i = 0; i < rcategs; i++)
1915      like[i] = 1.0;
1916    for (i = sites - 1; i >= 0; i--) {
1917      sum = 0.0;
1918      for (j = 0; j < rcategs; j++) {
1919        nulike[j] = (lambda1 + lambda * probcat[j]) * like[j];
1920        mp[i][j] = j + 1;
1921        for (k = 1; k <= rcategs; k++) {
1922          if (k != j + 1) {
1923            if (lambda * probcat[k - 1] * like[k - 1] > nulike[j]) {
1924              nulike[j] = lambda * probcat[k - 1] * like[k - 1];
1925              mp[i][j] = k;
1926            }
1927          }
1928        }
1929        if ((ally[i] > 0) && (location[ally[i]-1] > 0))
1930          nulike[j] *= contribution[location[ally[i] - 1] - 1][j];
1931        sum += nulike[j];
1932      }
1933      for (j = 0; j < rcategs; j++)
1934        nulike[j] /= sum;
1935      memcpy(like, nulike, rcategs * sizeof(double));
1936    }
1937    mode = 0.0;
1938    mx = 1;
1939    for (i = 1; i <= rcategs; i++) {
1940      if (probcat[i - 1] * like[i - 1] > mode) {
1941        mx = i;
1942        mode = probcat[i - 1] * like[i - 1];
1943      }
1944    }
1945    mx0 = mx;
1946    fprintf(outfile,
1947 "Combination of categories that contributes the most to the likelihood:\n\n");
1948    for (i = 1; i <= nmlngth + 3; i++)
1949      putc(' ', outfile);
1950    for (i = 1; i <= sites; i++) {
1951      fprintf(outfile, "%ld", mx);
1952      if (i % 10 == 0)
1953        putc(' ', outfile);
1954      if (i % 60 == 0 && i != sites) {
1955        putc('\n', outfile);
1956        for (j = 1; j <= nmlngth + 3; j++)
1957          putc(' ', outfile);
1958      }
1959      mx = mp[i - 1][mx - 1];
1960    }
1961    fprintf(outfile, "\n\n");
1962    marginal = (double **) Malloc( sites*sizeof(double *));
1963    for (i = 0; i < sites; i++)
1964      marginal[i] = (double *) Malloc( rcategs*sizeof(double));
1965    for (i = 0; i < rcategs; i++)
1966      like[i] = 1.0;
1967    for (i = sites - 1; i >= 0; i--) {
1968      sum = 0.0;
1969      for (j = 0; j < rcategs; j++) {
1970        nulike[j] = (lambda1 + lambda * probcat[j]) * like[j];
1971        for (k = 1; k <= rcategs; k++) {
1972          if (k != j + 1)
1973              nulike[j] += lambda * probcat[k - 1] * like[k - 1];
1974        }
1975        if ((ally[i] > 0) && (location[ally[i]-1] > 0))
1976          nulike[j] *= contribution[location[ally[i] - 1] - 1][j];
1977        sum += nulike[j];
1978      }
1979      for (j = 0; j < rcategs; j++) {
1980        nulike[j] /= sum;
1981        marginal[i][j] = nulike[j];
1982      }
1983      memcpy(like, nulike, rcategs * sizeof(double));
1984    }
1985    for (i = 0; i < rcategs; i++)
1986      like[i] = 1.0;
1987    for (i = 0; i < sites; i++) {
1988      sum = 0.0;
1989      for (j = 0; j < rcategs; j++) {
1990        nulike[j] = (lambda1 + lambda * probcat[j]) * like[j];
1991        for (k = 1; k <= rcategs; k++) {
1992          if (k != j + 1)
1993              nulike[j] += lambda * probcat[k - 1] * like[k - 1];
1994        }
1995        marginal[i][j] *= like[j] * probcat[j];
1996        sum += nulike[j];
1997      }
1998      for (j = 0; j < rcategs; j++)
1999        nulike[j] /= sum;
2000      memcpy(like, nulike, rcategs * sizeof(double));
2001      sum = 0.0;
2002      for (j = 0; j < rcategs; j++)
2003        sum += marginal[i][j];
2004      for (j = 0; j < rcategs; j++)
2005        marginal[i][j] /= sum;
2006    }
2007    fprintf(outfile, "Most probable category at each site if > 0.95 probability (\".\" otherwise)\n\n");
2008    for (i = 1; i <= nmlngth + 3; i++)
2009      putc(' ', outfile);
2010    for (i = 0; i < sites; i++) {
2011      sum = 0.0;
2012      for (j = 0; j < rcategs; j++)
2013        if (marginal[i][j] > sum) {
2014          sum = marginal[i][j];
2015          mm = j;
2016        }
2017        if (sum >= 0.95)
2018        fprintf(outfile, "%ld", mm+1);
2019      else
2020        putc('.', outfile);
2021      if ((i+1) % 60 == 0) {
2022        if (i != 0) {
2023          putc('\n', outfile);
2024          for (j = 1; j <= nmlngth + 3; j++)
2025            putc(' ', outfile);
2026        }
2027      }
2028      else if ((i+1) % 10 == 0)
2029        putc(' ', outfile);
2030    }
2031    putc('\n', outfile);
2032    for (i = 0; i < sites; i++)
2033      free(marginal[i]);
2034    free(marginal);
2035  }
2036  putc('\n', outfile);
2037  putc('\n', outfile);
2038  if (hypstate) {
2039    fprintf(outfile, "Probable sequences at interior nodes:\n\n");
2040    fprintf(outfile, "  node       ");
2041    for (i = 0; (i < 13) && (i < ((sites + (sites-1)/10 - 39) / 2)); i++)
2042      putc(' ', outfile);
2043    fprintf(outfile, "Reconstructed sequence (caps if > 0.95)\n\n");
2044    if (!rctgry || (rcategs == 1))
2045      mx0 = 1;
2046    for (i = 0; i < sites; i += 60) {
2047      k = i + 59;
2048      if (k >= sites)
2049        k = sites - 1;
2050      rectrav(curtree.root, i, k);
2051      putc('\n', outfile);
2052      mx0 = mx1;
2053    }
2054  }
2055  for (i = 0; i < sites; ++i)
2056    free(mp[i]);
2057  free(mp);
2058}  /* summarize */
2059
2060
2061void dnamlk_treeout(node *p)
2062{
2063  /* write out file with representation of final tree */
2064  node *sib_ptr;
2065  long i, n, w, num_sibs;
2066  Char c;
2067  double local_x;
2068
2069  if (p->tip) {
2070    n = 0;
2071    for (i = 1; i <= nmlngth; i++) {
2072      if (nayme[p->index - 1][i - 1] != ' ')
2073        n = i;
2074    }
2075    for (i = 0; i < n; i++) {
2076      c = nayme[p->index - 1][i];
2077      if (c == ' ')
2078        c = '_';
2079      putc(c, outtree);
2080    }
2081    col += n;
2082  } else {
2083    sib_ptr = p;
2084    num_sibs = count_sibs(p);
2085    putc('(', outtree);
2086    col++;
2087
2088    for (i=0; i < (num_sibs - 1); i++) {
2089      sib_ptr = sib_ptr->next;
2090      dnamlk_treeout(sib_ptr->back);
2091      putc(',', outtree);
2092      col++;
2093      if (col > 55) {
2094        putc('\n', outtree);
2095        col = 0;
2096      }
2097    }
2098    sib_ptr = sib_ptr->next;
2099    dnamlk_treeout(sib_ptr->back);
2100    putc(')', outtree);
2101    col++;
2102  }
2103  if (p == curtree.root) {
2104    fprintf(outtree, ";\n");
2105    return;
2106  }
2107  local_x = fracchange * (p->tyme - curtree.nodep[p->back->index - 1]->tyme);
2108  if (local_x > 0.0)
2109    w = (long)(0.4342944822 * log(local_x));
2110  else if (local_x == 0.0)
2111    w = 0;
2112  else
2113    w = (long)(0.4342944822 * log(-local_x)) + 1;
2114  if (w < 0)
2115    w = 0;
2116  fprintf(outtree, ":%*.5f", (int)(w + 7), local_x);
2117  col += w + 8;
2118}  /* dnamlk_treeout */
2119
2120
2121void nodeinit(node *p)
2122{
2123  /* set up times at one node */
2124  node *sib_ptr, *sib_back_ptr;
2125  long i, num_sibs;
2126  double lowertyme;
2127
2128  sib_ptr = p;
2129  num_sibs = count_sibs(p);
2130
2131  /* lowertyme = lowest of children's times */
2132  lowertyme = p->next->back->tyme;
2133  for (i=0 ; i < num_sibs; i++) {
2134    sib_ptr      = sib_ptr->next;
2135    sib_back_ptr = sib_ptr->back;
2136    if (sib_back_ptr->tyme < lowertyme)
2137      lowertyme = sib_back_ptr->tyme;
2138  }
2139
2140  p->tyme = lowertyme - 0.1;
2141
2142  sib_ptr = p;
2143  for (i=0 ; i < num_sibs; i++) {
2144    sib_ptr = sib_ptr->next;
2145    sib_back_ptr = sib_ptr->back;
2146
2147    sib_ptr->tyme = p->tyme;
2148    sib_back_ptr->v = sib_back_ptr->tyme - p->tyme;
2149    sib_ptr->v = sib_back_ptr->v;
2150  }
2151}  /* nodeinit */
2152
2153
2154void initrav(node *p)
2155{
2156
2157  long i, num_sibs;
2158  node *sib_ptr, *sib_back_ptr;
2159
2160  /* traverse to set up times throughout tree */
2161  if (p->tip)
2162    return;
2163
2164  sib_ptr = p;
2165  num_sibs = count_sibs(p);
2166  for (i=0 ; i < num_sibs; i++) {
2167    sib_ptr      = sib_ptr->next;
2168    sib_back_ptr = sib_ptr->back;
2169    initrav(sib_back_ptr);
2170  }
2171
2172  nodeinit(p);
2173}  /* initrav */
2174
2175
2176void travinit(node *p)
2177{
2178  long i, num_sibs;
2179  node *sib_ptr, *sib_back_ptr;
2180
2181  /* traverse to set up initial values */
2182  if (p == NULL)
2183    return;
2184  if (p->tip)
2185    return;
2186  if (p->initialized)
2187    return;
2188
2189  sib_ptr = p;
2190  num_sibs = count_sibs(p);
2191  for (i=0 ; i < num_sibs; i++) {
2192    sib_ptr      = sib_ptr->next;
2193    sib_back_ptr = sib_ptr->back;
2194    travinit(sib_back_ptr);
2195  }
2196
2197  nuview(p);
2198  p->initialized = true;
2199}  /* travinit */
2200
2201
2202void travsp(node *p)
2203{
2204  long i, num_sibs;
2205  node *sib_ptr, *sib_back_ptr;
2206
2207  /* traverse to find tips */
2208  if (p == curtree.root)
2209    travinit(p);
2210  if (p->tip)
2211    travinit(p->back);
2212  else {
2213    sib_ptr = p;
2214    num_sibs = count_sibs(p);
2215    for (i=0 ; i < num_sibs; i++) {
2216      sib_ptr      = sib_ptr->next;
2217      sib_back_ptr = sib_ptr->back;
2218      travsp(sib_back_ptr);
2219    }
2220  }
2221}  /* travsp */
2222
2223
2224void treevaluate()
2225{
2226  /* evaluate likelihood of tree, after iterating branch lengths */
2227  long i, j,  num_sibs;
2228  node *sib_ptr;
2229
2230  polishing = true;
2231  smoothit = true;
2232  if (lngths == 0 && usertree == 1) {
2233    for (i = 0; i < spp; i++)
2234        curtree.nodep[i]->initialized = false;
2235    for (i = spp; i < nonodes; i++) {
2236        sib_ptr = curtree.nodep[i];
2237        sib_ptr->initialized = false;
2238        num_sibs = count_sibs(sib_ptr);
2239        for (j=0 ; j < num_sibs; j++) {
2240        sib_ptr      = sib_ptr->next;
2241        sib_ptr->initialized = false;
2242        }
2243    }
2244    initrav(curtree.root);
2245    travsp(curtree.root);
2246  }
2247  for (i = 1; i <= smoothings * 4; i++)
2248    smooth(curtree.root);
2249  evaluate(curtree.root);
2250}  /* treevaluate */
2251
2252
2253void maketree()
2254{
2255  /* constructs a binary tree from the pointers in curtree.nodep,
2256     adds each node at location which yields highest likelihood
2257     then rearranges the tree for greatest likelihood */
2258
2259  long i, j, numtrees;
2260  double local_x;
2261  node *item, *nufork, *dummy, *q, *root=NULL;
2262  boolean dummy_haslengths, dummy_first, goteof;
2263  long nextnode;
2264  pointarray dummy_treenode=NULL;
2265  double oldbest;
2266  node *tmp;
2267  int succeded = false;
2268
2269  inittable(); 
2270
2271  if (!usertree) {
2272    for (i = 1; i <= spp; i++)
2273      enterorder[i - 1] = i;
2274    if (jumble)
2275      randumize(seed, enterorder);
2276    curtree.root = curtree.nodep[spp];
2277    curtree.root->back = NULL;
2278    for (i = 0; i < spp; i++)
2279       curtree.nodep[i]->back = NULL;
2280    for (i = spp; i < nonodes; i++) {
2281       q = curtree.nodep[i];
2282       q->back = NULL;
2283       while ((q = q->next) != curtree.nodep[i])
2284         q->back = NULL;
2285    }
2286    polishing = false;
2287    dnamlk_add(curtree.nodep[enterorder[0] - 1], curtree.nodep[enterorder[1] - 1],
2288        curtree.nodep[spp]);
2289    if (progress) {
2290      printf("\nAdding species:\n");
2291      writename(0, 2, enterorder);
2292#ifdef WIN32
2293      phyFillScreenColor();
2294#endif
2295    }
2296    lastsp = false;
2297    smoothit = false;
2298    for (i = 3; i <= spp; i++) {
2299      bestree.likelihood = UNDEFINED;
2300      bestyet = UNDEFINED;
2301      there = curtree.root;
2302      item = curtree.nodep[enterorder[i - 1] - 1];
2303      nufork = curtree.nodep[spp + i - 2];
2304      lastsp = (i == spp);
2305      addpreorder(curtree.root, item, nufork, true, true);
2306      dnamlk_add(there, item, nufork);
2307      global_like = evaluate(curtree.root);
2308      copy_(&curtree, &bestree, nonodes, rcategs);
2309      rearrange(&curtree.root);
2310      if (curtree.likelihood > bestree.likelihood) {
2311        copy_(&curtree, &bestree, nonodes, rcategs);
2312      }
2313      if (progress) {
2314        writename(i - 1, 1, enterorder);
2315#ifdef WIN32
2316        phyFillScreenColor();
2317#endif
2318      }
2319      if (lastsp && global) {
2320        if (progress) {
2321          printf("Doing global rearrangements\n");
2322          printf("  !");
2323          for (j = 1; j <= nonodes; j++)
2324            putchar('-');
2325          printf("!\n");
2326        }
2327        global2 = true;
2328        do {
2329          succeded = false;
2330          if (progress)
2331            printf("   ");
2332          save_tree_tyme(&curtree, tymes);
2333          for (j = 0; j < nonodes; j++) {
2334            oldbest = bestree.likelihood;
2335            bestyet = UNDEFINED;
2336            item = curtree.nodep[j];
2337            if (item != curtree.root) {
2338              nufork = curtree.nodep[curtree.nodep[j]->back->index - 1];
2339             
2340              if (nufork != curtree.root) { 
2341                tmp = nufork->next->back;
2342                if (tmp == item) 
2343                    tmp = nufork->next->next->back; 
2344                    /* can't figure out why we never get here */
2345              }
2346              else {
2347                  if (nufork->next->back != item)
2348                      tmp  = nufork->next->back;
2349                  else tmp = nufork->next->next->back;
2350              } /* if we add item at tmp we have done nothing */
2351              dnamlk_re_move(&item, &nufork, false);
2352              there = curtree.root;
2353              addpreorder(curtree.root, item, nufork, true, true);
2354              if ( tmp != there && bestree.likelihood > oldbest)
2355                succeded = true;
2356              dnamlk_add(there, item, nufork);
2357              restore_saved_tyme(&curtree,tymes);
2358            }
2359            if (progress) {
2360              putchar('.');
2361              fflush(stdout);
2362            }
2363          } 
2364          if (progress)
2365            putchar('\n');
2366        } while ( succeded );
2367      }
2368    }
2369    if (njumble > 1 && lastsp) {
2370      for (i = 0; i < spp; i++ )
2371        dnamlk_re_move(&curtree.nodep[i], &dummy, false);
2372      if (jumb == 1 || bestree2.likelihood < bestree.likelihood)
2373        copy_(&bestree, &bestree2, nonodes, rcategs);
2374    }
2375    if (jumb == njumble) {
2376      if (njumble > 1)
2377        copy_(&bestree2, &curtree, nonodes, rcategs);
2378      else copy_(&bestree, &curtree, nonodes, rcategs);
2379      fprintf(outfile, "\n\n");
2380      treevaluate();
2381      curtree.likelihood = evaluate(curtree.root);
2382      dnamlk_printree();
2383      summarize();
2384      if (trout) {
2385        col = 0;
2386        dnamlk_treeout(curtree.root);
2387      }
2388    } 
2389  } else {
2390    openfile(&intree, INTREE, "input tree file", "r", progname, intreename);
2391    inittable_for_usertree (intree);
2392    numtrees = countsemic(&intree);
2393    if (numtrees > 2)
2394      initseed(&inseed, &inseed0, seed);
2395    l0gl = (double *)Malloc(numtrees * sizeof(double));
2396    l0gf = (double **)Malloc(numtrees * sizeof(double *));
2397    for (i=0; i < numtrees; ++i)
2398      l0gf[i] = (double *)Malloc(endsite * sizeof(double));
2399    if (treeprint) {
2400      fprintf(outfile, "User-defined tree");
2401      if (numtrees > 1)
2402        putc('s', outfile);
2403      fprintf(outfile, ":\n\n");
2404    }
2405    fprintf(outfile, "\n\n");
2406    which = 1;
2407    while (which <= numtrees) {
2408     
2409      /* These initializations required each time through the loop
2410         since multiple trees require re-initialization */
2411      dummy_haslengths = true;
2412      nextnode         = 0;
2413      dummy_first      = true;
2414      goteof           = false;
2415
2416      treeread(intree, &root, dummy_treenode, &goteof, &dummy_first,
2417               curtree.nodep, &nextnode,
2418               &dummy_haslengths, &grbg, initdnamlnode);
2419
2420      nonodes = nextnode;
2421     
2422      root = curtree.nodep[root->index - 1];
2423      curtree.root = root;
2424
2425      if (lngths)
2426        tymetrav(curtree.root, &local_x);
2427
2428      if (goteof && (which <= numtrees)) {
2429        /* if we hit the end of the file prematurely */
2430        printf ("\n");
2431        printf ("ERROR: trees missing at end of file.\n");
2432        printf ("\tExpected number of trees:\t\t%ld\n", numtrees);
2433        printf ("\tNumber of trees actually in file:\t%ld.\n\n", which - 1);
2434        exxit(-1);
2435      }
2436      curtree.start = curtree.nodep[0]->back;
2437      treevaluate();
2438      dnamlk_printree();
2439      summarize();
2440      if (trout) {
2441        col = 0;
2442        dnamlk_treeout(curtree.root);
2443      }
2444      which++;
2445    }     
2446
2447    FClose(intree);
2448    if (!auto_ && numtrees > 1 && weightsum > 1 )
2449      standev2(numtrees, maxwhich, 0, endsite, maxlogl, l0gl, l0gf,
2450               aliasweight, seed);
2451  }
2452 
2453  if (jumb == njumble) {
2454    if (progress) {
2455      printf("\nOutput written to file \"%s\"\n\n", outfilename);
2456      if (trout)
2457        printf("Tree also written onto file \"%s\"\n\n", outtreename);
2458    }
2459    free(contribution);
2460    freex(nonodes, curtree.nodep);
2461    if (!usertree) {
2462      freex(nonodes, bestree.nodep);
2463      if (njumble > 1)
2464        freex(nonodes, bestree2.nodep);
2465    }
2466  }
2467  free(root);
2468} /* maketree */
2469
2470/*?? Dnaml has a clean-up function for freeing memory, closing files, etc.
2471     Put one here too? */
2472
2473int main(int argc, Char *argv[])
2474{  /* DNA Maximum Likelihood with molecular clock */
2475
2476#ifdef MAC
2477  argc = 1;                /* macsetup("Dnamlk", "Dnamlk");        */
2478  argv[0] = "Dnamlk";
2479#endif
2480  init(argc,argv);
2481  progname = argv[0];
2482  openfile(&infile, INFILE, "input file", "r", argv[0], infilename);
2483  openfile(&outfile, OUTFILE, "output file", "w", argv[0], outfilename);
2484
2485  ibmpc = IBMCRT;
2486  ansi = ANSICRT;
2487  datasets = 1;
2488  mulsets = false;
2489  firstset = true;
2490  doinit();
2491
2492  ttratio0    = ttratio;
2493  if (trout)
2494    openfile(&outtree, OUTTREE, "output tree file", "w", argv[0], outtreename);
2495  if (ctgry)
2496    openfile(&catfile, CATFILE, "categories file", "r", argv[0], catfilename);
2497  if (weights || justwts)
2498   openfile(&weightfile, WEIGHTFILE, "weights file", "r", argv[0], weightfilename);
2499  for (ith = 1; ith <= datasets; ith++) {
2500    ttratio = ttratio0;
2501    if (datasets > 1) {
2502      fprintf(outfile, "Data set # %ld:\n\n", ith);
2503      if (progress)
2504        printf("\nData set # %ld:\n", ith);
2505    }
2506    getinput();
2507    if (ith == 1)
2508      firstset = false;
2509    for (jumb = 1; jumb <= njumble; jumb++)
2510      maketree();
2511  }
2512  FClose(infile); 
2513  FClose(outfile);
2514  FClose(outtree);
2515#ifdef MAC
2516  fixmacfile(outfilename);
2517  fixmacfile(outtreename);
2518#endif
2519  printf("Done.\n\n");
2520#ifdef WIN32
2521  phyRestoreConsoleAttributes();
2522#endif
2523  return 0;
2524}  /* DNA Maximum Likelihood with molecular clock */
2525
Note: See TracBrowser for help on using the repository browser.