source: branches/profile/GDE/FASTDNAML/fastDNAml.c

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