source: trunk/GDE/FASTDNAML/fastDNAml.c

Last change on this file was 19480, checked in by westram, 15 months ago
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 142.5 KB
Line 
1#define programName        "fastDNAml"
2#define programVersion     "1.2.2"
3#define programVersionInt   10202
4#define programDate        "January 3, 2000"
5#define programDateInt      20000103
6
7/*  fastDNAml, a program for estimation of phylogenetic trees from sequences.
8 *  Copyright (C) 1998, 1999, 2000 by Gary J. Olsen
9 *
10 *  This program is free software; you may redistribute it and/or modify it
11 *  under the terms of the GNU General Public License as published by the Free
12 *  Software Foundation; either version 2 of the License, or (at your option)
13 *  any later version.
14 *
15 *  This program is distributed in the hope that it will be useful, but
16 *  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
17 *  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
18 *  for more details.
19 *
20 *  You should have received a copy of the GNU General Public License along
21 *  with this program; if not, write to the Free Software Foundation, Inc.,
22 *  59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
23 *
24 *  For any other enquiries write to Gary J. Olsen, Department of Microbiology,
25 *  University of Illinois, Urbana, IL  61801, USA
26 *
27 *  Or send E-mail to gary@phylo.life.uiuc.edu
28 *
29 *
30 *  fastDNAml is based in part on the program dnaml by Joseph Felsenstein.
31 *
32 *  Copyright notice from dnaml:
33 *
34 *     version 3.3. (c) Copyright 1986, 1990 by the University of Washington
35 *     and Joseph Felsenstein.  Written by Joseph Felsenstein.  Permission is
36 *     granted to copy and use this program provided no fee is charged for it
37 *     and provided that this copyright notice is not removed.
38 *
39 *
40 *  When publishing work that based on results from fastDNAml please cite:
41 *
42 *  Felsenstein, J.  1981.  Evolutionary trees from DNA sequences:
43 *  A maximum likelihood approach.  J. Mol. Evol. 17: 368-376.
44 *
45 *  and
46 *
47 *  Olsen, G. J., Matsuda, H., Hagstrom, R., and Overbeek, R.  1994.
48 *  fastDNAml:  A tool for construction of phylogenetic trees of DNA
49 *  sequences using maximum likelihood.  Comput. Appl. Biosci. 10: 41-48.
50 */
51
52/*  Conversion to C and changes in sequential code by Gary Olsen, 1991-1994
53 *
54 *  p4 version by Hideo Matsuda and Ross Overbeek, 1991-1993
55 */
56
57/*
58 *  1.0    March 14, 1992
59 *         Initial "release" version
60 *
61 *  1.0.1  March 18, 1992
62 *         Add ntaxa to tree comments
63 *         Set minimum branch length on reading tree
64 *         Add blanks around operators in treeString (for prolog parsing)
65 *         Add program version to treeString comments
66 *
67 *  1.0.2  April 6, 1992
68 *         Improved option line diagnostics
69 *         Improved auxiliary line diagnostics
70 *         Removed some trailing blanks from output
71 *
72 *  1.0.3  April 6, 1992
73 *         Checkpoint trees that do not need any optimization
74 *         Print restart tree likelihood before optimizing
75 *         Fix treefile option so that it really toggles
76 *
77 *  1.0.4  July 13, 1992
78 *         Add support for tree fact (instead of true Newick tree) in
79 *            processTreeCom, treeReadLen, str_processTreeCom and
80 *            str_treeReadLen
81 *         Use bit operations in randum
82 *         Correct error in bootstrap mask used with weighting mask
83 *
84 *  1.0.5  August 22, 1992
85 *         Fix reading of underscore as first nonblank character in name
86 *         Add strchr and strstr functions to source code
87 *         Add output treefile name to message "Tree also written ..."
88 *
89 *  1.0.6  November 20, 1992
90 *         Change (! nsites) test in setupTopol to (nsites == 0) for MIPS R4000
91 *         Add vectorizing compiler directives for CRAY
92 *         Include updates and corrections to parallel code from H. Matsuda
93 *
94 *  1.0.7  March 25, 1993
95 *         Remove translation of underlines in taxon names
96 *
97 *  1.0.8  April 30, 1993
98 *         Remove version number from fastDNAml.h file name
99 *
100 *  1.0.9  August 12, 1993
101 *         Version was never released.
102 *         Redefine treefile formats and default:
103 *             0  None
104 *             1  Newick
105 *             2  Prolog
106 *             3  PHYLIP (Default)
107 *         Remove quote marks and comment from PHYLIP treefile format.
108 *
109 *  1.1.0  September 3-5, 1993
110 *         Arrays of size maxpatterns moved from stack to heap (mallocs) in
111 *            evaluateslope, makenewz, and cmpBestTrees.
112 *         Correct [maxsites] to [maxpatterns] in temporary array definitions
113 *            in Vectorize code of newview and evaluate.  (These should also
114 *            get converted to use malloc() at some point.)
115 *         Change randum to use 12 bit segments, not 6.  Change its seed
116 *            parameter to long *.
117 *         Remove the code that took the absolute value of random seeds.
118 *         Correct integer divide artifact in setting default transition/
119 *            transversion parameter values.
120 *         When transition/transversion ratio is "reset", change to small
121 *            value, not the program default.
122 *         Report the "reset" transition/transversion ratio in the output.
123 *         Move global data into analdef, rawDNA, and crunchedDNA structures.
124 *         Change names of routines white and digit to whitechar and digitchar.
125 *         Convert y[] to yType, which is normally char, but is int if the
126 *            Vectorize flag is set.
127 *         Split option line reading out of getoptions routine.
128 *
129 *  1.1.1  September 30, 1994
130 *         Incorporate changes made in 1.0.A (Feb. 11, 1994):
131 *            Remove processing of quotation marks within comments.
132 *            Break label finding into copy to string and find tip.
133 *            Generalize tree reading to read trees when names are and are not
134 *               already known.
135 *            Remove absolute value from randum seed reading.
136 *         Include integer version number and program date.
137 *         Remove maxsite, maxpatterns and maxsp limitations.
138 *         Incorporate code for retaining multiple trees.
139 *         Activate code for Hasegawa & Kishino test of tree differences.
140 *         Make quick add the default, with Q turning it off.
141 *         Make emperical frequencies the option with F turning it off.
142 *         Allow a residue frequency option line anywhere in the options.
143 *         Increase string length passed to treeString (should be length
144 *               checked, but ...)
145 *         Introduce (Sept.30) and fix (Oct. 26) bug in bootstrap sampling.
146 *         Fix error when user frequencies are last line and start with F.
147 *
148 *  1.2    September 5, 1997
149 *         Move likelihood components into structure.
150 *         Change rawDNA to rawdata.
151 *         Change crunchedDNA to cruncheddata.
152 *         Recast the likelihoods per site into an array of stuctures,
153 *               where each stucture (likelivector) includes the likelihoods
154 *               of each residue type at the site, and a magnitude scale
155 *               factor (exp).  This requires changing the space allocation,
156 *               newview, makenewz, evaluate, and sigma.
157 *         Change code of newview to rescale likelihoods up by 2**256 when
158 *               the largest value falls below 2**-256.  This should solve
159 *               floating point underflow for all practical sized trees.
160 *               No changes are necessary in makenewz or sigma, since only
161 *               relative likelihoods are necessary.
162 *
163 *  1.2.1  March 9, 1998
164 *         Convert likelihood adjustment factor (2**256) to a constant.
165 *         Fix vectorized calculation of likelihood (error introduced in 1.2)
166 *
167 *  1.2.2  December 23, 1998
168 *         General code clean-up.
169 *         Convert to function definitions with parameter type lists
170 *
171 *  1.2.2  January 3, 2000
172 *         Add copyright and license information
173 *         Make this the current release version
174 */
175
176#ifdef Master
177#  undef  Master
178#  define Master     1
179#  define Slave      0
180#  define Sequential 0
181#else
182#  ifdef Slave
183#    undef Slave
184#    define Master     0
185#    define Slave      1
186#    define Sequential 0
187#  else
188#    ifdef Sequential
189#      undef Sequential
190#    endif
191#    define Master     0
192#    define Slave      0
193#    define Sequential 1
194#  endif
195#endif
196
197#ifdef  CRAY
198#  define  Vectorize
199#endif
200
201#ifdef  Vectorize
202#  define maxpatterns  10000  /* maximum number of different site patterns */
203#endif
204
205#include <stdio.h>
206#include <string.h>
207#include <unistd.h>
208#include <math.h>
209#include "fastDNAml.h"  /*  Requires version 1.2  */
210
211#if Master || Slave
212#  include "p4.h"
213#  include "comm_link.h"
214#endif
215
216/*  Global variables */
217
218xarray       *usedxtip, *freextip;
219
220#if Sequential     /*  Use standard input */
221#  undef   DNAML_STEP
222#  define  DNAML_STEP  0
223#  define  INFILE  stdin
224#endif
225
226#if Master
227#  define MAX_SEND_AHEAD 400
228  char   *best_tr_recv = NULL;     /* these are used for flow control */
229  double  best_lk_recv;
230  int     send_ahead = 0;          /* number of outstanding sends */
231
232#  ifdef DNAML_STEP
233#    define  DNAML_STEP  1
234#  endif
235#  define  INFILE   Seqf
236#  define  OUTFILE  Outf
237  FILE  *INFILE, *OUTFILE;
238  comm_block comm_slave;
239#endif
240
241#if Slave
242#  undef   DNAML_STEP
243#  define  DNAML_STEP  0
244#  define  INFILE   Seqf
245#  define  OUTFILE  Outf
246  FILE  *INFILE, *OUTFILE;
247  comm_block comm_master;
248#endif
249
250#if Debug
251  FILE *debug;
252#endif
253
254#if DNAML_STEP
255  int begin_step_time, end_step_time;
256#  define  REPORT_ADD_SPECS  p4_send(DNAML_ADD_SPECS, DNAML_HOST_ID, NULL, 0)
257#  define  REPORT_SEND_TREE  p4_send(DNAML_SEND_TREE, DNAML_HOST_ID, NULL, 0)
258#  define  REPORT_RECV_TREE  p4_send(DNAML_RECV_TREE, DNAML_HOST_ID, NULL, 0)
259#  define  REPORT_STEP_TIME \
260   {\
261       char send_buf[80]; \
262       end_step_time = p4_clock(); \
263       (void) sprintf(send_buf, "%d", end_step_time-begin_step_time); \
264       p4_send(DNAML_STEP_TIME, DNAML_HOST_ID, send_buf,strlen(send_buf)+1); \
265       begin_step_time = end_step_time; \
266   }
267#else
268#  define  REPORT_ADD_SPECS
269#  define  REPORT_SEND_TREE
270#  define  REPORT_RECV_TREE
271#  define  REPORT_STEP_TIME
272#endif
273
274/*=======================================================================*/
275/*                              PROGRAM                                  */
276/*=======================================================================*/
277/*                    Best tree handling for dnaml                       */
278/*=======================================================================*/
279
280/*  Tip value comparisons
281 *
282 *  Use void pointers to hide type from other routines.  Only tipValPtr and
283 *  cmpTipVal need to be changed to alter the nature of the values compared
284 *  (e.g., names instead of node numbers).
285 *
286 *    cmpTipVal(tipValPtr(nodeptr p), tipValPtr(nodeptr q)) == -1, 0 or 1.
287 *
288 *  This provides direct comparison of tip values (for example, for
289 *  definition of tr->start).
290 */
291
292
293void  *tipValPtr (nodeptr p)
294  { return  (void *) & p->number;
295    }
296
297
298int  cmpTipVal (void *v1, void *v2)
299  { /* cmpTipVal */
300    int  i1, i2;
301
302    i1 = *((int *) v1);
303    i2 = *((int *) v2);
304    return  (i1 < i2) ? -1 : ((i1 == i2) ? 0 : 1);
305  } /* cmpTipVal */
306
307
308/*  These are the only routines that need to UNDERSTAND topologies */
309
310
311topol  *setupTopol (int maxtips, int nsites)
312  { /* setupTopol */
313    topol   *tpl;
314
315    if (! (tpl = (topol *) Malloc(sizeof(topol))) || 
316        ! (tpl->links = (connptr) Malloc((2*maxtips-3) * sizeof(connect))) || 
317        (nsites && ! (tpl->log_f
318                = (double *) Malloc(nsites * sizeof(double))))) {
319      printf("ERROR: Unable to get topology memory");
320      tpl = (topol *) NULL;
321      }
322
323    else {
324      if (nsites == 0)  tpl->log_f = (double *) NULL;
325      tpl->likelihood  = unlikely;
326      tpl->start       = (node *) NULL;
327      tpl->nextlink    = 0;
328      tpl->ntips       = 0;
329      tpl->nextnode    = 0;
330      tpl->opt_level   = 0;     /* degree of branch swapping explored */
331      tpl->scrNum      = 0;     /* position in sorted list of scores */
332      tpl->tplNum      = 0;     /* position in sorted list of trees */
333      tpl->log_f_valid = 0;     /* log_f value sites */
334      tpl->prelabeled  = TRUE;
335      tpl->smoothed    = FALSE; /* branch optimization converged? */
336      }
337
338    return  tpl;
339  } /* setupTopol */
340
341
342void  freeTopol (topol *tpl)
343  { /* freeTopol */
344    Free(tpl->links);
345    if (tpl->log_f)  Free(tpl->log_f);
346    Free(tpl);
347  } /* freeTopol */
348
349
350int  saveSubtree (nodeptr p, topol *tpl)
351    /*  Save a subtree in a standard order so that earlier branches
352     *  from a node contain lower value tips than do second branches from
353     *  the node.  This code works with arbitrary furcations in the tree.
354     */
355  { /* saveSubtree */
356    connptr  r, r0;
357    nodeptr  q, s;
358    int      t, t0, t1;
359
360    r0 = tpl->links;
361    r = r0 + (tpl->nextlink)++;
362    r->p = p;
363    r->q = q = p->back;
364    r->z = p->z;
365    r->descend = 0;                     /* No children (yet) */
366
367    if (q->tip) {
368      r->valptr = tipValPtr(q);         /* Assign value */
369      }
370
371    else {                              /* Internal node, look at children */
372      s = q->next;                      /* First child */
373      do {
374        t = saveSubtree(s, tpl);        /* Generate child's subtree */
375
376        t0 = 0;                         /* Merge child into list */
377        t1 = r->descend;
378        while (t1 && (cmpTipVal(r0[t1].valptr, r0[t].valptr) < 0)) {
379          t0 = t1;
380          t1 = r0[t1].sibling;
381          }
382        if (t0) r0[t0].sibling = t;  else  r->descend = t;
383        r0[t].sibling = t1;
384
385        s = s->next;                    /* Next child */
386        } while (s != q);
387
388      r->valptr = r0[r->descend].valptr;   /* Inherit first child's value */
389      }                                 /* End of internal node processing */
390
391    return  r - r0;
392  } /* saveSubtree */
393
394
395nodeptr  minSubtreeTip (nodeptr  p0)
396  { /* minTreeTip */
397    nodeptr  minTip, p, testTip;
398
399    if (p0->tip) return p0;
400
401    p = p0->next;
402    minTip = minSubtreeTip(p->back);
403    while ((p = p->next) != p0) {
404      testTip = minSubtreeTip(p->back);
405      if (cmpTipVal(tipValPtr(testTip), tipValPtr(minTip)) < 0)
406        minTip = testTip;
407      }
408    return minTip;
409  } /* minTreeTip */
410
411
412nodeptr  minTreeTip (nodeptr  p)
413  { /* minTreeTip */
414    nodeptr  minp, minpb;
415
416    minp  = minSubtreeTip(p);
417    minpb = minSubtreeTip(p->back);
418    return cmpTipVal(tipValPtr(minp), tipValPtr(minpb)) < 0 ? minp : minpb;
419  } /* minTreeTip */
420
421
422void saveTree (tree *tr, topol *tpl)
423    /*  Save a tree topology in a standard order so that first branches
424     *  from a node contain lower value tips than do second branches from
425     *  the node.  The root tip should have the lowest value of all.
426     */
427  { /* saveTree */
428    connptr  r;
429    double  *tr_log_f, *tpl_log_f;
430    int  i;
431
432    tpl->nextlink = 0;                             /* Reset link pointer */
433    r = tpl->links + saveSubtree(minTreeTip(tr->start), tpl);  /* Save tree */
434    r->sibling = 0;
435
436    tpl->likelihood = tr->likelihood;
437    tpl->start      = tr->start;
438    tpl->ntips      = tr->ntips;
439    tpl->nextnode   = tr->nextnode;
440    tpl->opt_level  = tr->opt_level;
441    tpl->prelabeled = tr->prelabeled;
442    tpl->smoothed   = tr->smoothed;
443
444    if (tpl_log_f = tpl->log_f) {
445      tr_log_f  = tr->log_f;
446      i = tpl->log_f_valid = tr->log_f_valid;
447      while (--i >= 0)  *tpl_log_f++ = *tr_log_f++;
448      }
449    else {
450      tpl->log_f_valid = 0;
451      }
452  } /* saveTree */
453
454
455void copyTopol (topol *tpl1, topol *tpl2)
456  { /* copyTopol */
457    connptr  r1, r2, r10, r20;
458    double  *tpl1_log_f, *tpl2_log_f;
459    int  i;
460
461    r10 = tpl1->links;
462    r20 = tpl2->links;
463    tpl2->nextlink = tpl1->nextlink; 
464
465    r1 = r10;
466    r2 = r20;
467    i = 2 * tpl1->ntips - 3;
468    while (--i >= 0) {
469      r2->z = r1->z;
470      r2->p = r1->p;
471      r2->q = r1->q;
472      r2->valptr = r1->valptr;
473      r2->descend = r1->descend; 
474      r2->sibling = r1->sibling; 
475      r1++;
476      r2++;
477      }
478
479    if (tpl1->log_f_valid && tpl2->log_f) {
480      tpl1_log_f = tpl1->log_f;
481      tpl2_log_f = tpl2->log_f;
482      tpl2->log_f_valid = i = tpl1->log_f_valid;
483      while (--i >= 0)  *tpl2_log_f++ = *tpl1_log_f++;
484      }
485    else {
486      tpl2->log_f_valid = 0;
487      }
488
489    tpl2->likelihood = tpl1->likelihood;
490    tpl2->start      = tpl1->start;
491    tpl2->ntips      = tpl1->ntips;
492    tpl2->nextnode   = tpl1->nextnode;
493    tpl2->opt_level  = tpl1->opt_level;
494    tpl2->prelabeled = tpl1->prelabeled;
495    tpl2->scrNum     = tpl1->scrNum;
496    tpl2->tplNum     = tpl1->tplNum;
497    tpl2->smoothed   = tpl1->smoothed;
498  } /* copyTopol */
499
500
501boolean restoreTree (topol *tpl, tree *tr)
502  { /* restoreTree */
503    void  hookup();
504    boolean  initrav();
505
506    connptr  r;
507    nodeptr  p, p0;
508    double  *tr_log_f, *tpl_log_f;
509    int  i;
510
511/*  Clear existing connections */
512
513    for (i = 1; i <= 2*(tr->mxtips) - 2; i++) {  /* Uses p = p->next at tip */
514      p0 = p = tr->nodep[i];
515      do {
516        p->back = (nodeptr) NULL;
517        p = p->next;
518        } while (p != p0);
519      }
520
521/*  Copy connections from topology */
522
523    for (r = tpl->links, i = 0; i < tpl->nextlink; r++, i++) {
524      hookup(r->p, r->q, r->z);
525      }
526
527    tr->likelihood = tpl->likelihood;
528    tr->start      = tpl->start;
529    tr->ntips      = tpl->ntips;
530    tr->nextnode   = tpl->nextnode;
531    tr->opt_level  = tpl->opt_level;
532    tr->prelabeled = tpl->prelabeled;
533    tr->smoothed   = tpl->smoothed;
534
535    if (tpl_log_f = tpl->log_f) {
536      tr_log_f = tr->log_f;
537      i = tr->log_f_valid = tpl->log_f_valid;
538      while (--i >= 0)  *tr_log_f++ = *tpl_log_f++;
539      }
540    else {
541      tr->log_f_valid = 0;
542      }
543
544    return (initrav(tr, tr->start) && initrav(tr, tr->start->back));
545  } /* restoreTree */
546
547
548int initBestTree (bestlist *bt, int newkeep, int numsp, int sites)
549  { /* initBestTree */
550    int  i, nlogf;
551
552
553    bt->nkeep = 0;
554
555    if (bt->ninit <= 0) {
556      if (! (bt->start = setupTopol(numsp, sites)))  return  0;
557      bt->ninit = -1;
558      bt->nvalid = 0;
559      bt->numtrees = 0;
560      bt->best = unlikely;
561      bt->improved = FALSE;
562      bt->byScore = (topol **) Malloc((newkeep+1) * sizeof(topol *));
563      bt->byTopol = (topol **) Malloc((newkeep+1) * sizeof(topol *));
564      if (! bt->byScore || ! bt->byTopol) {
565        fprintf(stderr, "initBestTree: Malloc failure\n");
566        return 0;
567        }
568      }
569    else if (ABS(newkeep) > bt->ninit) {
570      if (newkeep <  0) newkeep = -(bt->ninit);
571      else newkeep = bt->ninit;
572      }
573
574    if (newkeep < 1) {    /*  Use negative newkeep to clear list  */
575      newkeep = -newkeep;
576      if (newkeep < 1) newkeep = 1;
577      bt->nvalid = 0;
578      bt->best = unlikely;
579      }
580
581    if (bt->nvalid >= newkeep) {
582      bt->nvalid = newkeep;
583      bt->worst = bt->byScore[newkeep]->likelihood;
584      }
585    else {
586      bt->worst = unlikely;
587      }
588
589    for (i = bt->ninit + 1; i <= newkeep; i++) {
590      nlogf = (i <= maxlogf) ? sites : 0;
591      if (! (bt->byScore[i] = setupTopol(numsp, nlogf)))  break;
592      bt->byTopol[i] = bt->byScore[i];
593      bt->ninit = i;
594      }
595
596    return  (bt->nkeep = MIN(newkeep, bt->ninit));
597  } /* initBestTree */
598
599
600
601int resetBestTree (bestlist *bt)
602  { /* resetBestTree */
603    bt->best     = unlikely;
604    bt->worst    = unlikely;
605    bt->nvalid   = 0;
606    bt->improved = FALSE;
607  } /* resetBestTree */
608
609
610boolean  freeBestTree(bestlist *bt)
611  { /* freeBestTree */
612    while (bt->ninit >= 0)  freeTopol(bt->byScore[(bt->ninit)--]);
613    freeTopol(bt->start);
614    return TRUE;
615  } /* freeBestTree */
616
617
618/*  Compare two trees, assuming that each is in standard order.  Return
619 *  -1 if first preceeds second, 0 if they are identical, or +1 if first
620 *  follows second in standard order.  Lower number tips preceed higher
621 *  number tips.  A tip preceeds a corresponding internal node.  Internal
622 *  nodes are ranked by their lowest number tip.
623 */
624
625int  cmpSubtopol (connptr p10, connptr p1, connptr p20, connptr p2)
626  { /* cmpSubtopol */
627    connptr  p1d, p2d;
628    int  cmp;
629
630    if (! p1->descend && ! p2->descend)          /* Two tips */
631      return cmpTipVal(p1->valptr, p2->valptr);
632
633    if (! p1->descend) return -1;                /* p1 = tip, p2 = node */
634    if (! p2->descend) return  1;                /* p2 = tip, p1 = node */
635
636    p1d = p10 + p1->descend;
637    p2d = p20 + p2->descend;
638    while (1) {                                  /* Two nodes */
639      if (cmp = cmpSubtopol(p10, p1d, p20, p2d))  return cmp; /* Subtrees */
640      if (! p1d->sibling && ! p2d->sibling)  return  0; /* Lists done */
641      if (! p1d->sibling) return -1;             /* One done, other not */
642      if (! p2d->sibling) return  1;             /* One done, other not */
643      p1d = p10 + p1d->sibling;                  /* Neither done */
644      p2d = p20 + p2d->sibling;
645      }
646  } /* cmpSubtopol */
647
648
649
650int  cmpTopol (void *tpl1, void *tpl2)
651  { /* cmpTopol */
652    connptr  r1, r2;
653    int      cmp;
654
655    r1 = ((topol *) tpl1)->links;
656    r2 = ((topol *) tpl2)->links;
657    cmp = cmpTipVal(tipValPtr(r1->p), tipValPtr(r2->p));
658    if (cmp) return cmp;
659    return  cmpSubtopol(r1, r1, r2, r2);
660  } /* cmpTopol */
661
662
663
664int  cmpTplScore (void *tpl1, void *tpl2)
665  { /* cmpTplScore */
666    double  l1, l2;
667
668    l1 = ((topol *) tpl1)->likelihood;
669    l2 = ((topol *) tpl2)->likelihood;
670    return  (l1 > l2) ? -1 : ((l1 == l2) ? 0 : 1);
671  } /* cmpTplScore */
672
673
674
675/*  Find an item in a sorted list of n items.  If the item is in the list,
676 *  return its index.  If it is not in the list, return the negative of the
677 *  position into which it should be inserted.
678 */
679
680int  findInList (void *item, void *list[], int n, int (* cmpFunc)())
681  { /* findInList */
682    int  mid, hi, lo, cmp;
683
684    if (n < 1) return  -1;                    /*  No match; first index  */
685
686    lo = 1;
687    mid = 0;
688    hi = n;
689    while (lo < hi) {
690      mid = (lo + hi) >> 1;
691      cmp = (* cmpFunc)(item, list[mid-1]);
692      if (cmp) {
693        if (cmp < 0) hi = mid;
694        else lo = mid + 1;
695        }
696      else  return  mid;                        /*  Exact match  */
697      }
698
699    if (lo != mid) {
700       cmp = (* cmpFunc)(item, list[lo-1]);
701       if (cmp == 0) return lo;
702       }
703    if (cmp > 0) lo++;                         /*  Result of step = 0 test  */
704    return  -lo;
705  } /* findInList */
706
707
708
709int  findTreeInList (bestlist *bt, tree *tr)
710  { /* findTreeInList */
711    topol  *tpl;
712
713    tpl = bt->byScore[0];
714    saveTree(tr, tpl);
715    return  findInList((void *) tpl, (void **) (& (bt->byTopol[1])),
716                       bt->nvalid, cmpTopol);
717  } /* findTreeInList */
718
719
720int  saveBestTree (bestlist *bt, tree *tr)
721  { /* saveBestTree */
722    double *tr_log_f, *tpl_log_f;
723    topol  *tpl, *reuse;
724    int  tplNum, scrNum, reuseScrNum, reuseTplNum, i, oldValid, newValid;
725
726    tplNum = findTreeInList(bt, tr);
727    tpl = bt->byScore[0];
728    oldValid = newValid = bt->nvalid;
729
730    if (tplNum > 0) {                      /* Topology is in list  */
731      reuse = bt->byTopol[tplNum];         /* Matching topol  */
732      reuseScrNum = reuse->scrNum;
733      reuseTplNum = reuse->tplNum;
734      }
735                                           /* Good enough to keep? */
736    else if (tr->likelihood < bt->worst)  return 0;
737
738    else {                                 /* Topology is not in list */
739      tplNum = -tplNum;                    /* Add to list (not replace) */
740      if (newValid < bt->nkeep) bt->nvalid = ++newValid;
741      reuseScrNum = newValid;              /* Take worst tree */
742      reuse = bt->byScore[reuseScrNum];
743      reuseTplNum = (newValid > oldValid) ? newValid : reuse->tplNum;
744      if (tr->likelihood > bt->start->likelihood) bt->improved = TRUE;
745      }
746
747    scrNum = findInList((void *) tpl, (void **) (& (bt->byScore[1])),
748                         oldValid, cmpTplScore);
749    scrNum = ABS(scrNum);
750
751    if (scrNum < reuseScrNum)
752      for (i = reuseScrNum; i > scrNum; i--)
753        (bt->byScore[i] = bt->byScore[i-1])->scrNum = i;
754
755    else if (scrNum > reuseScrNum) {
756      scrNum--;
757      for (i = reuseScrNum; i < scrNum; i++)
758        (bt->byScore[i] = bt->byScore[i+1])->scrNum = i;
759      }
760
761    if (tplNum < reuseTplNum)
762      for (i = reuseTplNum; i > tplNum; i--)
763        (bt->byTopol[i] = bt->byTopol[i-1])->tplNum = i;
764
765    else if (tplNum > reuseTplNum) {
766      tplNum--;
767      for (i = reuseTplNum; i < tplNum; i++)
768        (bt->byTopol[i] = bt->byTopol[i+1])->tplNum = i;
769      }
770
771    if (tpl_log_f = tpl->log_f) {
772      tr_log_f  = tr->log_f;
773      i = tpl->log_f_valid = tr->log_f_valid;
774      while (--i >= 0)  *tpl_log_f++ = *tr_log_f++;
775      }
776    else {
777      tpl->log_f_valid = 0;
778      }
779
780    tpl->scrNum = scrNum;
781    tpl->tplNum = tplNum;
782    bt->byTopol[tplNum] = bt->byScore[scrNum] = tpl;
783    bt->byScore[0] = reuse;
784
785    if (scrNum == 1)  bt->best = tr->likelihood;
786    if (newValid == bt->nkeep) bt->worst = bt->byScore[newValid]->likelihood;
787
788    return  scrNum;
789  } /* saveBestTree */
790
791
792int  startOpt (bestlist *bt, tree *tr)
793  { /* startOpt */
794    int  scrNum;
795
796    scrNum = saveBestTree(bt, tr);
797    copyTopol(bt->byScore[scrNum], bt->start);
798    bt->improved = FALSE;
799    return  scrNum;
800  } /* startOpt */
801
802
803int  setOptLevel (bestlist *bt, int opt_level)
804  { /* setOptLevel */
805    int  tplNum, scrNum;
806
807    tplNum = findInList((void *) bt->start, (void **) (&(bt->byTopol[1])),
808                        bt->nvalid, cmpTopol);
809    if (tplNum > 0) {
810      bt->byTopol[tplNum]->opt_level = opt_level;
811      scrNum = bt->byTopol[tplNum]->scrNum;
812      }
813    else {
814      scrNum = 0;
815      }
816
817    return  scrNum;
818  } /* setOptLevel */
819
820
821int  recallBestTree (bestlist *bt, int rank, tree *tr)
822  { /* recallBestTree */
823    if (rank < 1)  rank = 1;
824    if (rank > bt->nvalid)  rank = bt->nvalid;
825    if (rank > 0)  if (! restoreTree(bt->byScore[rank], tr)) return FALSE;
826    return  rank;
827  } /* recallBestTree */
828
829
830/*=======================================================================*/
831/*                       End of best tree routines                       */
832/*=======================================================================*/
833
834
835#if 0
836  void hang(char *msg)
837   { printf("Hanging around: %s\n", msg);
838     while(1);
839     }
840#endif
841
842
843boolean getnums (rawdata *rdta)
844    /* input number of species, number of sites */
845  { /* getnums */
846    printf("\n%s, version %s, %s,\nCopyright (C) 1998, 1999, 2000 by Gary J. Olsen\n\n",
847            programName,
848            programVersion,
849            programDate);
850    printf("Based in part on Joseph Felsenstein's\n\n");
851    printf("   Nucleic acid sequence Maximum Likelihood method, version 3.3\n\n\n");
852
853    if (fscanf(INFILE, "%d %d", & rdta->numsp, & rdta->sites) != 2) {
854      printf("ERROR: Problem reading number of species and sites\n");
855      return FALSE;
856      }
857    printf("%d Species, %d Sites\n\n", rdta->numsp, rdta->sites);
858
859    if (rdta->numsp < 4) {
860      printf("TOO FEW SPECIES\n");
861      return FALSE;
862      }
863
864    if (rdta->sites < 1) {
865      printf("TOO FEW SITES\n");
866      return FALSE;
867      }
868
869    return TRUE;
870  } /* getnums */
871
872
873boolean digitchar (int ch) {return (ch >= '0' && ch <= '9'); }
874
875
876boolean whitechar (int ch)
877   { return (ch == ' ' || ch == '\n' || ch == '\t');
878     }
879
880
881void uppercase (int *chptr)
882    /* convert character to upper case -- either ASCII or EBCDIC */
883  { /* uppercase */
884    int  ch;
885
886    ch = *chptr;
887    if ((ch >= 'a' && ch <= 'i') || (ch >= 'j' && ch <= 'r')
888                                 || (ch >= 's' && ch <= 'z'))
889      *chptr = ch + 'A' - 'a';
890  } /* uppercase */
891
892
893int base36 (int ch)
894  { /* base36 */
895    if      (ch >= '0' && ch <= '9') return (ch - '0');
896    else if (ch >= 'A' && ch <= 'I') return (ch - 'A' + 10);
897    else if (ch >= 'J' && ch <= 'R') return (ch - 'J' + 19);
898    else if (ch >= 'S' && ch <= 'Z') return (ch - 'S' + 28);
899    else if (ch >= 'a' && ch <= 'i') return (ch - 'a' + 10);
900    else if (ch >= 'j' && ch <= 'r') return (ch - 'j' + 19);
901    else if (ch >= 's' && ch <= 'z') return (ch - 's' + 28);
902    else return -1;
903  } /* base36 */
904
905
906int itobase36 (int i)
907  { /* itobase36 */
908    if      (i <  0) return '?';
909    else if (i < 10) return (i      + '0');
910    else if (i < 19) return (i - 10 + 'A');
911    else if (i < 28) return (i - 19 + 'J');
912    else if (i < 36) return (i - 28 + 'S');
913    else return '?';
914  } /* itobase36 */
915
916
917int findch (int c)
918  { /* findch */
919    int ch;
920
921    while ((ch = getc(INFILE)) != EOF && ch != c) ;
922    return  ch;
923  } /* findch */
924
925
926#if Master || Slave
927int str_findch (char **treestrp, int c)
928  { /* str_findch */
929    int ch;
930
931    while ((ch = *(*treestrp)++) != NULL && ch != c) ;
932    return  ch;
933  } /* str_findch */
934#endif
935
936
937boolean inputboot(analdef *adef)
938    /* read the bootstrap auxilliary info */
939  { /* inputboot */
940    if (! adef->boot) {
941      printf("ERROR: Unexpected Bootstrap auxiliary data line\n");
942      return FALSE;
943      }
944    else if (fscanf(INFILE, "%ld", & adef->boot) != 1 ||
945             findch('\n') == EOF) {
946      printf("ERROR: Problem reading bootstrap random seed value\n");
947      return FALSE;
948      }
949
950    return TRUE;
951  } /* inputboot */
952
953
954boolean inputcategories (rawdata *rdta)
955    /* read the category rates and the categories for each site */
956  { /* inputcategories */
957    int  i, j, ch, ci;
958
959    if (rdta->categs >= 0) {
960      printf("ERROR: Unexpected Categories auxiliary data line\n");
961      return FALSE;
962      }
963    if (fscanf(INFILE, "%d", & rdta->categs) != 1) {
964      printf("ERROR: Problem reading number of rate categories\n");
965      return FALSE;
966      }
967    if (rdta->categs < 1 || rdta->categs > maxcategories) {
968      printf("ERROR: Bad number of categories: %d\n", rdta->categs);
969      printf("Must be in range 1 - %d\n", maxcategories);
970      return FALSE;
971      }
972
973    for (j = 1; j <= rdta->categs
974           && fscanf(INFILE, "%lf", &(rdta->catrat[j])) == 1; j++) ;
975
976    if ((j <= rdta->categs) || (findch('\n') == EOF)) {
977      printf("ERROR: Problem reading rate values\n");
978      return FALSE;
979      }
980
981    for (i = 1; i <= nmlngth; i++)  (void) getc(INFILE);
982
983    i = 1;
984    while (i <= rdta->sites) {
985      ch = getc(INFILE);
986      ci = base36(ch);
987      if (ci >= 0 && ci <= rdta->categs)
988        rdta->sitecat[i++] = ci;
989      else if (! whitechar(ch)) {
990        printf("ERROR: Bad category character (%c) at site %d\n", ch, i);
991        return FALSE;
992        }
993      }
994
995    if (findch('\n') == EOF) {      /* skip to end of line */
996      printf("ERROR: Missing newline at end of category data\n");
997      return FALSE;
998      }
999
1000    return TRUE;
1001  } /* inputcategories */
1002
1003
1004boolean inputextra (analdef *adef)
1005  { /* inputextra */
1006    if (fscanf(INFILE,"%d", & adef->extra) != 1 ||
1007        findch('\n') == EOF) {
1008      printf("ERROR: Problem reading extra info value\n");
1009      return FALSE;
1010      }
1011
1012    return TRUE;
1013  } /* inputextra */
1014
1015
1016boolean inputfreqs (rawdata *rdta)
1017  { /* inputfreqs */
1018    if (fscanf(INFILE, "%lf%lf%lf%lf",
1019               & rdta->freqa, & rdta->freqc,
1020               & rdta->freqg, & rdta->freqt) != 4 ||
1021        findch('\n') == EOF) {
1022      printf("ERROR: Problem reading user base frequencies data\n");
1023      return  FALSE;
1024      }
1025
1026    rdta->freqread = TRUE;
1027    return TRUE;
1028  } /* inputfreqs */
1029
1030
1031boolean inputglobal (tree *tr)
1032    /* input the global option information */
1033  { /* inputglobal */
1034    int  ch;
1035
1036    if (tr->global != -2) {
1037      printf("ERROR: Unexpected Global auxiliary data line\n");
1038      return FALSE;
1039      }
1040    if (fscanf(INFILE, "%d", &(tr->global)) != 1) {
1041      printf("ERROR: Problem reading rearrangement region size\n");
1042      return FALSE;
1043      }
1044    if (tr->global < 0) {
1045      printf("WARNING: Global region size too small;\n");
1046      printf("         value reset to local\n\n");
1047      tr->global = 1;
1048      }
1049    else if (tr->global == 0)  tr->partswap = 0;
1050    else if (tr->global > tr->mxtips - 3) {
1051      tr->global = tr->mxtips - 3;
1052      }
1053
1054    while ((ch = getc(INFILE)) != '\n') {  /* Scan for second value */
1055      if (! whitechar(ch)) {
1056        if (ch != EOF)  (void) ungetc(ch, INFILE);
1057        if (ch == EOF || fscanf(INFILE, "%d", &(tr->partswap)) != 1
1058                      || findch('\n') == EOF) {
1059          printf("ERROR: Problem reading insert swap region size\n");
1060          return FALSE;
1061          }
1062        else if (tr->partswap < 0)  tr->partswap = 1;
1063        else if (tr->partswap > tr->mxtips - 3) {
1064          tr->partswap = tr->mxtips - 3;
1065          }
1066
1067        if (tr->partswap > tr->global)  tr->global = tr->partswap;
1068        break;   /*  Break while loop */
1069        }
1070      }
1071
1072    return TRUE;
1073  } /* inputglobal */
1074
1075
1076boolean inputjumble (analdef *adef)
1077  { /* inputjumble */
1078    if (! adef->jumble) {
1079      printf("ERROR: Unexpected Jumble auxiliary data line\n");
1080      return FALSE;
1081      }
1082    else if (fscanf(INFILE, "%ld", & adef->jumble) != 1 ||
1083             findch('\n') == EOF) {
1084      printf("ERROR: Problem reading jumble random seed value\n");
1085      return FALSE;
1086      }
1087    else if (adef->jumble == 0) {
1088      printf("WARNING: Jumble random number seed is zero\n\n");
1089      }
1090
1091    return TRUE;
1092  } /* inputjumble */
1093
1094
1095boolean inputkeep (analdef *adef)
1096  { /* inputkeep */
1097    if (fscanf(INFILE, "%d", & adef->nkeep) != 1 ||
1098        findch('\n') == EOF || adef->nkeep < 1) {
1099      printf("ERROR: Problem reading number of kept trees\n");
1100      return FALSE;
1101      }
1102
1103    return TRUE;
1104  } /* inputkeep */
1105
1106
1107boolean inputoutgroup (analdef *adef, tree *tr)
1108  { /* inputoutgroup */
1109    if (! adef->root || tr->outgr > 0) {
1110      printf("ERROR: Unexpected Outgroup auxiliary data line\n");
1111      return FALSE;
1112      }
1113    else if (fscanf(INFILE, "%d", &(tr->outgr)) != 1 ||
1114             findch('\n') == EOF) {
1115      printf("ERROR: Problem reading outgroup number\n");
1116      return FALSE;
1117      }
1118    else if ((tr->outgr < 1) || (tr->outgr > tr->mxtips)) {
1119      printf("ERROR: Bad outgroup: '%d'\n", tr->outgr);
1120      return FALSE;
1121      }
1122
1123    return TRUE;
1124  } /* inputoutgroup */
1125
1126
1127boolean inputratio (rawdata *rdta)
1128  { /* inputratio */
1129    if (rdta->ttratio >= 0.0) {
1130      printf("ERROR: Unexpected Transition/transversion auxiliary data\n");
1131      return FALSE;
1132      }
1133    else if (fscanf(INFILE,"%lf", & rdta->ttratio)!=1 ||
1134             findch('\n') == EOF) {
1135      printf("ERROR: Problem reading transition/transversion ratio\n");
1136      return FALSE;
1137      }
1138
1139    return TRUE;
1140  } /* inputratio */
1141
1142
1143/*  Y 0 is treeNone   (no tree)
1144    Y 1 is treeNewick
1145    Y 2 is treeProlog
1146    Y 3 is treePHYLIP
1147 */
1148
1149boolean inputtreeopt (analdef *adef)
1150  { /* inputtreeopt */
1151    if (! adef->trout) {
1152      printf("ERROR: Unexpected Treefile auxiliary data\n");
1153      return FALSE;
1154      }
1155    else if (fscanf(INFILE,"%d", & adef->trout) != 1 ||
1156             findch('\n') == EOF) {
1157      printf("ERROR: Problem reading output tree-type number\n");
1158      return FALSE;
1159      }
1160    else if ((adef->trout < 0) || (adef->trout > treeMaxType)) {
1161      printf("ERROR: Bad output tree-type number: '%d'\n", adef->trout);
1162      return FALSE;
1163      }
1164
1165    return TRUE;
1166  } /* inputtreeopt */
1167
1168
1169boolean inputweights (analdef *adef, rawdata *rdta, cruncheddata *cdta)
1170    /* input the character weights 0, 1, 2 ... 9, A, B, ... Y, Z */
1171  { /* inputweights */
1172    int i, ch, wi;
1173
1174    if (! adef->userwgt || cdta->wgtsum > 0) {
1175      printf("ERROR: Unexpected Weights auxiliary data\n");
1176      return FALSE;
1177      }
1178
1179    for (i = 2; i <= nmlngth; i++)  (void) getc(INFILE);
1180    cdta->wgtsum = 0;
1181    i = 1;
1182    while (i <= rdta->sites) {
1183      ch = getc(INFILE);
1184      wi = base36(ch);
1185      if (wi >= 0)
1186        cdta->wgtsum += rdta->wgt[i++] = wi;
1187      else if (! whitechar(ch)) {
1188        printf("ERROR: Bad weight character: '%c'", ch);
1189        printf("       Weights in dnaml must be a digit or a letter.\n");
1190        return FALSE;
1191        }
1192      }
1193
1194    if (findch('\n') == EOF) {      /* skip to end of line */
1195      printf("ERROR: Missing newline at end of weight data\n");
1196      return FALSE;
1197      }
1198
1199    return TRUE;
1200  } /* inputweights */
1201
1202
1203boolean getoptions (analdef *adef, rawdata *rdta, cruncheddata *cdta, tree *tr)
1204  { /* getoptions */
1205    int     ch, i, extranum;
1206
1207    adef->boot    =           0;  /* Don't bootstrap column weights */
1208    adef->empf    =        TRUE;  /* Use empirical base frequencies */
1209    adef->extra   =           0;  /* No extra runtime info unless requested */
1210    adef->interleaved =    TRUE;  /* By default, data format is interleaved */
1211    adef->jumble  =       FALSE;  /* Use random addition sequence */
1212    adef->nkeep   =           0;  /* Keep only the one best tree */
1213    adef->prdata  =       FALSE;  /* Don't echo data to output stream */
1214    adef->qadd    =        TRUE;  /* Smooth branches globally in add */
1215    adef->restart =       FALSE;  /* Restart from user tree */
1216    adef->root    =       FALSE;  /* User-defined outgroup rooting */
1217    adef->trout   = treeDefType;  /* Output tree file */
1218    adef->trprint =        TRUE;  /* Print tree to output stream */
1219    rdta->categs  =           0;  /* No rate categories */
1220    rdta->catrat[1] =       1.0;  /* Rate values */
1221    rdta->freqread =      FALSE;  /* User-defined frequencies not read yet */
1222    rdta->ttratio =         2.0;  /* Transition/transversion rate ratio */
1223    tr->global    =          -1;  /* Default search locale for optimum */
1224    tr->mxtips    = rdta->numsp;
1225    tr->outgr     =           1;  /* Outgroup number */
1226    tr->partswap  =           1;  /* Default to swap locally after insert */
1227    tr->userlen   =       FALSE;  /* User-supplied branch lengths */
1228    adef->usertree =      FALSE;  /* User-defined tree topologies */
1229    adef->userwgt =       FALSE;  /* User-defined position weights */
1230    extranum      =           0;
1231
1232    while ((ch = getc(INFILE)) != '\n' && ch != EOF) {
1233      uppercase(& ch);
1234      switch (ch) {
1235          case '1' : adef->prdata  = ! adef->prdata; break;
1236          case '3' : adef->trprint = ! adef->trprint; break;
1237          case '4' : adef->trout   = treeDefType - adef->trout; break;
1238          case 'B' : adef->boot    =  1; extranum++; break;
1239          case 'C' : rdta->categs  = -1; extranum++; break;
1240          case 'E' : adef->extra   = -1; break;
1241          case 'F' : adef->empf    = ! adef->empf; break;
1242          case 'G' : tr->global    = -2; break;
1243          case 'I' : adef->interleaved = ! adef->interleaved; break;
1244          case 'J' : adef->jumble  = 1; extranum++; break;
1245          case 'K' : extranum++; break;
1246          case 'L' : tr->userlen   = TRUE; break;
1247          case 'O' : adef->root    = TRUE; tr->outgr = 0; extranum++; break;
1248          case 'Q' : adef->qadd    = FALSE; break;
1249          case 'R' : adef->restart = TRUE; break;
1250          case 'T' : rdta->ttratio = -1.0; extranum++; break;
1251          case 'U' : adef->usertree = TRUE; break;
1252          case 'W' : adef->userwgt = TRUE; cdta->wgtsum = 0; extranum++; break;
1253          case 'Y' : adef->trout   = treeDefType - adef->trout; break;
1254          case ' ' : break;
1255          case '\t': break;
1256          default  :
1257              printf("ERROR: Bad option character: '%c'\n", ch);
1258              return FALSE;
1259          }
1260      }
1261
1262    if (ch == EOF) {
1263      printf("ERROR: End-of-file in options list\n");
1264      return FALSE;
1265      }
1266
1267    if (adef->usertree && adef->restart) {
1268      printf("ERROR:  The restart and user-tree options conflict:\n");
1269      printf("        Restart adds rest of taxa to a starting tree;\n");
1270      printf("        User-tree does not add any taxa.\n\n");
1271      return FALSE;
1272      }
1273
1274    if (adef->usertree && adef->jumble) {
1275      printf("WARNING:  The jumble and user-tree options conflict:\n");
1276      printf("          Jumble adds taxa to a tree in random order;\n");
1277      printf("          User-tree does not use taxa addition.\n");
1278      printf("          Jumble option cancelled for this run.\n\n");
1279      adef->jumble = FALSE;
1280      }
1281
1282    if (tr->userlen && tr->global != -1) {
1283      printf("ERROR:  The global and user-lengths options conflict:\n");
1284      printf("        Global optimizes a starting tree;\n");
1285      printf("        User-lengths constrain the starting tree.\n\n");
1286      return FALSE;
1287      }
1288
1289    if (tr->userlen && ! adef->usertree) {
1290      printf("WARNING:  User lengths required user tree option.\n");
1291      printf("          User-tree option set for this run.\n\n");
1292      adef->usertree = TRUE;
1293      }
1294
1295    rdta->wgt      = (int *)    Malloc((rdta->sites + 1) * sizeof(int));
1296    rdta->wgt2     = (int *)    Malloc((rdta->sites + 1) * sizeof(int));
1297    rdta->sitecat  = (int *)    Malloc((rdta->sites + 1) * sizeof(int));
1298    cdta->alias    = (int *)    Malloc((rdta->sites + 1) * sizeof(int));
1299    cdta->aliaswgt = (int *)    Malloc((rdta->sites + 1) * sizeof(int));
1300    cdta->patcat   = (int *)    Malloc((rdta->sites + 1) * sizeof(int));
1301    cdta->patrat   = (double *) Malloc((rdta->sites + 1) * sizeof(double));
1302    cdta->wr       = (double *) Malloc((rdta->sites + 1) * sizeof(double));
1303    cdta->wr2      = (double *) Malloc((rdta->sites + 1) * sizeof(double));
1304    if ( ! rdta->wgt || ! rdta->wgt2     || ! rdta->sitecat || ! cdta->alias
1305                     || ! cdta->aliaswgt || ! cdta->patcat  || ! cdta->patrat
1306                     || ! cdta->wr       || ! cdta->wr2) {
1307      fprintf(stderr, "getoptions: Malloc failure\n");
1308      return 0;
1309      }
1310
1311    /*  process lines with auxiliary data */
1312
1313    while (extranum--) {
1314      ch = getc(INFILE);
1315      uppercase(& ch);
1316      switch (ch) {
1317        case 'B':  if (! inputboot(adef)) return FALSE; break;
1318        case 'C':  if (! inputcategories(rdta)) return FALSE; break;
1319        case 'E':  if (! inputextra(adef)) return FALSE; extranum++; break;
1320        case 'F':  if (! inputfreqs(rdta)) return FALSE; break;
1321        case 'G':  if (! inputglobal(tr)) return FALSE; extranum++; break;
1322        case 'J':  if (! inputjumble(adef)) return FALSE; break;
1323        case 'K':  if (! inputkeep(adef)) return FALSE; break;
1324        case 'O':  if (! inputoutgroup(adef, tr)) return FALSE; break;
1325        case 'T':  if (! inputratio(rdta)) return FALSE; break;
1326        case 'W':  if (! inputweights(adef, rdta, cdta)) return FALSE; break;
1327        case 'Y':  if (! inputtreeopt(adef)) return FALSE; extranum++; break;
1328
1329        default:
1330            printf("ERROR: Auxiliary options line starts with '%c'\n", ch);
1331            return FALSE;
1332        }
1333      }
1334
1335    if (! adef->userwgt) {
1336      for (i = 1; i <= rdta->sites; i++) rdta->wgt[i] = 1;
1337      cdta->wgtsum = rdta->sites;
1338      }
1339
1340    if (adef->userwgt && cdta->wgtsum < 1) {
1341      printf("ERROR:  Missing or bad user-supplied weight data.\n");
1342      return FALSE;
1343      }
1344
1345    if (adef->boot) {
1346      printf("Bootstrap random number seed = %ld\n\n", adef->boot);
1347      }
1348
1349    if (adef->jumble) {
1350      printf("Jumble random number seed = %ld\n\n", adef->jumble);
1351      }
1352
1353    if (adef->qadd) {
1354      printf("Quick add (only local branches initially optimized) in effect\n\n");
1355      }
1356
1357    if (rdta->categs > 0) {
1358      printf("Site category   Rate of change\n\n");
1359      for (i = 1; i <= rdta->categs; i++)
1360        printf("           %c%13.3f\n", itobase36(i), rdta->catrat[i]);
1361      putchar('\n');
1362      for (i = 1; i <= rdta->sites; i++) {
1363        if ((rdta->wgt[i] > 0) && (rdta->sitecat[i] < 1)) {
1364          printf("ERROR: Bad category (%c) at site %d\n",
1365                  itobase36(rdta->sitecat[i]), i);
1366          return FALSE;
1367          }
1368        }
1369      }
1370    else if (rdta->categs < 0) {
1371      printf("ERROR: Category auxiliary data missing from input\n");
1372      return FALSE;
1373      }
1374    else {                                        /* rdta->categs == 0 */
1375      for (i = 1; i <= rdta->sites; i++) rdta->sitecat[i] = 1;
1376      rdta->categs = 1;
1377      }
1378
1379    if (tr->outgr < 1) {
1380      printf("ERROR: Outgroup auxiliary data missing from input\n");
1381      return FALSE;
1382      }
1383
1384    if (rdta->ttratio < 0.0) {
1385      printf("ERROR: Transition/transversion auxiliary data missing from input\n");
1386      return FALSE;
1387      }
1388
1389    if (tr->global < 0) {
1390      if (tr->global == -2) tr->global = tr->mxtips - 3;  /* Default global */
1391      else                  tr->global = adef->usertree ? 0 : 1;/* No global */
1392      }
1393
1394    if (adef->restart) {
1395      printf("Restart option in effect.  ");
1396      printf("Sequence addition will start from appended tree.\n\n");
1397      }
1398
1399    if (adef->usertree && ! tr->global) {
1400      printf("User-supplied tree topology%swill be used.\n\n",
1401        tr->userlen ? " and branch lengths " : " ");
1402      }
1403    else {
1404      if (! adef->usertree) {
1405        printf("Rearrangements of partial trees may cross %d %s.\n",
1406               tr->partswap, tr->partswap == 1 ? "branch" : "branches");
1407        }
1408      printf("Rearrangements of full tree may cross %d %s.\n\n",
1409             tr->global, tr->global == 1 ? "branch" : "branches");
1410      }
1411
1412    if (! adef->usertree && adef->nkeep == 0) adef->nkeep = 1;
1413
1414    return TRUE;
1415  } /* getoptions */
1416
1417
1418boolean getbasefreqs (rawdata *rdta)
1419  { /* getbasefreqs */
1420    int  ch;
1421
1422    if (rdta->freqread) return TRUE;
1423
1424    ch = getc(INFILE);
1425    if (! ((ch == 'F') || (ch == 'f')))  (void) ungetc(ch, INFILE);
1426
1427    if (fscanf(INFILE, "%lf%lf%lf%lf",
1428               & rdta->freqa, & rdta->freqc,
1429               & rdta->freqg, & rdta->freqt) != 4 ||
1430        findch('\n') == EOF) {
1431      printf("ERROR: Problem reading user base frequencies\n");
1432      return  FALSE;
1433      }
1434
1435    return TRUE;
1436  } /* getbasefreqs */
1437
1438
1439boolean getyspace (rawdata *rdta)
1440  { /* getyspace */
1441    long   size;
1442    int    i;
1443    yType *y0;
1444
1445    if (! (rdta->y = (yType **) Malloc((rdta->numsp + 1) * sizeof(yType *)))) {
1446      printf("ERROR: Unable to obtain space for data array pointers\n");
1447      return  FALSE;
1448      }
1449
1450    size = 4 * (rdta->sites / 4 + 1);
1451    if (! (y0 = (yType *) Malloc((rdta->numsp + 1) * size * sizeof(yType)))) {
1452      printf("ERROR: Unable to obtain space for data array\n");
1453      return  FALSE;
1454      }
1455
1456    for (i = 0; i <= rdta->numsp; i++) {
1457      rdta->y[i] = y0;
1458      y0 += size;
1459      }
1460
1461    return  TRUE;
1462  } /* getyspace */
1463
1464
1465boolean setupTree (tree *tr, int nsites)
1466  { /* setupTree */
1467    nodeptr  p0, p, q;
1468    int      i, j, tips, inter;
1469
1470    tips  = tr->mxtips;
1471    inter = tr->mxtips - 1;
1472
1473    if (!(p0 = (nodeptr) Malloc((tips + 3*inter) * sizeof(node)))) {
1474      printf("ERROR: Unable to obtain sufficient tree memory\n");
1475      return  FALSE;
1476      }
1477
1478    if (!(tr->nodep = (nodeptr *) Malloc((2*tr->mxtips) * sizeof(nodeptr)))) {
1479      printf("ERROR: Unable to obtain sufficient tree memory, too\n");
1480      return  FALSE;
1481      }
1482
1483    tr->nodep[0] = (node *) NULL;    /* Use as 1-based array */
1484
1485    for (i = 1; i <= tips; i++) {    /* Set-up tips */
1486      p = p0++;
1487      p->x      = (xarray *) NULL;
1488      p->tip    = (yType *) NULL;
1489      p->number = i;
1490      p->next   = p;
1491      p->back   = (node *) NULL;
1492
1493      tr->nodep[i] = p;
1494      }
1495
1496    for (i = tips + 1; i <= tips + inter; i++) { /* Internal nodes */
1497      q = (node *) NULL;
1498      for (j = 1; j <= 3; j++) {
1499        p = p0++;
1500        p->x      = (xarray *) NULL;
1501        p->tip    = (yType *) NULL;
1502        p->number = i;
1503        p->next   = q;
1504        p->back   = (node *) NULL;
1505        q = p;
1506        }
1507      p->next->next->next = p;
1508      tr->nodep[i] = p;
1509      }
1510
1511    tr->likelihood  = unlikely;
1512    tr->start       = (node *) NULL;
1513    tr->outgrnode   = tr->nodep[tr->outgr];
1514    tr->ntips       = 0;
1515    tr->nextnode    = 0;
1516    tr->opt_level   = 0;
1517    tr->prelabeled  = TRUE;
1518    tr->smoothed    = FALSE;
1519    tr->log_f_valid = 0;
1520
1521    tr->log_f = (double *) Malloc(nsites * sizeof(double));
1522    if (! tr->log_f) {
1523      printf("ERROR: Unable to obtain sufficient tree memory, trey\n");
1524      return  FALSE;
1525      }
1526
1527    return TRUE;
1528  } /* setupTree */
1529
1530
1531void freeTreeNode (nodeptr p)   /* Free tree node (sector) associated data */
1532  { /* freeTreeNode */
1533    if (p) {
1534      if (p->x) {
1535        if (p->x->lv) Free(p->x->lv);
1536        Free(p->x);
1537        }
1538      }
1539  } /* freeTreeNode */
1540
1541
1542void freeTree (tree *tr)
1543  { /* freeTree */
1544    nodeptr  p, q;
1545    int  i, tips, inter;
1546
1547    tips  = tr->mxtips;
1548    inter = tr->mxtips - 1;
1549
1550    for (i = 1; i <= tips; i++) freeTreeNode(tr->nodep[i]);
1551
1552    for (i = tips + 1; i <= tips + inter; i++) {
1553      if (p = tr->nodep[i]) {
1554        if (q = p->next) {
1555          freeTreeNode(q->next);
1556          freeTreeNode(q);
1557          }
1558        freeTreeNode(p);
1559        }
1560      }
1561
1562    Free(tr->nodep[1]);       /* Free the actual nodes */
1563  } /* freeTree */
1564
1565
1566boolean getdata (analdef *adef, rawdata *rdta, tree *tr)
1567    /* read sequences */
1568  { /* getdata */
1569    int   i, j, k, l, basesread, basesnew, ch;
1570    int   meaning[256];          /*  meaning of input characters */ 
1571    char *nameptr;
1572    boolean  allread, firstpass;
1573
1574    for (i = 0; i <= 255; i++) meaning[i] = 0;
1575    meaning['A'] =  1;
1576    meaning['B'] = 14;
1577    meaning['C'] =  2;
1578    meaning['D'] = 13;
1579    meaning['G'] =  4;
1580    meaning['H'] = 11;
1581    meaning['K'] = 12;
1582    meaning['M'] =  3;
1583    meaning['N'] = 15;
1584    meaning['O'] = 15;
1585    meaning['R'] =  5;
1586    meaning['S'] =  6;
1587    meaning['T'] =  8;
1588    meaning['U'] =  8;
1589    meaning['V'] =  7;
1590    meaning['W'] =  9;
1591    meaning['X'] = 15;
1592    meaning['Y'] = 10;
1593    meaning['?'] = 15;
1594    meaning['-'] = 15;
1595
1596    basesread = basesnew = 0;
1597
1598    allread = FALSE;
1599    firstpass = TRUE;
1600    ch = ' ';
1601
1602    while (! allread) {
1603      for (i = 1; i <= tr->mxtips; i++) {     /*  Read data line */
1604
1605        if (firstpass) {                      /*  Read species names */
1606          j = 1;
1607          while (whitechar(ch = getc(INFILE))) {  /*  Skip blank lines */
1608            if (ch == '\n')  j = 1;  else  j++;
1609            }
1610
1611          if (j > nmlngth) {
1612            printf("ERROR: Blank name for species %d; ", i);
1613            printf("check number of species,\n");
1614            printf("       number of sites, and interleave option.\n");
1615            return  FALSE;
1616            }
1617
1618          nameptr = tr->nodep[i]->name;
1619          for (k = 1; k < j; k++)  *nameptr++ = ' ';
1620
1621          while (ch != '\n' && ch != EOF) {
1622            if (whitechar(ch))  ch = ' ';
1623            *nameptr++ = ch;
1624            if (++j > nmlngth) break;
1625            ch = getc(INFILE);
1626            }
1627
1628          while (*(--nameptr) == ' ') ;          /*  remove trailing blanks */
1629          *(++nameptr) = '\0';                   /*  add null termination */
1630
1631          if (ch == EOF) {
1632            printf("ERROR: End-of-file in name of species %d\n", i);
1633            return  FALSE;
1634            }
1635          }    /* if (firstpass) */
1636
1637        j = basesread;
1638        while ((j < rdta->sites)
1639               && ((ch = getc(INFILE)) != EOF)
1640               && ((! adef->interleaved) || (ch != '\n'))) {
1641          uppercase(& ch);
1642          if (meaning[ch] || ch == '.') {
1643            j++;
1644            if (ch == '.') {
1645              if (i != 1) ch = rdta->y[1][j];
1646              else {
1647                printf("ERROR: Dot (.) found at site %d of sequence 1\n", j);
1648                return  FALSE;
1649                }
1650              }
1651            rdta->y[i][j] = ch;
1652            }
1653          else if (whitechar(ch) || digitchar(ch)) ;
1654          else {
1655            printf("ERROR: Bad base (%c) at site %d of sequence %d\n",
1656                    ch, j, i);
1657            return  FALSE;
1658            }
1659          }
1660
1661        if (ch == EOF) {
1662          printf("ERROR: End-of-file at site %d of sequence %d\n", j, i);
1663          return  FALSE;
1664          }
1665
1666        if (! firstpass && (j == basesread)) i--;        /* no data on line */
1667        else if (i == 1) basesnew = j;
1668        else if (j != basesnew) {
1669          printf("ERROR: Sequences out of alignment\n");
1670          printf("%d (instead of %d) residues read in sequence %d\n",
1671                  j - basesread, basesnew - basesread, i);
1672          return  FALSE;
1673          }
1674
1675        while (ch != '\n' && ch != EOF) ch = getc(INFILE);  /* flush line */
1676        }                                                  /* next sequence */
1677      firstpass = FALSE;
1678      basesread = basesnew;
1679      allread = (basesread >= rdta->sites);
1680      }
1681
1682    /*  Print listing of sequence alignment */
1683
1684    if (adef->prdata) {
1685      j = nmlngth - 5 + ((rdta->sites + ((rdta->sites - 1)/10))/2);
1686      if (j < nmlngth - 1) j = nmlngth - 1;
1687      if (j > 37) j = 37;
1688      printf("Name"); for (i=1;i<=j;i++) putchar(' '); printf("Sequences\n");
1689      printf("----"); for (i=1;i<=j;i++) putchar(' '); printf("---------\n");
1690      putchar('\n');
1691
1692      for (i = 1; i <= rdta->sites; i += 60) {
1693        l = i + 59;
1694        if (l > rdta->sites) l = rdta->sites;
1695
1696        if (adef->userwgt) {
1697          printf("Weights   ");
1698          for (j = 11; j <= nmlngth+3; j++) putchar(' ');
1699          for (k = i; k <= l; k++) {
1700            putchar(itobase36(rdta->wgt[k]));
1701            if (((k % 10) == 0) && (k < l)) putchar(' ');
1702            }
1703          putchar('\n');
1704          }
1705
1706        if (rdta->categs > 1) {
1707          printf("Categories");
1708          for (j = 11; j <= nmlngth+3; j++) putchar(' ');
1709          for (k = i; k <= l; k++) {
1710            putchar(itobase36(rdta->sitecat[k]));
1711            if (((k % 10) == 0) && (k < l)) putchar(' ');
1712            }
1713          putchar('\n');
1714          }
1715
1716        for (j = 1; j <= tr->mxtips; j++) {
1717          nameptr = tr->nodep[j]->name;
1718          k = nmlngth+3;
1719          while (ch = *nameptr++) {putchar(ch); k--;}
1720          while (--k >= 0) putchar(' ');
1721
1722          for (k = i; k <= l; k++) {
1723            ch = rdta->y[j][k];
1724            if ((j > 1) && (ch == rdta->y[1][k])) ch = '.';
1725            putchar(ch);
1726            if (((k % 10) == 0) && (k < l)) putchar(' ');
1727            }
1728          putchar('\n');
1729          }
1730        putchar('\n');
1731        }
1732      }
1733
1734    for (j = 1; j <= tr->mxtips; j++)    /* Convert characters to meanings */
1735      for (i = 1; i <= rdta->sites; i++) {
1736        rdta->y[j][i] = meaning[rdta->y[j][i]];
1737        }
1738
1739    return  TRUE;
1740  } /* getdata */
1741
1742
1743boolean  getntrees (analdef *adef)
1744  { /* getntrees */
1745
1746    if (fscanf(INFILE, "%d", &(adef->numutrees)) != 1 || findch('\n') == EOF) {
1747      printf("ERROR: Problem reading number of user trees\n");
1748      return  FALSE;
1749      }
1750
1751    if (adef->nkeep == 0) adef->nkeep = adef->numutrees;
1752
1753    return  TRUE;
1754  } /* getntrees */
1755
1756
1757boolean getinput (analdef *adef, rawdata *rdta, cruncheddata *cdta, tree *tr)
1758  { /* getinput */
1759    if (! getnums(rdta))                       return FALSE;
1760    if (! getoptions(adef, rdta, cdta, tr))    return FALSE;
1761    if (! adef->empf && ! getbasefreqs(rdta))  return FALSE;
1762    if (! getyspace(rdta))                     return FALSE;
1763    if (! setupTree(tr, rdta->sites))          return FALSE;
1764    if (! getdata(adef, rdta, tr))             return FALSE;
1765    if (adef->usertree && ! getntrees(adef))   return FALSE;
1766
1767    return TRUE;
1768  } /* getinput */
1769
1770
1771void makeboot (analdef *adef, rawdata *rdta, cruncheddata *cdta)
1772  { /* makeboot */
1773    int  i, j, nonzero;
1774    double  randum();
1775
1776    nonzero = 0;
1777    for (i = 1; i <= rdta->sites; i++)  if (rdta->wgt[i] > 0) nonzero++;
1778
1779    for (j = 1; j <= nonzero; j++) cdta->aliaswgt[j] = 0;
1780    for (j = 1; j <= nonzero; j++)
1781      cdta->aliaswgt[(int) (nonzero*randum(& adef->boot)) + 1]++;
1782
1783    j = 0;
1784    cdta->wgtsum = 0;
1785    for (i = 1; i <= rdta->sites; i++) {
1786      if (rdta->wgt[i] > 0)
1787        cdta->wgtsum += (rdta->wgt2[i] = rdta->wgt[i] * cdta->aliaswgt[++j]);
1788      else
1789        rdta->wgt2[i] = 0;
1790      }
1791  } /* makeboot */
1792
1793
1794void sitesort (rawdata *rdta, cruncheddata *cdta)
1795    /* Shell sort keeping sites with identical residues and weights in
1796     * the original order (i.e., a stable sort).
1797     * The index created in cdta->alias is 1 based.  The
1798     * sitecombcrunch routine packs it to a 0 based index.
1799     */
1800  { /* sitesort */
1801    int  gap, i, j, jj, jg, k, n, nsp;
1802    int  *index, *category;
1803    boolean  flip, tied;
1804    yType  **data;
1805
1806    index    = cdta->alias;
1807    category = rdta->sitecat;
1808    data     = rdta->y;
1809    n        = rdta->sites;
1810    nsp      = rdta->numsp;
1811
1812    for (gap = n / 2; gap > 0; gap /= 2) {
1813      for (i = gap + 1; i <= n; i++) {
1814        j = i - gap;
1815
1816        do {
1817          jj = index[j];
1818          jg = index[j+gap];
1819          flip = (category[jj] >  category[jg]);
1820          tied = (category[jj] == category[jg]);
1821          for (k = 1; (k <= nsp) && tied; k++) {
1822            flip = (data[k][jj] >  data[k][jg]);
1823            tied = (data[k][jj] == data[k][jg]);
1824            }
1825          if (flip) {
1826            index[j]     = jg;
1827            index[j+gap] = jj;
1828            j -= gap;
1829            }
1830          } while (flip && (j > 0));
1831
1832        }  /* for (i ...   */
1833      }    /* for (gap ... */
1834  } /* sitesort */
1835
1836
1837void sitecombcrunch (rawdata *rdta, cruncheddata *cdta)
1838    /* combine sites that have identical patterns (and nonzero weight) */
1839  { /* sitecombcrunch */
1840    int  i, sitei, j, sitej, k;
1841    boolean  tied;
1842
1843    i = 0;
1844    cdta->alias[0] = cdta->alias[1];
1845    cdta->aliaswgt[0] = 0;
1846
1847    for (j = 1; j <= rdta->sites; j++) {
1848      sitei = cdta->alias[i];
1849      sitej = cdta->alias[j];
1850      tied = (rdta->sitecat[sitei] == rdta->sitecat[sitej]);
1851
1852      for (k = 1; tied && (k <= rdta->numsp); k++)
1853        tied = (rdta->y[k][sitei] == rdta->y[k][sitej]);
1854
1855      if (tied) {
1856        cdta->aliaswgt[i] += rdta->wgt2[sitej];
1857        }
1858      else {
1859        if (cdta->aliaswgt[i] > 0) i++;
1860        cdta->aliaswgt[i] = rdta->wgt2[sitej];
1861        cdta->alias[i] = sitej;
1862        }
1863      }
1864
1865    cdta->endsite = i;
1866    if (cdta->aliaswgt[i] > 0) cdta->endsite++;
1867  } /* sitecombcrunch */
1868
1869
1870boolean makeweights (analdef *adef, rawdata *rdta, cruncheddata *cdta)
1871    /* make up weights vector to avoid duplicate computations */
1872  { /* makeweights */
1873    int  i;
1874
1875    if (adef->boot)  makeboot(adef, rdta, cdta);
1876    else  for (i = 1; i <= rdta->sites; i++)  rdta->wgt2[i] = rdta->wgt[i];
1877
1878    for (i = 1; i <= rdta->sites; i++)  cdta->alias[i] = i;
1879    sitesort(rdta, cdta);
1880    sitecombcrunch(rdta, cdta);
1881
1882    printf("Total weight of positions in analysis = %d\n", cdta->wgtsum);
1883    printf("There are %d distinct data patterns (columns)\n\n", cdta->endsite);
1884
1885    return TRUE;
1886  } /* makeweights */
1887
1888
1889boolean makevalues (rawdata *rdta, cruncheddata *cdta)
1890    /* set up fractional likelihoods at tips */
1891  { /* makevalues */
1892    double  temp, wtemp;
1893    int  i, j;
1894
1895    for (i = 1; i <= rdta->numsp; i++) {    /* Pack and move tip data */
1896      for (j = 0; j < cdta->endsite; j++) {
1897        rdta->y[i-1][j] = rdta->y[i][cdta->alias[j]];
1898        }
1899      }
1900
1901    for (j = 0; j < cdta->endsite; j++) {
1902      cdta->patcat[j] = i = rdta->sitecat[cdta->alias[j]];
1903      cdta->patrat[j] = temp = rdta->catrat[i];
1904      cdta->wr[j]  = wtemp = temp * cdta->aliaswgt[j];
1905      cdta->wr2[j] = temp * wtemp;
1906      }
1907
1908    return TRUE;
1909  } /* makevalues */
1910
1911
1912boolean empiricalfreqs (rawdata *rdta, cruncheddata *cdta)
1913    /* Get empirical base frequencies from the data */
1914  { /* empiricalfreqs */
1915    double  sum, suma, sumc, sumg, sumt, wj, fa, fc, fg, ft;
1916    int     i, j, k, code;
1917    yType  *yptr;
1918
1919    rdta->freqa = 0.25;
1920    rdta->freqc = 0.25;
1921    rdta->freqg = 0.25;
1922    rdta->freqt = 0.25;
1923    for (k = 1; k <= 8; k++) {
1924      suma = 0.0;
1925      sumc = 0.0;
1926      sumg = 0.0;
1927      sumt = 0.0;
1928      for (i = 0; i < rdta->numsp; i++) {
1929        yptr = rdta->y[i];
1930        for (j = 0; j < cdta->endsite; j++) {
1931          code = *yptr++;
1932          fa = rdta->freqa * ( code       & 1);
1933          fc = rdta->freqc * ((code >> 1) & 1);
1934          fg = rdta->freqg * ((code >> 2) & 1);
1935          ft = rdta->freqt * ((code >> 3) & 1);
1936          wj = cdta->aliaswgt[j] / (fa + fc + fg + ft);
1937          suma += wj * fa;
1938          sumc += wj * fc;
1939          sumg += wj * fg;
1940          sumt += wj * ft;
1941          }
1942        }
1943      sum = suma + sumc + sumg + sumt;
1944      rdta->freqa = suma / sum;
1945      rdta->freqc = sumc / sum;
1946      rdta->freqg = sumg / sum;
1947      rdta->freqt = sumt / sum;
1948      }
1949
1950    return TRUE;
1951  } /* empiricalfreqs */
1952
1953
1954void reportfreqs (analdef *adef, rawdata *rdta)
1955  { /* reportfreqs */
1956    double  suma, sumb;
1957
1958    if (adef->empf) printf("Empirical ");
1959    printf("Base Frequencies:\n\n");
1960    printf("   A    %10.5f\n",   rdta->freqa);
1961    printf("   C    %10.5f\n",   rdta->freqc);
1962    printf("   G    %10.5f\n",   rdta->freqg);
1963    printf("  T(U)  %10.5f\n\n", rdta->freqt);
1964    rdta->freqr = rdta->freqa + rdta->freqg;
1965    rdta->invfreqr = 1.0/rdta->freqr;
1966    rdta->freqar = rdta->freqa * rdta->invfreqr;
1967    rdta->freqgr = rdta->freqg * rdta->invfreqr;
1968    rdta->freqy = rdta->freqc + rdta->freqt;
1969    rdta->invfreqy = 1.0/rdta->freqy;
1970    rdta->freqcy = rdta->freqc * rdta->invfreqy;
1971    rdta->freqty = rdta->freqt * rdta->invfreqy;
1972    printf("Transition/transversion ratio = %10.6f\n\n", rdta->ttratio);
1973    suma = rdta->ttratio*rdta->freqr*rdta->freqy
1974         - (rdta->freqa*rdta->freqg + rdta->freqc*rdta->freqt);
1975    sumb = rdta->freqa*rdta->freqgr + rdta->freqc*rdta->freqty;
1976    rdta->xi = suma/(suma+sumb);
1977    rdta->xv = 1.0 - rdta->xi;
1978    if (rdta->xi <= 0.0) {
1979      printf("WARNING: This transition/transversion ratio\n");
1980      printf("         is impossible with these base frequencies!\n");
1981      printf("Transition/transversion parameter reset\n\n");
1982      rdta->xi = 0.000001;
1983      rdta->xv = 1.0 - rdta->xi;
1984      rdta->ttratio = (sumb * rdta->xi / rdta->xv
1985                       + rdta->freqa * rdta->freqg
1986                       + rdta->freqc * rdta->freqt)
1987                    / (rdta->freqr * rdta->freqy);
1988      printf("Transition/transversion ratio = %10.6f\n\n", rdta->ttratio);
1989      }
1990    printf("(Transition/transversion parameter = %10.6f)\n\n",
1991            rdta->xi/rdta->xv);
1992    rdta->fracchange = 2.0 * rdta->xi * (rdta->freqa * rdta->freqgr
1993                                       + rdta->freqc * rdta->freqty)
1994                     + rdta->xv * (1.0 - rdta->freqa * rdta->freqa
1995                                       - rdta->freqc * rdta->freqc
1996                                       - rdta->freqg * rdta->freqg
1997                                       - rdta->freqt * rdta->freqt);
1998  } /* reportfreqs */
1999
2000
2001boolean linkdata2tree (rawdata *rdta, cruncheddata *cdta, tree *tr)
2002    /* Link data array to the tree tips */
2003  { /* linkdata2tree */
2004    int  i;
2005
2006    for (i = 1; i <= tr->mxtips; i++) {    /* Associate data with tips */
2007      tr->nodep[i]->tip = &(rdta->y[i-1][0]);
2008      }
2009
2010    tr->rdta       = rdta;
2011    tr->cdta       = cdta;
2012    return TRUE;
2013  } /* linkdata2tree */
2014
2015
2016xarray *setupxarray (int npat)
2017  { /* setupxarray */
2018    xarray        *x;
2019    likelivector  *data;
2020
2021    x = (xarray *) Malloc(sizeof(xarray));
2022    if (x) {
2023      data = (likelivector *) Malloc(npat * sizeof(likelivector));
2024      if (data) {
2025        x->lv = data;
2026        x->prev = x->next = x;
2027        x->owner = (node *) NULL;
2028        }
2029      else {
2030        Free(x);
2031        return (xarray *) NULL;
2032        }
2033      }
2034    return x;
2035  } /* setupxarray */
2036
2037
2038boolean linkxarray (int req, int min, int npat,
2039                    xarray **freexptr, xarray **usedxptr)
2040    /*  Link a set of xarrays */
2041  { /* linkxarray */
2042    xarray  *first, *prev, *x;
2043    int  i;
2044
2045    first = prev = (xarray *) NULL;
2046    i = 0;
2047
2048    do {
2049      x = setupxarray(npat);
2050      if (x) {
2051        if (! first) first = x;
2052        else {
2053          prev->next = x;
2054          x->prev = prev;
2055          }
2056        prev = x;
2057        i++;
2058        }
2059      else {
2060        printf("ERROR: Failure to get requested xarray memory\n");
2061        if (i < min)  return  FALSE;
2062        }
2063      } while ((i < req) && x);
2064
2065    if (first) {
2066      first->prev = prev;
2067      prev->next = first;
2068      }
2069
2070    *freexptr = first;
2071    *usedxptr = (xarray *) NULL;
2072
2073    return  TRUE;
2074  } /* linkxarray */
2075
2076
2077boolean setupnodex (tree *tr)
2078  { /* setupnodex */
2079    nodeptr  p;
2080    int  i;
2081
2082    for (i = tr->mxtips + 1; (i <= 2*(tr->mxtips) - 2); i++) {
2083      p = tr->nodep[i];
2084      if (! (p->x = setupxarray(tr->cdta->endsite))) {
2085        printf("ERROR: Failure to get internal node xarray memory\n");
2086        return  FALSE;
2087        }
2088      }
2089
2090    return  TRUE;
2091  } /* setupnodex */
2092
2093
2094xarray *getxtip (nodeptr p)
2095  { /* getxtip */
2096    xarray  *new;
2097    boolean  splice;
2098
2099    if (! p) return (xarray *) NULL;
2100
2101    splice = FALSE;
2102
2103    if (p->x) {                  /* array is there; move to tail of list */
2104      new = p->x;
2105      if (new == new->prev) ;             /* linked to self; leave it */
2106      else if (new == usedxtip) usedxtip = usedxtip->next; /* at head */
2107      else if (new == usedxtip->prev) ;   /* already at tail */
2108      else {                              /* move to tail of list */
2109        new->prev->next = new->next;
2110        new->next->prev = new->prev;
2111        splice = TRUE;
2112        }
2113      }
2114
2115    else if (freextip) {                 /* take from unused list */
2116      p->x = new = freextip;
2117      new->owner = p;
2118      if (new->prev != new) {            /* not only member of freelist */
2119        new->prev->next = new->next;
2120        new->next->prev = new->prev;
2121        freextip = new->next;
2122        }
2123      else
2124        freextip = (xarray *) NULL;
2125
2126      splice = TRUE;
2127      }
2128
2129    else if (usedxtip) {                 /* take from head of used list */
2130      usedxtip->owner->x = (xarray *) NULL;
2131      p->x = new = usedxtip;
2132      new->owner = p;
2133      usedxtip = usedxtip->next;
2134      }
2135
2136    else {
2137      printf("ERROR: Unable to locate memory for tip %d.\n", p->number);
2138      return  (xarray *) NULL;
2139      }
2140
2141    if (splice) {
2142      if (usedxtip) {                  /* list is not empty */
2143        usedxtip->prev->next = new;
2144        new->prev = usedxtip->prev;
2145        usedxtip->prev = new;
2146        new->next = usedxtip;
2147        }
2148      else
2149        usedxtip = new->prev = new->next = new;
2150      }
2151
2152    return  new;
2153  } /* getxtip */
2154
2155
2156xarray *getxnode (nodeptr p)
2157    /* Ensure that internal node p has memory */
2158  { /* getxnode */
2159    nodeptr  s;
2160
2161    if (! (p->x)) {  /*  Move likelihood array on this node to sector p */
2162      if ((s = p->next)->x || (s = s->next)->x) {
2163        p->x = s->x;
2164        s->x = (xarray *) NULL;
2165        }
2166      else {
2167        printf("ERROR: Unable to locate memory at node %d.\n", p->number);
2168        exit(1);
2169        }
2170      }
2171    return  p->x;
2172  } /* getxnode */
2173
2174
2175boolean newview (tree *tr, nodeptr p)        /*  Update likelihoods at node */
2176  { /* newview */
2177    double   zq, lzq, xvlzq, zr, lzr, xvlzr;
2178    nodeptr  q, r;
2179    likelivector *lp, *lq, *lr;
2180    int  i;
2181
2182    if (p->tip) {             /*  Make sure that data are at tip */
2183      likelivector *l;
2184      int           code;
2185      yType        *yptr;
2186
2187      if (p->x) return TRUE;  /*  They are already there */
2188
2189      if (! getxtip(p)) return FALSE; /*  They are not, so get memory */
2190      l = p->x->lv;           /*  Pointer to first likelihood vector value */
2191      yptr = p->tip;          /*  Pointer to first nucleotide datum */
2192      for (i = 0; i < tr->cdta->endsite; i++) {
2193        code = *yptr++;
2194        l->a =  code       & 1;
2195        l->c = (code >> 1) & 1;
2196        l->g = (code >> 2) & 1;
2197        l->t = (code >> 3) & 1;
2198        l->exp = 0;
2199        l++;
2200        }
2201      return TRUE;
2202      }
2203
2204/*  Internal node needs update */
2205
2206    q = p->next->back;
2207    r = p->next->next->back;
2208
2209    while ((! p->x) || (! q->x) || (! r->x)) {
2210      if (! q->x) if (! newview(tr, q))  return FALSE;
2211      if (! r->x) if (! newview(tr, r))  return FALSE;
2212      if (! p->x) if (! getxnode(p)) return FALSE;
2213      }
2214
2215    lp = p->x->lv;
2216
2217    lq = q->x->lv;
2218    zq = q->z;
2219    lzq = (zq > zmin) ? log(zq) : log(zmin);
2220    xvlzq = tr->rdta->xv * lzq;
2221
2222    lr = r->x->lv;
2223    zr = r->z;
2224    lzr = (zr > zmin) ? log(zr) : log(zmin);
2225    xvlzr = tr->rdta->xv * lzr;
2226
2227    { double  zzqtable[maxcategories+1], zvqtable[maxcategories+1],
2228              zzrtable[maxcategories+1], zvrtable[maxcategories+1],
2229             *zzqptr, *zvqptr, *zzrptr, *zvrptr, *rptr;
2230      double  fxqr, fxqy, fxqn, sumaq, sumgq, sumcq, sumtq,
2231              fxrr, fxry, fxrn, ki, tempi, tempj;
2232      int  *cptr;
2233
2234#     ifdef Vectorize
2235        double zzq[maxpatterns], zvq[maxpatterns],
2236               zzr[maxpatterns], zvr[maxpatterns];
2237        int  cat;
2238#     else
2239        double zzq, zvq, zzr, zvr;
2240        int cat;
2241#     endif
2242
2243      rptr   = &(tr->rdta->catrat[1]);
2244      zzqptr = &(zzqtable[1]);
2245      zvqptr = &(zvqtable[1]);
2246      zzrptr = &(zzrtable[1]);
2247      zvrptr = &(zvrtable[1]);
2248
2249#     ifdef Vectorize
2250#       pragma IVDEP
2251#     endif
2252
2253      for (i = 1; i <= tr->rdta->categs; i++) {   /* exps for each category */
2254        ki = *rptr++;
2255        *zzqptr++ = exp(ki *   lzq);
2256        *zvqptr++ = exp(ki * xvlzq);
2257        *zzrptr++ = exp(ki *   lzr);
2258        *zvrptr++ = exp(ki * xvlzr);
2259        }
2260
2261      cptr = &(tr->cdta->patcat[0]);
2262
2263#     ifdef Vectorize
2264#       pragma IVDEP
2265        for (i = 0; i < tr->cdta->endsite; i++) {
2266          cat = *cptr++;
2267          zzq[i] = zzqtable[cat];
2268          zvq[i] = zvqtable[cat];
2269          zzr[i] = zzrtable[cat];
2270          zvr[i] = zvrtable[cat];
2271        }
2272
2273#       pragma IVDEP
2274        for (i = 0; i < tr->cdta->endsite; i++) {
2275          fxqr = tr->rdta->freqa * lq->a + tr->rdta->freqg * lq->g;
2276          fxqy = tr->rdta->freqc * lq->c + tr->rdta->freqt * lq->t;
2277          fxqn = fxqr + fxqy;
2278          tempi = fxqr * tr->rdta->invfreqr;
2279          tempj = zvq[i] * (tempi-fxqn) + fxqn;
2280          sumaq = zzq[i] * (lq->a - tempi) + tempj;
2281          sumgq = zzq[i] * (lq->g - tempi) + tempj;
2282          tempi = fxqy * tr->rdta->invfreqy;
2283          tempj = zvq[i] * (tempi-fxqn) + fxqn;
2284          sumcq = zzq[i] * (lq->c - tempi) + tempj;
2285          sumtq = zzq[i] * (lq->t - tempi) + tempj;
2286
2287          fxrr = tr->rdta->freqa * lr->a + tr->rdta->freqg * lr->g;
2288          fxry = tr->rdta->freqc * lr->c + tr->rdta->freqt * lr->t;
2289          fxrn = fxrr + fxry;
2290          tempi = fxrr * tr->rdta->invfreqr;
2291          tempj = zvr[i] * (tempi-fxrn) + fxrn;
2292          lp->a = sumaq * (zzr[i] * (lr->a - tempi) + tempj);
2293          lp->g = sumgq * (zzr[i] * (lr->g - tempi) + tempj);
2294          tempi = fxry * tr->rdta->invfreqy;
2295          tempj = zvr[i] * (tempi-fxrn) + fxrn;
2296          lp->c = sumcq * (zzr[i] * (lr->c - tempi) + tempj);
2297          lp->t = sumtq * (zzr[i] * (lr->t - tempi) + tempj);
2298          lp->exp = lq->exp + lr->exp;
2299
2300          if (lp->a < minlikelihood && lp->g < minlikelihood
2301           && lp->c < minlikelihood && lp->t < minlikelihood) {
2302            lp->a   *= twotothe256;
2303            lp->g   *= twotothe256;
2304            lp->c   *= twotothe256;
2305            lp->t   *= twotothe256;
2306            lp->exp += 1;
2307            }
2308          lp++;
2309          lq++;
2310          lr++;
2311          }
2312
2313#     else  /*  Not Vectorize  */
2314        for (i = 0; i < tr->cdta->endsite; i++) {
2315          cat = *cptr++;
2316          zzq = zzqtable[cat];
2317          zvq = zvqtable[cat];
2318          fxqr = tr->rdta->freqa * lq->a + tr->rdta->freqg * lq->g;
2319          fxqy = tr->rdta->freqc * lq->c + tr->rdta->freqt * lq->t;
2320          fxqn = fxqr + fxqy;
2321          tempi = fxqr * tr->rdta->invfreqr;
2322          tempj = zvq * (tempi-fxqn) + fxqn;
2323          sumaq = zzq * (lq->a - tempi) + tempj;
2324          sumgq = zzq * (lq->g - tempi) + tempj;
2325          tempi = fxqy * tr->rdta->invfreqy;
2326          tempj = zvq * (tempi-fxqn) + fxqn;
2327          sumcq = zzq * (lq->c - tempi) + tempj;
2328          sumtq = zzq * (lq->t - tempi) + tempj;
2329
2330          zzr = zzrtable[cat];
2331          zvr = zvrtable[cat];
2332          fxrr = tr->rdta->freqa * lr->a + tr->rdta->freqg * lr->g;
2333          fxry = tr->rdta->freqc * lr->c + tr->rdta->freqt * lr->t;
2334          fxrn = fxrr + fxry;
2335          tempi = fxrr * tr->rdta->invfreqr;
2336          tempj = zvr * (tempi-fxrn) + fxrn;
2337          lp->a = sumaq * (zzr * (lr->a - tempi) + tempj);
2338          lp->g = sumgq * (zzr * (lr->g - tempi) + tempj);
2339          tempi = fxry * tr->rdta->invfreqy;
2340          tempj = zvr * (tempi-fxrn) + fxrn;
2341          lp->c = sumcq * (zzr * (lr->c - tempi) + tempj);
2342          lp->t = sumtq * (zzr * (lr->t - tempi) + tempj);
2343          lp->exp = lq->exp + lr->exp;
2344
2345          if (lp->a < minlikelihood && lp->g < minlikelihood
2346           && lp->c < minlikelihood && lp->t < minlikelihood) {
2347            lp->a   *= twotothe256;
2348            lp->g   *= twotothe256;
2349            lp->c   *= twotothe256;
2350            lp->t   *= twotothe256;
2351            lp->exp += 1;
2352            }
2353          lp++;
2354          lq++;
2355          lr++;
2356          }
2357#     endif  /*  Vectorize or not  */
2358
2359      return TRUE;
2360      }
2361  } /* newview */
2362
2363
2364double evaluate (tree *tr, nodeptr p)
2365  { /* evaluate */
2366    double   sum, z, lz, xvlz,
2367             ki, fxpa, fxpc, fxpg, fxpt, fxpr, fxpy, fxqr, fxqy,
2368             suma, sumb, sumc, term;
2369
2370#   ifdef Vectorize
2371       double   zz[maxpatterns], zv[maxpatterns];
2372#   else
2373       double   zz, zv;
2374#   endif
2375
2376    double        zztable[maxcategories+1], zvtable[maxcategories+1],
2377                 *zzptr, *zvptr;
2378    double       *log_f, *rptr;
2379    likelivector *lp, *lq;
2380    nodeptr       q;
2381    int           cat, *cptr, i, *wptr;
2382
2383    q = p->back;
2384    while ((! p->x) || (! q->x)) {
2385      if (! (p->x)) if (! newview(tr, p)) return badEval;
2386      if (! (q->x)) if (! newview(tr, q)) return badEval;
2387      }
2388
2389    lp = p->x->lv;
2390    lq = q->x->lv;
2391
2392    z = p->z;
2393    if (z < zmin) z = zmin;
2394    lz = log(z);
2395    xvlz = tr->rdta->xv * lz;
2396
2397    rptr  = &(tr->rdta->catrat[1]);
2398    zzptr = &(zztable[1]);
2399    zvptr = &(zvtable[1]);
2400
2401#   ifdef Vectorize
2402#     pragma IVDEP
2403#   endif
2404
2405    for (i = 1; i <= tr->rdta->categs; i++) {
2406      ki = *rptr++;
2407      *zzptr++ = exp(ki *   lz);
2408      *zvptr++ = exp(ki * xvlz);
2409      }
2410
2411    wptr = &(tr->cdta->aliaswgt[0]);
2412    cptr = &(tr->cdta->patcat[0]);
2413    log_f = tr->log_f;
2414    tr->log_f_valid = tr->cdta->endsite;
2415    sum = 0.0;
2416
2417#   ifdef Vectorize
2418#     pragma IVDEP
2419      for (i = 0; i < tr->cdta->endsite; i++) {
2420        cat   = *cptr++;
2421        zz[i] = zztable[cat];
2422        zv[i] = zvtable[cat];
2423      }
2424
2425#     pragma IVDEP
2426      for (i = 0; i < tr->cdta->endsite; i++) {
2427        fxpa = tr->rdta->freqa * lp->a;
2428        fxpg = tr->rdta->freqg * lp->g;
2429        fxpc = tr->rdta->freqc * lp->c;
2430        fxpt = tr->rdta->freqt * lp->t;
2431        suma = fxpa * lq->a + fxpc * lq->c + fxpg * lq->g + fxpt * lq->t;
2432        fxqr = tr->rdta->freqa * lq->a + tr->rdta->freqg * lq->g;
2433        fxqy = tr->rdta->freqc * lq->c + tr->rdta->freqt * lq->t;
2434        fxpr = fxpa + fxpg;
2435        fxpy = fxpc + fxpt;
2436        sumc = (fxpr + fxpy) * (fxqr + fxqy);
2437        sumb = fxpr * fxqr * tr->rdta->invfreqr + fxpy * fxqy * tr->rdta->invfreqy;
2438        suma -= sumb;
2439        sumb -= sumc;
2440        term = log(zz[i] * suma + zv[i] * sumb + sumc) + (lp->exp + lq->exp)*log(minlikelihood);
2441        sum += *wptr++ * term;
2442        *log_f++ = term;
2443        lp++;
2444        lq++;
2445        }
2446
2447#   else  /*  Not Vectorize  */
2448      for (i = 0; i < tr->cdta->endsite; i++) {
2449        cat  = *cptr++;
2450        zz   = zztable[cat];
2451        zv   = zvtable[cat];
2452        fxpa = tr->rdta->freqa * lp->a;
2453        fxpg = tr->rdta->freqg * lp->g;
2454        fxpc = tr->rdta->freqc * lp->c;
2455        fxpt = tr->rdta->freqt * lp->t;
2456        suma = fxpa * lq->a + fxpc * lq->c + fxpg * lq->g + fxpt * lq->t;
2457        fxqr = tr->rdta->freqa * lq->a + tr->rdta->freqg * lq->g;
2458        fxqy = tr->rdta->freqc * lq->c + tr->rdta->freqt * lq->t;
2459        fxpr = fxpa + fxpg;
2460        fxpy = fxpc + fxpt;
2461        sumc = (fxpr + fxpy) * (fxqr + fxqy);
2462        sumb = fxpr * fxqr * tr->rdta->invfreqr + fxpy * fxqy * tr->rdta->invfreqy;
2463        suma -= sumb;
2464        sumb -= sumc;
2465        term = log(zz * suma + zv * sumb + sumc) + (lp->exp + lq->exp)*log(minlikelihood);
2466/* printf("evaluate: %le\n", term); */
2467        sum += *wptr++ * term;
2468        *log_f++ = term;
2469        lp++;
2470        lq++;
2471        }
2472#   endif  /*  Vectorize or not  */
2473
2474    tr->likelihood = sum;
2475    return  sum;
2476  } /* evaluate */
2477
2478
2479double makenewz (tree *tr, nodeptr p, nodeptr q, double z0, int maxiter)
2480  { /* makenewz */
2481    likelivector *lp, *lq;
2482    double  *abi, *bci, *sumci, *abptr, *bcptr, *sumcptr;
2483    double   dlnLidlz, dlnLdlz, d2lnLdlz2, z, zprev, zstep, lz, xvlz,
2484             ki, suma, sumb, sumc, ab, bc, inv_Li, t1, t2,
2485             fx1a, fx1c, fx1g, fx1t, fx1r, fx1y, fx2r, fx2y;
2486    double   zztable[maxcategories+1], zvtable[maxcategories+1],
2487            *zzptr, *zvptr;
2488    double  *rptr, *wrptr, *wr2ptr;
2489    int      cat, *cptr, i, curvatOK;
2490
2491
2492    while ((! p->x) || (! q->x)) {
2493      if (! (p->x)) if (! newview(tr, p)) return badZ;
2494      if (! (q->x)) if (! newview(tr, q)) return badZ;
2495      }
2496
2497    lp = p->x->lv;
2498    lq = q->x->lv;
2499
2500    { unsigned scratch_size;
2501      scratch_size = sizeof(double) * tr->cdta->endsite;
2502      if ((abi   = (double *) Malloc(scratch_size)) &&
2503          (bci   = (double *) Malloc(scratch_size)) &&
2504          (sumci = (double *) Malloc(scratch_size))) ;
2505      else {
2506        printf("ERROR: makenewz unable to obtain space for arrays\n");
2507        return badZ;
2508        }
2509      }
2510    abptr   = abi;
2511    bcptr   = bci;
2512    sumcptr = sumci;
2513
2514#   ifdef Vectorize
2515#     pragma IVDEP
2516#   endif
2517
2518    for (i = 0; i < tr->cdta->endsite; i++) {
2519      fx1a = tr->rdta->freqa * lp->a;
2520      fx1g = tr->rdta->freqg * lp->g;
2521      fx1c = tr->rdta->freqc * lp->c;
2522      fx1t = tr->rdta->freqt * lp->t;
2523      suma = fx1a * lq->a + fx1c * lq->c + fx1g * lq->g + fx1t * lq->t;
2524      fx2r = tr->rdta->freqa * lq->a + tr->rdta->freqg * lq->g;
2525      fx2y = tr->rdta->freqc * lq->c + tr->rdta->freqt * lq->t;
2526      fx1r = fx1a + fx1g;
2527      fx1y = fx1c + fx1t;
2528      *sumcptr++ = sumc = (fx1r + fx1y) * (fx2r + fx2y);
2529      sumb       = fx1r * fx2r * tr->rdta->invfreqr + fx1y * fx2y * tr->rdta->invfreqy;
2530      *abptr++   = suma - sumb;
2531      *bcptr++   = sumb - sumc;
2532      lp++;
2533      lq++;
2534      }
2535
2536    z = z0;
2537    do {
2538      zprev = z;
2539      zstep = (1.0 - zmax) * z + zmin;
2540      curvatOK = FALSE;
2541
2542      do {
2543        if (z < zmin) z = zmin;
2544        else if (z > zmax) z = zmax;
2545
2546        lz    = log(z);
2547        xvlz  = tr->rdta->xv * lz;
2548        rptr  = &(tr->rdta->catrat[1]);
2549        zzptr = &(zztable[1]);
2550        zvptr = &(zvtable[1]);
2551
2552#       ifdef Vectorize
2553#         pragma IVDEP
2554#       endif
2555
2556        for (i = 1; i <= tr->rdta->categs; i++) {
2557          ki = *rptr++;
2558          *zzptr++ = exp(ki *   lz);
2559          *zvptr++ = exp(ki * xvlz);
2560          }
2561
2562        abptr   = abi;
2563        bcptr   = bci;
2564        sumcptr = sumci;
2565        cptr    = &(tr->cdta->patcat[0]);
2566        wrptr   = &(tr->cdta->wr[0]);
2567        wr2ptr  = &(tr->cdta->wr2[0]);
2568        dlnLdlz = 0.0;                 /*  = d(ln(likelihood))/d(lz) */
2569        d2lnLdlz2 = 0.0;               /*  = d2(ln(likelihood))/d(lz)2 */
2570
2571#       ifdef Vectorize
2572#         pragma IVDEP
2573#       endif
2574
2575        for (i = 0; i < tr->cdta->endsite; i++) {
2576          cat    = *cptr++;              /*  ratecategory(i) */
2577          ab     = *abptr++ * zztable[cat];
2578          bc     = *bcptr++ * zvtable[cat];
2579          sumc   = *sumcptr++;
2580          inv_Li = 1.0/(ab + bc + sumc);
2581          t1     = ab * inv_Li;
2582          t2     = tr->rdta->xv * bc * inv_Li;
2583          dlnLidlz   = t1 + t2;
2584          dlnLdlz   += *wrptr++  * dlnLidlz;
2585          d2lnLdlz2 += *wr2ptr++ * (t1 + tr->rdta->xv * t2 - dlnLidlz * dlnLidlz);
2586          }
2587
2588        if ((d2lnLdlz2 >= 0.0) && (z < zmax))
2589          zprev = z = 0.37 * z + 0.63;  /*  Bad curvature, shorten branch */
2590        else
2591          curvatOK = TRUE;
2592
2593        } while (! curvatOK);
2594
2595      if (d2lnLdlz2 < 0.0) {
2596        z *= exp(-dlnLdlz / d2lnLdlz2);
2597        if (z < zmin) z = zmin;
2598        if (z > 0.25 * zprev + 0.75)    /*  Limit steps toward z = 1.0 */
2599          z = 0.25 * zprev + 0.75;
2600        }
2601
2602      if (z > zmax) z = zmax;
2603
2604      } while ((--maxiter > 0) && (ABS(z - zprev) > zstep));
2605
2606    Free(abi);
2607    Free(bci);
2608    Free(sumci);
2609
2610/* printf("makenewz: %le\n", z); */
2611
2612    return  z;
2613  } /* makenewz */
2614
2615
2616boolean update (tree *tr, nodeptr p)
2617  { /* update */
2618    nodeptr  q;
2619    double   z0, z;
2620
2621    q = p->back;
2622    z0 = q->z;
2623    if ((z = makenewz(tr, p, q, z0, newzpercycle)) == badZ) return FALSE;
2624    p->z = q->z = z;
2625    if (ABS(z - z0) > deltaz)  tr->smoothed = FALSE;
2626    return TRUE;
2627  } /* update */
2628
2629
2630boolean smooth (tree *tr, nodeptr p)
2631  { /* smooth */
2632    nodeptr  q;
2633
2634    if (! update(tr, p))               return FALSE; /*  Adjust branch */
2635    if (! p->tip) {                                  /*  Adjust descendants */
2636        q = p->next;
2637        while (q != p) {
2638          if (! smooth(tr, q->back))   return FALSE;
2639          q = q->next;
2640          }
2641
2642#     if ReturnSmoothedView
2643        if (! newview(tr, p)) return FALSE;
2644#     endif
2645      }
2646
2647    return TRUE;
2648  } /* smooth */
2649
2650
2651boolean smoothTree (tree *tr, int maxtimes)
2652  { /* smoothTree */
2653    nodeptr  p, q;
2654
2655    p = tr->start;
2656
2657    while (--maxtimes >= 0) {
2658      tr->smoothed = TRUE;
2659      if (! smooth(tr, p->back))       return FALSE;
2660      if (! p->tip) {
2661        q = p->next;
2662        while (q != p) {
2663          if (! smooth(tr, q->back))   return FALSE;
2664          q = q->next;
2665          }
2666        }
2667      if (tr->smoothed)  break;
2668      }
2669
2670    return TRUE;
2671  } /* smoothTree */
2672
2673
2674boolean localSmooth (tree *tr, nodeptr p, int maxtimes)
2675  { /* localSmooth -- Smooth branches around p */
2676    nodeptr  q;
2677
2678    if (p->tip) return FALSE;            /* Should be an error */
2679
2680    while (--maxtimes >= 0) {
2681      tr->smoothed = TRUE;
2682      q = p;
2683      do {
2684        if (! update(tr, q)) return FALSE;
2685        q = q->next;
2686        } while (q != p);
2687      if (tr->smoothed)  break;
2688      }
2689
2690    tr->smoothed = FALSE;             /* Only smooth locally */
2691    return TRUE;
2692  } /* localSmooth */
2693
2694
2695void hookup (nodeptr p, nodeptr q, double z)
2696  { /* hookup */
2697    p->back = q;
2698    q->back = p;
2699    p->z = q->z = z;
2700  } /* hookup */
2701
2702
2703/* Insert node p into branch q <-> q->back */
2704
2705boolean insert (tree *tr, nodeptr p, nodeptr q, boolean glob)
2706/* glob -- Smooth tree globally? */
2707
2708/*                q
2709                 /.
2710             add/ .
2711               /  .
2712             pn   .
2713    s ---- p      .remove
2714             pnn  .
2715               \  .
2716             add\ .
2717                 \.      pn  = p->next;
2718                  r      pnn = p->next->next;
2719 */
2720
2721  { /* insert */
2722    nodeptr  r, s;
2723
2724    r = q->back;
2725    s = p->back;
2726
2727#   if BestInsertAverage && ! Master
2728    { double  zqr, zqs, zrs, lzqr, lzqs, lzrs, lzsum, lzq, lzr, lzs, lzmax;
2729
2730      if ((zqr = makenewz(tr, q, r, q->z,     iterations)) == badZ) return FALSE;
2731      if ((zqs = makenewz(tr, q, s, defaultz, iterations)) == badZ) return FALSE;
2732      if ((zrs = makenewz(tr, r, s, defaultz, iterations)) == badZ) return FALSE;
2733
2734      lzqr = (zqr > zmin) ? log(zqr) : log(zmin);  /* long branches */
2735      lzqs = (zqs > zmin) ? log(zqs) : log(zmin);
2736      lzrs = (zrs > zmin) ? log(zrs) : log(zmin);
2737      lzsum = 0.5 * (lzqr + lzqs + lzrs);
2738
2739      lzq = lzsum - lzrs;
2740      lzr = lzsum - lzqs;
2741      lzs = lzsum - lzqr;
2742      lzmax = log(zmax);
2743
2744      if      (lzq > lzmax) {lzq = lzmax; lzr = lzqr; lzs = lzqs;} /* short */
2745      else if (lzr > lzmax) {lzr = lzmax; lzq = lzqr; lzs = lzrs;}
2746      else if (lzs > lzmax) {lzs = lzmax; lzq = lzqs; lzr = lzrs;}
2747
2748      hookup(p->next,       q, exp(lzq));
2749      hookup(p->next->next, r, exp(lzr));
2750      hookup(p,             s, exp(lzs));
2751      }
2752
2753#   else
2754    { double  z;
2755      z = sqrt(q->z);
2756      hookup(p->next,       q, z);
2757      hookup(p->next->next, r, z);
2758      }
2759
2760#   endif
2761
2762    if (! newview(tr, p)) return FALSE;   /*  So that p is valid at update */
2763    tr->opt_level = 0;
2764
2765#   if ! Master         /*  Smoothings are done by slave */
2766      if (glob) {                                    /* Smooth whole tree */
2767        if (! smoothTree(tr, smoothings)) return FALSE;
2768        }
2769      else {                                         /* Smooth locale of p */
2770        if (! localSmooth(tr, p, smoothings)) return FALSE;
2771        }
2772
2773#   else
2774      tr->likelihood = unlikely;
2775#   endif
2776    return  TRUE;
2777  } /* insert */
2778
2779
2780nodeptr  removeNode (tree *tr, nodeptr p)
2781
2782/*                q
2783                 .|
2784          remove. |
2785               .  |
2786             pn   |
2787    s ---- p      |add
2788             pnn  |
2789               .  |
2790          remove. |
2791                 .|      pn  = p->next;
2792                  r      pnn = p->next->next;
2793 */
2794
2795    /* remove p and return where it was */
2796  { /* removeNode */
2797    double   zqr;
2798    nodeptr  q, r;
2799
2800    q = p->next->back;
2801    r = p->next->next->back;
2802    zqr = q->z * r->z;
2803#   if ! Master
2804      if ((zqr = makenewz(tr, q, r, zqr, iterations)) == badZ) return (node *) NULL;
2805#   endif
2806    hookup(q, r, zqr);
2807
2808    p->next->next->back = p->next->back = (node *) NULL;
2809    return  q;
2810  } /* removeNode */
2811
2812
2813boolean initrav (tree *tr, nodeptr p)
2814  { /* initrav */
2815    nodeptr  q;
2816
2817    if (! p->tip) {
2818      q = p->next;
2819      do {
2820        if (! initrav(tr, q->back))  return FALSE;
2821        q = q->next;
2822        } while (q != p);
2823      if (! newview(tr, p))         return FALSE;
2824      }
2825
2826    return TRUE;
2827  } /* initrav */
2828
2829
2830nodeptr buildNewTip (tree *tr, nodeptr p)
2831  { /* buildNewTip */
2832    nodeptr  q;
2833
2834    q = tr->nodep[(tr->nextnode)++];
2835    hookup(p, q, defaultz);
2836    return  q;
2837  } /* buildNewTip */
2838
2839
2840boolean buildSimpleTree (tree *tr, int ip, int iq, int ir)
2841  { /* buildSimpleTree */
2842    /* p, q and r are tips meeting at s */
2843    nodeptr  p, s;
2844    int  i;
2845
2846    i = MIN(ip, iq);
2847    if (ir < i)  i = ir; 
2848    tr->start = tr->nodep[i];
2849    tr->ntips = 3;
2850    p = tr->nodep[ip];
2851    hookup(p, tr->nodep[iq], defaultz);
2852    s = buildNewTip(tr, tr->nodep[ir]);
2853
2854    return insert(tr, s, p, FALSE);  /* Smoothing is local to s */
2855  } /* buildSimpleTree */
2856
2857
2858#if 0
2859char * strchr (char *str, int chr)
2860{ /* strchr */
2861    int  c;
2862
2863    while (c = *str)  {if (c == chr) return str; str++;}
2864    return  (char *) NULL;
2865 } /* strchr */
2866
2867
2868char * strstr (char *str1, char *str2)
2869 { /* strstr */
2870    char *s1, *s2;
2871    int  c;
2872
2873    while (*(s1 = str1)) {
2874      s2 = str2;
2875      do {
2876        if (! (c = *s2++))  return str1;
2877        }
2878        while (*s1++ == c);
2879      str1++;
2880      }
2881    return  (char *) NULL;
2882 } /* strstr */
2883#endif
2884
2885boolean readKeyValue (char *string, const char *key, const char *format, void *value)
2886  { /* readKeyValue */
2887
2888    if (! (string = strstr(string, key)))  return FALSE;
2889    string += strlen(key);
2890    if (! (string = strchr(string, '=')))  return FALSE;
2891    string++;
2892    return  sscanf(string, format, value);  /* 1 if read, otherwise 0 */
2893  } /* readKeyValue */
2894
2895
2896#if Master || Slave
2897
2898double str_readTreeLikelihood (char *treestr)
2899  { /* str_readTreeLikelihood */
2900    double lk1;
2901    char    *com, *com_end;
2902    boolean  readKeyValue();
2903
2904    if ((com = strchr(treestr, '[')) && (com < strchr(treestr, '('))
2905                                     && (com_end = strchr(com, ']'))) {
2906      com++;
2907      *com_end = 0;
2908      if (readKeyValue(com, likelihood_key, "%lg", (void *) &(lk1))) {
2909        *com_end = ']';
2910        return lk1;
2911        }
2912      }
2913
2914    fprintf(stderr, "ERROR reading likelihood in receiveTree\n");
2915    return  badEval;
2916  } /* str_readTreeLikelihood */
2917
2918
2919boolean sendTree (comm_block *comm, tree *tr)
2920  { /* sendTree */
2921    char  *treestr;
2922    char  *treeString();
2923#   if Master
2924      void sendTreeNum();
2925#   endif
2926
2927    comm->done_flag = tr->likelihood > 0.0;
2928    if (comm->done_flag)
2929      write_comm_msg(comm, NULL);
2930
2931    else {
2932      treestr = (char *) Malloc((tr->ntips * (nmlngth+32)) + 256);
2933      if (! treestr) {
2934        fprintf(stderr, "sendTree: Malloc failure\n");
2935        return 0;
2936        }
2937
2938#     if Master
2939        if (send_ahead >= MAX_SEND_AHEAD) {
2940          double new_likelihood;
2941          int  n_to_get;
2942
2943          n_to_get = (send_ahead+1)/2;
2944          sendTreeNum(n_to_get);
2945          send_ahead -= n_to_get;
2946          read_comm_msg(& comm_slave, treestr);
2947          new_likelihood = str_readTreeLikelihood(treestr);
2948          if (new_likelihood == badEval)  return FALSE;
2949          if (! best_tr_recv || (new_likelihood > best_lk_recv)) {
2950            if (best_tr_recv)  Free(best_tr_recv);
2951            best_tr_recv = Malloc(strlen(treestr) + 1);
2952            strcpy(best_tr_recv, treestr);
2953            best_lk_recv = new_likelihood;
2954            }
2955          }
2956        send_ahead++;
2957#     endif           /*  End #if Master  */
2958
2959      REPORT_SEND_TREE;
2960      (void) treeString(treestr, tr, tr->start->back, 1);
2961      write_comm_msg(comm, treestr);
2962
2963      Free(treestr);
2964      }
2965
2966    return TRUE;
2967  } /* sendTree */
2968
2969
2970boolean  receiveTree (comm_block *comm, tree *tr)
2971  { /* receiveTree */
2972    char   *treestr;
2973    boolean status;
2974    boolean str_treeReadLen();
2975
2976    treestr = (char *) Malloc((tr->ntips * (nmlngth+32)) + 256);
2977    if (! treestr) {
2978      fprintf(stderr, "receiveTree: Malloc failure\n");
2979      return 0;
2980      }
2981
2982    read_comm_msg(comm, treestr);
2983    if (comm->done_flag) {
2984      tr->likelihood = 1.0;
2985      status = TRUE;
2986      }
2987
2988    else {
2989#     if Master
2990        if (best_tr_recv) {
2991          if (str_readTreeLikelihood(treestr) < best_lk_recv) {
2992            strcpy(treestr, best_tr_recv);  /* Overwrite new tree with best */
2993            }
2994          Free(best_tr_recv);
2995          best_tr_recv = NULL;
2996          }
2997#     endif           /*  End #if Master  */
2998
2999      status = str_treeReadLen(treestr, tr);
3000      }
3001
3002    Free(treestr);
3003    return status;
3004  } /* receiveTree */
3005
3006
3007void requestForWork (void)
3008  { /* requestForWork */
3009    p4_send(DNAML_REQUEST, DNAML_DISPATCHER_ID, NULL, 0);
3010  } /* requestForWork */
3011#endif                  /* End #if Master || Slave  */
3012
3013
3014#if Master
3015void sendTreeNum(int n_to_get)
3016  { /* sendTreeNum */
3017    char scr[512];
3018
3019    sprintf(scr, "%d", n_to_get);
3020    p4_send(DNAML_NUM_TREE, DNAML_MERGER_ID, scr, strlen(scr)+1);
3021  } /* sendTreeNum */
3022
3023
3024boolean  getReturnedTrees (tree *tr, bestlist *bt, int n_tree_sent)
3025 /* n_tree_sent -- number of trees sent to slaves */
3026  { /* getReturnedTrees */
3027    void sendTreeNum();
3028    boolean receiveTree();
3029
3030    sendTreeNum(send_ahead);
3031    send_ahead = 0;
3032
3033    if (! receiveTree(& comm_slave, tr))  return FALSE;
3034    tr->smoothed = TRUE;
3035    (void) saveBestTree(bt, tr);
3036
3037    return TRUE;
3038  } /* getReturnedTrees */
3039#endif
3040
3041
3042void cacheZ (tree *tr)
3043  { /* cacheZ */
3044    nodeptr  p;
3045    int  nodes;
3046
3047    nodes = tr->mxtips  +  3 * (tr->mxtips - 2);
3048    p = tr->nodep[1];
3049    while (nodes-- > 0) {p->z0 = p->z; p++;}
3050  } /* cacheZ */
3051
3052
3053void restoreZ (tree *tr)
3054  { /* restoreZ */
3055    nodeptr  p;
3056    int  nodes;
3057
3058    nodes = tr->mxtips  +  3 * (tr->mxtips - 2);
3059    p = tr->nodep[1];
3060    while (nodes-- > 0) {p->z = p->z0; p++;}
3061  } /* restoreZ */
3062
3063
3064boolean testInsert (tree *tr, nodeptr p, nodeptr q, bestlist *bt, boolean  fast)
3065  { /* testInsert */
3066    double  qz;
3067    nodeptr  r;
3068
3069    r = q->back;             /* Save original connection */
3070    qz = q->z;
3071    if (! insert(tr, p, q, ! fast)) return FALSE;
3072
3073#   if ! Master
3074      if (evaluate(tr, fast ? p->next->next : tr->start) == badEval) return FALSE;
3075      (void) saveBestTree(bt, tr);
3076#   else  /* Master */
3077      tr->likelihood = unlikely;
3078      if (! sendTree(& comm_slave, tr))  return FALSE;
3079#   endif
3080
3081    /* remove p from this branch */
3082
3083    hookup(q, r, qz);
3084    p->next->next->back = p->next->back = (nodeptr) NULL;
3085    if (! fast) {            /* With fast add, other values are still OK */
3086      restoreZ(tr);          /*   Restore branch lengths */
3087#     if ! Master            /*   Regenerate x values */
3088        if (! initrav(tr, p->back))  return FALSE;
3089        if (! initrav(tr, q))        return FALSE;
3090        if (! initrav(tr, r))        return FALSE;
3091#     endif
3092      }
3093
3094    return TRUE;
3095  } /* testInsert */
3096
3097
3098int addTraverse (tree *tr, nodeptr p, nodeptr q,
3099                 int mintrav, int maxtrav, bestlist *bt, boolean fast)
3100  { /* addTraverse */
3101    int  tested, newtested;
3102
3103    tested = 0;
3104    if (--mintrav <= 0) {           /* Moved minimum distance? */
3105      if (! testInsert(tr, p, q, bt, fast))  return badRear;
3106      tested++;
3107      }
3108
3109    if ((! q->tip) && (--maxtrav > 0)) {    /* Continue traverse? */
3110      newtested = addTraverse(tr, p, q->next->back,
3111                              mintrav, maxtrav, bt, fast);
3112      if (newtested == badRear) return badRear;
3113      tested += newtested;
3114      newtested = addTraverse(tr, p, q->next->next->back,
3115                              mintrav, maxtrav, bt, fast);
3116      if (newtested == badRear) return badRear;
3117      tested += newtested;
3118      }
3119
3120    return tested;
3121  } /* addTraverse */
3122
3123
3124int  rearrange (tree *tr, nodeptr p, int mintrav, int maxtrav, bestlist *bt)
3125    /* rearranges the tree, globally or locally */
3126  { /* rearrange */
3127    double   p1z, p2z, q1z, q2z;
3128    nodeptr  p1, p2, q, q1, q2;
3129    int      tested, mintrav2, newtested;
3130
3131    tested = 0;
3132    if (maxtrav < 1 || mintrav > maxtrav)  return tested;
3133
3134/* Moving subtree forward in tree. */
3135
3136    if (! p->tip) {
3137      p1 = p->next->back;
3138      p2 = p->next->next->back;
3139      if (! p1->tip || ! p2->tip) {
3140        p1z = p1->z;
3141        p2z = p2->z;
3142        if (! removeNode(tr, p)) return badRear;
3143        cacheZ(tr);
3144        if (! p1->tip) {
3145          newtested = addTraverse(tr, p, p1->next->back,
3146                                  mintrav, maxtrav, bt, FALSE);
3147          if (newtested == badRear) return badRear;
3148          tested += newtested;
3149          newtested = addTraverse(tr, p, p1->next->next->back,
3150                                  mintrav, maxtrav, bt, FALSE);
3151          if (newtested == badRear) return badRear;
3152          tested += newtested;
3153          }
3154
3155        if (! p2->tip) {
3156          newtested = addTraverse(tr, p, p2->next->back,
3157                                  mintrav, maxtrav, bt, FALSE);
3158          if (newtested == badRear) return badRear;
3159          tested += newtested;
3160          newtested = addTraverse(tr, p, p2->next->next->back,
3161                                  mintrav, maxtrav, bt, FALSE);
3162          if (newtested == badRear) return badRear;
3163          tested += newtested;
3164          }
3165
3166        hookup(p->next,       p1, p1z);  /*  Restore original tree */
3167        hookup(p->next->next, p2, p2z);
3168        if (! (initrav(tr, tr->start)
3169            && initrav(tr, tr->start->back))) return badRear;
3170        }
3171      }   /* if (! p->tip) */
3172
3173/* Moving subtree backward in tree.  Minimum move is 2 to avoid duplicates */
3174
3175    q = p->back;
3176    if (! q->tip && maxtrav > 1) {
3177      q1 = q->next->back;
3178      q2 = q->next->next->back;
3179      if (! q1->tip && (!q1->next->back->tip || !q1->next->next->back->tip) ||
3180          ! q2->tip && (!q2->next->back->tip || !q2->next->next->back->tip)) {
3181        q1z = q1->z;
3182        q2z = q2->z;
3183        if (! removeNode(tr, q)) return badRear;
3184        cacheZ(tr);
3185        mintrav2 = mintrav > 2 ? mintrav : 2;
3186
3187        if (! q1->tip) {
3188          newtested = addTraverse(tr, q, q1->next->back,
3189                                  mintrav2 , maxtrav, bt, FALSE);
3190          if (newtested == badRear) return badRear;
3191          tested += newtested;
3192          newtested = addTraverse(tr, q, q1->next->next->back,
3193                                  mintrav2 , maxtrav, bt, FALSE);
3194          if (newtested == badRear) return badRear;
3195          tested += newtested;
3196          }
3197
3198        if (! q2->tip) {
3199          newtested = addTraverse(tr, q, q2->next->back,
3200                                  mintrav2 , maxtrav, bt, FALSE);
3201          if (newtested == badRear) return badRear;
3202          tested += newtested;
3203          newtested = addTraverse(tr, q, q2->next->next->back,
3204                                  mintrav2 , maxtrav, bt, FALSE);
3205          if (newtested == badRear) return badRear;
3206          tested += newtested;
3207          }
3208
3209        hookup(q->next,       q1, q1z);  /*  Restore original tree */
3210        hookup(q->next->next, q2, q2z);
3211        if (! (initrav(tr, tr->start)
3212            && initrav(tr, tr->start->back))) return badRear;
3213        }
3214      }   /* if (! q->tip && maxtrav > 1) */
3215
3216/* Move other subtrees */
3217
3218    if (! p->tip) {
3219      newtested = rearrange(tr, p->next->back,       mintrav, maxtrav, bt);
3220      if (newtested == badRear) return badRear;
3221      tested += newtested;
3222      newtested = rearrange(tr, p->next->next->back, mintrav, maxtrav, bt);
3223      if (newtested == badRear) return badRear;
3224      tested += newtested;
3225      }
3226
3227    return  tested;
3228  } /* rearrange */
3229
3230
3231FILE *fopen_pid (const char *filenm, const char *mode, char *name_pid)
3232  { /* fopen_pid */
3233
3234    (void) sprintf(name_pid, "%s.%d", filenm, getpid());
3235    return  fopen(name_pid, mode);
3236  } /* fopen_pid */
3237
3238
3239#if DeleteCheckpointFile
3240void  unlink_pid (char *filenm)
3241  { /* unlink_pid */
3242    char scr[512];
3243
3244    (void) sprintf(scr, "%s.%d", filenm, getpid());
3245    unlink(scr);
3246  } /* unlink_pid */
3247#endif
3248
3249
3250void  writeCheckpoint (tree *tr)
3251  { /* writeCheckpoint */
3252    char   filename[128];
3253    FILE  *checkpointf;
3254    void   treeOut();
3255
3256    checkpointf = fopen_pid(checkpointname, "a", filename);
3257    if (checkpointf) {
3258      treeOut(checkpointf, tr, treeNewick);
3259      (void) fclose(checkpointf);
3260      }
3261  } /* writeCheckpoint */
3262
3263
3264node * findAnyTip(nodeptr p)
3265  { /* findAnyTip */
3266    return  p->tip ? p : findAnyTip(p->next->back);
3267  } /* findAnyTip */
3268
3269
3270boolean  optimize (tree *tr, int maxtrav, bestlist *bt)
3271  { /* optimize */
3272    nodeptr  p;
3273    int    mintrav, tested;
3274
3275    if (tr->ntips < 4)  return  TRUE;
3276
3277    writeCheckpoint(tr);                    /* checkpoint the starting tree */
3278
3279    if (maxtrav > tr->ntips - 3)  maxtrav = tr->ntips - 3;
3280    if (maxtrav <= tr->opt_level)  return  TRUE;
3281
3282    printf("      Doing %s rearrangements\n",
3283             (maxtrav == 1)            ? "local" :
3284             (maxtrav < tr->ntips - 3) ? "regional" : "global");
3285
3286    /* loop while tree gets better  */
3287
3288    do {
3289      (void) startOpt(bt, tr);
3290      mintrav = tr->opt_level + 1;
3291
3292      /* rearrange must start from a tip or it will miss some trees */
3293
3294      p = findAnyTip(tr->start);
3295      tested = rearrange(tr, p->back, mintrav, maxtrav, bt);
3296      if (tested == badRear)  return FALSE;
3297
3298#     if Master
3299        if (! getReturnedTrees(tr, bt, tested)) return FALSE;
3300#     endif
3301
3302      bt->numtrees += tested;
3303      (void) setOptLevel(bt, maxtrav);
3304      if (! recallBestTree(bt, 1, tr)) return FALSE;   /* recover best tree */
3305
3306      printf("      Tested %d alternative trees\n", tested);
3307      if (bt->improved) {
3308        printf("      Ln Likelihood =%14.5f\n", tr->likelihood);
3309        }
3310
3311      writeCheckpoint(tr);                  /* checkpoint the new tree */
3312      } while (maxtrav > tr->opt_level);
3313
3314    return TRUE;
3315  } /* optimize */
3316
3317
3318void coordinates (tree *tr, nodeptr p, double lengthsum, drawdata *tdptr)
3319  { /* coordinates */
3320    /* establishes coordinates of nodes */
3321    double  x, z;
3322    nodeptr  q, first, last;
3323
3324    if (p->tip) {
3325      p->xcoord = NINT(over * lengthsum);
3326      p->ymax = p->ymin = p->ycoord = tdptr->tipy;
3327      tdptr->tipy += down;
3328      if (lengthsum > tdptr->tipmax) tdptr->tipmax = lengthsum;
3329      }
3330
3331    else {
3332      q = p->next;
3333      do {
3334        z = q->z;
3335        if (z < zmin) z = zmin;
3336        x = lengthsum - tr->rdta->fracchange * log(z);
3337        coordinates(tr, q->back, x, tdptr);
3338        q = q->next;
3339        } while (p == tr->start->back ? q != p->next : q != p);
3340
3341      first = p->next->back;
3342      q = p;
3343      while (q->next != p) q = q->next;
3344      last = q->back;
3345      p->xcoord = NINT(over * lengthsum);
3346      p->ycoord = (first->ycoord + last->ycoord)/2;
3347      p->ymin = first->ymin;
3348      p->ymax = last->ymax;
3349      }
3350  } /* coordinates */
3351
3352
3353void drawline (tree *tr, int i, double scale)
3354    /* draws one row of the tree diagram by moving up tree */
3355    /* Modified to handle 1000 taxa, October 16, 1991 */
3356  { /* drawline */
3357    nodeptr  p, q, r, first, last;
3358    int  n, j, k, l, extra;
3359    boolean  done;
3360
3361    p = q = tr->start->back;
3362    extra = 0;
3363
3364    if (i == p->ycoord) {
3365      k = q->number - tr->mxtips;
3366      for (j = k; j < 1000; j *= 10) putchar('-');
3367      printf("%d", k);
3368      extra = 1;
3369      }
3370    else printf("   ");
3371
3372    do {
3373      if (! p->tip) {
3374        r = p->next;
3375        done = FALSE;
3376        do {
3377          if ((i >= r->back->ymin) && (i <= r->back->ymax)) {
3378            q = r->back;
3379            done = TRUE;
3380            }
3381          r = r->next;
3382          } while (! done && (p == tr->start->back ? r != p->next : r != p));
3383
3384        first = p->next->back;
3385        r = p;
3386        while (r->next != p) r = r->next;
3387        last = r->back;
3388        if (p == tr->start->back) last = p->back;
3389        }
3390
3391      done = (p->tip) || (p == q);
3392      n = NINT(scale*(q->xcoord - p->xcoord));
3393      if ((n < 3) && (! q->tip)) n = 3;
3394      n -= extra;
3395      extra = 0;
3396
3397      if ((q->ycoord == i) && (! done)) {
3398        if (p->ycoord != q->ycoord) putchar('+');
3399        else                        putchar('-');
3400
3401        if (! q->tip) {
3402          k = q->number - tr->mxtips;
3403          l = n - 3;
3404          for (j = k; j < 100; j *= 10)  l++;
3405          for (j = 1; j <= l; j++) putchar('-');
3406          printf("%d", k);
3407          extra = 1;
3408          }
3409        else for (j = 1; j <= n-1; j++) putchar('-');
3410        }
3411
3412      else if (! p->tip) {
3413        if ((last->ycoord > i) && (first->ycoord < i) && (i != p->ycoord)) {
3414          putchar('!');
3415          for (j = 1; j <= n-1; j++) putchar(' ');
3416          }
3417        else for (j = 1; j <= n; j++) putchar(' ');
3418        }
3419
3420      else
3421        for (j = 1; j <= n; j++) putchar(' ');
3422
3423      p = q;
3424      } while (! done);
3425
3426    if ((p->ycoord == i) && p->tip) {
3427      printf(" %s", p->name);
3428      }
3429
3430    putchar('\n');
3431  } /* drawline */
3432
3433
3434void printTree (tree *tr, analdef *adef)
3435    /* prints out diagram of the tree */
3436  { /* printTree */
3437    drawdata  tipdata;
3438    double  scale;
3439    int  i, imax;
3440
3441    if (adef->trprint) {
3442      putchar('\n');
3443      tipdata.tipy = 1;
3444      tipdata.tipmax = 0.0;
3445      coordinates(tr, tr->start->back, (double) 0.0, & tipdata);
3446      scale = 1.0 / tipdata.tipmax;
3447      imax = tipdata.tipy - down;
3448      for (i = 1; i <= imax; i++)  drawline(tr, i, scale);
3449      printf("\nRemember: ");
3450      if (adef->root) printf("(although rooted by outgroup) ");
3451      printf("this is an unrooted tree!\n\n");
3452      }
3453  } /* printTree */
3454
3455
3456double sigma (tree *tr, nodeptr p, double *sumlrptr)
3457    /* compute standard deviation */
3458  { /* sigma */
3459    likelivector *lp, *lq;
3460    double  slope, sum, sumlr, z, zv, zz, lz,
3461            rat, suma, sumb, sumc, d2, d, li, temp, abzz, bczv, t3,
3462            fxpa, fxpc, fxpg, fxpt, fxpr, fxpy, fxqr, fxqy, w;
3463    double  *rptr;
3464    nodeptr  q;
3465    int  i, *wptr;
3466
3467    q = p->back;
3468    while ((! p->x) || (! q->x)) {
3469      if (! (p->x)) if (! newview(tr, p)) return -1.0;
3470      if (! (q->x)) if (! newview(tr, q)) return -1.0;
3471      }
3472
3473    lp = p->x->lv;
3474    lq = q->x->lv;
3475
3476    z = p->z;
3477    if (z < zmin) z = zmin;
3478    lz = log(z);
3479
3480    wptr = &(tr->cdta->aliaswgt[0]);
3481    rptr = &(tr->cdta->patrat[0]);
3482    sum = sumlr = slope = 0.0;
3483
3484#   ifdef Vectorize
3485#     pragma IVDEP
3486#   endif
3487
3488    for (i = 0; i < tr->cdta->endsite; i++) {
3489      rat  = *rptr++;
3490      zz   = exp(rat                * lz);
3491      zv   = exp(rat * tr->rdta->xv * lz);
3492
3493      fxpa = tr->rdta->freqa * lp->a;
3494      fxpg = tr->rdta->freqg * lp->g;
3495      fxpc = tr->rdta->freqc * lp->c;
3496      fxpt = tr->rdta->freqt * lp->t;
3497      fxpr = fxpa + fxpg;
3498      fxpy = fxpc + fxpt;
3499      suma = fxpa * lq->a + fxpc * lq->c + fxpg * lq->g + fxpt * lq->t;
3500      fxqr = tr->rdta->freqa * lq->a + tr->rdta->freqg * lq->g;
3501      fxqy = tr->rdta->freqc * lq->c + tr->rdta->freqt * lq->t;
3502      sumc = (fxpr + fxpy) * (fxqr + fxqy);
3503      sumb = fxpr * fxqr * tr->rdta->invfreqr + fxpy * fxqy * tr->rdta->invfreqy;
3504      abzz = zz * (suma - sumb);
3505      bczv = zv * (sumb - sumc);
3506      li = sumc + abzz + bczv;
3507      t3 = tr->rdta->xv * bczv;
3508      d  = abzz + t3;
3509      d2 = rat * (abzz*(rat-1.0) + t3*(rat * tr->rdta->xv - 1.0));
3510
3511      temp = rat * d / li;
3512      w = *wptr++;
3513      slope += w *  temp;
3514      sum   += w * (temp * temp - d2/li);
3515      sumlr += w * log(li / (suma + 1.0E-300));
3516      lp++;
3517      lq++;
3518      }
3519
3520    *sumlrptr = sumlr;
3521    return (sum > 1.0E-300) ? z*(-slope + sqrt(slope*slope + 3.841*sum))/sum
3522                            : 1.0;
3523  } /* sigma */
3524
3525
3526void describe (tree *tr, nodeptr p)
3527    /* print out information for one branch */
3528  { /* describe */
3529    double   z, s, sumlr;
3530    nodeptr  q;
3531    char    *nameptr;
3532    int      k, ch;
3533
3534    q = p->back;
3535    printf("%4d          ", q->number - tr->mxtips);
3536    if (p->tip) {
3537      nameptr = p->name;
3538      k = nmlngth;
3539      while (ch = *nameptr++) {putchar(ch); k--;}
3540      while (--k >= 0) putchar(' ');
3541      }
3542    else {
3543      printf("%4d", p->number - tr->mxtips);
3544      for (k = 4; k < nmlngth; k++) putchar(' ');
3545      }
3546
3547    z = q->z;
3548    if (z <= zmin) printf("    infinity");
3549    else printf("%15.5f", -log(z) * tr->rdta->fracchange);
3550
3551    s = sigma(tr, q, & sumlr);
3552    printf("     (");
3553    if (z + s >= zmax) printf("     zero");
3554    else printf("%9.5f", (double) -log(z + s) * tr->rdta->fracchange);
3555    putchar(',');
3556    if (z - s <= zmin) printf("    infinity");
3557    else printf("%12.5f", (double) -log(z - s) * tr->rdta->fracchange);
3558    putchar(')');
3559
3560    if      (sumlr > 2.995 ) printf(" **");
3561    else if (sumlr > 1.9205) printf(" *");
3562    putchar('\n');
3563
3564    if (! p->tip) {
3565      describe(tr, p->next->back);
3566      describe(tr, p->next->next->back);
3567      }
3568  } /* describe */
3569
3570
3571void summarize (tree *tr)
3572    /* print out branch length information and node numbers */
3573  { /* summarize */
3574    printf("Ln Likelihood =%14.5f\n", tr->likelihood);
3575    putchar('\n');
3576    printf(" Between        And             Length");
3577    printf("      Approx. Confidence Limits\n");
3578    printf(" -------        ---             ------");
3579    printf("      ------- ---------- ------\n");
3580
3581    describe(tr, tr->start->back->next->back);
3582    describe(tr, tr->start->back->next->next->back);
3583    describe(tr, tr->start);
3584    putchar('\n');
3585    printf("     *  = significantly positive, P < 0.05\n");
3586    printf("     ** = significantly positive, P < 0.01\n\n\n");
3587  } /* summarize */
3588
3589
3590/*===========  This is a problem if tr->start->back is a tip!  ===========*/
3591/*  All routines should be contrived so that tr->start->back is not a tip */
3592
3593char *treeString (char *treestr, tree *tr, nodeptr p, int form)
3594    /* write string with representation of tree */
3595    /*   form == 1 -> Newick tree */
3596    /*   form == 2 -> Prolog fact */
3597    /*   form == 3 -> PHYLIP tree */
3598  { /* treeString */
3599    double  x, z;
3600    char  *nameptr;
3601    int    c;
3602
3603    if (p == tr->start->back) {
3604      if (form != treePHYLIP) {
3605        if (form == treeProlog) {
3606          (void) sprintf(treestr, "phylip_tree(");
3607          while (*treestr) treestr++;            /* move pointer to null */
3608          }
3609
3610        (void) sprintf(treestr, "[&&%s: version = '%s'",
3611                                 programName, programVersion);
3612        while (*treestr) treestr++;
3613
3614        (void) sprintf(treestr, ", %s = %15.13g",
3615                                 likelihood_key, tr->likelihood);
3616        while (*treestr) treestr++;
3617
3618        (void) sprintf(treestr, ", %s = %d", ntaxa_key, tr->ntips);
3619        while (*treestr) treestr++;
3620
3621        (void) sprintf(treestr,", %s = %d", opt_level_key, tr->opt_level);
3622        while (*treestr) treestr++;
3623
3624        (void) sprintf(treestr, ", %s = %d", smoothed_key, tr->smoothed);
3625        while (*treestr) treestr++;
3626
3627        (void) sprintf(treestr, "]%s", form == treeProlog ? ", " : " ");
3628        while (*treestr) treestr++;
3629        }
3630      }
3631
3632    if (p->tip) {
3633      if (form != treePHYLIP) *treestr++ = '\'';
3634      nameptr = p->name;
3635      while (c = *nameptr++) {
3636        if (form != treePHYLIP) {if (c == '\'') *treestr++ = '\'';}
3637        else if (c == ' ') {c = '_';}
3638        *treestr++ = c;
3639        }
3640      if (form != treePHYLIP) *treestr++ = '\'';
3641      }
3642
3643    else {
3644      *treestr++ = '(';
3645      treestr = treeString(treestr, tr, p->next->back, form);
3646      *treestr++ = ',';
3647      treestr = treeString(treestr, tr, p->next->next->back, form);
3648      if (p == tr->start->back) {
3649        *treestr++ = ',';
3650        treestr = treeString(treestr, tr, p->back, form);
3651        }
3652      *treestr++ = ')';
3653      }
3654
3655    if (p == tr->start->back) {
3656      (void) sprintf(treestr, ":0.0%s\n", (form != treeProlog) ? ";" : ").");
3657      }
3658    else {
3659      z = p->z;
3660      if (z < zmin) z = zmin;
3661      x = -log(z) * tr->rdta->fracchange;
3662      (void) sprintf(treestr, ": %8.6f", x);  /* prolog needs the space */
3663      }
3664
3665    while (*treestr) treestr++;     /* move pointer up to null termination */
3666    return  treestr;
3667  } /* treeString */
3668
3669
3670void treeOut (FILE *treefile, tree *tr, int form)
3671    /* write out file with representation of final tree */
3672  { /* treeOut */
3673    int    c;
3674    char  *cptr, *treestr;
3675
3676    treestr = (char *) Malloc((tr->ntips * (nmlngth+32)) + 256);
3677    if (! treestr) {
3678      fprintf(stderr, "treeOut: Malloc failure\n");
3679      exit(1);
3680      }
3681
3682    (void) treeString(treestr, tr, tr->start->back, form);
3683    cptr = treestr;
3684    while (c = *cptr++) putc(c, treefile);
3685
3686    Free(treestr);
3687  } /* treeOut */
3688
3689
3690/*=======================================================================*/
3691/*                         Read a tree from a file                       */
3692/*=======================================================================*/
3693
3694
3695/*  1.0.A  Processing of quotation marks in comment removed
3696 */
3697
3698int treeFinishCom (FILE *fp, char **strp)
3699  { /* treeFinishCom */
3700    int  ch;
3701
3702    while ((ch = getc(fp)) != EOF && ch != ']') {
3703      if (strp != NULL) *(*strp)++ = ch;    /* save character  */
3704      if (ch == '[') {                      /* nested comment; find its end */
3705        if ((ch = treeFinishCom(fp, strp)) == EOF)  break;
3706        if (strp != NULL) *(*strp)++ = ch;  /* save closing ]  */
3707        }
3708      }
3709
3710    if (strp != NULL) **strp = '\0';        /* terminate string  */
3711    return  ch;
3712  } /* treeFinishCom */
3713
3714
3715int treeGetCh (FILE *fp)         /* get next nonblank, noncomment character */
3716  { /* treeGetCh */
3717    int  ch;
3718
3719    while ((ch = getc(fp)) != EOF) {
3720      if (whitechar(ch)) ;
3721      else if (ch == '[') {                   /* comment; find its end */
3722        if ((ch = treeFinishCom(fp, (char **) NULL)) == EOF)  break;
3723        }
3724      else  break;
3725      }
3726
3727    return  ch;
3728  } /* treeGetCh */
3729
3730
3731boolean  treeLabelEnd (int ch)
3732  { /* treeLabelEnd */
3733    switch (ch) {
3734        case EOF:  case '\0':  case '\t':  case '\n':  case ' ':
3735        case ':':  case ',':   case '(':   case ')':   case '[':
3736        case ';':
3737          return TRUE;
3738        default:
3739          break;
3740        }
3741    return FALSE;
3742  } /* treeLabelEnd */
3743
3744
3745boolean  treeGetLabel (FILE *fp, char *lblPtr, int maxlen)
3746  { /* treeGetLabel */
3747    int      ch;
3748    boolean  done, quoted, lblfound;
3749
3750    if (--maxlen < 0) lblPtr = (char *) NULL;  /* reserves space for '\0' */
3751    else if (lblPtr == NULL) maxlen = 0;
3752
3753    ch = getc(fp);
3754    done = treeLabelEnd(ch);
3755
3756    lblfound = ! done;
3757    quoted = (ch == '\'');
3758    if (quoted && ! done) {ch = getc(fp); done = (ch == EOF);}
3759
3760    while (! done) {
3761      if (quoted) {
3762        if (ch == '\'') {ch = getc(fp); if (ch != '\'') break;}
3763        }
3764
3765      else if (treeLabelEnd(ch)) break;
3766
3767      else if (ch == '_') ch = ' ';  /* unquoted _ goes to space */
3768
3769      if (--maxlen >= 0) *lblPtr++ = ch;
3770      ch = getc(fp);
3771      if (ch == EOF) break;
3772      }
3773
3774    if (ch != EOF)  (void) ungetc(ch, fp);
3775
3776    if (lblPtr != NULL) *lblPtr = '\0';
3777
3778    return lblfound;
3779  } /* treeGetLabel */
3780
3781
3782boolean  treeFlushLabel (FILE *fp)
3783  { /* treeFlushLabel */
3784    return  treeGetLabel(fp, (char *) NULL, (int) 0);
3785  } /* treeFlushLabel */
3786
3787
3788int  treeFindTipByLabel (char  *str, tree *tr)
3789                     /*  str -- label string pointer */
3790  { /* treeFindTipByLabel */
3791    nodeptr  q;
3792    char    *nameptr;
3793    int      ch, i, n;
3794    boolean  found;
3795
3796    for (n = 1; n <= tr->mxtips; n++) {
3797      q = tr->nodep[n];
3798      if (! (q->back)) {          /*  Only consider unused tips */
3799        i = 0;
3800        nameptr = q->name;
3801        while ((found = (str[i++] == (ch = *nameptr++))) && ch) ;
3802        if (found) return n;
3803        }
3804      }
3805
3806    printf("ERROR: Cannot find tree species: %s\n", str);
3807
3808    return  0;
3809  } /* treeFindTipByLabel */
3810
3811
3812int  treeFindTipName (FILE *fp, tree *tr)
3813  { /* treeFindTipName */
3814    char    *nameptr, str[nmlngth+2];
3815    int      n;
3816
3817    if (tr->prelabeled) {
3818      if (treeGetLabel(fp, str, nmlngth+2))
3819        n = treeFindTipByLabel(str, tr);
3820      else
3821        n = 0;
3822      }
3823
3824    else if (tr->ntips < tr->mxtips) {
3825      n = tr->ntips + 1;
3826      nameptr = tr->nodep[n]->name;
3827      if (! treeGetLabel(fp, nameptr, nmlngth+1)) n = 0;
3828      }
3829
3830    else {
3831      n = 0;
3832      }
3833
3834    return  n;
3835  } /* treeFindTipName */
3836
3837
3838void  treeEchoContext (FILE *fp1, FILE *fp2, int n)
3839 { /* treeEchoContext */
3840   int      ch;
3841   boolean  waswhite;
3842
3843   waswhite = TRUE;
3844
3845   while (n > 0 && ((ch = getc(fp1)) != EOF)) {
3846     if (whitechar(ch)) {
3847       ch = waswhite ? '\0' : ' ';
3848       waswhite = TRUE;
3849       }
3850     else {
3851       waswhite = FALSE;
3852       }
3853
3854     if (ch > '\0') {putc(ch, fp2); n--;}
3855     }
3856 } /* treeEchoContext */
3857
3858
3859boolean treeProcessLength (FILE *fp, double *dptr)
3860  { /* treeProcessLength */
3861    int  ch;
3862
3863    if ((ch = treeGetCh(fp)) == EOF)  return FALSE;    /*  Skip comments */
3864    (void) ungetc(ch, fp);
3865
3866    if (fscanf(fp, "%lf", dptr) != 1) {
3867      printf("ERROR: treeProcessLength: Problem reading branch length\n");
3868      treeEchoContext(fp, stdout, 40);
3869      printf("\n");
3870      return  FALSE;
3871      }
3872
3873    return  TRUE;
3874  } /* treeProcessLength */
3875
3876
3877boolean  treeFlushLen (FILE  *fp)
3878  { /* treeFlushLen */
3879    double  dummy;
3880    int     ch;
3881
3882    if ((ch = treeGetCh(fp)) == ':') return treeProcessLength(fp, & dummy);
3883
3884    if (ch != EOF) (void) ungetc(ch, fp);
3885    return TRUE;
3886  } /* treeFlushLen */
3887
3888
3889boolean  treeNeedCh (FILE *fp, int c1, const char *where)
3890  { /* treeNeedCh */
3891    int  c2;
3892
3893    if ((c2 = treeGetCh(fp)) == c1)  return TRUE;
3894
3895    printf("ERROR: Expecting '%c' %s tree; found:", c1, where);
3896    if (c2 == EOF) {
3897      printf("End-of-File");
3898      }
3899    else {
3900      ungetc(c2, fp);
3901      treeEchoContext(fp, stdout, 40);
3902      }
3903    putchar('\n');
3904    return FALSE;
3905  } /* treeNeedCh */
3906
3907
3908boolean  addElementLen (FILE *fp, tree *tr, nodeptr p)
3909  { /* addElementLen */
3910    double   z, branch;
3911    nodeptr  q;
3912    int      n, ch;
3913
3914    if ((ch = treeGetCh(fp)) == '(') {     /*  A new internal node */
3915      n = (tr->nextnode)++;
3916      if (n > 2*(tr->mxtips) - 2) {
3917        if (tr->rooted || n > 2*(tr->mxtips) - 1) {
3918          printf("ERROR: Too many internal nodes.  Is tree rooted?\n");
3919          printf("       Deepest splitting should be a trifurcation.\n");
3920          return FALSE;
3921          }
3922        else {
3923          tr->rooted = TRUE;
3924          }
3925        }
3926      q = tr->nodep[n];
3927      if (! addElementLen(fp, tr, q->next))        return FALSE;
3928      if (! treeNeedCh(fp, ',', "in"))             return FALSE;
3929      if (! addElementLen(fp, tr, q->next->next))  return FALSE;
3930      if (! treeNeedCh(fp, ')', "in"))             return FALSE;
3931      (void) treeFlushLabel(fp);
3932      }
3933
3934    else {                               /*  A new tip */
3935      ungetc(ch, fp);
3936      if ((n = treeFindTipName(fp, tr)) <= 0)          return FALSE;
3937      q = tr->nodep[n];
3938      if (tr->start->number > n)  tr->start = q;
3939      (tr->ntips)++;
3940      }                                  /* End of tip processing */
3941
3942    if (tr->userlen) {
3943      if (! treeNeedCh(fp, ':', "in"))             return FALSE;
3944      if (! treeProcessLength(fp, & branch))       return FALSE;
3945      z = exp(-branch / tr->rdta->fracchange);
3946      if (z > zmax)  z = zmax;
3947      hookup(p, q, z);
3948      }
3949    else {
3950      if (! treeFlushLen(fp))                       return FALSE;
3951      hookup(p, q, defaultz);
3952      }
3953
3954    return TRUE;
3955  } /* addElementLen */
3956
3957
3958int saveTreeCom (char  **comstrp)
3959  { /* saveTreeCom */
3960    int  ch;
3961    boolean  inquote;
3962
3963    inquote = FALSE;
3964    while ((ch = getc(INFILE)) != EOF && (inquote || ch != ']')) {
3965      *(*comstrp)++ = ch;                        /* save character  */
3966      if (ch == '[' && ! inquote) {              /* comment; find its end */
3967        if ((ch = saveTreeCom(comstrp)) == EOF)  break;
3968        *(*comstrp)++ = ch;                      /* add ] */
3969        }
3970      else if (ch == '\'') inquote = ! inquote;  /* start or end of quote */
3971      }
3972
3973    return  ch;
3974  } /* saveTreeCom */
3975
3976
3977boolean processTreeCom (FILE *fp, tree *tr)
3978  { /* processTreeCom */
3979    int   text_started, functor_read, com_open;
3980
3981    /*  Accept prefatory "phylip_tree(" or "pseudoNewick("  */
3982
3983    functor_read = text_started = 0;
3984    (void) fscanf(fp, " p%nhylip_tree(%n", & text_started, & functor_read);
3985    if (text_started && ! functor_read) {
3986      (void) fscanf(fp, "seudoNewick(%n", & functor_read);
3987      if (! functor_read) {
3988        printf("Start of tree 'p...' not understood.\n");
3989        return FALSE;
3990        }
3991      }
3992
3993    com_open = 0;
3994    (void) fscanf(fp, " [%n", & com_open);
3995
3996    if (com_open) {                                  /* comment; read it */
3997      char  com[1024], *com_end;
3998
3999      com_end = com;
4000      if (treeFinishCom(fp, & com_end) == EOF) {     /* omits enclosing []s */
4001        printf("Missing end of tree comment\n");
4002        return FALSE;
4003        }
4004
4005      (void) readKeyValue(com, likelihood_key, "%lg",
4006                               (void *) &(tr->likelihood));
4007      (void) readKeyValue(com, opt_level_key,  "%d",
4008                               (void *) &(tr->opt_level));
4009      (void) readKeyValue(com, smoothed_key,   "%d",
4010                               (void *) &(tr->smoothed));
4011
4012      if (functor_read) (void) fscanf(fp, " ,");   /* remove trailing comma */
4013      }
4014
4015    return (functor_read > 0);
4016  } /* processTreeCom */
4017
4018
4019nodeptr uprootTree (tree *tr, nodeptr p)
4020  { /* uprootTree */
4021    nodeptr  q, r, s, start;
4022    int      n;
4023
4024    if (p->tip || p->back) {
4025      printf("ERROR: Unable to uproot tree.\n");
4026      printf("       Inappropriate node marked for removal.\n");
4027      return (nodeptr) NULL;
4028      }
4029
4030    n = --(tr->nextnode);               /* last internal node added */
4031    if (n != tr->mxtips + tr->ntips - 1) {
4032      printf("ERROR: Unable to uproot tree.  Inconsistent\n");
4033      printf("       number of tips and nodes for rooted tree.\n");
4034      return (nodeptr) NULL;
4035      }
4036
4037    q = p->next->back;                  /* remove p from tree */
4038    r = p->next->next->back;
4039    hookup(q, r, tr->userlen ? (q->z * r->z) : defaultz);
4040
4041    start = (r->tip || (! q->tip)) ? r : r->next->next->back;
4042
4043    if (tr->ntips > 2 && p->number != n) {
4044      q = tr->nodep[n];            /* transfer last node's conections to p */
4045      r = q->next;
4046      s = q->next->next;
4047      hookup(p,             q->back, q->z);   /* move connections to p */
4048      hookup(p->next,       r->back, r->z);
4049      hookup(p->next->next, s->back, s->z);
4050      if (start->number == q->number) start = start->back->back;
4051      q->back = r->back = s->back = (nodeptr) NULL;
4052      }
4053    else {
4054      p->back = p->next->back = p->next->next->back = (nodeptr) NULL;
4055      }
4056
4057    tr->rooted = FALSE;
4058    return  start;
4059  } /* uprootTree */
4060
4061
4062boolean treeReadLen (FILE *fp, tree *tr)
4063  { /* treeReadLen */
4064    nodeptr  p;
4065    int      i, ch;
4066    boolean  is_fact;
4067
4068    for (i = 1; i <= tr->mxtips; i++) tr->nodep[i]->back = (node *) NULL;
4069    tr->start       = tr->nodep[tr->mxtips];
4070    tr->ntips       = 0;
4071    tr->nextnode    = tr->mxtips + 1;
4072    tr->opt_level   = 0;
4073    tr->log_f_valid = 0;
4074    tr->smoothed    = FALSE;
4075    tr->rooted      = FALSE;
4076
4077    is_fact = processTreeCom(fp, tr);
4078
4079    p = tr->nodep[(tr->nextnode)++];
4080    if (! treeNeedCh(fp, '(', "at start of"))       return FALSE;
4081    if (! addElementLen(fp, tr, p))                 return FALSE;
4082    if (! treeNeedCh(fp, ',', "in"))                return FALSE;
4083    if (! addElementLen(fp, tr, p->next))           return FALSE;
4084    if (! tr->rooted) {
4085      if ((ch = treeGetCh(fp)) == ',') {        /*  An unrooted format */
4086        if (! addElementLen(fp, tr, p->next->next)) return FALSE;
4087        }
4088      else {                                    /*  A rooted format */
4089        tr->rooted = TRUE;
4090        if (ch != EOF)  (void) ungetc(ch, fp);
4091        }
4092      }
4093    else {
4094      p->next->next->back = (nodeptr) NULL;
4095      }
4096    if (! treeNeedCh(fp, ')', "in"))                return FALSE;
4097    (void) treeFlushLabel(fp);
4098    if (! treeFlushLen(fp))                         return FALSE;
4099    if (is_fact) {
4100      if (! treeNeedCh(fp, ')', "at end of"))       return FALSE;
4101      if (! treeNeedCh(fp, '.', "at end of"))       return FALSE;
4102      }
4103    else {
4104      if (! treeNeedCh(fp, ';', "at end of"))       return FALSE;
4105      }
4106
4107    if (tr->rooted) {
4108      p->next->next->back = (nodeptr) NULL;
4109      tr->start = uprootTree(tr, p->next->next);
4110      if (! tr->start)                              return FALSE;
4111      }
4112    else {
4113      tr->start = p->next->next->back;  /* This is start used by treeString */
4114      }
4115
4116    return  (initrav(tr, tr->start) && initrav(tr, tr->start->back));
4117  } /* treeReadLen */
4118
4119
4120/*=======================================================================*/
4121/*                        Read a tree from a string                      */
4122/*=======================================================================*/
4123
4124
4125#if Master || Slave
4126int str_treeFinishCom (char **treestrp, char **strp)
4127                      /* treestrp -- tree string pointer */
4128                      /* strp -- comment string pointer */
4129  { /* str_treeFinishCom */
4130    int  ch;
4131
4132    while ((ch = *(*treestrp)++) != NULL && ch != ']') {
4133      if (strp != NULL) *(*strp)++ = ch;    /* save character  */
4134      if (ch == '[') {                      /* nested comment; find its end */
4135        if ((ch = str_treeFinishCom(treestrp)) == NULL)  break;
4136        if (strp != NULL) *(*strp)++ = ch;  /* save closing ]  */
4137        }
4138      }
4139    if (strp != NULL) **strp = '\0';        /* terminate string  */
4140    return  ch;
4141  } /* str_treeFinishCom */
4142
4143
4144int str_treeGetCh (char **treestrp)
4145    /* get next nonblank, noncomment character */
4146  { /* str_treeGetCh */
4147    int  ch;
4148   
4149    while ((ch = *(*treestrp)++) != NULL) {
4150      if (whitechar(ch)) ;
4151      else if (ch == '[') {                  /* comment; find its end */
4152        if ((ch = str_treeFinishCom(treestrp, (char *) NULL)) == NULL)  break;
4153        }
4154      else  break;
4155      }
4156
4157    return  ch;
4158  } /* str_treeGetCh */
4159
4160
4161boolean  str_treeGetLabel (char **treestrp, char *lblPtr, int maxlen)
4162  { /* str_treeGetLabel */
4163    int      ch;
4164    boolean  done, quoted, lblfound;
4165
4166    if (--maxlen < 0) lblPtr = (char *) NULL;  /* reserves space for '\0' */
4167    else if (lblPtr == NULL) maxlen = 0;
4168
4169    ch = *(*treestrp)++;
4170    done = treeLabelEnd(ch);
4171
4172    lblfound = ! done;
4173    quoted = (ch == '\'');
4174    if (quoted && ! done) {ch = *(*treestrp)++; done = (ch == '\0');}
4175
4176    while (! done) {
4177      if (quoted) {
4178        if (ch == '\'') {ch = *(*treestrp)++; if (ch != '\'') break;}
4179        }
4180
4181      else if (treeLabelEnd(ch)) break;
4182
4183      else if (ch == '_') ch = ' ';  /* unquoted _ goes to space */
4184
4185      if (--maxlen >= 0) *lblPtr++ = ch;
4186      ch = *(*treestrp)++;
4187      if (ch == '\0') break;
4188      }
4189
4190    (*treestrp)--;
4191
4192    if (lblPtr != NULL) *lblPtr = '\0';
4193
4194    return lblfound;
4195  } /* str_treeGetLabel */
4196
4197
4198boolean  str_treeFlushLabel (char **treestrp)
4199  { /* str_treeFlushLabel */
4200    return  str_treeGetLabel(treestrp, (char *) NULL, (int) 0);
4201  } /* str_treeFlushLabel */
4202
4203
4204int  str_treeFindTipName (char **treestrp, tree *tr)
4205  { /* str_treeFindTipName */
4206    nodeptr  q;
4207    char    *nameptr, str[nmlngth+2];
4208    int      ch, i, n;
4209
4210    if (tr->prelabeled) {
4211      if (str_treeGetLabel(treestrp, str, nmlngth+2))
4212        n = treeFindTipByLabel(str, tr);
4213      else
4214        n = 0;
4215      }
4216
4217    else if (tr->ntips < tr->mxtips) {
4218      n = tr->ntips + 1;
4219      nameptr = tr->nodep[n]->name;
4220      if (! str_treeGetLabel(treestrp, nameptr, nmlngth+1)) n = 0;
4221      }
4222
4223    else {
4224      n = 0;
4225      }
4226
4227    return  n;
4228  } /* str_treeFindTipName */
4229
4230
4231boolean str_treeProcessLength (char **treestrp, double *dptr)
4232  { /* str_treeProcessLength */
4233    int     used;
4234
4235    if(! str_treeGetCh(treestrp))  return FALSE;    /*  Skip comments */
4236    (*treestrp)--;
4237
4238    if (sscanf(*treestrp, "%lf%n", dptr, & used) != 1) {
4239      printf("ERROR: str_treeProcessLength: Problem reading branch length\n");
4240      printf("%40s\n", *treestrp);
4241      *dptr = 0.0;
4242      return FALSE;
4243      }
4244    else {
4245      *treestrp += used;
4246      }
4247
4248    return  TRUE;
4249  } /* str_treeProcessLength */
4250
4251
4252boolean  str_treeFlushLen (char **treestrp)
4253  { /* str_treeFlushLen */
4254    int  ch;
4255
4256    if ((ch = str_treeGetCh(treestrp)) == ':')
4257      return str_treeProcessLength(treestrp, (double *) NULL);
4258    else {
4259      (*treestrp)--;
4260      return TRUE;
4261      }
4262  } /* str_treeFlushLen */
4263
4264
4265boolean  str_treeNeedCh (char **treestrp, int c1, char *where)
4266  { /* str_treeNeedCh */
4267    int  c2, i;
4268
4269    if ((c2 = str_treeGetCh(treestrp)) == c1)  return TRUE;
4270
4271    printf("ERROR: Missing '%c' %s tree; ", c1, where);
4272    if (c2 == '\0') 
4273      printf("end-of-string");
4274    else {
4275      putchar('"');
4276      for (i = 24; i-- && (c2 != '\0'); c2 = *(*treestrp)++)  putchar(c2);
4277      putchar('"');
4278      }
4279
4280    printf(" found instead\n");
4281    return FALSE;
4282  } /* str_treeNeedCh */
4283
4284
4285boolean  str_addElementLen (char **treestrp, tree *tr, nodeptr p)
4286  { /* str_addElementLen */
4287    double   z, branch;
4288    nodeptr  q;
4289    int      n, ch;
4290
4291    if ((ch = str_treeGetCh(treestrp)) == '(') { /*  A new internal node */
4292      n = (tr->nextnode)++;
4293      if (n > 2*(tr->mxtips) - 2) {
4294        if (tr->rooted || n > 2*(tr->mxtips) - 1) {
4295          printf("ERROR: too many internal nodes.  Is tree rooted?\n");
4296          printf("Deepest splitting should be a trifurcation.\n");
4297          return  FALSE;
4298          }
4299        else {
4300          tr->rooted = TRUE;
4301          }
4302        }
4303      q = tr->nodep[n];
4304      if (! str_addElementLen(treestrp, tr, q->next))          return FALSE;
4305      if (! str_treeNeedCh(treestrp, ',', "in"))               return FALSE;
4306      if (! str_addElementLen(treestrp, tr, q->next->next))    return FALSE;
4307      if (! str_treeNeedCh(treestrp, ')', "in"))               return FALSE;
4308      if (! str_treeFlushLabel(treestrp))                      return FALSE;
4309      }
4310
4311    else {                           /*  A new tip */
4312      n = str_treeFindTipName(treestrp, tr, ch);
4313      if (n <= 0) return FALSE;
4314      q = tr->nodep[n];
4315      if (tr->start->number > n)  tr->start = q;
4316      (tr->ntips)++;
4317      }                              /* End of tip processing */
4318
4319    /*  Master and Slave always use lengths */
4320
4321    if (! str_treeNeedCh(treestrp, ':', "in"))                 return FALSE;
4322    if (! str_treeProcessLength(treestrp, & branch))           return FALSE;
4323    z = exp(-branch / tr->rdta->fracchange);
4324    if (z > zmax)  z = zmax;
4325    hookup(p, q, z);
4326
4327    return  TRUE;
4328  } /* str_addElementLen */
4329
4330
4331boolean str_processTreeCom(tree *tr, char **treestrp)
4332  { /* str_processTreeCom */
4333    char  *com, *com_end;
4334    int  text_started, functor_read, com_open;
4335
4336    com = *treestrp;
4337
4338    functor_read = text_started = 0;
4339    sscanf(com, " p%nhylip_tree(%n", & text_started, & functor_read);
4340    if (functor_read) {
4341      com += functor_read;
4342      }
4343    else if (text_started) {
4344      com += text_started;
4345      sscanf(com, "seudoNewick(%n", & functor_read);
4346      if (! functor_read) {
4347        printf("Start of tree 'p...' not understood.\n");
4348        return  FALSE;
4349        }
4350      else {
4351        com += functor_read;
4352        }
4353      }
4354
4355    com_open = 0;
4356    sscanf(com, " [%n", & com_open);
4357    com += com_open;
4358
4359    if (com_open) {                              /* comment; read it */
4360        if (!(com_end = strchr(com, ']'))) {
4361        printf("Missing end of tree comment.\n");
4362        return  FALSE;
4363        }
4364
4365      *com_end = 0;
4366      (void) readKeyValue(com, likelihood_key, "%lg",
4367                               (void *) &(tr->likelihood));
4368      (void) readKeyValue(com, opt_level_key,  "%d",
4369                               (void *) &(tr->opt_level));
4370      (void) readKeyValue(com, smoothed_key,   "%d",
4371                               (void *) &(tr->smoothed));
4372      *com_end = ']';
4373      com_end++;
4374
4375      if (functor_read) {                          /* remove trailing comma */
4376        text_started = 0;
4377        sscanf(com_end, " ,%n", & text_started);
4378        com_end += text_started;
4379        }
4380
4381      *treestrp = com_end;
4382      }
4383
4384    return (functor_read > 0);
4385  } /* str_processTreeCom */
4386
4387
4388boolean str_treeReadLen (char *treestr, tree *tr)
4389    /* read string with representation of tree */
4390  { /* str_treeReadLen */
4391    nodeptr  p;
4392    int  i;
4393    boolean  is_fact, found;
4394
4395    for (i = 1; i <= tr->mxtips; i++) tr->nodep[i]->back = (node *) NULL;
4396    tr->start       = tr->nodep[tr->mxtips];
4397    tr->ntips       = 0;
4398    tr->nextnode    = tr->mxtips + 1;
4399    tr->opt_level   = 0;
4400    tr->log_f_valid = 0;
4401    tr->smoothed    = Master;
4402    tr->rooted      = FALSE;
4403
4404    is_fact = str_processTreeCom(tr, & treestr);
4405
4406    p = tr->nodep[(tr->nextnode)++];
4407    if (! str_treeNeedCh(& treestr, '(', "at start of"))       return FALSE;
4408    if (! str_addElementLen(& treestr, tr, p))                 return FALSE;
4409    if (! str_treeNeedCh(& treestr, ',', "in"))                return FALSE;
4410    if (! str_addElementLen(& treestr, tr, p->next))           return FALSE;
4411    if (! tr->rooted) {
4412      if (str_treeGetCh(& treestr) == ',') {        /*  An unrooted format */
4413        if (! str_addElementLen(& treestr, tr, p->next->next)) return FALSE;
4414        }
4415      else {                                       /*  A rooted format */
4416        p->next->next->back = (nodeptr) NULL;
4417        tr->rooted = TRUE;
4418        treestr--;
4419        }
4420      }
4421    if (! str_treeNeedCh(& treestr, ')', "in"))                return FALSE;
4422    if (! str_treeFlushLabel(& treestr))                       return FALSE;
4423    if (! str_treeFlushLen(& treestr))                         return FALSE;
4424    if (is_fact) {
4425      if (! str_treeNeedCh(& treestr, ')', "at end of"))       return FALSE;
4426      if (! str_treeNeedCh(& treestr, '.', "at end of"))       return FALSE;
4427      }
4428    else {
4429      if (! str_treeNeedCh(& treestr, ';', "at end of"))       return FALSE;
4430      }
4431
4432    if (tr->rooted)  if (! uprootTree(tr, p->next->next))     return FALSE;
4433    tr->start = p->next->next->back;  /* This is start used by treeString */
4434
4435    return  (initrav(tr, tr->start) && initrav(tr, tr->start->back));
4436  } /* str_treeReadLen */
4437#endif
4438
4439
4440boolean treeEvaluate (tree *tr, bestlist *bt)       /* Evaluate a user tree */
4441  { /* treeEvaluate */
4442
4443    if (Slave || ! tr->userlen) {
4444      if (! smoothTree(tr, 4 * smoothings)) return FALSE;
4445      }
4446
4447    if (evaluate(tr, tr->start) == badEval)  return FALSE;
4448
4449#   if ! Slave
4450      (void) saveBestTree(bt, tr);
4451#   endif
4452    return TRUE;
4453  } /* treeEvaluate */
4454
4455
4456#if Master || Slave
4457FILE *freopen_pid (char *filenm, char *mode, FILE *stream)
4458  { /* freopen_pid */
4459    char scr[512];
4460
4461    (void) sprintf(scr, "%s.%d", filenm, getpid());
4462    return  freopen(scr, mode, stream);
4463  } /* freopen_pid */
4464#endif
4465
4466
4467boolean  showBestTrees (bestlist *bt, tree *tr, analdef *adef, FILE *treefile)
4468  { /* showBestTrees */
4469    int     rank;
4470
4471    for (rank = 1; rank <= bt->nvalid; rank++) {
4472      if (rank > 1) {
4473        if (rank != recallBestTree(bt, rank, tr))  break;
4474        }
4475      if (evaluate(tr, tr->start) == badEval) return FALSE;
4476      if (tr->outgrnode->back)  tr->start = tr->outgrnode;
4477      printTree(tr, adef);
4478      summarize(tr);
4479      if (treefile)  treeOut(treefile, tr, adef->trout);
4480      }
4481
4482    return TRUE;
4483  } /* showBestTrees */
4484
4485
4486boolean cmpBestTrees (bestlist *bt, tree *tr)
4487  { /* cmpBestTrees */
4488    double  sum, sum2, sd, temp, wtemp, bestscore;
4489    double *log_f0, *log_f0_ptr;      /* Save a copy of best log_f */
4490    double *log_f_ptr;
4491    int     i, j, num, besttips;
4492
4493    num = bt->nvalid;
4494    if ((num <= 1) || (tr->cdta->wgtsum <= 1)) return TRUE;
4495
4496    if (! (log_f0 = (double *) Malloc(sizeof(double) * tr->cdta->endsite))) {
4497      printf("ERROR: cmpBestTrees unable to obtain space for log_f0\n");
4498      return FALSE;
4499      }
4500
4501    printf("Tree      Ln L        Diff Ln L       Its S.D.");
4502    printf("   Significantly worse?\n\n");
4503
4504    for (i = 1; i <= num; i++) {
4505      if (i != recallBestTree(bt, i, tr))  break;
4506      if (! (tr->log_f_valid))  {
4507        if (evaluate(tr, tr->start) == badEval) return FALSE;
4508        }
4509
4510      printf("%3d%14.5f", i, tr->likelihood);
4511      if (i == 1) {
4512        printf("  <------ best\n");
4513        besttips = tr->ntips;
4514        bestscore = tr->likelihood;
4515        log_f0_ptr = log_f0;
4516        log_f_ptr  = tr->log_f;
4517        for (j = 0; j < tr->cdta->endsite; j++)  *log_f0_ptr++ = *log_f_ptr++;
4518        }
4519      else if (tr->ntips != besttips)
4520        printf("  (different number of species)\n");
4521      else {
4522        sum = sum2 = 0.0;
4523        log_f0_ptr = log_f0;
4524        log_f_ptr  = tr->log_f;
4525        for (j = 0; j < tr->cdta->endsite; j++) {
4526          temp  = *log_f0_ptr++ - *log_f_ptr++;
4527          wtemp = tr->cdta->aliaswgt[j] * temp;
4528          sum  += wtemp;
4529          sum2 += wtemp * temp;
4530          }
4531        sd = sqrt( tr->cdta->wgtsum * (sum2 - sum*sum / tr->cdta->wgtsum)
4532                                    / (tr->cdta->wgtsum - 1) );
4533        printf("%14.5f%14.4f", tr->likelihood - bestscore, sd);
4534        printf("           %s\n", (sum > 1.95996 * sd) ? "Yes" : " No");
4535        }
4536      }
4537
4538    Free(log_f0);
4539    printf("\n\n");
4540
4541    return TRUE;
4542  } /* cmpBestTrees */
4543
4544
4545boolean  makeUserTree (tree *tr, bestlist *bt, analdef *adef)
4546  { /* makeUserTree */
4547    char   filename[128];
4548    FILE  *treefile;
4549    int    nusertrees, which;
4550
4551    nusertrees = adef->numutrees;
4552
4553    printf("User-defined %s:\n\n", (nusertrees == 1) ? "tree" : "trees");
4554
4555    treefile = adef->trout ? fopen_pid("treefile", "w", filename) : (FILE *) NULL;
4556
4557    for (which = 1; which <= nusertrees; which++) {
4558      if (! treeReadLen(INFILE, tr)) return FALSE;
4559      if (! treeEvaluate(tr, bt))    return FALSE;
4560      if (tr->global <= 0) {
4561        if (tr->outgrnode->back)  tr->start = tr->outgrnode;
4562        printTree(tr, adef);
4563        summarize(tr);
4564        if (treefile)  treeOut(treefile, tr, adef->trout);
4565        }
4566      else {
4567        printf("%6d:  Ln Likelihood =%14.5f\n", which, tr->likelihood);
4568        }
4569      }
4570
4571    if (tr->global > 0) {
4572      putchar('\n');
4573      if (! recallBestTree(bt, 1, tr))  return FALSE;
4574      printf("      Ln Likelihood =%14.5f\n", tr->likelihood);
4575      if (! optimize(tr, tr->global, bt))  return FALSE;
4576      if (tr->outgrnode->back)  tr->start = tr->outgrnode;
4577      printTree(tr, adef);
4578      summarize(tr);
4579      if (treefile)  treeOut(treefile, tr, adef->trout);
4580      }
4581
4582    if (treefile) {
4583      (void) fclose(treefile);
4584      printf("Tree also written to %s\n", filename);
4585      }
4586
4587    putchar('\n');
4588
4589    (void) cmpBestTrees(bt, tr);
4590    return TRUE;
4591  } /* makeUserTree */
4592
4593
4594#if Slave
4595boolean slaveTreeEvaluate (tree *tr, bestlist *bt)
4596  { /* slaveTreeEvaluate */
4597    boolean done;
4598
4599    do {
4600       requestForWork();
4601       if (! receiveTree(& comm_master, tr))        return FALSE;
4602       done = tr->likelihood > 0.0;
4603       if (! done) {
4604         if (! treeEvaluate(tr, bt))                return FALSE;
4605         if (! sendTree(& comm_master, tr))         return FALSE;
4606         }
4607       } while (! done);
4608
4609    return TRUE;
4610  } /* slaveTreeEvaluate */
4611#endif
4612
4613
4614double randum (long  *seed)
4615    /* random number generator, modified to use 12 bit chunks */
4616  { /* randum */
4617    long  sum, mult0, mult1, seed0, seed1, seed2, newseed0, newseed1, newseed2;
4618
4619    mult0 = 1549;
4620    seed0 = *seed & 4095;
4621    sum  = mult0 * seed0;
4622    newseed0 = sum & 4095;
4623    sum >>= 12;
4624    seed1 = (*seed >> 12) & 4095;
4625    mult1 =  406;
4626    sum += mult0 * seed1 + mult1 * seed0;
4627    newseed1 = sum & 4095;
4628    sum >>= 12;
4629    seed2 = (*seed >> 24) & 255;
4630    sum += mult0 * seed2 + mult1 * seed1;
4631    newseed2 = sum & 255;
4632
4633    *seed = newseed2 << 24 | newseed1 << 12 | newseed0;
4634    return  0.00390625 * (newseed2
4635                          + 0.000244140625 * (newseed1
4636                                              + 0.000244140625 * newseed0));
4637  } /* randum */
4638
4639
4640boolean makeDenovoTree (tree *tr, bestlist *bt, analdef *adef)
4641  { /* makeDenovoTree */
4642    char   filename[128];
4643    FILE  *treefile;
4644    nodeptr  p;
4645    int  *enterorder;      /*  random entry order */
4646    int  i, j, k, nextsp, newsp, maxtrav, tested;
4647
4648    double randum();
4649
4650
4651    enterorder = (int *) Malloc(sizeof(int) * (tr->mxtips + 1));
4652    if (! enterorder) {
4653       fprintf(stderr, "makeDenovoTree: Malloc failure for enterorder\n");
4654       return 0;
4655       }
4656
4657    if (adef->restart) {
4658      printf("Restarting from tree with the following sequences:\n");
4659      tr->userlen = TRUE;
4660      if (! treeReadLen(INFILE, tr))          return FALSE;
4661      if (! smoothTree(tr, smoothings))       return FALSE;
4662      if (evaluate(tr, tr->start) == badEval) return FALSE;
4663      if (saveBestTree(bt, tr) < 1)           return FALSE;
4664
4665      for (i = 1, j = tr->ntips; i <= tr->mxtips; i++) { /* find loose tips */
4666        if (! tr->nodep[i]->back) {
4667          enterorder[++j] = i;
4668          }
4669        else {
4670          printf("   %s\n", tr->nodep[i]->name);
4671
4672#         if Master
4673            if (i>3) REPORT_ADD_SPECS;
4674#         endif
4675          }
4676        }
4677      putchar('\n');
4678      }
4679
4680    else {                                           /* start from scratch */
4681      tr->ntips = 0;
4682      for (i = 1; i <= tr->mxtips; i++) enterorder[i] = i;
4683      }
4684
4685    if (adef->jumble) for (i = tr->ntips + 1; i <= tr->mxtips; i++) {
4686      j = randum(&(adef->jumble))*(tr->mxtips - tr->ntips) + tr->ntips + 1;
4687      k = enterorder[j];
4688      enterorder[j] = enterorder[i];
4689      enterorder[i] = k;
4690      }
4691
4692    bt->numtrees = 1;
4693    if (tr->ntips < tr->mxtips)  printf("Adding species:\n");
4694
4695    if (tr->ntips == 0) {
4696      for (i = 1; i <= 3; i++) {
4697        printf("   %s\n", tr->nodep[enterorder[i]]->name);
4698        }
4699      tr->nextnode = tr->mxtips + 1;
4700      if (! buildSimpleTree(tr, enterorder[1], enterorder[2], enterorder[3]))
4701        return FALSE;
4702      }
4703
4704    while (tr->ntips < tr->mxtips || tr->opt_level < tr->global) {
4705      maxtrav = (tr->ntips == tr->mxtips) ? tr->global : tr->partswap;
4706      if (maxtrav > tr->ntips - 3)  maxtrav = tr->ntips - 3;
4707
4708      if (tr->opt_level >= maxtrav) {
4709        nextsp = ++(tr->ntips);
4710        newsp = enterorder[nextsp];
4711        p = tr->nodep[newsp];
4712        printf("   %s\n", p->name);
4713
4714#       if Master
4715          if (nextsp % DNAML_STEP_TIME_COUNT == 1) {
4716            REPORT_STEP_TIME;
4717            }
4718          REPORT_ADD_SPECS;
4719#       endif
4720
4721        (void) buildNewTip(tr, p);
4722
4723        resetBestTree(bt);
4724        cacheZ(tr);
4725        tested = addTraverse(tr, p->back, findAnyTip(tr->start)->back,
4726                             1, tr->ntips - 2, bt, adef->qadd);
4727        if (tested == badRear) return FALSE;
4728        bt->numtrees += tested;
4729
4730#       if Master
4731          getReturnedTrees(tr, bt, tested);
4732#       endif
4733
4734        printf("      Tested %d alternative trees\n", tested);
4735
4736        (void) recallBestTree(bt, 1, tr);
4737        if (! tr->smoothed) {
4738          if (! smoothTree(tr, smoothings))        return FALSE;
4739          if (evaluate(tr, tr->start) == badEval)  return FALSE;
4740          (void) saveBestTree(bt, tr);
4741          }
4742
4743        if (tr->ntips == 4)  tr->opt_level = 1;  /* All 4 taxon trees done */
4744        maxtrav = (tr->ntips == tr->mxtips) ? tr->global : tr->partswap;
4745        if (maxtrav > tr->ntips - 3)  maxtrav = tr->ntips - 3;
4746        }
4747
4748      printf("      Ln Likelihood =%14.5f\n", tr->likelihood);
4749      if (! optimize(tr, maxtrav, bt)) return FALSE;
4750      }
4751
4752    printf("\nExamined %d %s\n", bt->numtrees,
4753                                 bt->numtrees != 1 ? "trees" : "tree");
4754
4755    treefile = adef->trout ? fopen_pid("treefile", "w", filename) : (FILE *) NULL;
4756    (void) showBestTrees(bt, tr, adef, treefile);
4757    if (treefile) {
4758      (void) fclose(treefile);
4759      printf("Tree also written to %s\n\n", filename);
4760      }
4761
4762    (void) cmpBestTrees(bt, tr);
4763
4764#   if DeleteCheckpointFile
4765      unlink_pid(checkpointname);
4766#   endif
4767
4768    Free(enterorder);
4769
4770    return TRUE;
4771  } /* makeDenovoTree */
4772
4773/*==========================================================================*/
4774/*                             "main" routine                               */
4775/*==========================================================================*/
4776
4777#if Sequential
4778  int main ()
4779#else
4780  slave ()
4781#endif
4782  { /* DNA Maximum Likelihood */
4783#   if Master
4784      int starttime, inputtime, endtime;
4785#   endif
4786
4787#   if Master || Slave
4788      int my_id, nprocs, type, from, sz;
4789      char *msg;
4790#   endif
4791
4792    analdef      *adef;
4793    rawdata      *rdta;
4794    cruncheddata  *cdta;
4795    tree         *tr;    /*  current tree */
4796    bestlist     *bt;    /*  topology of best found tree */
4797
4798
4799#   if Debug
4800      {
4801        char debugfilename[128];
4802        debug = fopen_pid("dnaml_debug", "w", debugfilename);
4803        }
4804#   endif
4805
4806#   if Master
4807      starttime = p4_clock();
4808      nprocs = p4_num_total_slaves();
4809
4810      if ((OUTFILE = freopen_pid("master.out", "w", stdout)) == NULL) {
4811        fprintf(stderr, "Could not open output file\n");
4812        exit(1);
4813        }
4814
4815      /* Receive input file name from host */
4816      type = DNAML_FILE_NAME;
4817      from = DNAML_HOST_ID;
4818      msg  = NULL;
4819      p4_recv(& type, & from, & msg, & sz);
4820      if ((INFILE = fopen(msg, "r")) == NULL) {
4821        fprintf(stderr, "master could not open input file %s\n", msg);
4822        exit(1);
4823        }
4824      p4_msg_free(msg);
4825
4826      open_link(& comm_slave);
4827#   endif
4828
4829#  if DNAML_STEP
4830      begin_step_time = starttime;
4831#  endif
4832
4833#   if Slave
4834      my_id = p4_get_my_id();
4835      nprocs = p4_num_total_slaves();
4836
4837      /* Receive input file name from host */
4838      type = DNAML_FILE_NAME;
4839      from = DNAML_HOST_ID;
4840      msg  = NULL;
4841      p4_recv(& type, & from, & msg, & sz);
4842      if ((INFILE = fopen(msg, "r")) == NULL) {
4843        fprintf(stderr, "slave could not open input file %s\n",msg);
4844        exit(1);
4845        }
4846      p4_msg_free(msg);
4847
4848#     ifdef P4DEBUG
4849        if ((OUTFILE = freopen_pid("slave.out", "w", stdout)) == NULL) {
4850          fprintf(stderr, "Could not open output file\n");
4851          exit(1);
4852          }
4853#     else
4854        if ((OUTFILE = freopen("/dev/null", "w", stdout)) == NULL) {
4855          fprintf(stderr, "Could not open output file\n");
4856          exit(1);
4857          }
4858#     endif
4859
4860      open_link(& comm_master);
4861#   endif
4862
4863
4864/*  Get data structure memory  */
4865
4866    if (! (adef = (analdef *) Malloc(sizeof(analdef)))) {
4867      printf("ERROR: Unable to get memory for analysis definition\n\n");
4868      return 1;
4869      }
4870
4871    if (! (rdta = (rawdata *) Malloc(sizeof(rawdata)))) {
4872      printf("ERROR: Unable to get memory for raw DNA\n\n");
4873      return 1;
4874      }
4875
4876    if (! (cdta = (cruncheddata *) Malloc(sizeof(cruncheddata)))) {
4877      printf("ERROR: Unable to get memory for crunched DNA\n\n");
4878      return 1;
4879      }
4880
4881    if ((tr = (tree *)     Malloc(sizeof(tree))) &&
4882        (bt = (bestlist *) Malloc(sizeof(bestlist)))) ;
4883    else {
4884      printf("ERROR: Unable to get memory for trees\n\n");
4885      return 1;
4886      }
4887    bt->ninit = 0;
4888
4889    if (! getinput(adef, rdta, cdta, tr))                            return 1;
4890
4891#   if Master
4892      inputtime = p4_clock();
4893      printf("Input time %d milliseconds\n", inputtime - starttime);
4894      REPORT_STEP_TIME;
4895#   endif
4896
4897#   if Slave
4898      (void) fclose(INFILE);
4899#   endif
4900
4901/*  The material below would be a loop over jumbles and/or boots */
4902
4903    if (! makeweights(adef, rdta, cdta))                             return 1;
4904    if (! makevalues(rdta, cdta))                                    return 1;
4905    if (adef->empf && ! empiricalfreqs(rdta, cdta))                  return 1;
4906    reportfreqs(adef, rdta);
4907    if (! linkdata2tree(rdta, cdta, tr))                             return 1;
4908
4909    if (! linkxarray(3, 3, cdta->endsite, & freextip, & usedxtip))   return 1;
4910    if (! setupnodex(tr))                                            return 1;
4911
4912#   if Slave
4913      if (! slaveTreeEvaluate(tr, bt))                               return 1;
4914#   else
4915      if (! initBestTree(bt, adef->nkeep, tr->mxtips, tr->cdta->endsite))    return 1;
4916      if (! adef->usertree) {
4917        if (! makeDenovoTree(tr, bt, adef))                          return 1;
4918        }
4919      else {
4920        if (! makeUserTree(tr, bt, adef))                            return 1;
4921        }
4922      if (! freeBestTree(bt))                                        return 1;
4923#   endif
4924
4925/*  Endpoint for jumble and/or boot loop */
4926
4927#   if Master
4928      tr->likelihood = 1.0;             /* terminate slaves */
4929      (void) sendTree(& comm_slave, tr);
4930#   endif
4931
4932    freeTree(tr);
4933
4934#   if Master
4935      close_link(& comm_slave);
4936      (void) fclose(INFILE);
4937
4938      REPORT_STEP_TIME;
4939      endtime = p4_clock();
4940      printf("Execution time %d milliseconds\n", endtime - inputtime);
4941      (void) fclose(OUTFILE);
4942#   endif
4943
4944#   if Slave
4945      close_link(& comm_master);
4946      (void) fclose(OUTFILE);
4947#   endif
4948
4949#   if Debug
4950      (void) fclose(debug);
4951#   endif
4952
4953#   if Master || Slave
4954      p4_send(DNAML_DONE, DNAML_HOST_ID, NULL, 0);
4955#   else
4956      return 0;
4957#   endif
4958  } /* DNA Maximum Likelihood */
Note: See TracBrowser for help on using the repository browser.