1 /*
2  *  MrBayes 3
3  *
4  *  (c) 2002-2013
5  *
6  *  John P. Huelsenbeck
7  *  Dept. Integrative Biology
8  *  University of California, Berkeley
9  *  Berkeley, CA 94720-3140
10  *  johnh@berkeley.edu
11  *
12  *  Fredrik Ronquist
13  *  Swedish Museum of Natural History
14  *  Box 50007
15  *  SE-10405 Stockholm, SWEDEN
16  *  fredrik.ronquist@nrm.se
17  *
18  *  With important contributions by
19  *
20  *  Paul van der Mark (paulvdm@sc.fsu.edu)
21  *  Maxim Teslenko (maxkth@gmail.com)
22  *  Chi Zhang (zhangchicool@gmail.com)
23  *
24  *  and by many users (run 'acknowledgments' to see more info)
25  *
26  * This program is free software; you can redistribute it and/or
27  * modify it under the terms of the GNU General Public License
28  * as published by the Free Software Foundation; either version 2
29  * of the License, or (at your option) any later version.
30  *
31  * This program is distributed in the hope that it will be useful,
32  * but WITHOUT ANY WARRANTY; without even the implied warranty of
33  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
34  * GNU General Public License for more details (www.gnu.org).
35  *
36  */
37 
38 #include "bayes.h"
39 #include "best.h"
40 #include "command.h"
41 #include "mcmc.h"
42 #include "model.h"
43 #include "proposal.h"
44 #include "utils.h"
45 
46 /* debugging compiler statements */
47 #undef  DEBUG_LOCAL
48 #undef  DEBUG_UNROOTED_SLIDER
49 #undef  DEBUG_ParsSPR
50 #undef  DEBUG_ExtSS
51 #undef  DEBUG_CSLIDER
52 #undef  DEBUG_ExtSPRClock
53 #undef  DEBUG_ParsSPRClock
54 #undef  DEBUG_ExtTBR
55 #undef  DEBUG_NNIClock
56 #undef  DEBUG_SPLITMERGE
57 #undef  DEBUG_FBDPR
58 
59 
60 extern int *chainId;
61 
62 void TouchAllTreeNodes (ModelInfo *m, int chain);
63 
64 
Move_Aamodel(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)65 int Move_Aamodel (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
66 {
67     /* Change amino acid model for model mixing
68        amino acid model ID's
69         AAMODEL_POISSON         0
70         AAMODEL_JONES           1
71         AAMODEL_DAY             2
72         AAMODEL_MTREV           3
73         AAMODEL_MTMAM           4
74         AAMODEL_WAG             5
75         AAMODEL_RTREV           6
76         AAMODEL_CPREV           7
77         AAMODEL_VT              8
78         AAMODEL_BLOSUM          9 */
79 
80     int         i, oldM, newM;
81     MrBFlt      *bs, *subValue;
82     ModelParams *mp;
83 
84     /* get model params */
85     mp = &modelParams[param->relParts[0]];
86 
87     subValue = GetParamSubVals(param, chain, state[chain]);
88 
89     /* get old value of model */
90     oldM = (int)*GetParamVals(param, chain, state[chain]);
91 
92     /* get a new model ID */
93     do {
94         newM = (int)(RandomNumber(seed) * 10);
95         }
96     while (newM == oldM);
97 
98     /* set proposal ratio */
99     *lnProposalRatio = 0.0;
100 
101     /* set prior ratio */
102     *lnPriorRatio = subValue[newM] - subValue[oldM];
103 
104     /* copy new amino acid model ID back */
105     *GetParamVals(param, chain, state[chain]) = (MrBFlt)newM;
106 
107     /* set amino acid frequencies */
108     bs = GetParamSubVals (modelSettings[param->relParts[0]].stateFreq, chain, state[chain]);
109     if (newM == AAMODEL_POISSON)
110         {
111         for (i=0; i<mp->nStates; i++)
112             bs[i] = 1.0 / 20.0;
113         }
114     else if (newM == AAMODEL_JONES)
115         {
116         for (i=0; i<mp->nStates; i++)
117             bs[i] = jonesPi[i];
118         }
119     else if (newM == AAMODEL_DAY)
120         {
121         for (i=0; i<mp->nStates; i++)
122             bs[i] = dayhoffPi[i];
123         }
124     else if (newM == AAMODEL_MTREV)
125         {
126         for (i=0; i<mp->nStates; i++)
127             bs[i] = mtrev24Pi[i];
128         }
129     else if (newM == AAMODEL_MTMAM)
130         {
131         for (i=0; i<mp->nStates; i++)
132             bs[i] = mtmamPi[i];
133         }
134     else if (newM == AAMODEL_WAG)
135         {
136         for (i=0; i<mp->nStates; i++)
137             bs[i] = wagPi[i];
138         }
139     else if (newM == AAMODEL_RTREV)
140         {
141         for (i=0; i<mp->nStates; i++)
142             bs[i] = rtrevPi[i];
143         }
144     else if (newM == AAMODEL_CPREV)
145         {
146         for (i=0; i<mp->nStates; i++)
147             bs[i] = cprevPi[i];
148         }
149     else if (newM == AAMODEL_VT)
150         {
151         for (i=0; i<mp->nStates; i++)
152             bs[i] = vtPi[i];
153         }
154     else if (newM == AAMODEL_BLOSUM)
155         {
156         for (i=0; i<mp->nStates; i++)
157             bs[i] = blosPi[i];
158         }
159 
160     /* Set update flags for all partitions that share this amino acid model. Note that the conditional
161        likelihood update flags have been set before we even call this function. */
162     for (i=0; i<param->nRelParts; i++)
163         TouchAllTreeNodes(&modelSettings[param->relParts[i]],chain);
164 
165     /* Set update flags for cijks for all affected partitions. */
166     for (i=0; i<param->nRelParts; i++)
167         modelSettings[param->relParts[i]].upDateCijk = YES;
168 
169     return (NO_ERROR);
170 }
171 
172 
Move_AddDeleteCPPEvent(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)173 int Move_AddDeleteCPPEvent (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
174 {
175     /* add or delete one Poisson process event */
176 
177     int         i, k, addEvent, *nEvents, numEvents;
178     MrBFlt      sigma, m, lognormalLnProb, **position, **rateMultiplier, length, pos, rate;
179     TreeNode    *p, *q;
180     ModelInfo   *model;
181     Tree        *t;
182 
183     /* get the model settings */
184     model = &modelSettings[param->relParts[0]];
185 
186     /* get cpp rate */
187     rate = *GetParamVals (model->cppRate, chain, state[chain]);
188 
189     /* get sigma of lognormal of rate multipliers */
190     sigma = *GetParamVals (model->cppMultDev, chain, state[chain]);
191 
192     /* get the cpp event data */
193     nEvents = param->nEvents[2*chain+state[chain]];
194     position = param->position[2*chain+state[chain]];
195     rateMultiplier = param->rateMult[2*chain+state[chain]];
196 
197     /* get tree */
198     t = GetTree (param, chain, state[chain]);
199 
200     /* pick a branch */
201     do
202         {
203         p = t->allDownPass[(int)(RandomNumber(seed) * (t->nNodes -2))];
204         } while (p->anc == NULL || (p->anc->anc == NULL));
205 
206     /* get number of events for convenience */
207     numEvents = nEvents[p->index];
208 
209     /* add or delete ? */
210     addEvent = NO;
211     if (numEvents == 0)
212         addEvent = YES;
213     else if (RandomNumber(seed) < 0.5)
214         addEvent = YES;
215 
216     if (addEvent == NO)
217         {
218         /* delete event */
219 
220         /* choose random event */
221         k = (int) (RandomNumber(seed) * numEvents);
222 
223         /* save multiplier to be deleted */
224         m = rateMultiplier[p->index][k];
225 
226         /* rearrange and reduce */
227         for (i=k; i<numEvents-1; i++)
228             {
229             position[p->index][i] = position[p->index][i+1];
230             rateMultiplier[p->index][i] = rateMultiplier[p->index][i+1];
231             }
232         if (numEvents-1 > 0)
233             {
234             position[p->index] = (MrBFlt *) SafeRealloc ((void *) position[p->index], (numEvents-1)*sizeof(MrBFlt));
235             rateMultiplier[p->index] = (MrBFlt *) SafeRealloc ((void *) rateMultiplier[p->index], (numEvents-1)*sizeof(MrBFlt));
236             assert (position[p->index] != NULL && rateMultiplier[p->index] != NULL);
237             }
238         else
239             {
240             free (position[p->index]);
241             free (rateMultiplier[p->index]);
242             position[p->index] = rateMultiplier[p->index] = NULL;
243             }
244         /* update number of events */
245         nEvents[p->index]--;
246         }
247     else /* if (addEvent == YES) */
248         {
249         /* add event */
250 
251         /* generate new multiplier */
252         m = LogNormalRandomVariable (0.0, sigma, seed);
253 
254         /* generate new position */
255         pos = RandomNumber(seed);
256 
257         /* find place in current array */
258         for (k=0; k<numEvents; k++)
259             {
260             if (position[p->index][k] > pos)
261                 break;
262             }
263 
264         /* rearrange and insert */
265         position[p->index] = (MrBFlt *) SafeRealloc ((void *)position[p->index], (numEvents+1)*sizeof(MrBFlt));
266         rateMultiplier[p->index] = (MrBFlt *) SafeRealloc ((void *)rateMultiplier[p->index], (numEvents+1)*sizeof(MrBFlt));
267         assert (position[p->index] != NULL && rateMultiplier[p->index] != NULL);
268         for (i=numEvents; i>k; i--)
269             {
270             position[p->index][i] = position[p->index][i-1];
271             rateMultiplier[p->index][i] = rateMultiplier[p->index][i-1];
272             }
273         position[p->index][k] = pos;
274         rateMultiplier[p->index][k] = m;
275 
276         /* update number of events */
277         nEvents[p->index]++;
278         }
279 
280     /* the CPP process is relative to expected substitutions */
281     length = p->length;
282 
283     lognormalLnProb = LnProbLogNormal(0.0, sigma, m);
284     if (addEvent == YES)
285         (*lnPriorRatio) = lognormalLnProb + log (rate);
286     else
287         (*lnPriorRatio) = -(lognormalLnProb + log(rate));
288 
289     if (addEvent == YES)
290         /* note that nEvents[p->index] now contains k+1 after addition */
291         (*lnProposalRatio) = log (length / ((double) nEvents[p->index])) - lognormalLnProb;
292     else
293         /* note that nEvents[p->index] contains k after deletion */
294         (*lnProposalRatio) = log ((double)(nEvents[p->index]+1) / length) + lognormalLnProb;
295 
296     /* take care of asymmetric add and delete probabilities around 0 and 1 events */
297     if (addEvent == YES && nEvents[p->index] == 1)
298         (*lnProposalRatio) += log (0.5);
299     else if (addEvent == NO && nEvents[p->index] == 0)
300         (*lnProposalRatio) += log (2.0);
301 
302     /* update evolLengths in subtree above new event */
303     if (UpdateCppEvolLengths (param, p, chain)==ERROR)
304         {
305         abortMove=YES;
306         return (NO_ERROR);
307         }
308 
309     /* set update of cond likes down to root */
310     /* crown tree update flags set in UpdateCppEvolLengths */
311     q = p->anc;
312     while (q->anc != NULL)
313         {
314         q->upDateCl = YES;
315         q = q->anc;
316         }
317 
318     return (NO_ERROR);
319 }
320 
321 
Move_Adgamma(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)322 int Move_Adgamma (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
323 {
324     /* Change correlation parameter (-1, 1) of adgamma model */
325 
326     int         i, isValidP;
327     MrBFlt      oldP, newP, window, minP, maxP, ran, *markovTiValues;
328     ModelParams *mp;
329 
330     /* get size of window, centered on current rho */
331     window = mvp[0];
332 
333     /* get model params */
334     mp = &modelParams[param->relParts[0]];
335 
336     /* get minimum and maximum values for rho */
337     minP = mp->corrUni[0];
338     maxP = mp->corrUni[1];
339 
340     /* get address of markovTi */
341     markovTiValues = GetParamSubVals (param, chain, state[chain]);
342 
343     /* get old value of rho */
344     oldP = *GetParamVals(param, chain, state[chain]);
345 
346     /* change value for rho */
347     ran = RandomNumber(seed);
348      if (maxP-minP < window)
349         {
350         window = maxP-minP;
351         }
352     newP = oldP + window * (ran - 0.5);
353 
354     /* check that new value is valid */
355     isValidP = NO;
356     do
357         {
358         if (newP < minP)
359             newP = 2* minP - newP;
360         else if (newP > maxP)
361             newP = 2 * maxP - newP;
362         else
363             isValidP = YES;
364         } while (isValidP == NO);
365 
366     /* get proposal ratio */
367     *lnProposalRatio = 0.0;
368 
369     /* get prior ratio */
370     *lnPriorRatio = 0.0;
371 
372     /* copy new rho value back */
373     *GetParamVals(param, chain, state[chain]) = newP;
374 
375     /* fill in new Markov trans probs */
376     AutodGamma (markovTiValues, newP, mp->numGammaCats);
377 
378     /* Set update flags for all partitions that share this rho. Note that the conditional
379        likelihood update flags have been set before we even call this function. */
380     for (i=0; i<param->nRelParts; i++)
381         TouchAllTreeNodes(&modelSettings[param->relParts[i]],chain);
382 
383     /* Update flags for divisions already set */
384 
385     return (NO_ERROR);
386 }
387 
388 
Move_Beta(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)389 int Move_Beta (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
390 {
391     /* change symmetric Dirichlet variance using multiplier */
392 
393     int         i, j, k, isValidB, isPriorExp, nStates;
394     MrBFlt      oldB, newB, minB, maxB, priorExp=0.0, *bs, ran, factor, tuning,
395                 x, y;
396     ModelParams *mp;
397 
398     /* get tuning parameter */
399     tuning = mvp[0];    /* multiplier tuning parameter lambda */
400 
401     /* get model paramaters */
402     mp = &modelParams[param->relParts[0]];
403 
404     /* get prior, minimum and maximum values for rate     */
405     if (!strcmp(mp->symPiPr,"Uniform"))
406         {
407         isPriorExp = NO;
408         minB = mp->symBetaUni[0];
409         maxB = mp->symBetaUni[1];
410         }
411     else
412         {
413         isPriorExp = YES;
414         priorExp = mp->symBetaExp;
415         minB = SYMPI_MIN;
416         maxB = SYMPI_MAX;
417         }
418 
419     /* get old value of symDir */
420     oldB = *GetParamVals(param, chain, state[chain]);
421 
422     /* change value */
423     ran = RandomNumber(seed);
424     factor = exp(tuning * (ran - 0.5));
425     newB = oldB * factor;
426 
427     /* check validity */
428     isValidB = NO;
429     do
430         {
431         if (newB < minB)
432             newB = minB * minB / newB;
433         else if (newB > maxB)
434             newB = maxB * maxB / newB;
435         else
436             isValidB = YES;
437         } while (isValidB == NO);
438 
439     /* set new value of symDir */
440     *GetParamVals(param, chain, state[chain]) = newB;
441 
442     /* get proposal ratio */
443     *lnProposalRatio = log (newB / oldB);
444 
445     /* get prior ratio */
446     if (isPriorExp == YES)
447         {
448         *lnPriorRatio = priorExp * (oldB - newB);
449         }
450     else
451         *lnPriorRatio = 0.0;
452 
453     /* fill in the new betacat frequencies */
454     bs = GetParamStdStateFreqs(param, chain, state[chain]);
455     k = mp->numBetaCats;
456     BetaBreaks (newB, newB, bs, k);
457     k *= 2;
458     for (i=k-2; i>0; i-=2)
459         {
460         bs[i] = bs[i/2];
461         }
462     for (i=1; i<k; i+=2)
463         {
464         bs[i] = 1.0 - bs[i-1];
465         }
466 
467     /* if there are multistate characters, update prior probability of current pis */
468     bs += 2 * mp->numBetaCats;
469     for (i=0; i<param->nSympi; i++)
470         {
471         /* get number of states */
472         nStates = param->sympinStates[i];
473 
474         /* get prior ratio update */
475         x = LnGamma(newB*nStates) - nStates*LnGamma(newB);
476         y = LnGamma(oldB*nStates) - nStates*LnGamma(oldB);
477         for (j=0; j<nStates; j++)
478             {
479             x += (newB-1.0)*log(bs[j]);
480             y += (oldB-1.0)*log(bs[j]);
481             }
482         (*lnPriorRatio) += x - y;
483 
484         /* update pointer to state freqs */
485         bs += nStates;
486         }
487 
488     /* Set update flags for all tree nodes. Note that the conditional
489        likelihood update flags have been set for the relevant partitions
490        before we even call the move function. */
491     for (i=0; i<param->nRelParts; i++)
492         TouchAllTreeNodes(&modelSettings[param->relParts[i]],chain);
493 
494     /* may need to hit update flag for cijks if we have multistate characters */
495     for (i=0; i<param->nRelParts; i++)
496         {
497         if (modelSettings[param->relParts[i]].nCijkParts > 0)
498             modelSettings[param->relParts[i]].upDateCijk = YES;
499         }
500 
501     return (NO_ERROR);
502 }
503 
504 
Move_BrLen(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)505 int Move_BrLen (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
506 {
507     /* change one branch length */
508 
509     MrBFlt      tuning, maxV, minV, m, newM, brlensPrExp=0.0;
510     TreeNode    *p;
511     ModelParams *mp;
512     Tree        *t;
513     int isVPriorExp;
514 
515     tuning = mvp[0]; /* Larget & Simon's tuning parameter lambda */
516 
517     mp = &modelParams[param->relParts[0]];
518 
519     /* max and min brlen */
520     if (param->paramId == BRLENS_UNI)
521         {
522         minV = mp->brlensUni[0];
523         maxV = mp->brlensUni[1];
524         isVPriorExp = NO;
525         }
526     else if (param->paramId == BRLENS_GamDir)
527         {
528         minV = BRLENS_MIN;
529         maxV = BRLENS_MAX;
530         isVPriorExp = 2;
531         }
532     else if (param->paramId == BRLENS_iGmDir)
533         {
534         minV = BRLENS_MIN;
535         maxV = BRLENS_MAX;
536         isVPriorExp = 3;
537         }
538     else if (param->paramId == BRLENS_twoExp)
539         {
540         minV = BRLENS_MIN;
541         maxV = BRLENS_MAX;
542         isVPriorExp = 4;
543         }
544     else
545         {
546         minV = BRLENS_MIN;
547         maxV = BRLENS_MAX;
548         brlensPrExp = mp->brlensExp;
549         isVPriorExp = YES;
550         }
551 
552     /* get tree */
553     t = GetTree (param, chain, state[chain]);
554 
555     /* Dirichlet or twoExp prior */
556     if (isVPriorExp > 1)
557         (*lnPriorRatio) = -LogDirPrior(t, mp, isVPriorExp);
558 
559     /* pick a branch */
560     do  {
561         p = t->allDownPass[(int)(RandomNumber(seed) * t->nNodes)];
562         }
563     while (p->anc == NULL || (t->isRooted == YES && p->anc->anc == NULL));
564 
565     /* determine new length */
566     m = p->length;
567     newM = m * exp(tuning * (RandomNumber(seed) - 0.5));
568 
569     /* reflect new length if necessary */
570     while (newM < minV || newM > maxV)
571         {
572         if (newM < minV)
573             newM = minV * minV / newM;
574         else if (newM > maxV)
575             newM = maxV * maxV / newM;
576         }
577     p->length = newM;
578 
579     /* calculate proposal ratio */
580     /* must be based on new length after reflection */
581     (*lnProposalRatio) = log(newM / m);
582 
583     /* set flags for update of transition probabilities at p */
584     p->upDateTi = YES;
585 
586     /* set the update flag for cond likes if p is connected to root in unrooted */
587     /* tree, if this is not done, cond likes are not updated in this case       */
588     if (t->isRooted == NO && p->anc->anc == NULL)
589         p->upDateCl = YES;
590 
591     /* set flags for update of cond likes from p->anc and down to root */
592     while (p->anc->anc != NULL)
593         {
594         p = p->anc;
595         p->upDateCl = YES;
596         }
597 
598     /* update prior if exponential prior on branch lengths */
599     if (param->paramId == BRLENS_EXP)
600         (*lnPriorRatio) = brlensPrExp * (m - newM);
601     /* Dirichlet or twoExp prior */
602     else if (isVPriorExp > 1)
603         (*lnPriorRatio) += LogDirPrior(t, mp, isVPriorExp);
604 
605     return (NO_ERROR);
606 }
607 
608 
Move_ClockRate_M(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)609 int Move_ClockRate_M (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
610 {
611     /* change clock rate using multiplier */
612 
613     int             i, j, k, *nEvents;
614     MrBFlt          oldRate, newRate, factor, lambda, nu, igrvar, *brlens, *igrRate, *tk02Rate,
615                     N, newTheta, oldTheta, growth, newLnPrior, oldLnPrior;
616     Tree            *t, *oldT;
617     TreeNode        *p, *q;
618     Param           *treeParam, *subParm;
619     ModelParams     *mp;
620     ModelInfo       *m;
621 
622     /* get old value of clock rate */
623     oldRate = *GetParamVals(param, chain, state[chain]);
624 
625     /* Rely on general algorithm to change the value */
626     Move_PosRealMultiplier(param, chain, seed, lnPriorRatio, lnProposalRatio, mvp);
627     if (abortMove == YES)
628         return NO_ERROR;
629 
630     /* get new value of clock rate */
631     newRate = *GetParamVals(param, chain, state[chain]);
632 
633     /* calculate factor */
634     factor = newRate / oldRate;
635 
636     /* clock rate applies to all clock trees */
637     for (i = 0; i < numTrees; i++)
638         {
639         t = GetTreeFromIndex(i, chain, state[chain]);
640         if (t->isClock == NO)
641             continue;
642         if (!strcmp(modelParams[t->relParts[0]].clockPr, "Fixed"))
643             continue;
644 
645         oldT = GetTreeFromIndex(i, chain, 1^state[chain]);
646         treeParam = modelSettings[t->relParts[0]].brlens;
647 
648         /* adjust the node depths and lengths */
649         for (j = 0; j < t->nNodes-1; j++)
650             {
651             p = t->allDownPass[j];
652             q = oldT->allDownPass[j];
653             p->nodeDepth *= factor; /* no harm done if nodeDepth==0.0 (undated tips) */
654             p->length *= factor;    /* no harm done if length==0.0 (root or fossil ancestors)*/
655             if (p->length < 0.0 || p->length > BRLENS_MAX ||
656                 (q->length > BRLENS_MIN && p->length < BRLENS_MIN) ||
657                 (q->length < TIME_MIN   && p->length > TIME_MIN))
658                 {  /* consider ancestral fossil (brl=0) in fossilized bd tree */
659                 abortMove = YES;
660                 return (NO_ERROR);
661                 }
662             }
663 
664         /* prior ratio for coalecent tree, as theta is changed */
665         mp = &modelParams[t->relParts[0]];
666         if (!strcmp(mp->clockPr,"Coalescence"))
667             {
668             m = &modelSettings[t->relParts[0]];
669             N = *GetParamVals(m->popSize, chain, state[chain]);
670             if (!strcmp(mp->ploidy, "Diploid"))
671                 N *= 4.0;
672             else if (!strcmp(mp->ploidy, "Zlinked"))
673                 N *= 3.0;
674             else
675                 N *= 2.0;
676             oldTheta = N * oldRate;
677             newTheta = N * newRate;
678             if (!strcmp(mp->growthPr, "Fixed"))
679                 growth = mp->growthFix;
680             else
681                 growth = *GetParamVals(m->growthRate, chain, state[chain]);
682 
683             if (LnCoalescencePriorPr (oldT, &oldLnPrior, oldTheta, growth) == ERROR)
684                 {
685                 MrBayesPrint ("%s   Problem calculating prior for coalescent process\n", spacer);
686                 return (ERROR);
687                 }
688             if (LnCoalescencePriorPr (t, &newLnPrior, newTheta, growth) == ERROR)
689                 {
690                 MrBayesPrint ("%s   Problem calculating prior for coalescent process\n", spacer);
691                 return (ERROR);
692                 }
693             (*lnPriorRatio) += newLnPrior - oldLnPrior;
694             }
695 
696         /* adjust proposal and prior ratio for relaxed clock models */
697         for (k = 0; k < treeParam->nSubParams; k++)
698             {
699             subParm = treeParam->subParams[k];
700             if (subParm->paramType == P_CPPEVENTS)
701                 {
702                 nEvents = subParm->nEvents[2*chain+state[chain]];
703                 lambda = *GetParamVals (modelSettings[subParm->relParts[0]].cppRate, chain, state[chain]);
704                 /* proposal ratio */
705                 for (j=0; j<t->nNodes-2; j++)
706                     {
707                     p = t->allDownPass[j];
708                     q = oldT->allDownPass[j];
709                     (*lnProposalRatio) += nEvents[p->index ] * log (p->length  / q->length);
710                     }
711                 /* prior ratio */
712                 (*lnPriorRatio) += lambda * (TreeLen(oldT) - TreeLen(t));
713                 /* update effective evolutionary lengths */
714                 if (UpdateCppEvolLengths (subParm, t->root->left, chain) == ERROR)
715                     {
716                     abortMove = YES;
717                     return (NO_ERROR);
718                     }
719                 }
720             else if ( subParm->paramType == P_TK02BRANCHRATES ||
721                      (subParm->paramType == P_MIXEDBRCHRATES && *GetParamIntVals(subParm, chain, state[chain]) == RCL_TK02))
722                 {
723                 if (subParm->paramType == P_TK02BRANCHRATES)
724                     nu = *GetParamVals (modelSettings[subParm->relParts[0]].tk02var, chain, state[chain]);
725                 else
726                     nu = *GetParamVals (modelSettings[subParm->relParts[0]].mixedvar, chain, state[chain]);
727                 tk02Rate = GetParamVals (subParm, chain, state[chain]);
728                 brlens = GetParamSubVals (subParm, chain, state[chain]);
729 
730                 /* no proposal ratio effect */
731 
732                 /* prior ratio and update of brlens */
733                 for (j = 0; j < t->nNodes-2; j++)
734                     {
735                     p = t->allDownPass[j];
736                     q = oldT->allDownPass[j];
737                     if (p->length > 0.0)  // not ancestral fossil
738                         {
739                         (*lnPriorRatio) -= LnProbTK02LogNormal (tk02Rate[q->anc->index], nu*q->length, tk02Rate[q->index]);
740                         (*lnPriorRatio) += LnProbTK02LogNormal (tk02Rate[p->anc->index], nu*p->length, tk02Rate[p->index]);
741 
742                         brlens[p->index] = p->length * (tk02Rate[p->anc->index]+tk02Rate[p->index])/2.0;
743                         }
744                     }
745                 }
746             else if ( subParm->paramType == P_IGRBRANCHRATES ||
747                      (subParm->paramType == P_MIXEDBRCHRATES && *GetParamIntVals(subParm, chain, state[chain]) == RCL_IGR))
748                 {
749                 if (subParm->paramType == P_IGRBRANCHRATES)
750                     igrvar = *GetParamVals (modelSettings[subParm->relParts[0]].igrvar, chain, state[chain]);
751                 else
752                     igrvar = *GetParamVals (modelSettings[subParm->relParts[0]].mixedvar, chain, state[chain]);
753                 igrRate = GetParamVals (subParm, chain, state[chain]);
754                 brlens = GetParamSubVals (subParm, chain, state[chain]);
755 
756                 /* prior ratio and update of brlens */
757                 for (j = 0; j < t->nNodes-2; j++)
758                     {
759                     p = t->allDownPass[j];
760                     q = oldT->allDownPass[j];
761                     if (p->length > 0.0)  // not ancestral fossil
762                         {
763                         (*lnPriorRatio) -= LnProbGamma (q->length/igrvar, q->length/igrvar, igrRate[q->index]);
764                         (*lnPriorRatio) += LnProbGamma (p->length/igrvar, p->length/igrvar, igrRate[p->index]);
765 
766                         brlens[p->index] = igrRate[p->index] * p->length;
767                         }
768                     }
769                 }
770             }
771         }
772 
773     return (NO_ERROR);
774 }
775 
776 
Move_CPPEventPosition(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)777 int Move_CPPEventPosition (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
778 {
779     /* move the position of one CPP event */
780 
781     int         i, j, k, *nEvents;
782     MrBFlt      pos, temp, **position, **rateMultiplier;
783     TreeNode    *p=NULL, *q;
784     Tree        *t;
785 
786     /* get the cpp event data */
787     nEvents = param->nEvents[2*chain+state[chain]];
788     position = param->position[2*chain+state[chain]];
789     rateMultiplier = param->rateMult[2*chain+state[chain]];
790 
791     /* get tree */
792     t = GetTree (param, chain, state[chain]);
793 
794     /* pick a branch and an event */
795     for (i=j=0; i<t->nNodes - 2; i++)
796         {
797         p = t->allDownPass[i];
798         j += nEvents[p->index];
799         }
800     if (j == 0)
801         {
802         abortMove = YES;
803         return (NO_ERROR);
804         }
805     k = (int) (RandomNumber(seed) * j);
806     for (i=j=0; i<t->nNodes - 2; i++)
807         {
808         p = t->allDownPass[i];
809         j += nEvents[p->index];
810         if (j > k)
811             break;
812         }
813     if (position[p->index] == NULL)
814         getchar();
815 
816     /* find local index */
817     k = k - (j - nEvents[p->index]);
818 
819     /* find new position */
820     pos = RandomNumber(seed);
821     if (pos < POS_MIN || 1.0 - pos < POS_MIN)
822         {
823         abortMove = YES;
824         return (NO_ERROR);
825         }
826     position[p->index][k] = pos;
827 
828     /* sort events; bubble sort for now */
829     for (i=0; i<nEvents[p->index]; i++)
830         {
831         for (j=i+1; j<nEvents[p->index]; j++)
832             {
833             if (position[p->index][j] < position[p->index][i])
834                 {
835                 temp = position[p->index][i];
836                 position[p->index][i] = position[p->index][j];
837                 position[p->index][j] = temp;
838                 temp = rateMultiplier[p->index][i];
839                 rateMultiplier[p->index][i] = rateMultiplier[p->index][j];
840                 rateMultiplier[p->index][j] = temp;
841                 }
842             }
843         }
844 
845     /* calculate prior and proposal ratio */
846     (*lnPriorRatio) = (*lnProposalRatio) = 0.0;
847 
848     /* update branch evolution lengths */
849     if (UpdateCppEvolLengths (param, p, chain) == ERROR)
850         {
851         abortMove = YES;
852         return (NO_ERROR);
853         }
854 
855     /* set update of cond likes down to root */
856     /* update of crowntree set in UpdateCppEvolLengths */
857     q = p->anc;
858     while (q->anc != NULL)
859         {
860         q->upDateCl = YES;
861         q = q->anc;
862         }
863 
864     return (NO_ERROR);
865 }
866 
867 
Move_CPPRate(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)868 int Move_CPPRate (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
869 {
870     /* move the CPP rate (lambda) using multiplier */
871 
872     int         i, j, *nEvents, sumEvents;
873     MrBFlt      oldLambda, newLambda, treeLength, tuning;
874     Model       *mp;
875     TreeNode    *p;
876     Tree        *t;
877 
878     /* get tuning parameter */
879     tuning = mvp[0];
880 
881     /* get model params */
882     mp = &modelParams[param->relParts[0]];
883 
884     /* get the CPP rate */
885     oldLambda = *GetParamVals (param, chain, state[chain]);
886 
887     /* set new value */
888     newLambda = oldLambda * exp ((0.5 - RandomNumber(seed))*tuning);
889 
890     /* reflect if necessary */
891     while (newLambda < CPPLAMBDA_MIN || newLambda > CPPLAMBDA_MAX)
892         {
893         if (newLambda < CPPLAMBDA_MIN)
894             newLambda = CPPLAMBDA_MIN * CPPLAMBDA_MIN / newLambda;
895         if (newLambda > CPPLAMBDA_MAX)
896             newLambda = CPPLAMBDA_MAX * CPPLAMBDA_MAX / newLambda;
897         }
898 
899     /* store new value */
900     (*GetParamVals (param, chain, state[chain])) = newLambda;
901 
902     /* calculate prior ratio */
903     (*lnPriorRatio) = 0.0;
904     for (i=0; i<param->nSubParams; i++)
905         {
906         nEvents = param->subParams[i]->nEvents[2*chain+state[chain]];
907         sumEvents = 0;
908         t = GetTree (param->subParams[i], chain, state[chain]);
909         treeLength = 0.0;
910         for (j=0; j<t->nNodes-2; j++)
911             {
912             p = t->allDownPass[j];
913             sumEvents += nEvents[p->index];
914             treeLength += p->length;
915             }
916         (*lnPriorRatio) += (oldLambda - newLambda) * treeLength;
917         (*lnPriorRatio) += sumEvents * log (newLambda / oldLambda);
918         }
919 
920     /* adjust for prior on cppRate */
921     if (!strcmp(mp->cppRatePr,"Exponential"))
922         (*lnPriorRatio) +=  mp->cppRateExp * (oldLambda - newLambda);
923 
924     /* calculate proposal ratio */
925     (*lnProposalRatio) = log (newLambda / oldLambda);
926 
927     /* we do not need to update likelihoods */
928     for (i=0; i<param->nRelParts; i++)
929         {
930         modelSettings[param->relParts[i]].upDateCl = NO;
931         }
932 
933     return (NO_ERROR);
934 }
935 
936 
Move_CPPRateMultiplier_M(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)937 int Move_CPPRateMultiplier_M (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
938 {
939     /* move one CPP rate multiplier using multiplier */
940 
941     int         i, j, k, *nEvents;
942     MrBFlt      newRateMultiplier, oldRateMultiplier, tuning, minM, maxM, sigma, **rateMultiplier;
943     TreeNode    *p = NULL;
944     ModelInfo   *m;
945     Tree        *t;
946     TreeNode    *q;
947 
948     /* get the tuning parameter */
949     tuning = mvp[0];
950 
951     /* get the model settings */
952     m = &modelSettings[param->relParts[0]];
953 
954     /* get tree */
955     t = GetTree (param, chain, state[chain]);
956 
957     /* get CPP event data */
958     nEvents = param->nEvents[2*chain+state[chain]];
959     rateMultiplier = param->rateMult[2*chain+state[chain]];
960 
961     /* get minimum and maximum of CPP rate multiplier */
962     minM = param->min;
963     maxM = param->max;
964 
965     /* pick a branch and a rateMultiplier */
966     for (i=j=0; i<t->nNodes - 2; i++)
967         {
968         p = t->allDownPass[i];
969         j += nEvents[p->index];
970         }
971     if (j == 0)
972         {
973         abortMove = YES;
974         return (NO_ERROR);
975         }
976     k = (int) (RandomNumber(seed) * j);
977     for (i=j=0; i<t->nNodes - 2; i++)
978         {
979         p = t->allDownPass[i];
980         j += nEvents[p->index];
981         if (j > k)
982             break;
983         }
984 
985     /* find local index */
986     k = nEvents[p->index] - (j - k);
987 
988     /* find new rateMultiplier */
989     oldRateMultiplier = rateMultiplier[p->index][k];
990     newRateMultiplier = oldRateMultiplier * (exp (0.5 - RandomNumber(seed) * tuning));
991 
992     /* reflect if necessary */
993     while (newRateMultiplier < minM || newRateMultiplier > maxM)
994         {
995         if (newRateMultiplier < minM)
996             newRateMultiplier = minM * minM / newRateMultiplier;
997         if (newRateMultiplier > maxM)
998             newRateMultiplier = maxM * maxM / newRateMultiplier;
999         }
1000 
1001     rateMultiplier[p->index][k] = newRateMultiplier;
1002 
1003     /* calculate prior ratio */
1004     sigma = *GetParamVals (m->cppMultDev, chain, state[chain]);
1005     (*lnPriorRatio) = LnRatioLogNormal (0.0, sigma, newRateMultiplier, oldRateMultiplier);
1006 
1007     /* calculate proposal ratio */
1008     (*lnProposalRatio) = log (newRateMultiplier / oldRateMultiplier);
1009 
1010     /* update branch evolution lengths */
1011     if (UpdateCppEvolLengths (param, p, chain)==ERROR)
1012         {
1013         abortMove = YES;
1014         return (NO_ERROR);
1015         }
1016 
1017     /* set update of cond likes down to root */
1018     /* update of crowntree set in UpdateCppEvolLengths */
1019     q = p->anc;
1020     while (q->anc != NULL)
1021         {
1022         q->upDateCl = YES;
1023         q = q->anc;
1024         }
1025 
1026     return (NO_ERROR);
1027 }
1028 
1029 
Move_CPPRateMultiplierRnd(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)1030 int Move_CPPRateMultiplierRnd (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
1031 {
1032     /* move one CPP rate multiplier by redrawing from prior */
1033 
1034     int         i, j, k, *nEvents;
1035     MrBFlt      sigma, newRateMultiplier, oldRateMultiplier, **rateMultiplier;
1036     TreeNode    *p=NULL, *q;
1037     ModelInfo   *m;
1038     Tree        *t;
1039 
1040     /* get the model settings */
1041     m = &modelSettings[param->relParts[0]];
1042 
1043     /* get the CPP event data */
1044     nEvents = param->nEvents[2*chain+state[chain]];
1045     rateMultiplier = param->rateMult[2*chain+state[chain]];
1046 
1047     /* get tree */
1048     t = GetTree (param, chain, state[chain]);
1049 
1050     /* pick a branch and a rateMultiplier */
1051     for (i=j=0; i<t->nNodes - 2; i++)
1052         {
1053         p = t->allDownPass[i];
1054         j += nEvents[p->index];
1055         }
1056     if (j == 0)
1057         {
1058         abortMove = YES;
1059         return (NO_ERROR);
1060         }
1061     k = (int) (RandomNumber(seed) * j);
1062     for (i=j=0; i<t->nNodes - 2; i++)
1063         {
1064         p = t->allDownPass[i];
1065         j += nEvents[p->index];
1066         if (j > k)
1067             break;
1068         }
1069 
1070     /* find local index */
1071     k = nEvents[p->index] - (j - k);
1072 
1073     /* record old rate multiplier */
1074     oldRateMultiplier = rateMultiplier[p->index][k];
1075 
1076     /* find stdev of lognormal */
1077     sigma = *GetParamVals (m->cppMultDev, chain, state[chain]);
1078 
1079     /* set new value */
1080     do {
1081         newRateMultiplier = LogNormalRandomVariable (0.0, sigma, seed);
1082         } while (newRateMultiplier < param->min || newRateMultiplier > param->max);
1083     rateMultiplier[p->index][k] = newRateMultiplier;
1084 
1085     /* calculate prior ratio */
1086     (*lnPriorRatio) = LnRatioLogNormal(0.0, sigma, newRateMultiplier, oldRateMultiplier);
1087 
1088     /* calculate proposal ratio */
1089     (*lnProposalRatio) += LnRatioLogNormal (0.0, sigma, oldRateMultiplier, newRateMultiplier);
1090 
1091     /* update branch evolution lengths */
1092     if (UpdateCppEvolLengths (param, p, chain) == ERROR)
1093         {
1094         abortMove = YES;
1095         return (NO_ERROR);
1096         }
1097 
1098     /* set update of cond likes down to root */
1099     /* update of crowntree set in UpdateCppEvolLengths */
1100     q = p->anc;
1101     while (q->anc != NULL)
1102         {
1103         q->upDateCl = YES;
1104         q = q->anc;
1105         }
1106 
1107     return (NO_ERROR);
1108 }
1109 
1110 
Move_AddBranch(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)1111 int Move_AddBranch (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
1112 {
1113     /* Move an ancestral fossil (brl = 0) to fossil tip (brl > 0)
1114 
1115        __|__              __|__
1116       |     |            |     |
1117             |       -->       q|___
1118             |       -->        |   |
1119            q|___p              |   |p
1120            r|                 r|
1121 
1122        1. Pich a fossil among those with brl = 0 (prob = 1/k)
1123        2. Propose brl from a uniform(0, ?) distribution
1124      */
1125 
1126     int    i, j, k, mFossil, kFossil;
1127     MrBFlt minDepth, maxDepth, newLength, clockRate, x, oldQLength, oldRLength,
1128            *brlens=NULL, nu=0.0, *tk02Rate=NULL, igrvar=0.0, *igrRate=NULL;
1129     TreeNode    *p=NULL, *q=NULL, *r;
1130     Tree        *t;
1131     ModelParams *mp;
1132     ModelInfo   *m;
1133     Param       *subParm;
1134     Calibration *calibrationPtr = NULL;
1135 
1136     (*lnProposalRatio) = (*lnPriorRatio) = 0.0;
1137 
1138     /* get tree */
1139     t = GetTree (param, chain, state[chain]);
1140 
1141     /* get number of ancestral and tip fossils */
1142     kFossil = mFossil = 0;
1143     for (i = 0; i < t->nNodes -1; i++)
1144         {
1145         p = t->allDownPass[i];
1146         p->marked = NO;  // reset marked node
1147         if (p->left == NULL && p->right == NULL && p->nodeDepth > 0.0)
1148             {
1149             if (p->length > 0.0)
1150                 {
1151                 mFossil++;        // count tip fossil
1152                 }
1153             else
1154                 {
1155                 p->marked = YES;  // mark  anc fossil
1156                 kFossil++;        // count anc fossil
1157                 }
1158             }
1159         }
1160     if (kFossil == 0)  // no ancestral fossil, nothing to do
1161         {
1162         abortMove = YES;
1163         return (NO_ERROR);
1164         }
1165 
1166     /* get model params and model info */
1167     mp = &modelParams[param->relParts[0]];
1168     m = &modelSettings[param->relParts[0]];
1169 
1170     /* get clock rate */
1171     clockRate = *(GetParamVals(m->clockRate, chain, state[chain]));
1172 
1173     /* pick an ancestral fossil randomly */
1174     j = (int) (RandomNumber(seed) * kFossil);
1175     for (i = k = 0; i < t->nNodes -1; i++)
1176         {
1177         p = t->allDownPass[i];
1178         if (p->marked == YES)
1179             k++;
1180         if (k > j)
1181             break;
1182         }
1183     /* now p is pointing to the ancestral fossil
1184        whose brl needs to be changed to >0. let's do it! */
1185     q = p->anc;
1186     if (q->left == p)
1187         r = q->right;
1188     else
1189         r = q->left;
1190 
1191     /* determine lower and upper bound of forward move, abort if impossible */
1192     minDepth = p->nodeDepth + BRLENS_MIN;
1193     if (q->anc->anc == NULL)
1194         maxDepth = TREEHEIGHT_MAX;
1195     else
1196         maxDepth = q->anc->nodeDepth - BRLENS_MIN;
1197 
1198     if (q->isDated == YES)
1199         calibrationPtr = q->calibration;
1200     else if (q->anc->anc == NULL)  // q is root but not dated
1201         calibrationPtr = &mp->treeAgePr;
1202 
1203     if (calibrationPtr != NULL)
1204         {
1205         if (calibrationPtr->prior == fixed || calibrationPtr->min * clockRate > minDepth)
1206             {
1207             abortMove = YES;
1208             return (NO_ERROR);
1209             }
1210         if (calibrationPtr->max * clockRate < maxDepth)
1211             maxDepth = calibrationPtr->max * clockRate;
1212         }
1213     if (minDepth >= maxDepth)
1214         {
1215         abortMove = YES;
1216         return (NO_ERROR);
1217         }
1218 
1219     /* record old lengths and depths */
1220     oldQLength = q->length;
1221     oldRLength = r->length;
1222     // oldDepth = q->nodeDepth;
1223 
1224     /* propose the branch length leading to the fossil */
1225     newLength = (RandomNumber(seed)) * (maxDepth - minDepth);
1226 
1227     /* adjust brls and depths, set flags for update of trans probs */
1228     p->length   = newLength;
1229     p->upDateTi = YES;
1230     q->nodeDepth += newLength;
1231     if (q->anc->anc != NULL)
1232         {
1233         q->length  -= newLength;
1234         q->upDateTi = YES;
1235         }
1236     r->length += newLength;
1237     r->upDateTi = YES;
1238     // newDepth = q->nodeDepth;
1239 
1240     /* adjust age of q if dated */
1241     if (calibrationPtr != NULL)
1242         {
1243         q->age = q->nodeDepth / clockRate;
1244         }
1245 
1246     /* set flags for update of cond likes from p/r to root */
1247     r->upDateCl = YES;
1248     q = p;
1249     while (q->anc != NULL)
1250         {
1251         q->upDateCl = YES;
1252         q = q->anc;
1253         }
1254     q = p->anc;
1255 
1256     /* calculate prior ratio */
1257     if (LogClockTreePriorRatio(param, chain, &x) == ERROR)
1258         return (ERROR);
1259     (*lnPriorRatio) += x;
1260 
1261     /* calculate proposal ratio; because we abort in the extreme conditions (k == 0 and m == 0), no correction for this needed */
1262     /* note that we assume here that the relative proposal probabilities are the same for the add move and the delete move */
1263     (*lnProposalRatio) = log(kFossil) - log(mFossil +1);
1264 
1265     /* add the Jacobian term */
1266     (*lnProposalRatio) += log((maxDepth - minDepth) / clockRate);
1267 
1268     /* adjust proposal and prior ratio for relaxed clock models */
1269     for (i=0; i<param->nSubParams; i++)
1270         {
1271         subParm = param->subParams[i];
1272         if (subParm->paramType == P_CPPEVENTS)
1273             {
1274             /* CPP is not compatible with FBD ancestral fossils until we have a good way to implement it !! */
1275             MrBayesPrint ("%s   CPP clock is not compatible with Fossilization prior currently\n", spacer);
1276             return (ERROR);
1277             }
1278         else if ( subParm->paramType == P_TK02BRANCHRATES ||
1279                  (subParm->paramType == P_MIXEDBRCHRATES && *GetParamIntVals(subParm, chain, state[chain]) == RCL_TK02))
1280             {
1281             if (subParm->paramType == P_TK02BRANCHRATES)
1282                 nu = *GetParamVals (modelSettings[subParm->relParts[0]].tk02var, chain, state[chain]);
1283             else
1284                 nu = *GetParamVals (modelSettings[subParm->relParts[0]].mixedvar, chain, state[chain]);
1285             tk02Rate = GetParamVals (subParm, chain, state[chain]);
1286             brlens = GetParamSubVals (subParm, chain, state[chain]);
1287 
1288             /* prior ratio */
1289             tk02Rate[p->index] = tk02Rate[q->index];
1290             (*lnPriorRatio) -= LnProbTK02LogNormal (tk02Rate[q->index], nu*oldRLength, tk02Rate[r->index]);
1291             (*lnPriorRatio) += LnProbTK02LogNormal (tk02Rate[q->index], nu* p->length, tk02Rate[p->index]);
1292             (*lnPriorRatio) += LnProbTK02LogNormal (tk02Rate[q->index], nu* r->length, tk02Rate[r->index]);
1293             if (q->anc->anc != NULL)
1294                 {
1295                 (*lnPriorRatio) -= LnProbTK02LogNormal (tk02Rate[q->anc->index], nu*oldQLength, tk02Rate[q->index]);
1296                 (*lnPriorRatio) += LnProbTK02LogNormal (tk02Rate[q->anc->index], nu* q->length, tk02Rate[q->index]);
1297                 }
1298 
1299             /* update effective evolutionary lengths */
1300             brlens[p->index] = p->length * (tk02Rate[p->index]+tk02Rate[q->index])/2.0;
1301             brlens[r->index] = r->length * (tk02Rate[r->index]+tk02Rate[q->index])/2.0;
1302             if (q->anc->anc != NULL)
1303                 {
1304                 brlens[q->index] = q->length * (tk02Rate[q->index]+tk02Rate[q->anc->index])/2.0;
1305                 }
1306             }
1307         else if ( subParm->paramType == P_IGRBRANCHRATES ||
1308                  (subParm->paramType == P_MIXEDBRCHRATES && *GetParamIntVals(subParm, chain, state[chain]) == RCL_IGR))
1309             {
1310             if (subParm->paramType == P_IGRBRANCHRATES)
1311                 igrvar = *GetParamVals (modelSettings[subParm->relParts[0]].igrvar, chain, state[chain]);
1312             else
1313                 igrvar = *GetParamVals (modelSettings[subParm->relParts[0]].mixedvar, chain, state[chain]);
1314             igrRate = GetParamVals (subParm, chain, state[chain]);
1315             brlens = GetParamSubVals (subParm, chain, state[chain]);
1316 
1317             /* prior ratio */
1318             igrRate[p->index] = igrRate[q->index];
1319             (*lnPriorRatio) -= LnProbGamma (oldRLength/igrvar, oldRLength/igrvar, igrRate[r->index]);
1320             (*lnPriorRatio) += LnProbGamma (p->length /igrvar, p->length /igrvar, igrRate[p->index]);
1321             (*lnPriorRatio) += LnProbGamma (r->length /igrvar, r->length /igrvar, igrRate[r->index]);
1322             if (q->anc->anc != NULL)
1323                 {
1324                 (*lnPriorRatio) -= LnProbGamma (oldQLength/igrvar, oldQLength/igrvar, igrRate[q->index]);
1325                 (*lnPriorRatio) += LnProbGamma (q->length /igrvar, q->length /igrvar, igrRate[q->index]);
1326                 }
1327 
1328             /* update effective evolutionary lengths */
1329             brlens[p->index] = igrRate[p->index] * p->length;
1330             brlens[r->index] = igrRate[r->index] * r->length;
1331             if (q->anc->anc != NULL)
1332                 {
1333                 brlens[q->index] = igrRate[q->index] * q->length;
1334                 }
1335             }
1336         }
1337 
1338     return (NO_ERROR);
1339 }
1340 
1341 
Move_DelBranch(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)1342 int Move_DelBranch (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
1343 {
1344     /* Move a fossil tip (brl > 0) to be ancestral (brl =0)
1345 
1346        __|__              __|__
1347       |     |            |     |
1348            q|___     -->       |
1349             |   |    -->       |
1350             |   |p            q|___p
1351            r|                 r|
1352 
1353        1. Pich a fossil among those with brl > 0 (prob = 1/m)
1354        2. Set brl = 0
1355      */
1356 
1357     int    i, j, k, mFossil, kFossil;
1358     MrBFlt minDepth, maxDepth, clockRate, x, oldPLength, oldQLength, oldRLength,
1359            *brlens=NULL, nu=0.0, *tk02Rate=NULL, igrvar=0.0, *igrRate=NULL;
1360     TreeNode    *p=NULL, *q=NULL, *r;
1361     Tree        *t;
1362     ModelParams *mp;
1363     ModelInfo   *m;
1364     Param       *subParm;
1365     Calibration *calibrationPtr = NULL;
1366 
1367     (*lnProposalRatio) = (*lnPriorRatio) = 0.0;
1368 
1369     /* get tree */
1370     t = GetTree (param, chain, state[chain]);
1371 
1372     /* get number of ancestral and tip fossils */
1373     kFossil = mFossil = 0;
1374     for (i = 0; i < t->nNodes -1; i++)
1375         {
1376         p = t->allDownPass[i];
1377         p->marked = NO;  // reset marked node
1378         if (p->left == NULL && p->right == NULL && p->nodeDepth > 0.0)
1379             {
1380             if (p->length > 0.0)
1381                 {
1382                 p->marked = YES;  // mark  tip fossil
1383                 mFossil++;        // count tip fossil
1384                 }
1385             else
1386                 {
1387                 kFossil++;        // count anc fossil
1388                 }
1389             }
1390         }
1391     if (mFossil == 0)  // no tip fossil, nothing to do
1392         {
1393         abortMove = YES;
1394         return (NO_ERROR);
1395         }
1396 
1397     /* get model params and model info */
1398     mp = &modelParams[param->relParts[0]];
1399     m = &modelSettings[param->relParts[0]];
1400 
1401     /* get clock rate */
1402     clockRate = *(GetParamVals(m->clockRate, chain, state[chain]));
1403 
1404     /* pick a tip fossil randomly */
1405     j = (int) (RandomNumber(seed) * mFossil);
1406     for (i = k = 0; i < t->nNodes -1; i++)
1407         {
1408         p = t->allDownPass[i];
1409         if (p->marked == YES)
1410             k++;
1411         if (k > j)
1412             break;
1413         }
1414     /* now p is pointing to the fossil tip
1415        whose brl needs to be changed to 0. let's do it */
1416     q = p->anc;
1417     if (q->left == p)
1418         r = q->right;
1419     else
1420         r = q->left;
1421 
1422     /* determine lower and upper bound of backward move, abort if impossible */
1423     minDepth = p->nodeDepth + BRLENS_MIN;
1424     if (q->anc->anc == NULL)
1425         maxDepth = TREEHEIGHT_MAX;
1426     else
1427         maxDepth = q->anc->nodeDepth - BRLENS_MIN;
1428 
1429     if (q->isDated == YES)
1430         calibrationPtr = q->calibration;
1431     else if (q->anc->anc == NULL)  // q is root but not dated
1432         calibrationPtr = &mp->treeAgePr;
1433 
1434     if (calibrationPtr != NULL)
1435         {
1436         if (calibrationPtr->prior == fixed || calibrationPtr->min * clockRate > minDepth)
1437             {
1438             abortMove = YES;
1439             return (NO_ERROR);
1440             }
1441         if (calibrationPtr->max * clockRate < maxDepth)
1442             maxDepth = calibrationPtr->max * clockRate;
1443         }
1444     if (r->nodeDepth > p->nodeDepth -BRLENS_MIN || minDepth >= maxDepth)
1445         {  /* the sister node (another fossil) is older than the current fossil */
1446         abortMove = YES;
1447         return (NO_ERROR);
1448         }
1449 
1450     /* record old lengths and depths */
1451     oldPLength = p->length;
1452     oldQLength = q->length;
1453     oldRLength = r->length;
1454     // oldDepth = q->nodeDepth;
1455 
1456     /* set the brl to 0 for the fossil tip, it becomes an ancestral fossil */
1457     /* set flags for update of transition probabilities too */
1458     q->nodeDepth = p->nodeDepth;
1459     if (q->anc->anc != NULL)
1460         {
1461         q->length += p->length;
1462         q->upDateTi = YES;
1463         }
1464     r->length  -= p->length;
1465     r->upDateTi = YES;
1466     p->length   = 0.0;
1467     p->upDateTi = YES;
1468     // newDepth = q->nodeDepth;
1469 
1470     /* adjust age of q if dated */
1471     if (calibrationPtr != NULL)
1472         {
1473         q->age = q->nodeDepth / clockRate;
1474         }
1475 
1476     /* set flags for update of cond likes from p/r to root */
1477     r->upDateCl = YES;
1478     q = p;
1479     while (q->anc != NULL)
1480         {
1481         q->upDateCl = YES;
1482         q = q->anc;
1483         }
1484     q = p->anc;
1485 
1486     /* calculate prior ratio */
1487     if (LogClockTreePriorRatio(param, chain, &x) == ERROR)
1488         return (ERROR);
1489     (*lnPriorRatio) += x;
1490 
1491     /* calculate proposal ratio; since we abort in the extreme cases (m == 0 and k == 0), no need to correct for these */
1492     /* note that we assume that the add and del move have the same relative proposal prob */
1493     (*lnProposalRatio) = log(mFossil) - log(kFossil +1);
1494 
1495     /* add the Jacobian term */
1496     (*lnProposalRatio) -= log((maxDepth - minDepth) / clockRate);
1497 
1498     /* adjust proposal and prior ratio for relaxed clock models */
1499     for (i=0; i<param->nSubParams; i++)
1500         {
1501         subParm = param->subParams[i];
1502         if (subParm->paramType == P_CPPEVENTS)
1503             {
1504             /* CPP is not compatible with FBD ancestral fossils until we have a good way to implement it !! */
1505             MrBayesPrint ("%s   CPP clock is not compatible with Fossilization prior currently\n", spacer);
1506             return (ERROR);
1507             }
1508         else if ( subParm->paramType == P_TK02BRANCHRATES ||
1509                  (subParm->paramType == P_MIXEDBRCHRATES && *GetParamIntVals(subParm, chain, state[chain]) == RCL_TK02))
1510            {
1511             if (subParm->paramType == P_TK02BRANCHRATES)
1512                 nu = *GetParamVals (modelSettings[subParm->relParts[0]].tk02var, chain, state[chain]);
1513             else
1514                 nu = *GetParamVals (modelSettings[subParm->relParts[0]].mixedvar, chain, state[chain]);
1515             tk02Rate = GetParamVals (subParm, chain, state[chain]);
1516             brlens = GetParamSubVals (subParm, chain, state[chain]);
1517 
1518             /* prior ratio */
1519             (*lnPriorRatio) -= LnProbTK02LogNormal (tk02Rate[q->index], nu*oldPLength, tk02Rate[p->index]);
1520             (*lnPriorRatio) -= LnProbTK02LogNormal (tk02Rate[q->index], nu*oldRLength, tk02Rate[r->index]);
1521             (*lnPriorRatio) += LnProbTK02LogNormal (tk02Rate[q->index], nu* r->length, tk02Rate[r->index]);
1522             if (q->anc->anc != NULL)
1523                 {
1524                 (*lnPriorRatio) -= LnProbTK02LogNormal (tk02Rate[q->anc->index], nu*oldQLength, tk02Rate[q->index]);
1525                 (*lnPriorRatio) += LnProbTK02LogNormal (tk02Rate[q->anc->index], nu* q->length, tk02Rate[q->index]);
1526                 }
1527 
1528             /* update effective evolutionary lengths */
1529             brlens[p->index] = 0.0;  // tk02Rate[p->index] = tk02Rate[q->index];
1530             brlens[r->index] = r->length * (tk02Rate[r->index]+tk02Rate[q->index])/2.0;
1531             if (q->anc->anc != NULL)
1532                 {
1533                 brlens[q->index] = q->length * (tk02Rate[q->index]+tk02Rate[q->anc->index])/2.0;
1534                 }
1535             }
1536         else if ( subParm->paramType == P_IGRBRANCHRATES ||
1537                  (subParm->paramType == P_MIXEDBRCHRATES && *GetParamIntVals(subParm, chain, state[chain]) == RCL_IGR))
1538             {
1539             if (subParm->paramType == P_IGRBRANCHRATES)
1540                 igrvar = *GetParamVals (modelSettings[subParm->relParts[0]].igrvar, chain, state[chain]);
1541             else
1542                 igrvar = *GetParamVals (modelSettings[subParm->relParts[0]].mixedvar, chain, state[chain]);
1543             igrRate = GetParamVals (subParm, chain, state[chain]);
1544             brlens = GetParamSubVals (subParm, chain, state[chain]);
1545 
1546             (*lnPriorRatio) -= LnProbGamma (oldPLength/igrvar, oldPLength/igrvar, igrRate[p->index]);
1547             (*lnPriorRatio) -= LnProbGamma (oldRLength/igrvar, oldRLength/igrvar, igrRate[r->index]);
1548             (*lnPriorRatio) += LnProbGamma (r->length /igrvar, r->length /igrvar, igrRate[r->index]);
1549             if (q->anc->anc != NULL)
1550                 {
1551                 (*lnPriorRatio) -= LnProbGamma (oldQLength/igrvar, oldQLength/igrvar, igrRate[q->index]);
1552                 (*lnPriorRatio) += LnProbGamma (q->length /igrvar, q->length /igrvar, igrRate[q->index]);
1553                 }
1554 
1555             /* update effective evolutionary lengths */
1556             brlens[p->index] = 0.0;  // igrRate[p->index] = igrRate[q->index];
1557             brlens[r->index] = igrRate[r->index] * r->length;
1558             if (q->anc->anc != NULL)
1559                 {
1560                 brlens[q->index] = igrRate[q->index] * q->length;
1561                 }
1562             }
1563         }
1564 
1565     return (NO_ERROR);
1566 }
1567 
1568 
Move_Extinction(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)1569 int Move_Extinction (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
1570 {
1571     /* change relative extinction rate using sliding window */
1572 
1573     int         i, isValidM, valIndex;
1574     MrBFlt      *valPtr, oldM, newM, window, minM, maxM, *sR, *eR, sF, *fR, oldLnPrior, newLnPrior,
1575                 oldProp[2], newProp[2], x, y, *alphaDir, clockRate;
1576     char        *sS;
1577     ModelParams *mp;
1578     ModelInfo   *m;
1579     Tree        *t;
1580 
1581     /* get size of window, centered on current value */
1582     window = mvp[0];
1583 
1584     /* get model params and settings */
1585     mp = &modelParams[param->relParts[0]];
1586     m = &modelSettings[param->relParts[0]];
1587 
1588     /* get minimum and maximum values */
1589     minM = 0.0;
1590     maxM = 0.999999;
1591 
1592     /* get pointer to value to be changed */
1593     valIndex = (int)(RandomNumber(seed) * param->nValues);
1594     valPtr = GetParamVals(param, chain, state[chain]) + valIndex;
1595 
1596     /* get old value */
1597     oldM = *valPtr;
1598 
1599     /* change value */
1600     if (window > maxM-minM)
1601         window = maxM-minM;
1602     newM = oldM + window * (RandomNumber(seed) - 0.5);
1603 
1604     /* check that new value is valid */
1605     isValidM = NO;
1606     do  {
1607         if (newM < minM)
1608             newM = 2 * minM - newM;
1609         else if (newM > maxM)
1610             newM = 2 * maxM - newM;
1611         else
1612             isValidM = YES;
1613         } while (isValidM == NO);
1614 
1615     /* get proposal ratio */
1616     *lnProposalRatio = 0.0;
1617 
1618     /* calculate prior ratio */
1619     t  = GetTree(modelSettings[param->relParts[0]].brlens,chain,state[chain]);
1620     sR = GetParamVals (m->speciationRates, chain, state[chain]);
1621     eR = GetParamVals (param, chain, state[chain]);
1622     sF = mp->sampleProb;
1623     sS = mp->sampleStrat;
1624     clockRate = *GetParamVals (m->clockRate, chain, state[chain]);
1625 
1626     if (!strcmp(mp->clockPr,"Birthdeath"))
1627         {
1628         if (LnBirthDeathPriorPr (t, clockRate, &oldLnPrior, *sR, *eR, sS, sF) == ERROR)
1629             {
1630             MrBayesPrint ("%s   Problem calculating prior for birth-death process\n", spacer);
1631             return (ERROR);
1632             }
1633         *valPtr = newM;  // update with new value
1634         if (LnBirthDeathPriorPr (t, clockRate, &newLnPrior, *sR, *eR, sS, sF) == ERROR)
1635             {
1636             MrBayesPrint ("%s   Problem calculating prior for birth-death process\n", spacer);
1637             return (ERROR);
1638             }
1639         }
1640     else if (!strcmp(mp->clockPr,"Fossilization"))
1641         {
1642         fR = GetParamVals (m->fossilizationRates, chain, state[chain]);
1643         if (LnFossilizationPriorPr (t, clockRate, &oldLnPrior, sR, eR, fR, sF, sS) == ERROR)
1644             {
1645             MrBayesPrint ("%s   Problem calculating prior for fossilized birth-death process\n", spacer);
1646             return (ERROR);
1647             }
1648         *valPtr = newM;  // update with new value
1649         // for (i=0; i<param->nValues; i++)  *(GetParamVals(param, chain, state[chain]) + i) = newM;
1650         if (LnFossilizationPriorPr (t, clockRate, &newLnPrior, sR, eR, fR, sF, sS) == ERROR)
1651             {
1652             MrBayesPrint ("%s   Problem calculating prior for fossilized birth-death process\n", spacer);
1653             return (ERROR);
1654             }
1655         }
1656     else {
1657         MrBayesPrint ("%s   Move_Extinction not applicable\n", spacer);
1658         return (ERROR);
1659         }
1660 
1661     /* get proportions */
1662     oldProp[0] = oldM;
1663     oldProp[1] = 1.0 - oldM;
1664     newProp[0] = newM;
1665     newProp[1] = 1.0 - newM;
1666 
1667     /* adjust prior ratio according to beta distribution */
1668     alphaDir = mp->extinctionBeta;
1669     x = y = 0.0;
1670     for (i=0; i<2; i++)
1671         x += (alphaDir[i]-1.0)*log(newProp[i]);
1672     for (i=0; i<2; i++)
1673         y += (alphaDir[i]-1.0)*log(oldProp[i]);
1674     (*lnPriorRatio) = x - y + newLnPrior - oldLnPrior;
1675 
1676     return (NO_ERROR);
1677 }
1678 
1679 
Move_Fossilization(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)1680 int Move_Fossilization (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
1681 {
1682     /* change fossilization rate using sliding window */
1683 
1684     int         i, isValidM, valIndex;
1685     MrBFlt      *valPtr, oldM, newM, window, minM, maxM, *sR, *eR, sF, *fR, oldLnPrior, newLnPrior,
1686                 oldProp[2], newProp[2], x, y, *alphaDir, clockRate;
1687     char        *sS;
1688     ModelParams *mp;
1689     ModelInfo   *m;
1690     Tree        *t;
1691 
1692     /* get size of window, centered on current value */
1693     window = mvp[0];
1694 
1695     /* get model params and settings */
1696     mp = &modelParams[param->relParts[0]];
1697     m = &modelSettings[param->relParts[0]];
1698 
1699     /* get minimum and maximum values */
1700     minM = 0.000001;
1701     maxM = 1.0;
1702 
1703     /* get pointer to value to be changed */
1704     valIndex = (int)(RandomNumber(seed) * param->nValues);
1705     valPtr = GetParamVals(param, chain, state[chain]) + valIndex;
1706 
1707     /* get old value */
1708     oldM = *valPtr;
1709 
1710     /* change value */
1711     if (window > maxM-minM)
1712         window = maxM-minM;
1713     newM = oldM + window * (RandomNumber(seed) - 0.5);
1714 
1715     /* check that new value is valid */
1716     isValidM = NO;
1717     do  {
1718         if (newM < minM)
1719             newM = 2 * minM - newM;
1720         else if (newM > maxM)
1721             newM = 2 * maxM - newM;
1722         else
1723             isValidM = YES;
1724         } while (isValidM == NO);
1725 
1726     /* get proposal ratio */
1727     *lnProposalRatio = 0.0;
1728 
1729     /* calculate prior ratio */
1730     t  = GetTree(modelSettings[param->relParts[0]].brlens,chain,state[chain]);
1731     sR = GetParamVals (m->speciationRates, chain, state[chain]);
1732     eR = GetParamVals (m->extinctionRates, chain, state[chain]);
1733     fR = GetParamVals (param, chain, state[chain]);
1734     sF = mp->sampleProb;
1735     sS = mp->sampleStrat;
1736     clockRate = *GetParamVals(m->clockRate, chain, state[chain]);
1737 
1738     if (LnFossilizationPriorPr (t, clockRate, &oldLnPrior, sR, eR, fR, sF, sS) == ERROR)
1739         {
1740         MrBayesPrint ("%s   Problem calculating prior for fossilized birth-death process\n", spacer);
1741         return (ERROR);
1742         }
1743     *valPtr = newM;  // update with new value
1744     if (LnFossilizationPriorPr (t, clockRate, &newLnPrior, sR, eR, fR, sF, sS) == ERROR)
1745         {
1746         MrBayesPrint ("%s   Problem calculating prior for fossilized birth-death process\n", spacer);
1747         return (ERROR);
1748         }
1749 
1750     /* get proportions */
1751     oldProp[0] = oldM;
1752     oldProp[1] = 1.0 - oldM;
1753     newProp[0] = newM;
1754     newProp[1] = 1.0 - newM;
1755 
1756     /* adjust prior ratio according to beta distribution */
1757     alphaDir = mp->fossilizationBeta;
1758     x = y = 0.0;
1759     for (i=0; i<2; i++)
1760         x += (alphaDir[i]-1.0)*log(newProp[i]);
1761     for (i=0; i<2; i++)
1762         y += (alphaDir[i]-1.0)*log(oldProp[i]);
1763     (*lnPriorRatio) = x - y + newLnPrior - oldLnPrior;
1764 
1765     return (NO_ERROR);
1766 }
1767 
1768 
Move_ExtFossilSPRClock(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)1769 int Move_ExtFossilSPRClock (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
1770 {
1771     /* This move is identical to the Move_ExtSPRClock move except that it only moves fossil subtrees. */
1772 
1773     int         i, j, topologyHasChanged=NO, isStartLocked=NO, isStopLocked=NO, nRootNodes, directionUp,
1774                 n1=0, n2=0, n3=0, n4=0, n5=0, *nEvents, numMovableNodesOld, numMovableNodesNew;
1775     MrBFlt      x, y=0.0, oldBrlen=0.0, newBrlen=0.0, extensionProb, igrvar, *igrRate=NULL,
1776     v1=0.0, v2=0.0, v3=0.0, v4=0.0, v5=0.0, v3new=0.0, lambda, *tk02Rate=NULL,
1777     **position=NULL, **rateMultiplier=NULL, *brlens, nu, minV, clockRate;
1778     TreeNode    *p, *a, *b, *u, *v, *oldA;
1779     Tree        *t;
1780     ModelInfo   *m;
1781     Param       *subParm;
1782 
1783     extensionProb = mvp[0]; /* extension probability */
1784 
1785     (*lnProposalRatio) = (*lnPriorRatio) = 0.0;
1786 
1787     /* get tree */
1788     t = GetTree (param, chain, state[chain]);
1789 
1790     /* get model params and model info */
1791     m = &modelSettings[param->relParts[0]];
1792 
1793     /* get clock rate */
1794     clockRate = *GetParamVals (m->clockRate, chain, state[chain]);
1795 
1796     /* get min and max branch lengths in relative time and substitution units */
1797     minV = BRLENS_MIN;
1798 
1799 #   if defined (DEBUG_ExtSPRClock)
1800     printf ("Before:\n");
1801     ShowNodes (t->root, 2, YES);
1802     getchar();
1803 #   endif
1804 
1805     /* mark all nodes that only have fossil children with YES and count number movable nodes in current tree */
1806     numMovableNodesOld=0;
1807     for (i=0; i<t->nNodes-2; ++i)
1808     {
1809         p = t->allDownPass[i];
1810         if (p->left == NULL)
1811         {
1812             if (p->calibration == NULL)
1813                 p->x = NO;
1814             else
1815             {
1816                 p->x = YES;
1817             }
1818         }
1819         else
1820         {
1821             if (p->left->x == YES && p->right->x == YES)
1822             {
1823                 p->x = YES;
1824             }
1825             else
1826                 p->x = NO;
1827         }
1828         a = p->anc->left;
1829         b = p->anc->right;
1830         if (p->anc->isLocked == YES || p->anc->anc->anc == NULL
1831             || (p == b && a->length < TIME_MIN) || (p == a && b->length < TIME_MIN) || p->x == NO)
1832             numMovableNodesOld++;
1833     }
1834 
1835     if (numMovableNodesOld==0)
1836         return (NO_ERROR);
1837 
1838     /* pick a branch */
1839     do  {
1840         p = t->allDownPass[(int)(RandomNumber(seed) * (t->nNodes - 2))];
1841         a = p->anc->left;
1842         b = p->anc->right;
1843     }
1844     while (p->anc->isLocked == YES || p->anc->anc->anc == NULL
1845            || (p == b && a->length < TIME_MIN) || (p == a && b->length < TIME_MIN)
1846            || (p->length < TIME_MIN && p->calibration->prior == fixed)
1847            || p->x == NO);
1848     /* skip constraints, siblings of root (and root); and consider ancestral fossils in fbd tree;
1849        skip all nodes that subtend extant terminals */
1850 
1851     /* set up pointers for nodes around the picked branch */
1852     v = p;
1853     u = p->anc;
1854     if (u->left == v)
1855         a = u->right;
1856     else
1857         a = u->left;
1858     b = u->anc;
1859     oldA = a;
1860 
1861     /* record branch length for insertion in back move */
1862     if (v->length > 0.0)  /* side branch, not anc fossil */
1863     {
1864         if (v->nodeDepth > a->nodeDepth)
1865             oldBrlen = b->nodeDepth - v->nodeDepth - 2.0*minV;
1866         else
1867             oldBrlen = b->nodeDepth - a->nodeDepth - 2.0*minV;
1868     }
1869     else  /* ancestral fossil */
1870     {
1871         y = (b->nodeDepth - minV > v->calibration->max * clockRate) ? (v->calibration->max * clockRate) : (b->nodeDepth - minV);
1872         x = (a->nodeDepth + minV < v->calibration->min * clockRate) ? (v->calibration->min * clockRate) : (a->nodeDepth + minV);
1873         oldBrlen = y - x;
1874     }
1875     v1 = a->length;
1876     v2 = u->length;
1877     v3 = v->length;
1878 
1879     /* reassign events for CPP and adjust prior and proposal ratios for relaxed clock models */
1880     for (i=0; i<param->subParams[0]->nSubParams; i++)
1881     {
1882         subParm = param->subParams[0]->subParams[i];
1883         if (subParm->paramType == P_CPPEVENTS)
1884         {
1885             /* get pointers to CPP events */
1886             nEvents = subParm->nEvents[2*chain+state[chain]];
1887             position = subParm->position[2*chain+state[chain]];
1888             rateMultiplier = subParm->rateMult[2*chain+state[chain]];
1889             n1 = nEvents[a->index];
1890             n2 = nEvents[u->index];
1891             n3 = nEvents[v->index];
1892             if (n2 > 0)
1893             {
1894                 position[a->index] = (MrBFlt *) SafeRealloc ((void *) position[a->index], (n1+n2) * sizeof (MrBFlt));
1895                 rateMultiplier[a->index] = (MrBFlt *) SafeRealloc ((void *) rateMultiplier[a->index], (n1+n2) * sizeof (MrBFlt));
1896             }
1897             for (j=0; j<n1; j++)
1898                 position[a->index][j] *= v1 / (v1+v2);
1899             for (j=n1; j<n1+n2; j++)
1900             {
1901                 position[a->index][j] = (position[u->index][j-n1] * v2 + v1) / (v1+v2);
1902                 rateMultiplier[a->index][j] = rateMultiplier[u->index][j-n1];
1903             }
1904             nEvents[a->index] = n1+n2;
1905             nEvents[u->index] = 0;
1906             if (n2 > 0)
1907             {
1908                 free (position[u->index]);
1909                 free (rateMultiplier[u->index]);
1910                 position[u->index] = rateMultiplier[u->index] = NULL;
1911             }
1912         }   /* end CPP events parm */
1913         else if ( subParm->paramType == P_TK02BRANCHRATES ||
1914                  (subParm->paramType == P_MIXEDBRCHRATES && *GetParamIntVals(subParm, chain, state[chain]) == RCL_TK02))
1915         {
1916             /* adjust prior ratio */
1917             if (subParm->paramType == P_TK02BRANCHRATES)
1918                 nu = *GetParamVals (modelSettings[subParm->relParts[0]].tk02var, chain, state[chain]);
1919             else
1920                 nu = *GetParamVals (modelSettings[subParm->relParts[0]].mixedvar, chain, state[chain]);
1921             tk02Rate = GetParamVals (subParm, chain, state[chain]);
1922             if (v->length > 0.0)
1923                 (*lnPriorRatio) -= LnProbTK02LogNormal(tk02Rate[v->anc->index], nu*v->length, tk02Rate[v->index]);
1924             (*lnPriorRatio) -= LnProbTK02LogNormal(tk02Rate[a->anc->index], nu*a->length, tk02Rate[a->index]);
1925             (*lnPriorRatio) -= LnProbTK02LogNormal(tk02Rate[u->anc->index], nu*u->length, tk02Rate[u->index]);
1926             (*lnPriorRatio) += LnProbTK02LogNormal(tk02Rate[u->anc->index], nu*(a->length+u->length), tk02Rate[a->index]);
1927 
1928             /* adjust effective branch lengths */
1929             brlens = GetParamSubVals (subParm, chain, state[chain]);
1930             brlens[a->index] = (tk02Rate[a->index] + tk02Rate[b->index]) / 2.0 * (a->length + u->length);
1931         }   /* end tk02 branch rate parameter */
1932         else if ( subParm->paramType == P_IGRBRANCHRATES ||
1933                  (subParm->paramType == P_MIXEDBRCHRATES && *GetParamIntVals(subParm, chain, state[chain]) == RCL_IGR))
1934         {
1935             if (subParm->paramType == P_IGRBRANCHRATES)
1936                 igrvar = *GetParamVals (modelSettings[subParm->relParts[0]].igrvar, chain, state[chain]);
1937             else
1938                 igrvar = *GetParamVals (modelSettings[subParm->relParts[0]].mixedvar, chain, state[chain]);
1939             igrRate = GetParamVals (subParm, chain, state[chain]);
1940 
1941             /* adjust prior ratio for old branches */
1942             if (v->length > 0.0)
1943                 (*lnPriorRatio) -= LnProbGamma(v->length/igrvar, v->length/igrvar, igrRate[v->index]);
1944             (*lnPriorRatio) -= LnProbGamma(a->length/igrvar, a->length/igrvar, igrRate[a->index]);
1945             (*lnPriorRatio) -= LnProbGamma(u->length/igrvar, u->length/igrvar, igrRate[u->index]);
1946             (*lnPriorRatio) += LnProbGamma((a->length+u->length)/igrvar, (a->length+u->length)/igrvar, igrRate[a->index]);
1947 
1948             /* adjust effective branch lengths and rates */
1949             brlens = GetParamSubVals (subParm, chain, state[chain]);
1950             brlens[a->index] = igrRate[a->index] * (a->length + u->length);
1951         }
1952     }   /* next subparameter */
1953 
1954     /* cut tree */
1955     a->anc = b;
1956     if (b->left == u)
1957         b->left = a;
1958     else
1959         b->right = a;
1960     a->length += u->length;
1961     a->upDateTi = YES;
1962 
1963     /* determine initial direction of move and whether the reverse move would be stopped by constraints */
1964     if (a->left == NULL || a->isLocked == YES || a->nodeDepth < v->nodeDepth + minV)
1965     {
1966         isStartLocked = YES;
1967         directionUp = NO;
1968     }
1969     else
1970     {
1971         isStartLocked = NO;
1972         if (RandomNumber(seed) < 0.5)
1973             directionUp = YES;
1974         else
1975             directionUp = NO;
1976     }
1977 
1978     /* move around in root subtree */
1979     for (nRootNodes=0; nRootNodes==0 || RandomNumber(seed)<extensionProb; nRootNodes++)
1980     {
1981         if (directionUp == YES)
1982         {   /* going up tree */
1983             if (a->left == NULL || a->isLocked == YES || a->nodeDepth < v->nodeDepth + minV)
1984                 break;      /* can't go farther */
1985             topologyHasChanged = YES;
1986             b = a;
1987             if (a->left->length < TIME_MIN)
1988                 a = a->right;
1989             else if (a->right->length < TIME_MIN)
1990                 a = a->left;
1991             else if (RandomNumber(seed) < 0.5)
1992                 a = a->left;
1993             else
1994                 a = a->right;
1995         }
1996         else
1997         {   /* going down tree */
1998             topologyHasChanged = YES;
1999             if (RandomNumber(seed) < 0.5 || b->anc->anc == NULL || b->isLocked == YES)
2000             {
2001                 directionUp = YES; /* switch direction */
2002                 /* find sister of a */
2003                 if (b->left == a)
2004                     a = b->right;
2005                 else
2006                     a = b->left;
2007                 /* as long as we are moving upwards
2008                  the cond likes to update will be
2009                  flagged by the last pass from u to the root */
2010             }
2011             else
2012             {   /* continue down */
2013                 a = b;
2014                 b = b->anc;
2015                 a->upDateCl = YES;
2016             }
2017         }
2018     }
2019 
2020     /* determine whether the forward move was or would have been stopped by constraints */
2021     isStopLocked = NO;
2022     if (directionUp == YES)
2023     {
2024         if (a->left == NULL || a->isLocked == YES || a->nodeDepth < v->nodeDepth + minV)
2025             isStopLocked = YES;
2026     }
2027 
2028     /* reattach u */
2029     if (u->left == v)
2030         u->right = a;
2031     else
2032         u->left = a;
2033     a->anc = u;
2034     u->anc = b;
2035     if (b->left == a)
2036         b->left = u;
2037     else
2038         b->right = u;
2039 
2040     if (v->length > 0.0)  /* side branch, not anc fossil */
2041     {
2042         if (a->nodeDepth > v->nodeDepth)
2043             newBrlen = b->nodeDepth - a->nodeDepth - 2.0*minV;
2044         else
2045             newBrlen = b->nodeDepth - v->nodeDepth - 2.0*minV;
2046     }
2047     else  /* ancestral fossil */
2048     {
2049         y = (b->nodeDepth - minV > v->calibration->max * clockRate) ? (v->calibration->max * clockRate) : (b->nodeDepth - minV);
2050         x = (a->nodeDepth + minV < v->calibration->min * clockRate) ? (v->calibration->min * clockRate) : (a->nodeDepth + minV);
2051         newBrlen = y - x;
2052     }
2053     if (newBrlen <= 0.0)
2054     {
2055         abortMove = YES;
2056         return (NO_ERROR);
2057     }
2058 
2059     /* adjust lengths */
2060     if (v->length > 0.0)  /* side branch, not anc fossil */
2061     {
2062         u->nodeDepth = b->nodeDepth - minV - RandomNumber(seed) * newBrlen;
2063         v->length = u->nodeDepth - v->nodeDepth;
2064     }
2065     else  /* ancestral fossil */
2066     {
2067         u->nodeDepth = y - RandomNumber(seed) * newBrlen;
2068         v->nodeDepth = u->nodeDepth;
2069         v->age = u->age = u->nodeDepth / clockRate;
2070     }
2071     u->length = b->nodeDepth - u->nodeDepth;
2072     a->length = u->nodeDepth - a->nodeDepth;
2073 
2074     v3new = v->length;
2075     v4 = a->length;
2076     v5 = u->length;
2077 
2078     /* adjust events, prior ratio and proposal ratio for relaxed clock models */
2079     for (i=0; i<param->subParams[0]->nSubParams; i++)
2080     {
2081         subParm = param->subParams[0]->subParams[i];
2082         if (subParm->paramType == P_CPPEVENTS)
2083         {
2084             /* reassign events for CPP */
2085             nEvents = subParm->nEvents[2*chain+state[chain]];
2086             position = subParm->position[2*chain+state[chain]];
2087             rateMultiplier = subParm->rateMult[2*chain+state[chain]];
2088             for (j=0; j<nEvents[a->index]; j++)
2089             {
2090                 if (position[a->index][j] > v4 / (v4+v5))
2091                     break;
2092             }
2093             n4 = j;
2094             n5 = nEvents[a->index] - j;
2095             nEvents[u->index] = n5;
2096             if (n5 > 0)
2097             {
2098                 position[u->index] = (MrBFlt *) SafeRealloc ((void *) position[u->index], n5 * sizeof (MrBFlt));
2099                 rateMultiplier[u->index] = (MrBFlt *) SafeRealloc ((void *) rateMultiplier[u->index], n5 * sizeof (MrBFlt));
2100                 for (j=n4; j<nEvents[a->index]; j++)
2101                 {
2102                     position[u->index][j-n4] = (position[a->index][j] * (v4+v5) - v4) / v5;
2103                     rateMultiplier[u->index][j-n4] = rateMultiplier[a->index][j];
2104                 }
2105                 if (n4 > 0)
2106                 {
2107                     position[a->index] = (MrBFlt *) SafeRealloc ((void *) position[a->index], n4 * sizeof (MrBFlt));
2108                     rateMultiplier[a->index] = (MrBFlt *) SafeRealloc ((void *) rateMultiplier[a->index], n4 * sizeof (MrBFlt));
2109                     for (j=0; j<n4; j++)
2110                         position[a->index][j] *= ((v4+v5) / v4);
2111                 }
2112                 else
2113                 {
2114                     free (position[a->index]);
2115                     free (rateMultiplier[a->index]);
2116                     position[a->index] = rateMultiplier[a->index] = NULL;
2117                 }
2118                 nEvents[a->index] = n4;
2119             }
2120             else
2121             {
2122                 for (j=0; j<nEvents[a->index]; j++)
2123                     position[a->index][j] *= ((v4+v5) / v4);
2124             }
2125 
2126             /* adjust proposal ratio for length change in v branch*/
2127             (*lnProposalRatio) += n3 * log (v3new / v3);
2128 
2129             /* adjust prior ratio for length change */
2130             lambda = *GetParamVals (modelSettings[subParm->relParts[0]].cppRate, chain, state[chain]);
2131             (*lnPriorRatio) += lambda * (v3 - v3new);
2132 
2133             /* update effective branch lengths */
2134             if (UpdateCppEvolLengths (subParm, oldA, chain) == ERROR)
2135             {
2136                 abortMove = YES;
2137                 return (NO_ERROR);
2138             }
2139             if (UpdateCppEvolLengths (subParm, u, chain) == ERROR)
2140             {
2141                 abortMove = YES;
2142                 return (NO_ERROR);
2143             }
2144         }   /* end cpp events parameter */
2145         else if ( subParm->paramType == P_TK02BRANCHRATES ||
2146                  (subParm->paramType == P_MIXEDBRCHRATES && *GetParamIntVals(subParm, chain, state[chain]) == RCL_TK02))
2147         {
2148             /* adjust prior ratio */
2149             if (subParm->paramType == P_TK02BRANCHRATES)
2150                 nu = *GetParamVals (modelSettings[subParm->relParts[0]].tk02var, chain, state[chain]);
2151             else
2152                 nu = *GetParamVals (modelSettings[subParm->relParts[0]].mixedvar, chain, state[chain]);
2153             tk02Rate = GetParamVals (subParm, chain, state[chain]);
2154             (*lnPriorRatio) -= LnProbTK02LogNormal(tk02Rate[u->anc->index], nu*(a->length+u->length), tk02Rate[a->index]);
2155             (*lnPriorRatio) += LnProbTK02LogNormal(tk02Rate[a->anc->index], nu*a->length, tk02Rate[a->index]);
2156             (*lnPriorRatio) += LnProbTK02LogNormal(tk02Rate[u->anc->index], nu*u->length, tk02Rate[u->index]);
2157             if (v->length > 0.0)
2158                 (*lnPriorRatio) += LnProbTK02LogNormal(tk02Rate[v->anc->index], nu*v->length, tk02Rate[v->index]);
2159 
2160             /* adjust effective branch lengths */
2161             brlens = GetParamSubVals (subParm, chain, state[chain]);
2162             brlens[a->index] = a->length * (tk02Rate[a->index] + tk02Rate[a->anc->index]) / 2.0;
2163             brlens[v->index] = v->length * (tk02Rate[v->index] + tk02Rate[v->anc->index]) / 2.0;
2164             brlens[u->index] = u->length * (tk02Rate[u->index] + tk02Rate[u->anc->index]) / 2.0;
2165         }   /* end tk02 branch rate parameter */
2166         else if ( subParm->paramType == P_IGRBRANCHRATES ||
2167                  (subParm->paramType == P_MIXEDBRCHRATES && *GetParamIntVals(subParm, chain, state[chain]) == RCL_IGR))
2168         {
2169             /* adjust prior ratio */
2170             if (subParm->paramType == P_IGRBRANCHRATES)
2171                 igrvar = *GetParamVals (modelSettings[subParm->relParts[0]].igrvar, chain, state[chain]);
2172             else
2173                 igrvar = *GetParamVals (modelSettings[subParm->relParts[0]].mixedvar, chain, state[chain]);
2174             igrRate = GetParamVals (subParm, chain, state[chain]);
2175             (*lnPriorRatio) -= LnProbGamma ((a->length+u->length)/igrvar, (a->length+u->length)/igrvar, igrRate[a->index]);
2176             (*lnPriorRatio) += LnProbGamma (a->length/igrvar, a->length/igrvar, igrRate[a->index]);
2177             (*lnPriorRatio) += LnProbGamma (u->length/igrvar, u->length/igrvar, igrRate[u->index]);
2178             if (v->length > 0.0)
2179                 (*lnPriorRatio) += LnProbGamma (v->length/igrvar, v->length/igrvar, igrRate[v->index]);
2180 
2181             /* adjust effective branch lengths */
2182             brlens = GetParamSubVals (subParm, chain, state[chain]);
2183             brlens[v->index] = igrRate[v->index] * v->length;
2184             brlens[u->index] = igrRate[u->index] * u->length;
2185             brlens[a->index] = igrRate[a->index] * a->length;
2186         }   /* end igr branch rate parameter */
2187     }   /* next subparameter */
2188 
2189     /* set tiprobs update flags */
2190     a->upDateTi = YES;
2191     u->upDateTi = YES;
2192     v->upDateTi = YES;
2193 
2194     /* set flags for update of cond likes from u and down to root */
2195     p = u;
2196     while (p->anc != NULL)
2197     {
2198         p->upDateCl = YES;
2199         p = p->anc;
2200     }
2201 
2202     /* adjust prior ratio for clock tree */
2203     if (LogClockTreePriorRatio(param, chain, &x) == ERROR)
2204         return (ERROR);
2205     (*lnPriorRatio) += x;
2206 
2207     if (topologyHasChanged == YES)
2208     {
2209         /* get down pass sequence if tree topology has changed */
2210         GetDownPass (t);
2211         /* calculate proposal ratio for tree change */
2212         (*lnProposalRatio) += log (newBrlen / oldBrlen);
2213         if (isStartLocked == NO && isStopLocked == YES)
2214             (*lnProposalRatio) += log (2.0 * (1.0 - extensionProb));
2215         else if (isStartLocked == YES && isStopLocked == NO)
2216             (*lnProposalRatio) -= log (2.0 * (1.0 - extensionProb));
2217     }
2218 
2219     /* adjust proposal prob for number movable nodes in new tree */
2220     numMovableNodesNew=0;
2221     for (i=0; i<t->nNodes-2; ++i)
2222     {
2223         p = t->allDownPass[i];
2224         if (p->left == NULL)
2225         {
2226             if (p->calibration == NULL)
2227                 p->x = NO;
2228             else
2229             {
2230                 p->x = YES;
2231             }
2232         }
2233         else
2234         {
2235             if (p->left->x == YES && p->right->x == YES)
2236             {
2237                 p->x = YES;
2238             }
2239             else
2240                 p->x = NO;
2241         }
2242         a = p->anc->left;
2243         b = p->anc->right;
2244         if (p->anc->isLocked == YES || p->anc->anc->anc == NULL
2245             || (p == b && a->length < TIME_MIN) || (p == a && b->length < TIME_MIN) || p->x == NO)
2246             numMovableNodesNew++;
2247     }
2248 
2249 
2250     if (numMovableNodesNew!=numMovableNodesOld)
2251     {
2252         /* FIXME: numMovableNodesNew may be zero (from clang static analyzer) */
2253         (*lnProposalRatio) += log (numMovableNodesOld / numMovableNodesNew);
2254     }
2255 
2256 #   if defined (DEBUG_ExtSPRClock)
2257     ShowNodes (t->root, 2, YES);
2258     printf ("After\nProposal ratio: %f\n",(*lnProposalRatio));
2259     printf ("v: %d  u: %d  a: %d  b: %d\n",v->index, u->index, a->index, b->index);
2260     printf ("No. nodes moved in root subtree: %d\n",nRootNodes);
2261     printf ("Has topology changed? %d\n",topologyHasChanged);
2262 #   endif
2263 
2264     return (NO_ERROR);
2265 }
2266 
2267 
Move_ExtSPR(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)2268 int Move_ExtSPR (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
2269 {
2270     /* Change topology (and branch lengths) using SPR (unrooted) with extension probability.
2271        Pick either external or internal branches instead of just internal branches. */
2272 
2273     int         i, j, topologyHasChanged, nCrownNodes, nRootNodes, directionLeft, directionUp,
2274                 isVPriorExp, moveInRoot, isStartConstrained, isStopConstrained;
2275     MrBFlt      m, x, y, tuning, maxV, minV, extensionProb, brlensExp=0.0;
2276     TreeNode    *p, *q, *a, *b, *c, *d, *u, *v;
2277     Tree        *t;
2278     ModelParams *mp;
2279 
2280     /* these parameters should be possible to set by user */
2281     extensionProb = mvp[0]; /* extension probability */
2282     tuning = mvp[1];        /* Larget & Simon's tuning parameter lambda */
2283 
2284     (*lnProposalRatio) = (*lnPriorRatio) = 0.0;
2285 
2286     /* get tree */
2287     t = GetTree (param, chain, state[chain]);
2288 
2289     /* get model params */
2290     mp = &modelParams[param->relParts[0]];
2291 
2292     /* max and min brlen */
2293     if (param->subParams[0]->paramId == BRLENS_UNI)
2294         {
2295         minV = mp->brlensUni[0] > BRLENS_MIN ? mp->brlensUni[0] : BRLENS_MIN;
2296         maxV = mp->brlensUni[1] < BRLENS_MAX ? mp->brlensUni[1] : BRLENS_MAX;
2297         isVPriorExp = NO;
2298         }
2299     else if (param->subParams[0]->paramId == BRLENS_GamDir)
2300         {
2301         minV = BRLENS_MIN;
2302         maxV = BRLENS_MAX;
2303         isVPriorExp = 2;
2304         }
2305     else if (param->subParams[0]->paramId == BRLENS_iGmDir)
2306         {
2307         minV = BRLENS_MIN;
2308         maxV = BRLENS_MAX;
2309         isVPriorExp = 3;
2310         }
2311     else if (param->subParams[0]->paramId == BRLENS_twoExp)
2312         {
2313         minV = BRLENS_MIN;
2314         maxV = BRLENS_MAX;
2315         isVPriorExp = 4;
2316         }
2317     else  /* (param->subParams[0]->paramId == BRLENS_EXP) */
2318         {
2319         minV = BRLENS_MIN;
2320         maxV = BRLENS_MAX;
2321         brlensExp = mp->brlensExp;
2322         isVPriorExp = YES;
2323         }
2324 
2325     /* Dirichlet or twoExp prior */
2326     if (isVPriorExp > 1)
2327         (*lnPriorRatio) = -LogDirPrior(t, mp, isVPriorExp);
2328 
2329     topologyHasChanged = NO;
2330 
2331 #   if defined (DEBUG_ExtSPR)
2332     printf ("Before:\n");
2333     ShowNodes (t->root, 2, NO);
2334     getchar();
2335 #   endif
2336 
2337     /* pick a random branch */
2338     do  {
2339         p = t->allDownPass[(int)(RandomNumber(seed) * (t->nNodes -1))];
2340         q = p->anc->right;  if (q == p) q = p->anc->left;
2341         i = j = 0;
2342         if (p->left == NULL)
2343             j = 2;
2344         if (p->anc->anc == NULL)
2345             i = 2;
2346         if (p->anc->anc != NULL && (p->anc->isLocked == YES || p->anc->anc->anc == NULL))
2347             i++;
2348         if (p->anc->anc != NULL && (q->isLocked == YES || q->left == NULL))
2349             i++;
2350         if (p->left != NULL && (p->left->isLocked == YES || p->left->left == NULL))
2351             j++;
2352         if (p->left != NULL && (p->right->isLocked == YES || p->right->left == NULL))
2353             j++;
2354         } while (i == 2 && j == 2);
2355 
2356     /* change in root tree ? */
2357     if (j == 2)
2358         moveInRoot = YES;
2359     else if (i == 2)
2360         moveInRoot = NO;
2361     else if (RandomNumber(seed) < 0.5)
2362         moveInRoot = YES;
2363     else
2364         moveInRoot = NO;
2365 
2366     /* determine whether start is constrained on backward move */
2367     isStartConstrained = isStopConstrained = NO;
2368     if (moveInRoot == YES && i == 1)
2369         isStartConstrained = YES;
2370     else if (moveInRoot == NO && j == 1)
2371         isStartConstrained = YES;
2372 
2373     /* set up pointers for nodes around the picked branch */
2374     /* cut the tree into crown, root and attachment part  */
2375     /* change the relevant lengths in the attachment part */
2376     v = p;
2377     u = p->anc;
2378 
2379     /* modify length of middle branch */
2380     m = v->length;
2381     x = m * exp(tuning * (RandomNumber(seed) - 0.5));
2382     while (x < minV || x > maxV)
2383         {
2384         if (x < minV) x = minV * minV / x;
2385         if (x > maxV) x = maxV * maxV / x;
2386         }
2387     v->length = x;
2388     v->upDateTi = YES;
2389 
2390     /* update proposal and prior ratio based on length modification */
2391     (*lnProposalRatio) += log (x / m);
2392     if (isVPriorExp == YES)
2393         (*lnPriorRatio) += brlensExp * (m - x);
2394 
2395     /* move around in root subtree */
2396     if (moveInRoot == YES)
2397         {
2398         /* mark nodes in root part */
2399         /* also determine direction of move in root part */
2400         if (u->left == v)
2401             a = u->right;
2402         else
2403             a = u->left;
2404         b = u->anc;
2405         if (u->anc->anc == NULL || u->isLocked == YES)
2406             directionUp = YES;
2407         else if (a->left == NULL || a->isLocked == YES)
2408             directionUp = NO;
2409         else if (RandomNumber(seed) < 0.5)
2410             directionUp = YES;
2411         else
2412             directionUp = NO;
2413         /* cut root part*/
2414         if (directionUp == NO)
2415             {
2416             b = a;  /* switch a and b */
2417             a = u->anc;
2418             b->anc = a;
2419             if (a->left == u)
2420                 a->left = b;
2421             else
2422                 a->right = b;
2423             }
2424         else  // if (directionUp == YES)
2425             {
2426             a->anc = b;
2427             if (b->left == u)
2428                 b->left = a;
2429             else
2430                 b->right = a;
2431             y = a->length;
2432             a->length = u->length;
2433             u->length = y;
2434             a->upDateTi = YES;
2435             u->upDateTi = YES;
2436             }
2437 
2438         for (nRootNodes=0; RandomNumber(seed)<extensionProb || nRootNodes==0; nRootNodes++)
2439             {
2440             if (directionUp == YES)
2441                 {   /* going up tree */
2442                 if (a->left == NULL || a->isLocked == YES)
2443                     break;      /* can't go further */
2444                 b = a;
2445                 if (RandomNumber(seed) < 0.5)
2446                     a = a->left;
2447                 else
2448                     a = a->right;
2449                 if (u->isLocked == YES)
2450                     {
2451                     b->isLocked = YES;
2452                     u->isLocked = NO;
2453                     b->lockID = u->lockID;
2454                     u->lockID = 0;
2455                     }
2456                 }
2457             else  // directionUp == NO
2458                 {   /* going down tree */
2459                 if (a->anc == NULL || u->isLocked == YES)
2460                     break;      /* can't go further */
2461                 if (RandomNumber(seed) < 0.5)
2462                     {
2463                     directionUp = YES; /* switch direction */
2464                     /* find sister of a */
2465                     if (a->left == b)
2466                         {
2467                         b = a;
2468                         a = a->right;
2469                         }
2470                     else
2471                         {
2472                         b = a;
2473                         a = a->left;
2474                         }
2475                     /* as long as we are moving upwards, the cond likes to update
2476                        will be flagged by the last pass from u to the root */
2477                     }
2478                 else
2479                     {   /* continue down */
2480                     b = a;
2481                     a = a->anc;
2482                     b->upDateCl = YES;
2483                     if (b->isLocked == YES)
2484                         {
2485                         u->isLocked = YES;
2486                         b->isLocked = NO;
2487                         u->lockID = b->lockID;
2488                         b->lockID = 0;
2489                         }
2490                     }
2491                 }
2492             }
2493 
2494         topologyHasChanged = YES;
2495         /* check whether stop is constrained */
2496         if (directionUp == YES && (a->left == NULL || a->isLocked == YES))
2497             isStopConstrained = YES;
2498         if (directionUp == NO  && (a->anc  == NULL || u->isLocked == YES))
2499             isStopConstrained = YES;
2500 
2501         /* modify branch length */
2502         m = u->length;
2503         x = m * exp(tuning * (RandomNumber(seed) - 0.5));
2504         while (x < minV || x > maxV)
2505             {
2506             if (x < minV) x = minV * minV / x;
2507             if (x > maxV) x = maxV * maxV / x;
2508             }
2509         u->length = x;
2510         u->upDateTi = YES;
2511 
2512         /* update proposal and prior ratio based on length modification */
2513         (*lnProposalRatio) += log (x / m);
2514         if (isVPriorExp == YES)
2515             (*lnPriorRatio) += brlensExp * (m - x);
2516 
2517         /* combine the subtrees */
2518         if (directionUp == YES)
2519             {
2520             u->anc = b;
2521             if (u->left == v)
2522                 u->right = a;
2523             else
2524                 u->left = a;
2525             a->anc = u;
2526             if (b->left == a)
2527                 b->left = u;
2528             else
2529                 b->right = u;
2530             }
2531         else  // if (directionUp == NO)
2532             {
2533             u->anc = a;
2534             if (u->left == v)
2535                 u->right = b;
2536             else
2537                 u->left = b;
2538             b->anc = u;
2539             if (a->left == b)
2540                 a->left = u;
2541             else
2542                 a->right = u;
2543             /* the modified branch contained in u->length will have to be moved to b->length to enable back move
2544                BUT if we haven't moved, it is better to keep it in place (necessary for rooted trees) */
2545             y = u->length;
2546             u->length = b->length;
2547             b->length = y;
2548             b->upDateTi = YES;
2549             u->upDateTi = YES;
2550             }
2551         }
2552 
2553     /* move around in crown subtree */
2554     if (moveInRoot == NO)
2555         {
2556         /* set up pointers for crown part */
2557         /* also determine direction of move in crown part */
2558         if (v->right->left == NULL || v->right->isLocked == YES)
2559             directionLeft = YES;
2560         else if (v->left->left == NULL || v->left->isLocked == YES)
2561             directionLeft = NO;
2562         else if (RandomNumber(seed) < 0.5)
2563             directionLeft = YES;
2564         else
2565             directionLeft = NO;
2566         if (directionLeft == YES)
2567             {
2568             c = v->left;
2569             d = v->right;
2570             }
2571         else
2572             {
2573             c = v->right;
2574             d = v->left;
2575             }
2576 
2577         /* store brlen nodes and brlen to move */
2578         x = c->length;
2579 
2580         /* cut and reconnect crown part */
2581         c->anc = d;
2582         d->anc = c;
2583 
2584         for (nCrownNodes=0; RandomNumber(seed)<extensionProb || nCrownNodes==0; nCrownNodes++)
2585             {
2586             if (c->left == NULL || c->isLocked == YES)
2587                 break;  /* can't go further */
2588             if (RandomNumber(seed) < 0.5)
2589                 {
2590                 /* rotate c anticlockwise - prepare pointers for move left */
2591                 c->anc = c->left;  /* the root will be in the direction we are heading */
2592                 c->left = c->right;
2593                 c->right = d;
2594                 }
2595             else
2596                 {
2597                 /* rotate c clockwise - prepare pointers for move right */
2598                 c->anc = c->right;  /* the root will be in the direction we are heading */
2599                 c->right = c->left;
2600                 c->left = d;
2601                 }
2602             /* OK - let's move! c->anc points in the right direction
2603                don't forget to move the branch lengths as well */
2604             d = c;
2605             c = c->anc;
2606             d->length = c->length;  /* also rotate other info ?? */
2607             d->upDateCl = YES;
2608             d->upDateTi = YES;
2609             }
2610 
2611         topologyHasChanged = YES;
2612         /* check if stop constrained */
2613         if (c->left == NULL || c->isLocked == YES)
2614             isStopConstrained = YES;
2615 
2616         /* combine the subtrees */
2617         c->anc = v;
2618         d->anc = v;
2619         if (directionLeft == YES)
2620             {
2621             v->left = c;
2622             v->right = d;
2623             }
2624         else
2625             {
2626             v->left = d;
2627             v->right = c;
2628             }
2629 
2630         /* the dangling branch is inserted in reverted position such that the back move will be possible
2631            if we have moved around in crown subtree otherwise it is left in its original position */
2632         d->length = x;
2633 
2634         /* modify branch length */
2635         m = d->length;
2636         x = m * exp(tuning * (RandomNumber(seed) - 0.5));
2637         while (x < minV || x > maxV)
2638             {
2639             if (x < minV) x = minV * minV / x;
2640             if (x > maxV) x = maxV * maxV / x;
2641             }
2642         d->length = x;
2643         d->upDateTi = YES;
2644 
2645         /* update proposal and prior ratio based on length modification */
2646         (*lnProposalRatio) += log (x / m);
2647         if (isVPriorExp == YES)
2648             (*lnPriorRatio) += brlensExp * (m - x);
2649         }
2650 
2651     /* adjust proposal ratio for constraints */
2652     if (isStartConstrained == NO && isStopConstrained == YES)
2653         (*lnProposalRatio) += log (2.0 * (1.0 - extensionProb));
2654     else if (isStartConstrained == YES && isStopConstrained == NO)
2655         (*lnProposalRatio) -= log (2.0 * (1.0 - extensionProb));
2656 
2657     /* set flags for update of cond likes from v and down to root */
2658     p = v;
2659     while (p->anc != NULL)
2660         {
2661         p->upDateCl = YES;
2662         p = p->anc;
2663         }
2664 
2665     /* get down pass sequence if tree topology has changed */
2666     if (topologyHasChanged == YES)
2667         {
2668         GetDownPass (t);
2669         }
2670 
2671     /* Dirichlet or twoExp prior */
2672     if (isVPriorExp > 1)
2673         (*lnPriorRatio) += LogDirPrior(t, mp, isVPriorExp);
2674 
2675 #   if defined (DEBUG_ExtSPR)
2676     printf ("After:\n");
2677     ShowNodes (t->root, 2, NO);
2678     getchar();
2679     printf ("Proposal ratio: %f\n",(*lnProposalRatio));
2680     printf ("v: %d  u: %d  c: %d  d: %d  a: %d  b: %d\n",v->index, u->index,
2681             c->index, d->index, a->index, b->index);
2682     printf ("No. nodes moved in root subtree: %d\n",nRootNodes);
2683     printf ("No. nodes moved in crown subtree: %d\n",nCrownNodes);
2684     printf ("Has topology changed? %d\n",topologyHasChanged);
2685     getchar();
2686 #   endif
2687 
2688     return (NO_ERROR);
2689 }
2690 
2691 
Move_ExtSPR1(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)2692 int Move_ExtSPR1 (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
2693 {
2694     /* Change topology (and branch lengths) using SPR (unrooted) with extension probability. */
2695     /* Pick only internal branches. For a description, see Lakner et al. (2008). */
2696 
2697     int         i, j, topologyHasChanged, nCrownNodes, nRootNodes, directionLeft, directionUp,
2698                 isVPriorExp, moveInRoot, isStartConstrained, isStopConstrained;
2699     MrBFlt      m, x, y, tuning, maxV, minV, extensionProb, brlensExp=0.0;
2700     TreeNode    *p, *a, *b, *c, *d, *u, *v, *brlenNode[7];
2701     Tree        *t;
2702     ModelParams *mp;
2703 
2704     /* these parameters should be possible to set by user */
2705     extensionProb = mvp[0]; /* extension probability */
2706     tuning = mvp[1];        /* Larget & Simon's tuning parameter lambda */
2707 
2708     (*lnProposalRatio) = (*lnPriorRatio) = 0.0;
2709 
2710     /* get tree */
2711     t = GetTree (param, chain, state[chain]);
2712 
2713     /* get model params */
2714     mp = &modelParams[param->relParts[0]];
2715 
2716     /* max and min brlen */
2717     if (param->subParams[0]->paramId == BRLENS_UNI)
2718         {
2719         minV = mp->brlensUni[0] > BRLENS_MIN ? mp->brlensUni[0] : BRLENS_MIN;
2720         maxV = mp->brlensUni[1] < BRLENS_MAX ? mp->brlensUni[1] : BRLENS_MAX;
2721         isVPriorExp = NO;
2722         }
2723     else if (param->subParams[0]->paramId == BRLENS_GamDir)
2724         {
2725         minV = BRLENS_MIN;
2726         maxV = BRLENS_MAX;
2727         isVPriorExp = 2;
2728         }
2729     else if (param->subParams[0]->paramId == BRLENS_iGmDir)
2730         {
2731         minV = BRLENS_MIN;
2732         maxV = BRLENS_MAX;
2733         isVPriorExp = 3;
2734         }
2735     else if (param->subParams[0]->paramId == BRLENS_twoExp)
2736         {
2737         minV = BRLENS_MIN;
2738         maxV = BRLENS_MAX;
2739         isVPriorExp = 4;
2740         }
2741     else
2742         {
2743         minV = BRLENS_MIN;
2744         maxV = BRLENS_MAX;
2745         brlensExp = mp->brlensExp;
2746         isVPriorExp = YES;
2747         }
2748 
2749     /* Dirichlet or twoExp prior */
2750     if (isVPriorExp > 1)
2751         (*lnPriorRatio) = -LogDirPrior(t, mp, isVPriorExp);
2752 
2753     topologyHasChanged = NO;
2754 
2755 #   if defined (DEBUG_ExtSPR)
2756     printf ("Before:\n");
2757     ShowNodes (t->root, 2, NO);
2758     getchar();
2759 #   endif
2760 
2761     /* pick an internal branch that is free to move in either end
2762        (i and j keep track of number of locked directions) */
2763     do  {
2764         p = t->intDownPass[(int)(RandomNumber(seed) * (t->nIntNodes-1))];
2765         if (p->anc->left == p)
2766             a = p->anc->right;
2767         else
2768             a = p->anc->left;
2769         i = j = 0;
2770         if (a->isLocked == YES || a->left == NULL)
2771             i++;
2772         if (p->anc->isLocked == YES || p->anc->anc->anc == NULL)
2773             i++;
2774         if (p->left->isLocked == YES || p->left->left == NULL)
2775             j++;
2776         if (p->right->isLocked == YES || p->right->left == NULL)
2777             j++;
2778         } while (i == 2 && j == 2);
2779 
2780     /* set up pointers for nodes around the picked branch */
2781     /* cut the tree into crown, root and attachment part */
2782     /* change the relevant lengths in the attachment part */
2783     /* the lengths of a and v are automatically contained in the */
2784     /* "attachment" part but the length of c has to be stored in x */
2785     v = p;
2786     u = p->anc;
2787 
2788     /* store brlen node */
2789     brlenNode[3] = v;
2790 
2791     /* change in root tree ? */
2792     if (j == 2)
2793         moveInRoot = YES;
2794     else if (i == 2)
2795         moveInRoot = NO;
2796     else if (RandomNumber(seed) < 0.5)
2797         moveInRoot = YES;
2798     else
2799         moveInRoot = NO;
2800 
2801     /* determine whether start is constrained on backward move */
2802     isStartConstrained = isStopConstrained = NO;
2803     if (moveInRoot == YES && i == 1)
2804         isStartConstrained = YES;
2805     else if (moveInRoot == NO && j == 1)
2806         isStartConstrained = YES;
2807 
2808     /* set up pointers for crown part */
2809     /* also determine direction of move in crown part */
2810     if (v->right->left == NULL || v->right->isLocked == YES)
2811         directionLeft = YES;
2812     else if (v->left->left == NULL || v->left->isLocked == YES)
2813         directionLeft = NO;
2814     else if (RandomNumber(seed) < 0.5)
2815         directionLeft = YES;
2816     else
2817         directionLeft = NO;
2818     if (directionLeft == YES)
2819         {
2820         c = v->left;
2821         d = v->right;
2822         }
2823     else
2824         {
2825         c = v->right;
2826         d = v->left;
2827         }
2828 
2829     /* store brlen nodes and brlen to move */
2830     brlenNode[0] = d;
2831     brlenNode[1] = c;
2832     x = c->length;
2833 
2834     /* cut and reconnect crown part */
2835     c->anc = d;
2836     d->anc = c;
2837 
2838     /* mark nodes in root part */
2839     /* also determine direction of move in root part */
2840     if (u->left == v)
2841         a = u->right;
2842     else
2843         a = u->left;
2844     b = u->anc;
2845     if (u->anc->anc == NULL || u->isLocked == YES)
2846         directionUp = YES;
2847     else if (a->left == NULL || a->isLocked == YES)
2848         directionUp = NO;
2849     else if (RandomNumber(seed) < 0.5)
2850         directionUp = YES;
2851     else
2852         directionUp = NO;
2853     if (directionUp == NO)
2854         {
2855         /* switch a and b */
2856         b = a;
2857         a = u->anc;
2858         }
2859 
2860     /* store brlen nodes */
2861     if (directionUp == YES)
2862         {
2863         brlenNode[4] = u;
2864         brlenNode[5] = a;
2865         }
2866     else
2867         {
2868         brlenNode[4] = b;
2869         brlenNode[5] = u;
2870         }
2871 
2872     /* cut root part*/
2873     if (directionUp == NO)
2874         {
2875         b->anc = a;
2876         if (a->left == u)
2877             a->left = b;
2878         else
2879             a->right = b;
2880         }
2881     else
2882         {
2883         a->anc = b;
2884         if (b->left == u)
2885             b->left = a;
2886         else
2887             b->right = a;
2888         y = a->length;
2889         a->length = u->length;
2890         u->length = y;
2891         a->upDateTi = YES;
2892         u->upDateTi = YES;
2893         }
2894 
2895     /* move around in root subtree */
2896     nRootNodes = 0;
2897     if (moveInRoot == YES)
2898         {
2899         for (nRootNodes=0; RandomNumber(seed)<extensionProb || nRootNodes==0; nRootNodes++)
2900             {
2901             if (directionUp == YES)
2902                 {   /* going up tree */
2903                 if (a->left == NULL || a->isLocked == YES)
2904                     break;      /* can't go further */
2905                 topologyHasChanged = YES;
2906                 b = a;
2907                 if (RandomNumber(seed) < 0.5)
2908                     a = a->left;
2909                 else
2910                     a = a->right;
2911                 if (u->isLocked == YES)
2912                     {
2913                     b->isLocked = YES;
2914                     u->isLocked = NO;
2915                     b->lockID = u->lockID;
2916                     u->lockID = 0;
2917                     }
2918                 }
2919             else
2920                 {   /* going down tree */
2921                 if (a->anc == NULL || u->isLocked == YES)
2922                     break;      /* can't go further */
2923                 topologyHasChanged = YES;
2924                 if (RandomNumber(seed)<0.5)
2925                     {
2926                     directionUp = YES; /* switch direction */
2927                     /* find sister of a */
2928                     if (a->left == b)
2929                         {
2930                         b = a;
2931                         a = a->right;
2932                         }
2933                     else
2934                         {
2935                         b = a;
2936                         a = a->left;
2937                         }
2938                     /* as long as we are moving upwards
2939                     the cond likes to update will be
2940                     flagged by the last pass from u to the root */
2941                     }
2942                 else
2943                     {   /* continue down */
2944                     b = a;
2945                     a = a->anc;
2946                     b->upDateCl = YES;
2947                     if (b->isLocked == YES)
2948                         {
2949                         u->isLocked = YES;
2950                         b->isLocked = NO;
2951                         u->lockID = b->lockID;
2952                         b->lockID = 0;
2953                         }
2954                     }
2955                 }
2956             }
2957         /* check whether stop is constrained */
2958         if (directionUp == YES)
2959             {
2960             if (a->left == NULL || a->isLocked == YES)
2961                 isStopConstrained = YES;
2962             }
2963         else
2964             {
2965             if (a->anc  == NULL || u->isLocked == YES)
2966                 isStopConstrained = YES;
2967             }
2968         }
2969 
2970     /* store brlen nodes */
2971     if (nRootNodes > 0)
2972         {
2973         if (directionUp == YES)
2974             {
2975             brlenNode[6] = a;
2976             brlenNode[5] = u;
2977             }
2978         else
2979             {
2980             brlenNode[6] = u;
2981             brlenNode[5] = b;
2982             }
2983         }
2984 
2985     /* move around in crown subtree */
2986     nCrownNodes = 0;
2987     if (moveInRoot == NO)
2988         {
2989         for (nCrownNodes=0; RandomNumber(seed)<extensionProb || nCrownNodes==0; nCrownNodes++)
2990             {
2991             if (c->left == NULL || c->isLocked == YES)
2992                 break;  /* can't go further */
2993             topologyHasChanged = YES;
2994             if (RandomNumber(seed) < 0.5)
2995                 {
2996                 /* rotate c anticlockwise - prepare pointers for move left */
2997                 c->anc = c->left;  /* the root will be in the direction we are heading */
2998                 c->left = c->right;
2999                 c->right = d;
3000                 }
3001             else
3002                 {
3003                 /* rotate c clockwise - prepare pointers for move right */
3004                 c->anc = c->right;  /* the root will be in the direction we are heading */
3005                 c->right = c->left;
3006                 c->left = d;
3007                 }
3008             /* OK - let's move!; c->anc points in the right direction
3009             don't forget to move the branch lengths as well */
3010             d = c;
3011             c = c->anc;
3012             d->length = c->length;
3013             d->upDateCl = YES;
3014             d->upDateTi = YES;
3015             }
3016         /* check if stop constrained */
3017         if (c->left == NULL || c->isLocked == YES)
3018             isStopConstrained = YES;
3019         }
3020 
3021     /* store brlen nodes */
3022     if (nCrownNodes > 0)
3023         {
3024         brlenNode[2] = c;
3025         brlenNode[1] = d;
3026         }
3027 
3028     /* adjust proposal ratio for constraints */
3029     if (isStartConstrained == NO && isStopConstrained == YES)
3030         (*lnProposalRatio) += log (2.0 * (1.0 - extensionProb));
3031     else if (isStartConstrained == YES && isStopConstrained == NO)
3032         (*lnProposalRatio) -= log (2.0 * (1.0 - extensionProb));
3033 
3034     /* combine the subtrees */
3035     c->anc = v;
3036     d->anc = v;
3037     if (directionLeft == YES)
3038         {
3039         v->left = c;
3040         v->right = d;
3041         }
3042     else
3043         {
3044         v->left = d;
3045         v->right = c;
3046         }
3047 
3048     /* the dangling branch is inserted in reverted position
3049        such that the back move will be possible
3050        if we have moved around in crown subtree
3051        otherwise it is left in its original position */
3052     if (nCrownNodes > 0)
3053         {
3054         d->length = x;
3055         d->upDateTi = YES;
3056         }
3057     else
3058         {
3059         c->length = x;
3060         }
3061 
3062     if (directionUp == YES)
3063         {
3064         u->anc = b;
3065         if (u->left == v)
3066             u->right = a;
3067         else
3068             u->left = a;
3069         a->anc = u;
3070         if (b->left == a)
3071             b->left = u;
3072         else
3073             b->right = u;
3074         /* the dangling branch is contained in u->length
3075            and will automatically be inserted in the right position
3076            to enable the back move regardless of whether it was
3077            initially directed upwards or downwards
3078            BUT if we haven't moved in root subtree, it is advantageous (necessary
3079            for rooted trees) to avoid switching branches, which occurs otherwise
3080            if directionUp == YES */
3081         if (nRootNodes == 0)
3082             {
3083             x = u->length;
3084             u->length = a->length;
3085             a->length = x;
3086             a->upDateTi = NO;
3087             u->upDateTi = NO;
3088             }
3089         }
3090     else
3091         {
3092         u->anc = a;
3093         if (u->left == v)
3094             u->right = b;
3095         else
3096             u->left = b;
3097         b->anc = u;
3098         if (a->left == b)
3099             a->left = u;
3100         else
3101             a->right = u;
3102         /* the modified branch contained in u->length will have
3103            to be moved to b->length to enable back move
3104            BUT if we haven't moved, it is better to keep it in place
3105            (necessary for rooted trees) */
3106         if (nRootNodes > 0)
3107             {
3108             x = u->length;
3109             u->length = b->length;
3110             b->length = x;
3111             b->upDateTi = YES;
3112             u->upDateTi = YES;
3113             }
3114         }
3115 
3116     /* modify branch lengths */
3117     /* first modify length of middle branch */
3118     m = brlenNode[3]->length;
3119     x = m * exp(tuning * (RandomNumber(seed) - 0.5));
3120     while (x < minV || x > maxV)
3121         {
3122         if (x < minV)
3123             x = minV * minV / x;
3124         else if (x > maxV)
3125             x = maxV * maxV / x;
3126         }
3127     brlenNode[3]->length = x;
3128     brlenNode[3]->upDateTi = YES;
3129 
3130     /* update proposal and prior ratio based on length modification */
3131     (*lnProposalRatio) += log (x / m);
3132     if (isVPriorExp == YES)
3133         (*lnPriorRatio) += brlensExp * (m - x);
3134 
3135     if (moveInRoot == NO)
3136         {
3137         /* if no move in crown, then select randomly, otherwise always the moved branch */
3138         if (nCrownNodes == 0 && RandomNumber(seed) < 0.5)
3139             p = brlenNode[0];
3140         else
3141             p = brlenNode[1];
3142 
3143         /* modify branch length */
3144         m = p->length;
3145         x = m * exp(tuning * (RandomNumber(seed) - 0.5));
3146         while (x < minV || x > maxV)
3147             {
3148             if (x < minV)
3149                 x = minV * minV / x;
3150             else if (x > maxV)
3151                 x = maxV * maxV / x;
3152             }
3153         p->length = x;
3154         p->upDateTi = YES;
3155 
3156         /* update proposal and prior ratio based on length modification */
3157         (*lnProposalRatio) += log (x / m);
3158         if (isVPriorExp == YES)
3159             (*lnPriorRatio) += brlensExp * (m - x);
3160         }
3161 
3162     if (moveInRoot == YES)
3163         {
3164         /* if no move in root, then select randomly, otherwise always the moved branch */
3165         if (nRootNodes == 0 && RandomNumber(seed) < 0.5)
3166             p = brlenNode[4];
3167         else
3168             p = brlenNode[5];
3169 
3170         /* modify branch length but not if 'root' branch in rooted tree */
3171         if (t->isRooted == NO || p->anc->anc != NULL)
3172             {
3173             m = p->length;
3174             x = m * exp(tuning * (RandomNumber(seed) - 0.5));
3175             while (x < minV || x > maxV)
3176                 {
3177                 if (x < minV)
3178                     x = minV * minV / x;
3179                 else if (x > maxV)
3180                     x = maxV * maxV / x;
3181                 }
3182             p->length = x;
3183             p->upDateTi = YES;
3184 
3185             /* update proposal and prior ratio based on length modification */
3186             (*lnProposalRatio) += log (x / m);
3187             if (isVPriorExp == YES)
3188                 (*lnPriorRatio) += brlensExp * (m - x);
3189             }
3190         }
3191 
3192     /* set flags for update of cond likes from v and down to root */
3193     p = v;
3194     while (p->anc != NULL)
3195         {
3196         p->upDateCl = YES;
3197         p = p->anc;
3198         }
3199 
3200     /* get down pass sequence if tree topology has changed */
3201     if (topologyHasChanged == YES)
3202         {
3203         GetDownPass (t);
3204         }
3205 
3206     /* Dirichlet or twoExp prior */
3207     if (isVPriorExp > 1)
3208         (*lnPriorRatio) += LogDirPrior(t, mp, isVPriorExp);
3209 
3210 #   if defined (DEBUG_ExtSPR)
3211     printf ("After:\n");
3212     ShowNodes (t->root, 2, NO);
3213     getchar();
3214     printf ("Proposal ratio: %f\n",(*lnProposalRatio));
3215     printf ("v: %d  u: %d  c: %d  d: %d  a: %d  b: %d\n",v->index, u->index,
3216             c->index, d->index, a->index, b->index);
3217     printf ("No. nodes moved in root subtree: %d\n",nRootNodes);
3218     printf ("No. nodes moved in crown subtree: %d\n",nCrownNodes);
3219     printf ("Has topology changed? %d\n",topologyHasChanged);
3220     getchar();
3221 #   endif
3222 
3223     return (NO_ERROR);
3224 }
3225 
3226 
Move_ExtSPRClock(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)3227 int Move_ExtSPRClock (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
3228 {
3229     /* Change branch lengths and topology (potentially) using SPR-type move
3230        with extension probability (rather than window, attachment rate or similar).
3231        The move is Metropolized, which should improve mixing. However, this means
3232        that it must be combined with a node slider move to be efficient.
3233 
3234        The move picks a branch and then moves its lower attachment point
3235        from its original position, one node at a time, with
3236        a probability determined by the extensionProb parameter. This is
3237        done in a way consistent with the clock constraints and any locked
3238        nodes there might be in the tree. The lower attachment point is
3239        minimally moved one node away.
3240 
3241        On the ending branch, the attachment point is reinserted randomly
3242        along the branch (below the minimum age of the node). */
3243 
3244     int         i, j, topologyHasChanged=NO, isStartLocked=NO, isStopLocked=NO, nRootNodes, directionUp,
3245                 n1=0, n2=0, n3=0, n4=0, n5=0, *nEvents;
3246     MrBFlt      x, y=0.0, oldBrlen=0.0, newBrlen=0.0, extensionProb, igrvar, *igrRate=NULL,
3247                 v1=0.0, v2=0.0, v3=0.0, v4=0.0, v5=0.0, v3new=0.0, lambda, *tk02Rate=NULL,
3248                 **position=NULL, **rateMultiplier=NULL, *brlens, nu, minV, clockRate;
3249     TreeNode    *p, *a, *b, *u, *v, *oldA;
3250     Tree        *t;
3251     ModelInfo   *m;
3252     Param       *subParm;
3253 
3254     extensionProb = mvp[0]; /* extension probability */
3255 
3256     (*lnProposalRatio) = (*lnPriorRatio) = 0.0;
3257 
3258     /* get tree */
3259     t = GetTree (param, chain, state[chain]);
3260 
3261     /* get model params and model info */
3262     m = &modelSettings[param->relParts[0]];
3263 
3264     /* get clock rate */
3265     clockRate = *GetParamVals (m->clockRate, chain, state[chain]);
3266 
3267     /* get min and max branch lengths in relative time and substitution units */
3268     minV = BRLENS_MIN;
3269 
3270 #   if defined (DEBUG_ExtSPRClock)
3271     printf ("Before:\n");
3272     ShowNodes (t->root, 2, YES);
3273     getchar();
3274 #   endif
3275 
3276     /* pick a branch */
3277     do  {
3278         p = t->allDownPass[(int)(RandomNumber(seed) * (t->nNodes - 2))];
3279         a = p->anc->left;
3280         b = p->anc->right;
3281         }
3282     while (p->anc->isLocked == YES || p->anc->anc->anc == NULL
3283            || (p == b && a->length < TIME_MIN) || (p == a && b->length < TIME_MIN)
3284            || (p->length < TIME_MIN && p->calibration->prior == fixed));
3285     /* skip constraints, siblings of root (and root); and consider ancestral fossils in fbd tree */
3286 
3287     /* set up pointers for nodes around the picked branch */
3288     v = p;
3289     u = p->anc;
3290     if (u->left == v)
3291         a = u->right;
3292     else
3293         a = u->left;
3294     b = u->anc;
3295     oldA = a;
3296 
3297     /* record branch length for insertion in back move */
3298     if (v->length > 0.0)  /* side branch, not anc fossil */
3299         {
3300         if (v->nodeDepth > a->nodeDepth)
3301             oldBrlen = b->nodeDepth - v->nodeDepth - 2.0*minV;
3302         else
3303             oldBrlen = b->nodeDepth - a->nodeDepth - 2.0*minV;
3304         }
3305     else  /* ancestral fossil */
3306         {
3307         y = (b->nodeDepth - minV > v->calibration->max * clockRate) ? (v->calibration->max * clockRate) : (b->nodeDepth - minV);
3308         x = (a->nodeDepth + minV < v->calibration->min * clockRate) ? (v->calibration->min * clockRate) : (a->nodeDepth + minV);
3309         oldBrlen = y - x;
3310         }
3311     v1 = a->length;
3312     v2 = u->length;
3313     v3 = v->length;
3314 
3315     /* reassign events for CPP and adjust prior and proposal ratios for relaxed clock models */
3316     for (i=0; i<param->subParams[0]->nSubParams; i++)
3317         {
3318         subParm = param->subParams[0]->subParams[i];
3319         if (subParm->paramType == P_CPPEVENTS)
3320             {
3321             /* get pointers to CPP events */
3322             nEvents = subParm->nEvents[2*chain+state[chain]];
3323             position = subParm->position[2*chain+state[chain]];
3324             rateMultiplier = subParm->rateMult[2*chain+state[chain]];
3325             n1 = nEvents[a->index];
3326             n2 = nEvents[u->index];
3327             n3 = nEvents[v->index];
3328             if (n2 > 0)
3329                 {
3330                 position[a->index] = (MrBFlt *) SafeRealloc ((void *) position[a->index], (n1+n2) * sizeof (MrBFlt));
3331                 rateMultiplier[a->index] = (MrBFlt *) SafeRealloc ((void *) rateMultiplier[a->index], (n1+n2) * sizeof (MrBFlt));
3332                 }
3333             for (j=0; j<n1; j++)
3334                 position[a->index][j] *= v1 / (v1+v2);
3335             for (j=n1; j<n1+n2; j++)
3336                 {
3337                 position[a->index][j] = (position[u->index][j-n1] * v2 + v1) / (v1+v2);
3338                 rateMultiplier[a->index][j] = rateMultiplier[u->index][j-n1];
3339                 }
3340             nEvents[a->index] = n1+n2;
3341             nEvents[u->index] = 0;
3342             if (n2 > 0)
3343                 {
3344                 free (position[u->index]);
3345                 free (rateMultiplier[u->index]);
3346                 position[u->index] = rateMultiplier[u->index] = NULL;
3347                 }
3348             }   /* end CPP events parm */
3349         else if ( subParm->paramType == P_TK02BRANCHRATES ||
3350                  (subParm->paramType == P_MIXEDBRCHRATES && *GetParamIntVals(subParm, chain, state[chain]) == RCL_TK02))
3351             {
3352             /* adjust prior ratio */
3353             if (subParm->paramType == P_TK02BRANCHRATES)
3354                 nu = *GetParamVals (modelSettings[subParm->relParts[0]].tk02var, chain, state[chain]);
3355             else
3356                 nu = *GetParamVals (modelSettings[subParm->relParts[0]].mixedvar, chain, state[chain]);
3357             tk02Rate = GetParamVals (subParm, chain, state[chain]);
3358             if (v->length > 0.0)
3359                 (*lnPriorRatio) -= LnProbTK02LogNormal(tk02Rate[v->anc->index], nu*v->length, tk02Rate[v->index]);
3360             (*lnPriorRatio) -= LnProbTK02LogNormal(tk02Rate[a->anc->index], nu*a->length, tk02Rate[a->index]);
3361             (*lnPriorRatio) -= LnProbTK02LogNormal(tk02Rate[u->anc->index], nu*u->length, tk02Rate[u->index]);
3362             (*lnPriorRatio) += LnProbTK02LogNormal(tk02Rate[u->anc->index], nu*(a->length+u->length), tk02Rate[a->index]);
3363 
3364             /* adjust effective branch lengths */
3365             brlens = GetParamSubVals (subParm, chain, state[chain]);
3366             brlens[a->index] = (tk02Rate[a->index] + tk02Rate[b->index]) / 2.0 * (a->length + u->length);
3367             }   /* end tk02 branch rate parameter */
3368         else if ( subParm->paramType == P_IGRBRANCHRATES ||
3369                  (subParm->paramType == P_MIXEDBRCHRATES && *GetParamIntVals(subParm, chain, state[chain]) == RCL_IGR))
3370             {
3371             if (subParm->paramType == P_IGRBRANCHRATES)
3372                 igrvar = *GetParamVals (modelSettings[subParm->relParts[0]].igrvar, chain, state[chain]);
3373             else
3374                 igrvar = *GetParamVals (modelSettings[subParm->relParts[0]].mixedvar, chain, state[chain]);
3375             igrRate = GetParamVals (subParm, chain, state[chain]);
3376 
3377              /* adjust prior ratio for old branches */
3378             if (v->length > 0.0)
3379                 (*lnPriorRatio) -= LnProbGamma(v->length/igrvar, v->length/igrvar, igrRate[v->index]);
3380             (*lnPriorRatio) -= LnProbGamma(a->length/igrvar, a->length/igrvar, igrRate[a->index]);
3381             (*lnPriorRatio) -= LnProbGamma(u->length/igrvar, u->length/igrvar, igrRate[u->index]);
3382             (*lnPriorRatio) += LnProbGamma((a->length+u->length)/igrvar, (a->length+u->length)/igrvar, igrRate[a->index]);
3383 
3384             /* adjust effective branch lengths and rates */
3385             brlens = GetParamSubVals (subParm, chain, state[chain]);
3386             brlens[a->index] = igrRate[a->index] * (a->length + u->length);
3387             }
3388         }   /* next subparameter */
3389 
3390     /* cut tree */
3391     a->anc = b;
3392     if (b->left == u)
3393         b->left = a;
3394     else
3395         b->right = a;
3396     a->length += u->length;
3397     a->upDateTi = YES;
3398 
3399     /* determine initial direction of move and whether the reverse move would be stopped by constraints */
3400     if (a->left == NULL || a->isLocked == YES || a->nodeDepth < v->nodeDepth + minV)
3401         {
3402         isStartLocked = YES;
3403         directionUp = NO;
3404         }
3405     else
3406         {
3407         isStartLocked = NO;
3408         if (RandomNumber(seed) < 0.5)
3409             directionUp = YES;
3410         else
3411             directionUp = NO;
3412         }
3413 
3414     /* move around in root subtree */
3415     for (nRootNodes=0; nRootNodes==0 || RandomNumber(seed)<extensionProb; nRootNodes++)
3416         {
3417         if (directionUp == YES)
3418             {   /* going up tree */
3419             if (a->left == NULL || a->isLocked == YES || a->nodeDepth < v->nodeDepth + minV)
3420                 break;      /* can't go farther */
3421             topologyHasChanged = YES;
3422             b = a;
3423             if (a->left->length < TIME_MIN)
3424                 a = a->right;
3425             else if (a->right->length < TIME_MIN)
3426                 a = a->left;
3427             else if (RandomNumber(seed) < 0.5)
3428                 a = a->left;
3429             else
3430                 a = a->right;
3431             }
3432         else
3433             {   /* going down tree */
3434             topologyHasChanged = YES;
3435             if (RandomNumber(seed) < 0.5 || b->anc->anc == NULL || b->isLocked == YES)
3436                 {
3437                 directionUp = YES; /* switch direction */
3438                 /* find sister of a */
3439                 if (b->left == a)
3440                     a = b->right;
3441                 else
3442                     a = b->left;
3443                 /* as long as we are moving upwards
3444                 the cond likes to update will be
3445                 flagged by the last pass from u to the root */
3446                 }
3447             else
3448                 {   /* continue down */
3449                 a = b;
3450                 b = b->anc;
3451                 a->upDateCl = YES;
3452                 }
3453             }
3454         }
3455 
3456     /* determine whether the forward move was or would have been stopped by constraints */
3457     isStopLocked = NO;
3458     if (directionUp == YES)
3459         {
3460         if (a->left == NULL || a->isLocked == YES || a->nodeDepth < v->nodeDepth + minV)
3461             isStopLocked = YES;
3462         }
3463 
3464     /* reattach u */
3465     if (u->left == v)
3466         u->right = a;
3467     else
3468         u->left = a;
3469     a->anc = u;
3470     u->anc = b;
3471     if (b->left == a)
3472         b->left = u;
3473     else
3474         b->right = u;
3475 
3476     if (v->length > 0.0)  /* side branch, not anc fossil */
3477         {
3478         if (a->nodeDepth > v->nodeDepth)
3479             newBrlen = b->nodeDepth - a->nodeDepth - 2.0*minV;
3480         else
3481             newBrlen = b->nodeDepth - v->nodeDepth - 2.0*minV;
3482         }
3483     else  /* ancestral fossil */
3484         {
3485         y = (b->nodeDepth - minV > v->calibration->max * clockRate) ? (v->calibration->max * clockRate) : (b->nodeDepth - minV);
3486         x = (a->nodeDepth + minV < v->calibration->min * clockRate) ? (v->calibration->min * clockRate) : (a->nodeDepth + minV);
3487         newBrlen = y - x;
3488         }
3489     if (newBrlen <= 0.0)
3490         {
3491         abortMove = YES;
3492         return (NO_ERROR);
3493         }
3494 
3495     /* adjust lengths */
3496     if (v->length > 0.0)  /* side branch, not anc fossil */
3497         {
3498         u->nodeDepth = b->nodeDepth - minV - RandomNumber(seed) * newBrlen;
3499         v->length = u->nodeDepth - v->nodeDepth;
3500         }
3501     else  /* ancestral fossil */
3502         {
3503         u->nodeDepth = y - RandomNumber(seed) * newBrlen;
3504         v->nodeDepth = u->nodeDepth;
3505         v->age = u->age = u->nodeDepth / clockRate;
3506         }
3507     u->length = b->nodeDepth - u->nodeDepth;
3508     a->length = u->nodeDepth - a->nodeDepth;
3509 
3510     v3new = v->length;
3511     v4 = a->length;
3512     v5 = u->length;
3513 
3514     /* adjust events, prior ratio and proposal ratio for relaxed clock models */
3515     for (i=0; i<param->subParams[0]->nSubParams; i++)
3516         {
3517         subParm = param->subParams[0]->subParams[i];
3518         if (subParm->paramType == P_CPPEVENTS)
3519             {
3520             /* reassign events for CPP */
3521             nEvents = subParm->nEvents[2*chain+state[chain]];
3522             position = subParm->position[2*chain+state[chain]];
3523             rateMultiplier = subParm->rateMult[2*chain+state[chain]];
3524             for (j=0; j<nEvents[a->index]; j++)
3525                 {
3526                 if (position[a->index][j] > v4 / (v4+v5))
3527                     break;
3528                 }
3529             n4 = j;
3530             n5 = nEvents[a->index] - j;
3531             nEvents[u->index] = n5;
3532             if (n5 > 0)
3533                 {
3534                 position[u->index] = (MrBFlt *) SafeRealloc ((void *) position[u->index], n5 * sizeof (MrBFlt));
3535                 rateMultiplier[u->index] = (MrBFlt *) SafeRealloc ((void *) rateMultiplier[u->index], n5 * sizeof (MrBFlt));
3536                 for (j=n4; j<nEvents[a->index]; j++)
3537                     {
3538                     position[u->index][j-n4] = (position[a->index][j] * (v4+v5) - v4) / v5;
3539                     rateMultiplier[u->index][j-n4] = rateMultiplier[a->index][j];
3540                     }
3541                 if (n4 > 0)
3542                     {
3543                     position[a->index] = (MrBFlt *) SafeRealloc ((void *) position[a->index], n4 * sizeof (MrBFlt));
3544                     rateMultiplier[a->index] = (MrBFlt *) SafeRealloc ((void *) rateMultiplier[a->index], n4 * sizeof (MrBFlt));
3545                     for (j=0; j<n4; j++)
3546                         position[a->index][j] *= ((v4+v5) / v4);
3547                     }
3548                 else
3549                     {
3550                     free (position[a->index]);
3551                     free (rateMultiplier[a->index]);
3552                     position[a->index] = rateMultiplier[a->index] = NULL;
3553                     }
3554                 nEvents[a->index] = n4;
3555                 }
3556             else
3557                 {
3558                 for (j=0; j<nEvents[a->index]; j++)
3559                     position[a->index][j] *= ((v4+v5) / v4);
3560                 }
3561 
3562             /* adjust proposal ratio for length change in v branch*/
3563             (*lnProposalRatio) += n3 * log (v3new / v3);
3564 
3565             /* adjust prior ratio for length change */
3566             lambda = *GetParamVals (modelSettings[subParm->relParts[0]].cppRate, chain, state[chain]);
3567             (*lnPriorRatio) += lambda * (v3 - v3new);
3568 
3569             /* update effective branch lengths */
3570             if (UpdateCppEvolLengths (subParm, oldA, chain) == ERROR)
3571                 {
3572                 abortMove = YES;
3573                 return (NO_ERROR);
3574                 }
3575             if (UpdateCppEvolLengths (subParm, u, chain) == ERROR)
3576                 {
3577                 abortMove = YES;
3578                 return (NO_ERROR);
3579                 }
3580             }   /* end cpp events parameter */
3581         else if ( subParm->paramType == P_TK02BRANCHRATES ||
3582                  (subParm->paramType == P_MIXEDBRCHRATES && *GetParamIntVals(subParm, chain, state[chain]) == RCL_TK02))
3583             {
3584             /* adjust prior ratio */
3585             if (subParm->paramType == P_TK02BRANCHRATES)
3586                 nu = *GetParamVals (modelSettings[subParm->relParts[0]].tk02var, chain, state[chain]);
3587             else
3588                 nu = *GetParamVals (modelSettings[subParm->relParts[0]].mixedvar, chain, state[chain]);
3589             tk02Rate = GetParamVals (subParm, chain, state[chain]);
3590             (*lnPriorRatio) -= LnProbTK02LogNormal(tk02Rate[u->anc->index], nu*(a->length+u->length), tk02Rate[a->index]);
3591             (*lnPriorRatio) += LnProbTK02LogNormal(tk02Rate[a->anc->index], nu*a->length, tk02Rate[a->index]);
3592             (*lnPriorRatio) += LnProbTK02LogNormal(tk02Rate[u->anc->index], nu*u->length, tk02Rate[u->index]);
3593             if (v->length > 0.0)
3594                 (*lnPriorRatio) += LnProbTK02LogNormal(tk02Rate[v->anc->index], nu*v->length, tk02Rate[v->index]);
3595 
3596             /* adjust effective branch lengths */
3597             brlens = GetParamSubVals (subParm, chain, state[chain]);
3598             brlens[a->index] = a->length * (tk02Rate[a->index] + tk02Rate[a->anc->index]) / 2.0;
3599             brlens[v->index] = v->length * (tk02Rate[v->index] + tk02Rate[v->anc->index]) / 2.0;
3600             brlens[u->index] = u->length * (tk02Rate[u->index] + tk02Rate[u->anc->index]) / 2.0;
3601             }   /* end tk02 branch rate parameter */
3602         else if ( subParm->paramType == P_IGRBRANCHRATES ||
3603                  (subParm->paramType == P_MIXEDBRCHRATES && *GetParamIntVals(subParm, chain, state[chain]) == RCL_IGR))
3604             {
3605             /* adjust prior ratio */
3606             if (subParm->paramType == P_IGRBRANCHRATES)
3607                 igrvar = *GetParamVals (modelSettings[subParm->relParts[0]].igrvar, chain, state[chain]);
3608             else
3609                 igrvar = *GetParamVals (modelSettings[subParm->relParts[0]].mixedvar, chain, state[chain]);
3610             igrRate = GetParamVals (subParm, chain, state[chain]);
3611             (*lnPriorRatio) -= LnProbGamma ((a->length+u->length)/igrvar, (a->length+u->length)/igrvar, igrRate[a->index]);
3612             (*lnPriorRatio) += LnProbGamma (a->length/igrvar, a->length/igrvar, igrRate[a->index]);
3613             (*lnPriorRatio) += LnProbGamma (u->length/igrvar, u->length/igrvar, igrRate[u->index]);
3614             if (v->length > 0.0)
3615                 (*lnPriorRatio) += LnProbGamma (v->length/igrvar, v->length/igrvar, igrRate[v->index]);
3616 
3617             /* adjust effective branch lengths */
3618             brlens = GetParamSubVals (subParm, chain, state[chain]);
3619             brlens[v->index] = igrRate[v->index] * v->length;
3620             brlens[u->index] = igrRate[u->index] * u->length;
3621             brlens[a->index] = igrRate[a->index] * a->length;
3622             }   /* end igr branch rate parameter */
3623         }   /* next subparameter */
3624 
3625     /* set tiprobs update flags */
3626     a->upDateTi = YES;
3627     u->upDateTi = YES;
3628     v->upDateTi = YES;
3629 
3630     /* set flags for update of cond likes from u and down to root */
3631     p = u;
3632     while (p->anc != NULL)
3633         {
3634         p->upDateCl = YES;
3635         p = p->anc;
3636         }
3637 
3638     /* adjust prior ratio for clock tree */
3639     if (LogClockTreePriorRatio(param, chain, &x) == ERROR)
3640         return (ERROR);
3641     (*lnPriorRatio) += x;
3642 
3643     if (topologyHasChanged == YES)
3644         {
3645         /* get down pass sequence if tree topology has changed */
3646         GetDownPass (t);
3647         /* calculate proposal ratio for tree change */
3648         (*lnProposalRatio) += log (newBrlen / oldBrlen);
3649         if (isStartLocked == NO && isStopLocked == YES)
3650             (*lnProposalRatio) += log (2.0 * (1.0 - extensionProb));
3651         else if (isStartLocked == YES && isStopLocked == NO)
3652             (*lnProposalRatio) -= log (2.0 * (1.0 - extensionProb));
3653         }
3654 
3655 #   if defined (DEBUG_ExtSPRClock)
3656     ShowNodes (t->root, 2, YES);
3657     printf ("After\nProposal ratio: %f\n",(*lnProposalRatio));
3658     printf ("v: %d  u: %d  a: %d  b: %d\n",v->index, u->index, a->index, b->index);
3659     printf ("No. nodes moved in root subtree: %d\n",nRootNodes);
3660     printf ("Has topology changed? %d\n",topologyHasChanged);
3661 #   endif
3662 
3663     return (NO_ERROR);
3664 }
3665 
3666 
Move_ExtSS(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)3667 int Move_ExtSS (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
3668 {
3669     /* Change branch lengths and topology (potentially) using Subtree Swapping (unrooted)
3670        with extension probability.
3671 
3672        This move type picks two subtrees and swaps their position. Like the SPR and TBR,
3673        it is a superset of the NNI but there are some interesting differences. With the
3674        SPR and TBR, it is not possible to go between all five-tip trees in a single
3675        step. For instance, going from ((1,2),3,(4,5)) to ((1,5),3,(4,2)) requires two
3676        steps. The SS move can go between all pairs of five-tip trees in a single step.
3677        Some six-tip tree pairs will require two steps though.
3678 
3679        Unlike the published version of the move (Lakner et al, Syst Bio), this version
3680        does _not_ multiply all branch lengths between the subtrees.
3681 
3682        */
3683 
3684     int         i, numFree, topologyHasChanged, nCrownNodes, nRootNodes, directionLeft, directionUp,
3685                 isVPriorExp, moveInRoot;
3686     MrBFlt      m, x, tuning, maxV, minV, extensionProb, brlensExp=0.0;
3687     TreeNode    *p, *q, *a, *b, *c, *d, *u, *v;
3688     Tree        *t;
3689     ModelParams *mp;
3690 
3691     (*lnPriorRatio) = (*lnProposalRatio) = 0.0;
3692 
3693     /* these parameters should be possible to set by user */
3694     extensionProb = mvp[0]; /* extension probability */
3695     tuning = mvp[1];        /* Larget & Simon's tuning parameter lambda */
3696 
3697     /* get tree */
3698     t = GetTree (param, chain, state[chain]);
3699 
3700     /* get model params */
3701     mp = &modelParams[param->relParts[0]];
3702 
3703     /* max and min brlen */
3704     if (param->subParams[0]->paramId == BRLENS_UNI)
3705         {
3706         minV = mp->brlensUni[0] > BRLENS_MIN ? mp->brlensUni[0] : BRLENS_MIN;
3707         maxV = mp->brlensUni[1];
3708         isVPriorExp = NO;
3709         }
3710     else if (param->subParams[0]->paramId == BRLENS_GamDir)
3711         {
3712         minV = BRLENS_MIN;
3713         maxV = BRLENS_MAX;
3714         isVPriorExp = 2;
3715         }
3716     else if (param->subParams[0]->paramId == BRLENS_iGmDir)
3717         {
3718         minV = BRLENS_MIN;
3719         maxV = BRLENS_MAX;
3720         isVPriorExp = 3;
3721         }
3722     else if (param->subParams[0]->paramId == BRLENS_twoExp)
3723         {
3724         minV = BRLENS_MIN;
3725         maxV = BRLENS_MAX;
3726         isVPriorExp = 4;
3727         }
3728     else
3729         {
3730         minV = BRLENS_MIN;
3731         maxV = BRLENS_MAX;
3732         brlensExp = mp->brlensExp;
3733         isVPriorExp = YES;
3734         }
3735 
3736     /* Dirichlet or twoExp prior */
3737     if (isVPriorExp > 1)
3738         (*lnPriorRatio) = -LogDirPrior(t, mp, isVPriorExp);
3739 
3740     topologyHasChanged = NO;
3741 
3742     /* unmark all tree */
3743     for (i=0; i<t->nNodes; i++)
3744         {
3745         p = t->allDownPass[i];
3746         p->marked = NO;
3747         }
3748 
3749     /* pick a branch */
3750     do
3751         {
3752         p = t->allDownPass[(int)(RandomNumber(seed) * t->nNodes)];
3753         } while (p->anc == NULL);
3754 
3755     /* set up pointers for nodes around the picked branch */
3756     v = p;
3757     u = p->anc;
3758 
3759     /* check the possible move directions */
3760     numFree = 0;
3761     if (v->left != NULL && v->left->isLocked == NO)
3762         numFree ++;
3763     if (v->right != NULL && v->right->isLocked == NO)
3764         numFree++;
3765     if (u->anc != NULL && u->isLocked == NO)
3766         numFree++;
3767     if (u->left == v)
3768         {
3769         if (u->right != NULL && u->right->isLocked == NO)
3770             numFree++;
3771         }
3772     else
3773         {
3774         if (u->left != NULL && u->left->isLocked == NO)
3775             numFree++;
3776         }
3777 
3778     /* select one of them randomly */
3779     i = (int) (RandomNumber(seed) * numFree) + 1;
3780     numFree = 0;
3781     a = b = c = d = p;
3782     directionLeft = directionUp = moveInRoot = NO;
3783     if (v->left != NULL && v->left->isLocked == NO)
3784         {
3785         numFree ++;
3786         if (i == numFree)
3787             {
3788             moveInRoot = NO;
3789             directionLeft = YES;
3790             c = v->left;
3791             d = v;
3792             }
3793         }
3794     if (v->right != NULL && v->right->isLocked == NO)
3795         {
3796         numFree ++;
3797         if (i == numFree)
3798             {
3799             moveInRoot = NO;
3800             directionLeft = NO;
3801             c = v->right;
3802             d = v;
3803             }
3804         }
3805     if (u->anc != NULL && u->isLocked == NO)
3806         {
3807         numFree ++;
3808         if (i == numFree)
3809             {
3810             moveInRoot = YES;
3811             directionUp = NO;
3812             a = u->anc;
3813             b = u;
3814             }
3815         }
3816     if (u->left == v)
3817         {
3818         if (u->right != NULL && u->right->isLocked == NO)
3819             {
3820             numFree ++;
3821             if (i == numFree)
3822                 {
3823                 moveInRoot = YES;
3824                 directionUp = YES;
3825                 a = u->right;
3826                 b = u;
3827                 }
3828             }
3829         }
3830     else
3831         {
3832         if (u->left != NULL && u->left->isLocked == NO)
3833             {
3834             numFree ++;
3835             if (i == numFree)
3836                 {
3837                 moveInRoot = YES;
3838                 directionUp = YES;
3839                 a = u->left;
3840                 b = u;
3841                 }
3842             }
3843         }
3844 
3845 #   if defined (DEBUG_ExtSS)
3846     printf ("Before:\n");
3847     ShowNodes (t->root, 2, NO);
3848     printf ("v: %d  u: %d  c: %d  d: %d  a: %d  b: %d\n",v->index, u->index,
3849         c->index, d->index, a->index, b->index);
3850     printf ("directionUp = %d -- directionLeft = %d -- moveInRoot = %d\n", directionUp, directionLeft, moveInRoot);
3851     getchar();
3852 #   endif
3853 
3854     /* move around and potentially swap in root subtree */
3855     nRootNodes = 0;
3856     if (moveInRoot == YES)
3857         {
3858         for (nRootNodes=0; nRootNodes==0 || RandomNumber(seed)<extensionProb; nRootNodes++)
3859             {
3860             if (directionUp == YES)
3861                 {   /* going up tree */
3862                 if (a->left == NULL || a->isLocked == YES)
3863                     break;      /* can't go further */
3864                 topologyHasChanged = YES;
3865                 b = a;
3866                 if (RandomNumber(seed) < 0.5)
3867                     a = a->left;
3868                 else
3869                     a = a->right;
3870                 }
3871             else
3872                 {   /* going down tree */
3873                 if (a->anc == NULL || a->isLocked == YES)
3874                     break;      /* can't go further */
3875                 topologyHasChanged = YES;
3876                 b->marked = YES;
3877 
3878                 if (RandomNumber(seed) < 0.5)
3879                     {
3880                     directionUp = YES; /* switch direction */
3881                     /* find sister of a */
3882                     if (a->left == b)
3883                         {
3884                         b = a;
3885                         a = a->right;
3886                         }
3887                     else
3888                         {
3889                         b = a;
3890                         a = a->left;
3891                         }
3892                     }
3893                 else
3894                     {   /* continue down */
3895                     b = a;
3896                     a = a->anc;
3897                     }
3898                 }
3899             }
3900         /* swap the root subtrees */
3901         if (nRootNodes > 0)
3902             {
3903             if (directionUp == YES)
3904                 {
3905                 v->anc = b;
3906                 a->anc = u;
3907                 if (b->left == a)
3908                     b->left = v;
3909                 else if (b->right == a)
3910                     b->right = v;
3911                 if (u->left == v)
3912                     u->left = a;
3913                 else
3914                     u->right = a;
3915                 }
3916             else
3917                 {
3918                 /* rotate the nodes from b to u*/
3919                 p = b;
3920                 q = a;
3921                 x = b->length;
3922                 while (p->left->marked == YES || p->right->marked == YES)
3923                     {
3924                     if (p->left->marked == YES)
3925                         {
3926                         /* rotate p anticlockwise - prepare pointers for move left */
3927                         p->anc = p->left;  /* the root will be in the direction we are heading */
3928                         p->left = p->right;
3929                         p->right = q;
3930                         }
3931                     else
3932                         {
3933                         /* rotate p clockwise - prepare pointers for move right */
3934                         p->anc = p->right;  /* the root will be in the direction we are heading */
3935                         p->right = p->left;
3936                         p->left = q;
3937                         }
3938                     /* OK - let's move!; p->anc points in the right direction
3939                     don't forget to move the branch lengths as well */
3940                     q = p;
3941                     p = p->anc;
3942                     q->length = p->length;
3943                     q->upDateTi = YES;
3944                     }
3945                 /* rotations finished, take care of u */
3946                 if (u->left == v)
3947                     u->left = u->anc;
3948                 else
3949                     u->right = u->anc;
3950                 u->length = x;
3951                 /* now swap the subtrees of u and b */
3952                 if (a->left == b)
3953                     a->left = u;
3954                 else
3955                     a->right = u;
3956                 u->anc = a;
3957                 v->anc = b;
3958                 if (b->left == a)
3959                     b->left = v;
3960                 else
3961                     b->right = v;
3962                 }
3963             }
3964         }
3965 
3966     /* move around and potentially swap in crown subtree */
3967     nCrownNodes = 0;
3968     if (moveInRoot == NO)
3969         {
3970         x = v->length;  /* save v length in case there is a move */
3971         for (nCrownNodes=0; nCrownNodes==0 || RandomNumber(seed)<extensionProb; nCrownNodes++)
3972             {
3973             if (c->left == NULL || c->isLocked == YES)
3974                 break;  /* can't go further */
3975 
3976             topologyHasChanged = YES;
3977 
3978             /* prepare d for move */
3979             d->anc = c;
3980             d->length = c->length;
3981             d->upDateTi = YES;
3982             d->upDateCl = YES;
3983             if (d->isLocked == YES)
3984                 {
3985                 c->isLocked = YES;
3986                 d->isLocked = NO;
3987                 c->lockID = d->lockID;
3988                 d->lockID = -1;
3989                 }
3990 
3991             /* go left or right with equal probability */
3992             if (RandomNumber(seed) < 0.5)
3993                 {
3994                 /* rotate c anticlockwise - prepare pointers for move left */
3995                 c->anc = c->left;  /* the root will be in the direction we are heading */
3996                 c->left = c->right;
3997                 c->right = d;
3998                 }
3999             else
4000                 {
4001                 /* rotate c clockwise - prepare pointers for move right */
4002                 c->anc = c->right;  /* the root will be in the direction we are heading */
4003                 c->right = c->left;
4004                 c->left = d;
4005                 }
4006             /* OK - let's move!; c->anc points in the right direction */
4007             d = c;
4008             c = c->anc;
4009             }
4010 
4011         /* swap the crown subtrees */
4012         if (nCrownNodes > 0)
4013             {
4014             d->anc = u;
4015             d->length = x;
4016             if (u->left == v)
4017                 u->left = d;
4018             else
4019                 u->right = d;
4020 
4021             c->anc = v;
4022             if (directionLeft == YES)
4023                 v->left = c;
4024             else
4025                 v->right = c;
4026             }
4027         }
4028 
4029     /* modify branch lengths */
4030     if (nCrownNodes > 0)
4031         {
4032         p = c;
4033         q = d;
4034         }
4035     else if (nRootNodes > 0)
4036         {
4037         if (directionUp == YES)
4038             {
4039             p = v;
4040             q = a;
4041             }
4042         else
4043             {
4044             p = v;
4045             q = u;
4046             }
4047         }
4048     else
4049         {
4050         p = v;
4051         if (RandomNumber(seed) < 0.5)
4052             {
4053             if (RandomNumber(seed) < 0.5)
4054                 q = u;
4055             else
4056                 {
4057                 if (u->left == v)
4058                     q = u->right;
4059                 else
4060                     q = u->left;
4061                 }
4062             }
4063         else
4064             {
4065             if (RandomNumber(seed) < 0.5)
4066                 q = v->left;
4067             else
4068                 q = v->right;
4069             }
4070         }
4071 
4072     if (p != NULL)
4073         {
4074         m = p->length;
4075         x = m * exp(tuning * (RandomNumber(seed) - 0.5));
4076         while (x < minV || x > maxV)
4077             {
4078             if (x < minV)
4079                 x = minV * minV / x;
4080             else if (x > maxV)
4081                 x = maxV * maxV / x;
4082             }
4083         p->length = x;
4084         p->upDateTi = YES;
4085 
4086         /* update proposal and prior ratio based on length modification */
4087         (*lnProposalRatio) += log (x / m);
4088         if (isVPriorExp == YES)
4089             (*lnPriorRatio) += brlensExp * (m - x);
4090         }
4091 
4092     if (q != NULL && q->anc != NULL)
4093         {
4094         m = q->length;
4095         x = m * exp(tuning * (RandomNumber(seed) - 0.5));
4096         while (x < minV || x > maxV)
4097             {
4098             if (x < minV)
4099                 x = minV * minV / x;
4100             else if (x > maxV)
4101                 x = maxV * maxV / x;
4102             }
4103         q->length = x;
4104         q->upDateTi = YES;
4105 
4106         /* update proposal and prior ratio based on length modification */
4107         (*lnProposalRatio) += log (x / m);
4108         if (isVPriorExp == YES)
4109             (*lnPriorRatio) += brlensExp * (m - x);
4110         }
4111 
4112     /* set flags for update of cond likes from v and down to root */
4113     p = v;
4114     while (p->anc != NULL)
4115         {
4116         p->upDateCl = YES;
4117         p = p->anc;
4118         }
4119 
4120     if (topologyHasChanged == YES)
4121         {
4122         /* set flags for update of cond likes from u and down to root */
4123         p = u;
4124         while (p->anc != NULL)
4125             {
4126             p->upDateCl = YES;
4127             p = p->anc;
4128             }
4129         }
4130 
4131     /* get down pass sequence if tree topology has changed */
4132     if (topologyHasChanged == YES)
4133         {
4134         GetDownPass (t);
4135         }
4136 
4137     /* Dirichlet or twoExp prior */
4138     if (isVPriorExp > 1)
4139         (*lnPriorRatio) += LogDirPrior(t, mp, isVPriorExp);
4140 
4141 #   if defined (DEBUG_ExtSS)
4142     printf ("After:\n");
4143     ShowNodes (t->root, 2, NO);
4144     getchar();
4145     printf ("Proposal ratio: %f\n",exp(*lnProposalRatio));
4146     printf ("v: %d  u: %d  c: %d  d: %d  a: %d  b: %d\n",v->index, u->index,
4147         c->index, d->index, a->index, b->index);
4148     printf ("No. nodes moved in root subtree: %d\n",nRootNodes);
4149     printf ("No. nodes moved in crown subtree: %d\n",nCrownNodes);
4150     printf ("Has topology changed? %d\n",topologyHasChanged);
4151     printf ("directionUp = %d -- directionLeft = %d\n", directionUp, directionLeft);
4152     getchar();
4153 #   endif
4154 
4155     return (NO_ERROR);
4156 }
4157 
4158 
Move_ExtSSClock(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)4159 int Move_ExtSSClock (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
4160 {
4161     /* Change branch lengths and topology (potentially) using SS-type move
4162        with extension probability (rather than window, attachment rate or similar). */
4163 
4164     /* This move picks a branch at random. It then moves away from this branch, one
4165        one node at a time, with a probability determined by the extensionProb parameter.
4166        The process stops when a tip is reached or when a move further upwards would break
4167        the clock assumption. When the extension process stops, the subtrees supported by
4168        the two chosen branches are swapped. Since 2010-11-01, the move is Metropolized for
4169        increased efficiency. */
4170     /* Note: this move is not compatible with fossilized birth-death model with ancestral fossils */
4171 
4172     int         i, *nEvents, numFreeOld, numFreeNew;
4173     MrBFlt      x, oldALength, oldCLength, extensionProb, igrvar, *igrRate,
4174                 *tk02Rate, *brlens, nu, ran, cumulativeProb, forwardProb,
4175                 backwardProb, minV;
4176     TreeNode    *p, *q, *a, *c;
4177     Tree        *t;
4178     Param       *subParm;
4179 
4180     extensionProb = mvp[0]; /* extension probability */
4181 
4182     (*lnProposalRatio) = (*lnPriorRatio) = 0.0;
4183 
4184     /* get tree */
4185     t = GetTree (param, chain, state[chain]);
4186 
4187     /* get min and max brlens in relative time and subst units */
4188     minV = BRLENS_MIN;
4189 
4190     /* calculate the number of free nodes */
4191     numFreeOld = t->nNodes-2;
4192     if (t->nConstraints > 1)
4193         {
4194         numFreeOld = 0;
4195         for (i=0; i<t->nNodes-2; i++)
4196             {
4197             p = t->allDownPass[i];
4198             if (p->anc->left == p)
4199                 q = p->anc->right;
4200             else
4201                 q = p->anc->left;
4202             if (p->anc->isLocked == NO || q->isLocked == NO)
4203                 numFreeOld++;
4204             }
4205         }
4206 
4207     /* pick a branch */
4208     do  {
4209         p = t->allDownPass[(int)(RandomNumber(seed) * (t->nNodes -2))];
4210         if (p->anc->left == p)
4211             q = p->anc->right;
4212         else
4213             q = p->anc->left;
4214         }
4215     while ((p->anc->isLocked == YES && q->isLocked == YES) || p->length < TIME_MIN || q->length < TIME_MIN);
4216     /* choose subtree that can be swapped */
4217 
4218     /* set up pointers for nodes around the picked branch */
4219     a = p;
4220     if (p->anc->left == p)
4221         q = p->anc->right;  /* FIXME: Not used? (from clang static analyzer) */
4222     else
4223         q = p->anc->left;   /* FIXME: Not used? (from clang static analyzer) */
4224     if (p->anc->anc->left == p->anc)
4225         c = p->anc->anc->right; /* FIXME: Not used? (from clang static analyzer) */
4226     else
4227         c = p->anc->anc->left;  /* FIXME: Not used? (from clang static analyzer) */
4228 
4229     /* record branch length */
4230     oldALength = a->length;
4231 
4232     /* reset scratch variables */
4233     for (i=0; i<t->nNodes-1; i++)
4234         {
4235         p = t->allDownPass[i];
4236         p->x = -1;
4237         p->y = NO;
4238         }
4239 
4240     /* calculate distance from picked node */
4241     p = a->anc;
4242     p->x = 0;
4243     while (p->isLocked == NO && p->anc != NULL)
4244         {
4245         p->anc->x = p->x + 1;
4246         p = p->anc;
4247         }
4248     for (i=t->nIntNodes-2; i>=0; i--)
4249         {
4250         p = t->intDownPass[i];
4251         if (p->x < 0 && p->anc->x >= 0 && p != a && p->isLocked == NO)
4252             p->x = p->anc->x + 1;
4253         }
4254 
4255     /* mark the free nodes and calculate the total score */
4256     cumulativeProb = 0.0;
4257     for (i=0; i<t->nNodes-2; i++)
4258         {
4259         p = t->allDownPass[i];
4260         if (p != a && p->anc->x > 0 && a->anc->nodeDepth > p->nodeDepth + minV && p->anc->nodeDepth > a->nodeDepth + minV)
4261             {
4262             p->y = YES;
4263             p->d = pow(0.5 * extensionProb, p->anc->x);
4264             cumulativeProb += p->d;
4265             }
4266         else
4267             p->d = 0.0;
4268         }
4269 
4270     /* find the target node */
4271     ran = RandomNumber(seed) * cumulativeProb;
4272     x = 0.0;
4273     for (i=0; i<t->nNodes-2; i++)
4274         {
4275         p = t->allDownPass[i];
4276         if (p->y == YES)
4277             {
4278             x += p->d;
4279             if (x > ran)
4280                 break;
4281             }
4282         }
4283     if (i == t->nNodes - 2)
4284         {
4285         abortMove = YES;
4286         return (NO_ERROR);
4287         }
4288 
4289     /* record first forward prob */
4290     forwardProb = p->d / cumulativeProb;
4291 
4292     /* record partner swap branch */
4293     c = p;
4294     oldCLength = c->length;
4295 
4296     /* calculate second forward prob */
4297 
4298     /* reset scratch variables */
4299     for (i=0; i<t->nNodes-1; i++)
4300         {
4301         p = t->allDownPass[i];
4302         p->x = -1;
4303         p->y = NO;
4304         }
4305 
4306     /* calculate distance from picked node */
4307     p = c->anc;
4308     p->x = 0;
4309     while (p->isLocked == NO && p->anc != NULL)
4310         {
4311         p->anc->x = p->x + 1;
4312         p = p->anc;
4313         }
4314     for (i=t->nIntNodes-1; i>=0; i--)
4315         {
4316         p = t->intDownPass[i];
4317         if (p->x < 0 && p != c && p->anc->x >= 0 && p->isLocked == NO)
4318             p->x = p->anc->x + 1;
4319         }
4320 
4321     /* mark the free nodes and calculate the total score */
4322     cumulativeProb = 0.0;
4323     for (i=0; i<t->nNodes-2; i++)
4324         {
4325         p = t->allDownPass[i];
4326         if (p != c && p->anc->x > 0 && c->anc->nodeDepth > p->nodeDepth + minV && p->anc->nodeDepth > c->nodeDepth + minV)
4327             {
4328             p->y = YES;
4329             p->d = pow(0.5 * extensionProb, p->anc->x);
4330             cumulativeProb += p->d;
4331             }
4332         else
4333             p->d = 0.0;
4334         }
4335 
4336     /* now we can calculate second forward prob */
4337     forwardProb += a->d / cumulativeProb;
4338 
4339     /* swap subtrees */
4340     if (a->anc->left == a)
4341         a->anc->left = c;
4342     else
4343         a->anc->right = c;
4344     if (c->anc->left == c)
4345         c->anc->left = a;
4346     else
4347         c->anc->right = a;
4348     p = a->anc;
4349     a->anc = c->anc;
4350     c->anc = p;
4351     a->length = a->anc->nodeDepth - a->nodeDepth;
4352     c->length = c->anc->nodeDepth - c->nodeDepth;
4353 
4354     /* get down pass sequence */
4355     GetDownPass (t);
4356 
4357     /* set tiprobs update flags */
4358     a->upDateTi = YES;
4359     c->upDateTi = YES;
4360 
4361     /* set flags for update of cond likes from a->anc and down to root */
4362     p = a->anc;
4363     while (p->anc != NULL)
4364         {
4365         p->upDateCl = YES;
4366         p = p->anc;
4367         }
4368 
4369     /* set flags for update of cond likes from c->anc and down to root */
4370     p = c->anc;
4371     while (p->anc != NULL)
4372         {
4373         p->upDateCl = YES;
4374         p = p->anc;
4375         }
4376 
4377     /* adjust prior ratio for clock tree */
4378     if (LogClockTreePriorRatio(param, chain, &x) == ERROR)
4379         return (ERROR);
4380     (*lnPriorRatio) += x;
4381 
4382     /* calculate first backward prob */
4383 
4384     /* reset scratch variables */
4385     for (i=0; i<t->nNodes-1; i++)
4386         {
4387         p = t->allDownPass[i];
4388         p->x = -1;
4389         p->y = NO;
4390         }
4391 
4392     /* calculate distance from picked node */
4393     p = a->anc;
4394     p->x = 0;
4395     while (p->isLocked == NO && p->anc != NULL)
4396         {
4397         p->anc->x = p->x + 1;
4398         p = p->anc;
4399         }
4400     for (i=t->nIntNodes-1; i>=0; i--)
4401         {
4402         p = t->intDownPass[i];
4403         if (p->x < 0 && p != a && p->anc->x >= 0 && p->isLocked == NO)
4404             p->x = p->anc->x + 1;
4405         }
4406 
4407     /* mark the free nodes and calculate the total score */
4408     cumulativeProb = 0.0;
4409     for (i=0; i<t->nNodes-2; i++)
4410         {
4411         p = t->allDownPass[i];
4412         if (p != a && p->anc->x > 0 && a->anc->nodeDepth > p->nodeDepth + minV && p->anc->nodeDepth > a->nodeDepth + minV)
4413             {
4414             p->y = YES;
4415             p->d = pow(0.5 * extensionProb, p->anc->x);
4416             cumulativeProb += p->d;
4417             }
4418         else
4419             p->d = 0.0;
4420         }
4421 
4422     /* calculate first backward prob */
4423     backwardProb = c->d / cumulativeProb;
4424 
4425     /* calculate second backward prob */
4426 
4427     /* reset scratch variables */
4428     for (i=0; i<t->nNodes-1; i++)
4429         {
4430         p = t->allDownPass[i];
4431         p->x = -1;
4432         p->y = NO;
4433         }
4434 
4435     /* calculate distance from picked node */
4436     p = c->anc;
4437     p->x = 0;
4438     while (p->isLocked == NO && p->anc != NULL)
4439         {
4440         p->anc->x = p->x + 1;
4441         p = p->anc;
4442         }
4443     for (i=t->nIntNodes-1; i>=0; i--)
4444         {
4445         p = t->intDownPass[i];
4446         if (p->x < 0 && p != c && p->anc->x >= 0 && p->isLocked == NO)
4447             p->x = p->anc->x + 1;
4448         }
4449 
4450     /* mark the free nodes and calculate the total score */
4451     cumulativeProb = 0.0;
4452     for (i=0; i<t->nNodes-2; i++)
4453         {
4454         p = t->allDownPass[i];
4455         if (p != c && p->anc->x > 0 && c->anc->nodeDepth > p->nodeDepth + minV && p->anc->nodeDepth > c->nodeDepth + minV)
4456             {
4457             p->y = YES;
4458             p->d = pow(0.5 * extensionProb, p->anc->x);
4459             cumulativeProb += p->d;
4460             }
4461         else
4462             p->d = 0.0;
4463         }
4464 
4465     /* calculate second backward prob */
4466     backwardProb += a->d / cumulativeProb;
4467 
4468     /* now we can calculate proposal ratio */
4469     (*lnProposalRatio) += log (backwardProb / forwardProb);
4470 
4471     /* adjust for number of free nodes */
4472     numFreeNew = t->nNodes-2;   /* FIXME: Not used? (from clang static analyzer) */
4473     if (t->nConstraints > 1)
4474         {
4475         numFreeNew = 0;
4476         for (i=0; i<t->nNodes-2; i++)
4477             {
4478             p = t->allDownPass[i];
4479             if (p->anc->left == p)
4480                 q = p->anc->right;
4481             else
4482                 q = p->anc->left;
4483             if (p->anc->isLocked == NO || q->isLocked == NO)
4484                 numFreeNew++;
4485             }
4486         (*lnProposalRatio) += log(numFreeOld / numFreeNew);
4487         }
4488 
4489     /* adjust proposal and prior ratio for relaxed clock models */
4490     for (i=0; i<param->subParams[0]->nSubParams; i++)
4491         {
4492         subParm = param->subParams[0]->subParams[i];
4493         if (subParm->paramType == P_CPPEVENTS)
4494             {
4495             nEvents = subParm->nEvents[2*chain+state[chain]];
4496 
4497             /* proposal ratio */
4498             (*lnProposalRatio) += nEvents[a->index] * log (a->length / oldALength);
4499             (*lnProposalRatio) += nEvents[c->index] * log (c->length / oldCLength);
4500 
4501             /* prior ratio: no effect because tree length is the same */
4502 
4503             /* update effective evolutionary lengths */
4504             if (UpdateCppEvolLengths (subParm, a, chain) == ERROR || UpdateCppEvolLengths (subParm, c, chain) == ERROR)
4505                 {
4506                 abortMove = YES;
4507                 return (NO_ERROR);
4508                 }
4509             }
4510         else if ( subParm->paramType == P_TK02BRANCHRATES ||
4511                  (subParm->paramType == P_MIXEDBRCHRATES && *GetParamIntVals(subParm, chain, state[chain]) == RCL_TK02))
4512             {
4513             if (subParm->paramType == P_TK02BRANCHRATES)
4514                 nu = *GetParamVals (modelSettings[subParm->relParts[0]].tk02var, chain, state[chain]);
4515             else
4516                 nu = *GetParamVals (modelSettings[subParm->relParts[0]].mixedvar, chain, state[chain]);
4517             tk02Rate = GetParamVals (subParm, chain, state[chain]);
4518             brlens = GetParamSubVals (subParm, chain, state[chain]);
4519 
4520             /* no proposal ratio effect */
4521 
4522             /* prior ratio and update of effective evolutionary lengths */
4523             (*lnPriorRatio) -= LnProbTK02LogNormal (tk02Rate[c->anc->index], nu*oldALength, tk02Rate[a->index]);
4524             (*lnPriorRatio) += LnProbTK02LogNormal (tk02Rate[a->anc->index], nu* a->length, tk02Rate[a->index]);
4525             (*lnPriorRatio) -= LnProbTK02LogNormal (tk02Rate[a->anc->index], nu*oldCLength, tk02Rate[c->index]);
4526             (*lnPriorRatio) += LnProbTK02LogNormal (tk02Rate[c->anc->index], nu* c->length, tk02Rate[c->index]);
4527             brlens[a->index] = a->length * (tk02Rate[a->index] + tk02Rate[a->anc->index])/2.0;
4528             brlens[c->index] = c->length * (tk02Rate[c->index] + tk02Rate[c->anc->index])/2.0;
4529             }
4530         else if ( subParm->paramType == P_IGRBRANCHRATES ||
4531                  (subParm->paramType == P_MIXEDBRCHRATES && *GetParamIntVals(subParm, chain, state[chain]) == RCL_IGR))
4532             {
4533             /* get relevant parameters */
4534             if (subParm->paramType == P_IGRBRANCHRATES)
4535                 igrvar = *GetParamVals (modelSettings[subParm->relParts[0]].igrvar, chain, state[chain]);
4536             else
4537                 igrvar = *GetParamVals (modelSettings[subParm->relParts[0]].mixedvar, chain, state[chain]);
4538             igrRate = GetParamVals (subParm, chain, state[chain]);
4539             brlens = GetParamSubVals (subParm, chain, state[chain]);
4540 
4541             /* prior ratio and update of effective evolutionary lengths */
4542             (*lnPriorRatio) -= LnProbGamma (oldALength/igrvar, oldALength/igrvar, igrRate[a->index]);
4543             (*lnPriorRatio) -= LnProbGamma (oldCLength/igrvar, oldCLength/igrvar, igrRate[c->index]);
4544             (*lnPriorRatio) += LnProbGamma (a->length /igrvar, a->length /igrvar, igrRate[a->index]);
4545             (*lnPriorRatio) += LnProbGamma (c->length /igrvar, c->length /igrvar, igrRate[c->index]);
4546             brlens[a->index] = igrRate[a->index] * a->length;
4547             brlens[c->index] = igrRate[c->index] * c->length;
4548             }
4549         }
4550 
4551     assert (*lnPriorRatio == *lnPriorRatio);
4552 
4553     return (NO_ERROR);
4554 }
4555 
4556 
Move_ExtTBR(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)4557 int Move_ExtTBR (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
4558 {
4559     /* Change topology (and branch lengths) using TBR with extension probability. */
4560 
4561     /* This move picks an internal branch and two "danglies", modifies their lengths
4562        independently according to the method of Larget & Simon (1999: MBE); it then
4563        moves the danglies away from their original position one node at a time with
4564        a probability determined by the extensionProb parameter. When the danglies are moved,
4565        their direction is changed -- "reflection" necessary to enable the back move.
4566 
4567        This move type has been tested on all combinations of rooted and unrooted,
4568        constrained and unconstrained trees */
4569 
4570     int         i, j, topologyHasChanged, nCrownNodes, nRootNodes, directionLeft, directionUp,
4571                 isVPriorExp, alwaysMoveRoot, isCrownStartConstrained, isRootStartConstrained, isStopConstrained;
4572     MrBFlt      m, x, y, tuning, maxV, minV, extensionProb, brlensExp=0.0;
4573     TreeNode    *p, *a, *b, *c, *d, *u, *v;
4574     Tree        *t;
4575     ModelParams *mp;
4576 
4577     /* these parameters should be possible to set by user */
4578     extensionProb = mvp[0]; /* extension probability */
4579     tuning = mvp[1];        /* Larget & Simon's tuning parameter lambda */
4580 
4581     (*lnProposalRatio) = (*lnPriorRatio) = 0.0;
4582 
4583     /* get tree */
4584     t = GetTree (param, chain, state[chain]);
4585 
4586     /* get model params */
4587     mp = &modelParams[param->relParts[0]];
4588 
4589     /* max and min brlen */
4590     if (param->subParams[0]->paramId == BRLENS_UNI)
4591         {
4592         minV = mp->brlensUni[0] > BRLENS_MIN ? mp->brlensUni[0] : BRLENS_MIN;
4593         maxV = mp->brlensUni[1] < BRLENS_MAX ? mp->brlensUni[1] : BRLENS_MAX;
4594         isVPriorExp = NO;
4595         }
4596     else if (param->subParams[0]->paramId == BRLENS_GamDir)
4597         {
4598         minV = BRLENS_MIN;
4599         maxV = BRLENS_MAX;
4600         isVPriorExp = 2;
4601         }
4602     else if (param->subParams[0]->paramId == BRLENS_iGmDir)
4603         {
4604         minV = BRLENS_MIN;
4605         maxV = BRLENS_MAX;
4606         isVPriorExp = 3;
4607         }
4608     else if (param->subParams[0]->paramId == BRLENS_twoExp)
4609         {
4610         minV = BRLENS_MIN;
4611         maxV = BRLENS_MAX;
4612         isVPriorExp = 4;
4613         }
4614     else
4615         {
4616         minV = BRLENS_MIN;
4617         maxV = BRLENS_MAX;
4618         brlensExp = mp->brlensExp;
4619         isVPriorExp = YES;
4620         }
4621 
4622     /* Dirichlet or twoExp prior */
4623     if (isVPriorExp > 1)
4624         (*lnPriorRatio) = -LogDirPrior(t, mp, isVPriorExp);
4625 
4626     topologyHasChanged = NO;
4627 
4628 #   if defined (DEBUG_ExtTBR)
4629     printf ("Before:\n");
4630     ShowNodes (t->root, 2, NO);
4631     getchar();
4632 #   endif
4633 
4634     /* pick an internal branch */
4635     do  {
4636         p = t->intDownPass[(int)(RandomNumber(seed) * (t->nIntNodes-1))];
4637         if (p->anc->left == p)
4638             a = p->anc->right;
4639         else
4640             a = p->anc->left;
4641         i = j = 0;
4642         if (a->isLocked == YES || a->left == NULL)
4643             i++;
4644         if (p->anc->isLocked == YES || p->anc->anc->anc == NULL)
4645             i++;
4646         if (p->left->isLocked == YES || p->left->left == NULL)
4647             j++;
4648         if (p->right->isLocked == YES || p->right->left == NULL)
4649             j++;
4650         } while (i == 2 && j == 2);
4651 
4652     /* determine whether to move first step unconditionally in root or in crown */
4653     if (j == 2)
4654         alwaysMoveRoot = YES;
4655     else if (i == 2)
4656         alwaysMoveRoot = NO;
4657     else if (RandomNumber(seed) < 0.5)
4658         alwaysMoveRoot = YES;
4659     else
4660         alwaysMoveRoot = NO;
4661 
4662     /* determine any starting constraints */
4663     isCrownStartConstrained = isRootStartConstrained = NO;
4664     if (i >= 1)
4665         isRootStartConstrained = YES;
4666     if (j >= 1)
4667         isCrownStartConstrained = YES;
4668 
4669     /* set up pointers for nodes around the picked branch */
4670     /* cut the tree into crown, root and attachment part */
4671     /* change the relevant lengths in the attachment part */
4672     /* the lengths of a and v are automatically contained in the */
4673     /* "attachment" part but the length of c has to be stored in x */
4674     v = p;
4675     u = p->anc;
4676 
4677     /* set up pointers for crown part */
4678     /* also determine direction of move in crown part */
4679     if (v->right->left == NULL || v->right->isLocked == YES)
4680         directionLeft = YES;
4681     else if (v->left->left == NULL || v->left->isLocked == YES)
4682         directionLeft = NO;
4683     else if (RandomNumber(seed) < 0.5)
4684         directionLeft = YES;
4685     else
4686         directionLeft = NO;
4687     if (directionLeft == YES)
4688         {
4689         c = v->left;
4690         d = v->right;
4691         }
4692     else
4693         {
4694         c = v->right;
4695         d = v->left;
4696         }
4697 
4698     /* cut and reconnect crown part */
4699     c->anc = d;
4700     d->anc = c;
4701 
4702     /* record c length and adjust with multiplier using reflection */
4703     m = c->length;
4704     x = c->length * exp(tuning * (RandomNumber(seed) - 0.5));       /* save the modified dangling branch for later use */
4705     while (x < minV || x > maxV)
4706         {
4707         if (x < minV) x = minV * minV / x;
4708         if (x > maxV) x = maxV * maxV / x;
4709         }
4710 
4711     /* calculate proposal and prior ratio based on length modification */
4712     (*lnProposalRatio) = log (x / m);
4713     if (isVPriorExp == YES)
4714         (*lnPriorRatio) = brlensExp * (m - x);
4715 
4716     /* record v length and adjust with multiplier using reflection*/
4717     m = v->length;
4718     v->length *= exp(tuning * (RandomNumber(seed) - 0.5));
4719     while (v->length < minV || v->length > maxV)
4720         {
4721         if (v->length < minV)
4722             v->length = minV * minV / v->length;
4723         else if (v->length > maxV)
4724             v->length = maxV * maxV / v->length;
4725         }
4726     v->upDateTi = YES;
4727 
4728     /* adjust proposal and prior ratio based on length modification */
4729     (*lnProposalRatio) += log (v->length / m);
4730     if (isVPriorExp == YES)
4731         (*lnPriorRatio) += brlensExp * (m - v->length);
4732 
4733     /* mark nodes in root part */
4734     /* also determine direction of move in root part */
4735     if (u->left == v)
4736         a = u->right;
4737     else
4738         a = u->left;
4739     b = u->anc;
4740     if (u->anc->anc == NULL || u->isLocked == YES)
4741         directionUp = YES;
4742     else if (a->left == NULL || a->isLocked == YES)
4743         directionUp = NO;
4744     else if (RandomNumber(seed) < 0.5)
4745         directionUp = YES;
4746     else
4747         directionUp = NO;
4748     if (directionUp == NO)
4749         {
4750         /* switch a and b */
4751         b = a;
4752         a = u->anc;
4753         }
4754 
4755     /* cut root part */
4756     if (directionUp == NO)
4757         {
4758         b->anc = a;
4759         if (a->left == u)
4760             a->left = b;
4761         else
4762             a->right = b;
4763         }
4764     else
4765         {
4766         a->anc = b;
4767         if (b->left == u)
4768             b->left = a;
4769         else
4770             b->right = a;
4771         y = a->length;
4772         a->length = u->length;
4773         u->length = y;
4774         a->upDateTi = YES;
4775         }
4776 
4777     /* adjust length of branch to be modified */
4778     /* if it is not the root branch of a rooted tree */
4779     if (t->isRooted == NO || u->anc->anc != NULL)
4780         {
4781         m = u->length;
4782         u->length *= exp(tuning * (RandomNumber(seed) - 0.5));
4783         while (u->length < minV || u->length > maxV)
4784             {
4785             if (u->length < minV)
4786                 u->length = minV * minV / u->length;
4787             else if (u->length > maxV)
4788                 u->length = maxV * maxV / u->length;
4789             }
4790 
4791         /* adjust proposal and prior ratio based on length modification */
4792         (*lnProposalRatio) += log (u->length / m);
4793         if (isVPriorExp == YES)
4794             (*lnPriorRatio) += brlensExp * (m - u->length);
4795         }
4796     u->upDateTi = YES;
4797 
4798     /* move around in root subtree */
4799     for (nRootNodes=0; (alwaysMoveRoot == YES && nRootNodes == 0) || RandomNumber(seed) < extensionProb; nRootNodes++)
4800         {
4801         if (directionUp == YES)
4802             {   /* going up tree */
4803             if (a->left == NULL || a->isLocked == YES)
4804                 break;      /* can't go further */
4805             topologyHasChanged = YES;
4806             b = a;
4807             if (RandomNumber(seed) < 0.5)
4808                 a = a->left;
4809             else
4810                 a = a->right;
4811             if (u->isLocked == YES)
4812                 {
4813                 b->isLocked = YES;
4814                 u->isLocked = NO;
4815                 b->lockID = u->lockID;
4816                 u->lockID = 0;
4817                 }
4818             }
4819         else
4820             {   /* going down tree */
4821             if (a->anc == NULL || u->isLocked == YES)
4822                 break;      /* can't go further */
4823             topologyHasChanged = YES;
4824             if (RandomNumber(seed)<0.5)
4825                 {
4826                 directionUp = YES; /* switch direction */
4827                 /* find sister of a */
4828                 if (a->left == b)
4829                     {
4830                     b = a;
4831                     a = a->right;
4832                     }
4833                 else
4834                     {
4835                     b = a;
4836                     a = a->left;
4837                     }
4838                 /* as long as we are moving upwards
4839                 the cond likes to update will be
4840                 flagged by the last pass from u to the root */
4841                 }
4842             else
4843                 {   /* continue down */
4844                 b = a;
4845                 a = a->anc;
4846                 b->upDateCl = YES;
4847                 if (b->isLocked == YES)
4848                     {
4849                     u->isLocked = YES;
4850                     b->isLocked = NO;
4851                     u->lockID = b->lockID;
4852                     b->lockID = 0;
4853                     }
4854                 }
4855             }
4856         }
4857 
4858     /* adjust proposal ratio for root move if unbalanced */
4859     isStopConstrained = NO;
4860     if (directionUp == YES && (a->left == NULL || a->isLocked == YES))
4861         isStopConstrained = YES;
4862     if (directionUp == NO && (a->anc  == NULL || u->isLocked == YES))
4863         isStopConstrained = YES;
4864     if (nRootNodes > 0)
4865         {
4866         if (isRootStartConstrained == YES && isStopConstrained == NO)
4867             (*lnProposalRatio) -= log (2.0 * (1.0 - extensionProb));
4868         else if (isRootStartConstrained == NO && isStopConstrained == YES)
4869             (*lnProposalRatio) += log (2.0 * (1.0 - extensionProb));
4870         }
4871 
4872     /* move around in crown subtree */
4873     for (nCrownNodes=0; (alwaysMoveRoot == NO && nCrownNodes == 0) || RandomNumber(seed) < extensionProb; nCrownNodes++)
4874         {
4875         if (c->left == NULL || c->isLocked == YES)
4876             break;  /* can't go further */
4877         topologyHasChanged = YES;
4878         if (RandomNumber(seed) < 0.5)
4879             {
4880             /* rotate c anticlockwise - prepare pointers for move left */
4881             c->anc = c->left;  /* the root will be in the direction we are heading */
4882             c->left = c->right;
4883             c->right = d;
4884             }
4885         else
4886             {
4887             /* rotate c clockwise - prepare pointers for move right */
4888             c->anc = c->right;  /* the root will be in the direction we are heading */
4889             c->right = c->left;
4890             c->left = d;
4891             }
4892         /* OK - let's move!; c->anc points in the right direction
4893         don't forget to move the branch lengths as well */
4894         d = c;
4895         c = c->anc;
4896         d->length = c->length;
4897         d->upDateCl = YES;
4898         d->upDateTi = YES;
4899         }
4900 
4901     /* adjust proposal ratio for crown move if unbalanced */
4902     isStopConstrained = NO;
4903     if (c->left == NULL || c->isLocked == YES)
4904         isStopConstrained = YES;
4905     if (nCrownNodes > 0)
4906         {
4907         if (isCrownStartConstrained == YES && isStopConstrained == NO)
4908             (*lnProposalRatio) -= log (2.0 * (1.0 - extensionProb));
4909         else if (isCrownStartConstrained == NO && isStopConstrained == YES)
4910             (*lnProposalRatio) += log (2.0 * (1.0 - extensionProb));
4911         }
4912 
4913     /* combine the subtrees */
4914     c->anc = v;
4915     d->anc = v;
4916     if (directionLeft == YES)
4917         {
4918         v->left = c;
4919         v->right = d;
4920         }
4921     else
4922         {
4923         v->left = d;
4924         v->right = c;
4925         }
4926 
4927     /* the dangling branch is inserted in reverted position
4928        such that the back move will be possible
4929        if we have moved around in crown subtree
4930        otherwise it is left in its original position */
4931     if (nCrownNodes > 0)
4932         {
4933         d->length = x;
4934         d->upDateTi = YES;
4935         }
4936     else
4937         {
4938         c->length = x;
4939         c->upDateTi = YES;
4940         }
4941 
4942     if (directionUp == YES)
4943         {
4944         u->anc = b;
4945         if (u->left == v)
4946             u->right = a;
4947         else
4948             u->left = a;
4949         a->anc = u;
4950         if (b->left == a)
4951             b->left = u;
4952         else
4953             b->right = u;
4954         /* the dangling branch is contained in u->length
4955            and will automatically be inserted in the right position
4956            to enable the back move regardless of whether it was
4957            initially directed upwards or downwards
4958            BUT if we haven't moved in root subtree, it is advantageous (necessary
4959            for rooted trees) to avoid switching branches, which occurs otherwise
4960            if directionUp == YES */
4961         if (nRootNodes == 0)
4962             {
4963             y = u->length;
4964             u->length = a->length;
4965             a->length = y;
4966             a->upDateTi = YES;
4967             u->upDateTi = NO;   /* u retains its old length */
4968             }
4969         }
4970     else
4971         {
4972         u->anc = a;
4973         if (u->left == v)
4974             u->right = b;
4975         else
4976             u->left = b;
4977         b->anc = u;
4978         if (a->left == b)
4979             a->left = u;
4980         else
4981             a->right = u;
4982         /* the modified branch contained in u->length will have
4983            to be moved to b->length to enable back move
4984            BUT if we haven't moved, it is better to keep it in place
4985            (necessary for rooted trees) */
4986         if (nRootNodes > 0)
4987             {
4988             y = u->length;
4989             u->length = b->length;
4990             b->length = y;
4991             b->upDateTi = YES;
4992             }
4993         }
4994 
4995     /* set flags for update of cond likes from v and down to root */
4996     p = v;
4997     while (p->anc != NULL)
4998         {
4999         p->upDateCl = YES;
5000         p = p->anc;
5001         }
5002 
5003     /* get down pass sequence if tree topology has changed */
5004     if (topologyHasChanged == YES)
5005         {
5006         GetDownPass (t);
5007         }
5008 
5009     /* Dirichlet or twoExp prior */
5010     if (isVPriorExp > 1)
5011         (*lnPriorRatio) += LogDirPrior(t, mp, isVPriorExp);
5012 
5013 #   if defined (DEBUG_ExtTBR)
5014     printf ("After:\n");
5015     ShowNodes (t->root, 2, NO);
5016     getchar();
5017     printf ("Proposal ratio: %f\n",(*lnProposalRatio));
5018     printf ("v: %d  u: %d  c: %d  d: %d  a: %d  b: %d\n",v->index, u->index,
5019             c->index, d->index, a->index, b->index);
5020     printf ("No. nodes moved in root subtree: %d\n",nRootNodes);
5021     printf ("No. nodes moved in crown subtree: %d\n",nCrownNodes);
5022     printf ("Has topology changed? %d\n",topologyHasChanged);
5023     getchar();
5024 #   endif
5025 
5026     return (NO_ERROR);
5027 }
5028 
5029 
5030 /*----------------------------------------------------------------
5031 |
5032 |   Move_GeneRate_Dir: Change gene rate multiplier using Dirichlet
5033 |      proposal.
5034 |
5035 ----------------------------------------------------------------*/
Move_GeneRate_Dir(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)5036 int Move_GeneRate_Dir (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
5037 {
5038     int         i, nRates, isValid;
5039     MrBFlt      alphaPi, *value, *subValue, numSites, *alphaDir, x, y, sum,
5040                 rate_pot, *dirParm, *oldRate, *newRate;
5041 
5042     /* allocate memory */
5043     dirParm = (MrBFlt *) SafeCalloc (3*(numTopologies-1), sizeof(MrBFlt));
5044     oldRate = dirParm + numCurrentDivisions;
5045     newRate = dirParm + 2*numCurrentDivisions;
5046 
5047     /* get number of rates */
5048     nRates = param->nValues;
5049 
5050     /* get pointer to rates and number of uncompressed chars */
5051     value = GetParamVals(param, chain, state[chain]);
5052     subValue = GetParamSubVals(param, chain, state[chain]);
5053 
5054     /* get Dirichlet parameters */
5055     alphaDir = subValue + nRates;
5056 
5057     /* calculate old ratesum proportions */
5058     numSites = 0.0;
5059     for (i=0; i<nRates; i++)
5060         numSites += subValue[i];  /* numSites should be equal to the number of sites */
5061     for (i=0; i<nRates; i++)
5062         oldRate[i] = value[i] * subValue[i] / numSites;
5063 
5064     /* get so called alphaPi parameter */
5065     alphaPi = mvp[0] * nRates;
5066 
5067     /* multiply old ratesum proportions with some large number to get new values close to the old ones */
5068     for (i=0; i<nRates; i++)
5069         dirParm[i] = oldRate[i] * alphaPi;
5070 
5071     /* get new values */
5072     DirichletRandomVariable (dirParm, newRate, nRates, seed);
5073 
5074     /* check new values. we rely on newRate be already normalized  */
5075     while (1)
5076         {
5077         sum = 0.0;
5078         rate_pot = 1.0;
5079         isValid=1;
5080         for (i=0; i<nRates; i++)
5081             {
5082             if (newRate[i] <= DIR_MIN)
5083                 {
5084                 if (newRate[i] < DIR_MIN)
5085                     {
5086                     newRate[i] = DIR_MIN;
5087                     isValid=0;
5088                     }
5089                 rate_pot -= DIR_MIN;
5090                 }
5091             else
5092                 sum += newRate[i];
5093             }
5094         if (isValid==1) break;
5095         for (i=0; i<nRates; i++)
5096             {
5097             if (newRate[i]!=DIR_MIN)
5098                 newRate[i] = rate_pot * newRate[i] / sum;
5099             }
5100         }
5101 
5102     /* calculate and copy new rate ratio values back */
5103     for (i=0; i<nRates; i++)
5104         value[i] = newRate[i] * (numSites / subValue[i]);
5105 
5106     /* get proposal ratio */
5107     sum = 0.0;
5108     for (i=0; i<nRates; i++)
5109         sum += newRate[i]*alphaPi;
5110     x = LnGamma(sum);
5111     for (i=0; i<nRates; i++)
5112         x -= LnGamma(newRate[i]*alphaPi);
5113     for (i=0; i<nRates; i++)
5114         x += (newRate[i]*alphaPi-1.0)*log(oldRate[i]);
5115     sum = 0.0;
5116     for (i=0; i<nRates; i++)
5117         sum += oldRate[i]*alphaPi;
5118     y = LnGamma(sum);
5119     for (i=0; i<nRates; i++)
5120         y -= LnGamma(oldRate[i]*alphaPi);
5121     for (i=0; i<nRates; i++)
5122         y += (oldRate[i]*alphaPi-1.0)*log(newRate[i]);
5123     (*lnProposalRatio) = x - y;
5124 
5125     /* get prior ratio */
5126     x = y = 0.0;
5127     for (i=0; i<nRates; i++)
5128         x += (alphaDir[i]-1.0)*log(newRate[i]);
5129     for (i=0; i<nRates; i++)
5130         y += (alphaDir[i]-1.0)*log(oldRate[i]);
5131     (*lnPriorRatio) = x - y;
5132 
5133     /* Set update flags for all partitions that share the rate multiplier. Note that the conditional
5134        likelihood update flags have been set before we even call this function. */
5135     for (i=0; i<param->nRelParts; i++)
5136         TouchAllTreeNodes(&modelSettings[param->relParts[i]],chain);
5137 
5138     /* may need to hit update flag for cijks when you have a covarion model */
5139     for (i=0; i<param->nRelParts; i++)
5140         if (modelSettings[param->relParts[i]].nCijkParts > 1)
5141             modelSettings[param->relParts[i]].upDateCijk = YES;
5142 
5143     free (dirParm);
5144 
5145     return (NO_ERROR);
5146 }
5147 
5148 
Move_Growth_M(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)5149 int Move_Growth_M (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
5150 {
5151     MrBFlt          oldG, newG, lambda, minG, maxG, ran, oldLnPrior, newLnPrior, curTheta;
5152     ModelParams     *mp;
5153     ModelInfo       *m;
5154     Tree            *t;
5155 
5156     /* get tuning parameter */
5157     lambda = mvp[0];
5158 
5159     /* get model params */
5160     m = &modelSettings[param->relParts[0]];
5161     mp = &modelParams[param->relParts[0]];
5162     curTheta = (*GetParamVals(m->popSize, chain, state[chain])) * (*GetParamVals(m->clockRate, chain, state[chain]));
5163     if (!strcmp(mp->ploidy, "Diploid"))
5164         curTheta *= 4.0;
5165     else if (!strcmp(mp->ploidy, "Zlinked"))
5166         curTheta *= 3.0;
5167     else
5168         curTheta *= 2.0;
5169 
5170     /* get minimum and maximum values for growth */
5171     minG = param->min;
5172     maxG = param->max;
5173 
5174     /* get old value of theta */
5175     newG = oldG = *GetParamVals(param, chain, state[chain]);
5176     if (newG < minG)
5177         oldG = minG;
5178 
5179     /* change value of growth */
5180     ran = RandomNumber(seed);
5181     newG = oldG * exp (lambda * (ran - 0.5));
5182 
5183     /* check that new value is valid */
5184     while (newG < minG || newG > maxG)
5185         {
5186         if (newG < minG)
5187             newG = minG * minG / newG;
5188         else if (newG > maxG)
5189             newG = maxG * maxG / newG;
5190         }
5191 
5192     /* get proposal ratio */
5193     (*lnProposalRatio) = log (newG / oldG);
5194 
5195     /* get prior ratio */
5196     t = GetTree(modelSettings[param->relParts[0]].brlens,chain,state[chain]);
5197     if (LnCoalescencePriorPr (t, &oldLnPrior, curTheta, oldG) == ERROR)
5198         {
5199         MrBayesPrint ("%s   Problem calculating prior for coalescent process\n", spacer);
5200         return (ERROR);
5201         }
5202     if (LnCoalescencePriorPr (t, &newLnPrior, curTheta, newG) == ERROR)
5203         {
5204         MrBayesPrint ("%s   Problem calculating prior for coalescent process\n", spacer);
5205         return (ERROR);
5206         }
5207     (*lnPriorRatio) = newLnPrior - oldLnPrior + param->LnPriorRatio(newG, oldG, param->priorParams);
5208 
5209     /* copy new growth value back */
5210     *GetParamVals(param, chain, state[chain]) = newG;
5211 
5212     return (NO_ERROR);
5213 }
5214 
5215 
Move_IgrBranchRate(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)5216 int Move_IgrBranchRate (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
5217 {
5218     /* move one IGR relaxed clock branch rate using multiplier */
5219 
5220     int         i;
5221     MrBFlt      newRate, oldRate, tuning, minR, maxR, igrvar, *igrRate, *brlens;
5222     TreeNode    *p = NULL;
5223     ModelInfo   *m;
5224     Tree        *t;
5225     TreeNode    *q;
5226 
5227     /* get the tuning parameter */
5228     tuning = mvp[0];
5229 
5230     /* get the model settings */
5231     m = &modelSettings[param->relParts[0]];
5232 
5233     /* get the IGR branch rate and effective branch length data */
5234     igrRate = GetParamVals (param, chain, state[chain]);
5235     brlens = GetParamSubVals (param, chain, state[chain]);
5236 
5237     /* get tree */
5238     t = GetTree (param, chain, state[chain]);
5239 
5240     /* get minimum and maximum rate */
5241     minR = RATE_MIN;
5242     maxR = RATE_MAX;
5243 
5244     /* randomly pick a branch */
5245     do  {
5246         i = (int) (RandomNumber(seed) * (t->nNodes -2));
5247         p = t->allDownPass[i];
5248         }
5249     while (p->length < TIME_MIN);  // not ancestral fossil
5250 
5251     /* find new rate using multiplier */
5252     oldRate = igrRate[p->index];
5253     newRate = oldRate * exp ((0.5 - RandomNumber(seed)) * tuning);
5254 
5255     /* reflect if necessary */
5256     while (newRate < minR || newRate > maxR)
5257         {
5258         if (newRate < minR)
5259             newRate = minR * minR / newRate;
5260         if (newRate > maxR)
5261             newRate = maxR * maxR / newRate;
5262         }
5263 
5264     igrRate[p->index] = newRate;
5265 
5266     /* calculate prior ratio */
5267     igrvar = *GetParamVals (m->igrvar, chain, state[chain]);
5268     (*lnPriorRatio) = LnProbGamma (p->length/igrvar, p->length/igrvar, newRate)
5269                     - LnProbGamma (p->length/igrvar, p->length/igrvar, oldRate);
5270 
5271     /* calculate proposal ratio */
5272     (*lnProposalRatio) = log (newRate / oldRate);
5273 
5274     /* update branch evolution lengths */
5275     brlens[p->index] = newRate * p->length;
5276 
5277     /* set update of transition probability */
5278     p->upDateTi = YES;
5279 
5280     /* set update of cond likes down to root */
5281     q = p->anc;
5282     while (q->anc != NULL)
5283         {
5284         q->upDateCl = YES;
5285         q = q->anc;
5286         }
5287 
5288     return (NO_ERROR);
5289 }
5290 
5291 
Move_IgrBranchRate2(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)5292 int Move_IgrBranchRate2 (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
5293 {
5294     /* move one IGR relaxed clock branch rate using sliding window */
5295 
5296     int         i;
5297     MrBFlt      newRate, oldRate, window, minR, maxR, igrvar, *igrRate, *brlens;
5298     TreeNode    *p = NULL;
5299     ModelInfo   *m;
5300     Tree        *t;
5301     TreeNode    *q;
5302 
5303     /* get the tuning parameter */
5304     window = mvp[0];
5305 
5306     /* get the model settings */
5307     m = &modelSettings[param->relParts[0]];
5308 
5309     /* get the IGR branch rate and effective branch length data */
5310     igrRate = GetParamVals (param, chain, state[chain]);
5311     brlens = GetParamSubVals (param, chain, state[chain]);
5312 
5313     /* get tree */
5314     t = GetTree (param, chain, state[chain]);
5315 
5316     /* get minimum and maximum rate */
5317     minR = RATE_MIN;
5318     maxR = RATE_MAX;
5319 
5320     /* randomly pick a branch */
5321     do  {
5322         i = (int) (RandomNumber(seed) * (t->nNodes -2));
5323         p = t->allDownPass[i];
5324         }
5325     while (p->length < TIME_MIN);  // not ancestral fossil
5326 
5327     /* find new rate using multiplier */
5328     oldRate = igrRate[p->index];
5329     newRate = oldRate + window * (RandomNumber(seed) - 0.5);
5330 
5331     /* reflect if necessary */
5332     while (newRate < minR || newRate > maxR)
5333         {
5334         if (newRate < minR)
5335             newRate = 2 * minR - newRate;
5336         if (newRate > maxR)
5337             newRate = 2 * maxR - newRate;
5338         }
5339 
5340     igrRate[p->index] = newRate;
5341 
5342     /* calculate prior ratio */
5343     igrvar = *GetParamVals (m->igrvar, chain, state[chain]);
5344     (*lnPriorRatio) = LnProbGamma (p->length/igrvar, p->length/igrvar, newRate)
5345                     - LnProbGamma (p->length/igrvar, p->length/igrvar, oldRate);
5346 
5347     /* calculate proposal ratio */
5348     (*lnProposalRatio) = 0.0;
5349 
5350     /* update branch evolution lengths */
5351     brlens[p->index] = newRate * p->length;
5352 
5353     /* set update of transition probability */
5354     p->upDateTi = YES;
5355 
5356     /* set update of cond likes down to root */
5357     q = p->anc;
5358     while (q->anc != NULL)
5359         {
5360         q->upDateCl = YES;
5361         q = q->anc;
5362         }
5363 
5364     return (NO_ERROR);
5365 }
5366 
5367 
Move_IgrVar(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)5368 int Move_IgrVar (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
5369 {
5370     /* move the variance of the IGR relaxed clock model using multiplier */
5371 
5372     int         i, j;
5373     MrBFlt      oldIgrvar, newIgrvar, minIgrvar, maxIgrvar, tuning, *igrRate;
5374     Model       *mp;
5375     TreeNode    *p;
5376     Tree        *t;
5377 
5378     /* get tuning parameter */
5379     tuning = mvp[0];
5380 
5381     /* get model params */
5382     mp = &modelParams[param->relParts[0]];
5383 
5384     /* get the min and max values */
5385     minIgrvar = IGRVAR_MIN;
5386     maxIgrvar = IGRVAR_MAX;
5387     if (!strcmp(mp->igrvarPr,"Uniform"))
5388         {
5389         minIgrvar = (mp->igrvarUni[0] < IGRVAR_MIN) ? IGRVAR_MIN : mp->igrvarUni[0];
5390         maxIgrvar = (mp->igrvarUni[1] > IGRVAR_MAX) ? IGRVAR_MAX : mp->igrvarUni[1];
5391         }
5392 
5393     /* get the igr variance */
5394     oldIgrvar = *GetParamVals (param, chain, state[chain]);
5395 
5396     /* set new value */
5397     newIgrvar = oldIgrvar * exp ((0.5 - RandomNumber(seed))*tuning);
5398 
5399     /* reflect if necessary */
5400     while (newIgrvar < minIgrvar || newIgrvar > maxIgrvar)
5401         {
5402         if (newIgrvar < minIgrvar)
5403             newIgrvar = minIgrvar * minIgrvar / newIgrvar;
5404         if (newIgrvar > maxIgrvar)
5405             newIgrvar = maxIgrvar * maxIgrvar / newIgrvar;
5406         }
5407 
5408     /* store new value */
5409     (*GetParamVals (param, chain, state[chain])) = newIgrvar;
5410 
5411     /* calculate prior ratio */
5412     for (i=0; i<param->nSubParams; i++)
5413         {
5414         igrRate = GetParamVals (param->subParams[i], chain, state[chain]);
5415         t = GetTree (param->subParams[i], chain, state[chain]);
5416         for (j=0; j<t->nNodes-2; j++)
5417             {
5418             p = t->allDownPass[j];
5419             if (p->length > 0.0)  // not ancestral fossil
5420                 {
5421                 (*lnPriorRatio) -= LnProbGamma (p->length/oldIgrvar, p->length/oldIgrvar, igrRate[p->index]);
5422                 (*lnPriorRatio) += LnProbGamma (p->length/newIgrvar, p->length/newIgrvar, igrRate[p->index]);
5423                 }
5424             }
5425         }
5426 
5427     /* take prior on Igrvar into account */
5428     if (!strcmp(mp->igrvarPr,"Exponential"))
5429         (*lnPriorRatio) += mp->igrvarExp * (oldIgrvar - newIgrvar);
5430 
5431     /* calculate proposal ratio */
5432     (*lnProposalRatio) = log (newIgrvar / oldIgrvar);
5433 
5434     /* we do not need to update likelihoods */
5435     for (i=0; i<param->nRelParts; i++)
5436         {
5437         modelSettings[param->relParts[i]].upDateCl = NO;
5438         }
5439 
5440     return (NO_ERROR);
5441 }
5442 
5443 
Move_MixedBranchRate(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)5444 int Move_MixedBranchRate (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
5445 {
5446     /* move one relaxed clock branch rate using multiplier */
5447 
5448     int         i, *rclModel=NULL;
5449     MrBFlt      newRate, oldRate, tuning, minR, maxR, mxvar, *mxRate, *brlens;
5450     TreeNode    *p = NULL, *q;
5451     ModelInfo   *m;
5452     Tree        *t;
5453 
5454     /* get the tuning parameter */
5455     tuning = mvp[0];
5456 
5457     /* get the model settings */
5458     m = &modelSettings[param->relParts[0]];
5459 
5460     /* get the branch rate and effective branch length data */
5461     mxRate = GetParamVals (param, chain, state[chain]);
5462     brlens = GetParamSubVals (param, chain, state[chain]);
5463     rclModel = GetParamIntVals(param, chain, state[chain]);
5464 
5465     /* get tree */
5466     t = GetTree (param, chain, state[chain]);
5467 
5468     /* get minimum and maximum rate */
5469     minR = RATE_MIN;
5470     maxR = RATE_MAX;
5471 
5472     /* randomly pick a length */
5473     do  {
5474         i = (int) (RandomNumber(seed) * (t->nNodes -2));
5475         p = t->allDownPass[i];
5476         }
5477     while (p->length < TIME_MIN);  // not ancestral fossil
5478 
5479     /* find new rate using multiplier */
5480     oldRate = mxRate[p->index];
5481     newRate = oldRate * exp ((0.5 - RandomNumber(seed)) * tuning);
5482 
5483     /* reflect if necessary */
5484     while (newRate < minR || newRate > maxR)
5485         {
5486         if (newRate < minR)
5487             newRate = minR * minR / newRate;
5488         if (newRate > maxR)
5489             newRate = maxR * maxR / newRate;
5490         }
5491 
5492     mxRate[p->index] = newRate;
5493 
5494     /* calculate prior ratio */
5495     mxvar = *GetParamVals (m->mixedvar, chain, state[chain]);
5496 
5497     if (*rclModel == RCL_TK02)
5498         {
5499         (*lnPriorRatio) += LnRatioTK02LogNormal (mxRate[p->anc->index], mxvar*p->length, newRate, oldRate);
5500         if (p->left != NULL)
5501             {
5502             if (p->left->length > 0.0)
5503                 {
5504                 (*lnPriorRatio) -= LnProbTK02LogNormal (oldRate, mxvar*p->left->length,  mxRate[p->left->index ]);
5505                 (*lnPriorRatio) += LnProbTK02LogNormal (newRate, mxvar*p->left->length,  mxRate[p->left->index ]);
5506                 }
5507             if (p->right->length > 0.0)
5508                 {
5509                 (*lnPriorRatio) -= LnProbTK02LogNormal (oldRate, mxvar*p->right->length, mxRate[p->right->index]);
5510                 (*lnPriorRatio) += LnProbTK02LogNormal (newRate, mxvar*p->right->length, mxRate[p->right->index]);
5511                 }
5512             }
5513 
5514         /* update branch evolution lengths */
5515         brlens[p->index] = p->length * (newRate + mxRate[p->anc->index]) / 2.0;
5516         if (p->left != NULL)
5517             {
5518             brlens[p->left->index ] = p->left->length  * (mxRate[p->left->index ] + newRate) / 2.0;
5519             brlens[p->right->index] = p->right->length * (mxRate[p->right->index] + newRate) / 2.0;
5520             }
5521 
5522         /* set update of ti probs */
5523         p->upDateTi = YES;
5524         if (p->left != NULL)
5525             {
5526             p->left ->upDateTi = YES;
5527             p->right->upDateTi = YES;
5528             }
5529         }
5530     else if (*rclModel == RCL_IGR)
5531         {
5532         (*lnPriorRatio) -= LnProbGamma (p->length/mxvar, p->length/mxvar, oldRate);
5533         (*lnPriorRatio) += LnProbGamma (p->length/mxvar, p->length/mxvar, newRate);
5534 
5535         brlens[p->index] = newRate * p->length;
5536 
5537         /* set update of transition probability */
5538         p->upDateTi = YES;
5539         }
5540 
5541     /* calculate proposal ratio */
5542     (*lnProposalRatio) = log (newRate / oldRate);
5543 
5544     /* set update of cond likes down to root */
5545     p->upDateCl = YES;
5546     q = p->anc;
5547     while (q->anc != NULL)
5548         {
5549         q->upDateCl = YES;
5550         q = q->anc;
5551         }
5552 
5553     return (NO_ERROR);
5554 }
5555 
5556 
Move_MixedVar(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)5557 int Move_MixedVar (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
5558 {
5559     /* move the variance of the mixed relaxed clock models using multiplier */
5560 
5561     int         i, j, *rclModel=NULL;
5562     MrBFlt      oldVar, newVar, minVar, maxVar, tuning, *igrRate, *tk02Rate;
5563     Model       *mp;
5564     TreeNode    *p;
5565     Tree        *t;
5566 
5567     /* get tuning parameter */
5568     tuning = mvp[0];
5569 
5570     /* get model params */
5571     mp = &modelParams[param->relParts[0]];
5572 
5573     /* get the min and max values */
5574     minVar = MIXEDVAR_MIN;
5575     maxVar = MIXEDVAR_MAX;
5576     if (!strcmp(mp->mixedvarPr,"Uniform"))
5577         {
5578         minVar = (mp->mixedvarUni[0] < MIXEDVAR_MIN) ? MIXEDVAR_MIN : mp->mixedvarUni[0];
5579         maxVar = (mp->mixedvarUni[1] > MIXEDVAR_MAX) ? MIXEDVAR_MAX : mp->mixedvarUni[1];
5580         }
5581 
5582     /* get the variance */
5583     oldVar = *GetParamVals (param, chain, state[chain]);
5584 
5585     /* set new value */
5586     newVar = oldVar * exp ((0.5 - RandomNumber(seed))*tuning);
5587 
5588     /* reflect if necessary */
5589     while (newVar < minVar || newVar > maxVar)
5590         {
5591         if (newVar < minVar)
5592             newVar = minVar * minVar / newVar;
5593         if (newVar > maxVar)
5594             newVar = maxVar * maxVar / newVar;
5595         }
5596 
5597     /* store new value */
5598     (*GetParamVals (param, chain, state[chain])) = newVar;
5599 
5600     /* calculate prior ratio */
5601     for (i=0; i<param->nSubParams; i++)
5602         {
5603         rclModel = GetParamIntVals (param->subParams[i], chain, state[chain]);
5604 
5605         if (*rclModel == RCL_TK02)
5606             {
5607             tk02Rate = GetParamVals (param->subParams[i], chain, state[chain]);
5608             t = GetTree (param->subParams[i], chain, state[chain]);
5609             for (j=0; j<t->nNodes-2; j++)
5610                 {
5611                 p = t->allDownPass[j];
5612                 if (p->length > 0.0)  // not ancestral fossil
5613                     {
5614                     (*lnPriorRatio) -= LnProbTK02LogNormal (tk02Rate[p->anc->index], oldVar*p->length, tk02Rate[p->index]);
5615                     (*lnPriorRatio) += LnProbTK02LogNormal (tk02Rate[p->anc->index], newVar*p->length, tk02Rate[p->index]);
5616                     }
5617                 }
5618             }
5619         else if (*rclModel == RCL_IGR)
5620             {
5621             igrRate = GetParamVals (param->subParams[i], chain, state[chain]);
5622             t = GetTree (param->subParams[i], chain, state[chain]);
5623             for (j=0; j<t->nNodes-2; j++)
5624                 {
5625                 p = t->allDownPass[j];
5626                 if (p->length > 0.0)  // not ancestral fossil
5627                     {
5628                     (*lnPriorRatio) -= LnProbGamma (p->length/oldVar, p->length/oldVar, igrRate[p->index]);
5629                     (*lnPriorRatio) += LnProbGamma (p->length/newVar, p->length/newVar, igrRate[p->index]);
5630                     }
5631                 }
5632             }
5633         }
5634 
5635     /* take prior on Mixedvar into account */
5636     if (!strcmp(mp->mixedvarPr,"Exponential"))
5637         (*lnPriorRatio) += mp->mixedvarExp * (oldVar - newVar);
5638 
5639     /* calculate proposal ratio */
5640     (*lnProposalRatio) = log (newVar / oldVar);
5641 
5642     /* we do not need to update likelihoods */
5643     for (i=0; i<param->nRelParts; i++)
5644         {
5645         modelSettings[param->relParts[i]].upDateCl = NO;
5646         }
5647 
5648     return (NO_ERROR);
5649 }
5650 
5651 
Move_RelaxedClockModel(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)5652 int Move_RelaxedClockModel (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
5653 {
5654     /* rjMCMC move between TK02 (correlated lognormal) and IGR (independent gamma rate)
5655      //chi */
5656 
5657     int         i, *rclModel;
5658     MrBFlt      *mxvar, *mxRate, *brlens, ratio, tk02var, igrvar;
5659     Tree        *t;
5660     TreeNode    *p = NULL;
5661     ModelInfo   *m;
5662     Model       *mp;
5663 
5664     /* get model settings and parameters */
5665     m = &modelSettings[param->relParts[0]];
5666     mp = &modelParams[param->relParts[0]];
5667     mxvar  = GetParamVals (m->mixedvar, chain, state[chain]);
5668     mxRate = GetParamVals (param, chain, state[chain]);
5669     brlens = GetParamSubVals (param, chain, state[chain]);
5670     t = GetTree (param, chain, state[chain]);
5671 
5672     /* get current value of model indicator */
5673     rclModel = GetParamIntVals(param, chain, state[chain]);
5674 
5675     /* get tk02/igr var ratio */
5676     ratio = mvp[0];
5677 
5678     (*lnPriorRatio) = (*lnProposalRatio) = 0.0;
5679 
5680     /* rjMCMC between models: Pr(TK02) = Pr(IGR) = 1/2 */
5681     /* the current model is TK02, move to IGR */
5682     if ((*rclModel) == RCL_TK02)
5683         {
5684         /* move the var parameter */
5685         tk02var = (*mxvar);
5686      // ratio  *= RandomNumber(seed);
5687         igrvar  = tk02var / ratio;
5688         if (igrvar < IGRVAR_MIN || igrvar > IGRVAR_MAX)
5689             {
5690             abortMove = YES;
5691             return (NO_ERROR);
5692             }
5693 
5694         /* take prior on Mixedvar into account */
5695         if (!strcmp(mp->mixedvarPr,"Exponential"))
5696             (*lnPriorRatio) += mp->mixedvarExp * (tk02var - igrvar);
5697 
5698         /* match the rates and change the effective branch lengths */
5699         for (i = 0; i < t->nNodes -2; i++)
5700             {
5701             p = t->allDownPass[i];
5702             if (p->length > 0.0)  // not ancestral fossil
5703                 {
5704                 (*lnPriorRatio) -= LnProbTK02LogNormal (mxRate[p->anc->index], tk02var*p->length, mxRate[p->index]);
5705                 (*lnPriorRatio) += LnProbGamma (p->length/igrvar, p->length/igrvar, mxRate[p->index]);
5706 
5707                 brlens[p->index] = mxRate[p->index] * p->length;
5708                 }
5709             }
5710 
5711         /* In this move, we simply match the parameters in each model,
5712            the dimension is same, the Jacobian is 1/ratio. */
5713         (*lnProposalRatio) -= log(ratio);
5714 
5715         /* switch model */
5716         (*rclModel) = RCL_IGR;
5717         (*mxvar) = igrvar;
5718         }
5719     /* the current model is IGR, move to TK02 */
5720     else
5721         {
5722         /* move the var parameter */
5723         igrvar  = (*mxvar);
5724      // ratio  *= RandomNumber(seed);
5725         tk02var = igrvar * ratio;
5726         if (tk02var < TK02VAR_MIN || tk02var > TK02VAR_MAX)
5727             {
5728             abortMove = YES;
5729             return (NO_ERROR);
5730             }
5731 
5732         /* take prior on Mixedvar into account */
5733         if (!strcmp(mp->mixedvarPr,"Exponential"))
5734             (*lnPriorRatio) += mp->mixedvarExp * (igrvar - tk02var);
5735 
5736         /* match the rates and change the effective branch lengths */
5737         for (i = 0; i < t->nNodes -2; i++)
5738             {
5739             p = t->allDownPass[i];
5740             if (p->length > 0.0)  // not ancestral fossil
5741                 {
5742                 (*lnPriorRatio) -= LnProbGamma (p->length/igrvar, p->length/igrvar, mxRate[p->index]);
5743                 (*lnPriorRatio) += LnProbTK02LogNormal (mxRate[p->anc->index], tk02var*p->length, mxRate[p->index]);
5744 
5745                 brlens[p->index] = p->length * (mxRate[p->index] + mxRate[p->anc->index]) /2.0;
5746                 }
5747             }
5748 
5749         /* In this move, we simply match the parameters in each model,
5750            the dimension is same, the Jacobian is ratio. */
5751         (*lnProposalRatio) += log(ratio);
5752 
5753         /* switch model */
5754         (*rclModel) = RCL_TK02;
5755         (*mxvar) = tk02var;
5756         }
5757 
5758     /* since effective branch lengths are updated, we need to update likelihood calculation */
5759     TouchAllTreeNodes(m, chain);
5760 
5761     return (NO_ERROR);
5762 }
5763 
5764 
5765 /*----------------------------------------------------------------
5766 |
5767 |   Move_Local: This proposal mechanism changes the topology and
5768 |      branch lengths of an unrooted tree using the LOCAL mech-
5769 |      anism described by Larget & Simon (1999):
5770 |
5771 |      Larget, B. L., and D. L. Simon. 1999. Markov chain
5772 |         Monte Carlo algorithms for the Bayesian analysis
5773 |         of phylogenetic trees. Molecular Biology and
5774 |         Evolution 16:750-759.
5775 |
5776 |      Programmed by FR 2001-10-14 and partly rewritten 2002-02-21
5777 |      for more elegance and the ability to deal with rooted trees.
5778 |      Support for locked nodes added 2004-01-12 based on mb v2.01.
5779 |      Calculation of the Hastings ratio corrected 2004-07-01.
5780 |      Boundary conditions correctly taken care of 2004-09-29.
5781 |      NB! An alternative to reflection is to skip moves, which might
5782 |          be better for the LOCAL given the complexity of taking
5783 |          the boundary conditions into account
5784 |
5785 ----------------------------------------------------------------*/
Move_Local(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)5786 int Move_Local (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
5787 {
5788     int         topologyHasChanged, isVPriorExp, directionUp, moveX;
5789     MrBFlt      oldM, newM, x, y, newX, newY,
5790                 tuning, minV, maxV, brlensExp=0.0;
5791     TreeNode    *v, *u, *a, *b, *c, *d;
5792     Tree        *t;
5793     ModelParams *mp;
5794 
5795     tuning = mvp[0]; /* Larget & Simon's tuning parameter lambda */
5796 
5797     /* get tree */
5798     t = GetTree (param, chain, state[chain]);
5799 
5800     /* get model params */
5801     mp = &modelParams[param->relParts[0]];
5802 
5803     /* max and min brlen */
5804     if (param->subParams[0]->paramId == BRLENS_UNI)
5805         {
5806         minV = mp->brlensUni[0] > BRLENS_MIN ? mp->brlensUni[0] : BRLENS_MIN;
5807         maxV = mp->brlensUni[1];
5808         isVPriorExp = NO;
5809         }
5810     else if (param->subParams[0]->paramId == BRLENS_GamDir)
5811         {
5812         minV = BRLENS_MIN;
5813         maxV = BRLENS_MAX;
5814         isVPriorExp = 2;
5815         }
5816     else if (param->subParams[0]->paramId == BRLENS_iGmDir)
5817         {
5818         minV = BRLENS_MIN;
5819         maxV = BRLENS_MAX;
5820         isVPriorExp = 3;
5821         }
5822     else if (param->subParams[0]->paramId == BRLENS_twoExp)
5823         {
5824         minV = BRLENS_MIN;
5825         maxV = BRLENS_MAX;
5826         isVPriorExp = 4;
5827         }
5828     else
5829         {
5830         minV = BRLENS_MIN;
5831         maxV = BRLENS_MAX;
5832         brlensExp = mp->brlensExp;
5833         isVPriorExp = YES;
5834         }
5835 
5836     /* Dirichlet or twoExp prior */
5837     if (isVPriorExp > 1)
5838         (*lnPriorRatio) = -LogDirPrior(t, mp, isVPriorExp);
5839 
5840     topologyHasChanged = NO;
5841 
5842 #   if defined (DEBUG_LOCAL)
5843     printf ("Before:\n");
5844     ShowNodes (t->root, 2, NO);
5845     getchar();
5846 #   endif
5847 
5848     /* pick an internal branch */
5849     do
5850         {
5851         v = t->intDownPass[(int)(RandomNumber(seed)*t->nIntNodes)];
5852         } while (v->anc->anc == NULL);
5853 
5854     /* set up pointers for crown part */
5855     if (RandomNumber(seed) < 0.5)
5856         {
5857         c = v->left;
5858         d = v->right;
5859         }
5860     else
5861         {
5862         c = v->right;
5863         d = v->left;
5864         }
5865 
5866     /* set up pointers for root part */
5867     u = v->anc;
5868     if (RandomNumber(seed) < 0.5 || (t->isRooted == YES && u->anc->anc == NULL))
5869         {
5870         directionUp = YES;
5871         if (u->left == v)
5872             a = u->right;
5873         else
5874             a = u->left;
5875         b = u->anc;
5876         }
5877     else
5878         {
5879         directionUp = NO;
5880         if (u->left == v)
5881             b = u->right;
5882         else
5883             b = u->left;
5884         a = u->anc;
5885         }
5886 
5887     /* store old and new path length as well as old x and y */
5888     oldM = c->length + v->length;
5889     if (directionUp == YES)
5890         {
5891         oldM += a->length;
5892         x = a->length;
5893         }
5894     else
5895         {
5896         oldM += u->length;
5897         x = u->length;
5898         }
5899 
5900     y = x + v->length;
5901 
5902     /* pick dangly to move */
5903     if (RandomNumber(seed) < 0.5)
5904         moveX = YES;
5905     else
5906         moveX = NO;
5907 
5908     /* find new m value */
5909     newM = exp(tuning * (RandomNumber(seed) - 0.5)) * oldM;
5910 
5911     /* pick dangly to move and
5912        pick new attachment point */
5913     if (moveX == YES)
5914         {
5915         /* choose new x */
5916 
5917         /* first update y */
5918         newY = y * (newM / oldM);
5919 
5920         /* find reinsertion point */
5921         if (v->isLocked == YES)
5922             {
5923             newX = RandomNumber(seed) *  newY;
5924             }
5925         else
5926             {
5927             newX = RandomNumber(seed) * newM;
5928             }
5929         }
5930     else
5931         {
5932         /* choose new y */
5933 
5934         /* first update x */
5935         newX = x * (newM / oldM);
5936 
5937         /* find reinsertion point */
5938         if (v->isLocked == YES)
5939             {
5940             newY = RandomNumber(seed) * (newM - newX) + newX;
5941             }
5942         else
5943             {
5944             newY = RandomNumber(seed) * newM;
5945             }
5946         }
5947 
5948     /* adjust proposal and prior ratio based on length modification */
5949     /* and insertion mechanism */
5950     (*lnProposalRatio) += 3.0 * log (newM / oldM);
5951     if (isVPriorExp == YES)
5952         (*lnPriorRatio) = brlensExp * (oldM - newM);
5953 
5954     /* make topology move if necessary and then set branch lengths */
5955     if (newX > newY)
5956         {
5957         /* check if we need to abort */
5958         if (newY < minV || newY > maxV || (newX-newY) < minV || (newX-newY) > maxV || (newM-newX) < minV || (newM-newX) > maxV)
5959             {
5960             abortMove = YES;
5961             return NO_ERROR;
5962             }
5963 
5964         /* topology has changed */
5965         topologyHasChanged = YES;
5966         /* detach v and d */
5967         /* this scheme differs from that used by Larget and Simon but is more
5968            convenient because it avoids tree rotations */
5969         if (u->left == v)
5970             u->left = c;
5971         else
5972             u->right = c;
5973         c->anc = u;
5974         if (directionUp == YES)
5975             {
5976             /* place v and d below a */
5977             if (v->left == d)
5978                 v->right = a;
5979             else
5980                 v->left = a;
5981             a->anc = v;
5982             if (u->left == a)
5983                 u->left = v;
5984             else
5985                 u->right = v;
5986             /* v->anc is already u */
5987             /* adjust lengths */
5988             c->length = newM - newX;
5989             v->length = newX - newY;
5990             a->length = newY;
5991             }
5992         else
5993             {
5994             /* place v and d below u */
5995             if (u->isLocked == YES)
5996                 {
5997                 v->isLocked = YES;
5998                 u->isLocked = NO;
5999                 v->lockID = u->lockID;
6000                 u->lockID = 0;
6001                 }
6002             if (v->left == d)
6003                 v->right = u;
6004             else
6005                 v->left = u;
6006             u->anc = v;
6007             v->anc = a;
6008             if (a->left == u)
6009                 a->left = v;
6010             else
6011                 a->right = v;
6012             /* adjust lengths */
6013             c->length = newM - newX;
6014             u->length = newX - newY;
6015             v->length = newY;
6016             }
6017         }
6018     else
6019         {
6020         /* check if we need to abort */
6021         if (newX < minV || newX > maxV || (newY-newX) < minV || (newY-newX) > maxV || (newM-newY) < minV || (newM-newY) > maxV)
6022             {
6023             abortMove = YES;
6024             return NO_ERROR;
6025             }
6026 
6027         /* topology has not changed */
6028         c->length = newM - newY;
6029         v->length = newY - newX;
6030         if (directionUp == YES)
6031             a->length = newX;
6032         else
6033             u->length = newX;
6034         }
6035 
6036     /* set update of transition probs */
6037     c->upDateTi = YES;
6038     v->upDateTi = YES;
6039     if (directionUp == YES)
6040         a->upDateTi = YES;
6041     else
6042         u->upDateTi = YES;
6043 
6044     /* set flags for update of cond likes from v and u down to root */
6045     v->upDateCl = YES;
6046     u->upDateCl = YES;
6047     if (directionUp == YES)
6048         v = b;
6049     else
6050         v = a;
6051     while (v->anc != NULL)
6052         {
6053         v->upDateCl = YES;
6054         v = v->anc;
6055         }
6056 
6057     /* get downpass sequence if tree topology has changed */
6058     if (topologyHasChanged == YES)
6059         {
6060         GetDownPass (t);
6061         }
6062 
6063     /* Dirichlet or twoExp prior */
6064     if (isVPriorExp > 1)
6065         (*lnPriorRatio) += LogDirPrior(t, mp, isVPriorExp);
6066 
6067 #   if defined (DEBUG_LOCAL)
6068     printf ("After:\n");
6069     ShowNodes (t->root, 2, NO);
6070     getchar();
6071     printf ("Proposal ratio: %f\n",(*lnProposalRatio));
6072     printf ("v: %d  u: %d  c: %d  d: %d  a: %d  b: %d\n",v->index, u->index,
6073             c->index, d->index, a->index, b->index);
6074     printf ("Has topology changed? %d\n",topologyHasChanged);
6075     getchar();
6076 #   endif
6077 
6078     return (NO_ERROR);
6079 }
6080 
6081 
6082 /*----------------------------------------------------------------
6083 |
6084 |   Move_LocalClock: This proposal mechanism changes the topology and
6085 |      branch lengths of a rooted tree using the LOCAL (clock) mech-
6086 |      anism described by Larget & Simon (1999):
6087 |
6088 |      Larget, B. L., and D. L. Simon. 1999. Markov chain
6089 |         Monte Carlo algorithms for the Bayesian analysis
6090 |         of phylogenetic trees. Molecular Biology and
6091 |         Evolution 16:750-759.
6092 |
6093 |      Programmed by JH 2002-07-07
6094 |      Modified by FR 2004-05-22 to handle locked and dated trees
6095 |      Modified by FR 2005-11-09 to take care of erroneous
6096 |           Hastings ratio. The fix implemented here results in
6097 |           a move that does not change tree height.
6098 |
6099 ----------------------------------------------------------------*/
Move_LocalClock(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)6100 int Move_LocalClock (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
6101 {
6102     int             i, topologyHasChanged, vIsRoot, aSister, bSister, cSister, *nEvents;
6103     MrBFlt          x, y, h1, h2, h3, h[3], tempD, ran, distUv, distCv,
6104                     oldALength, oldBLength, oldCLength, oldULength, oldVLength, lambda, nu,
6105                     *tk02Rate=NULL, *brlens, oldTreeLength, newTreeLength;
6106  // MrBFlt          newDepth, oldDepth, factor, diff;
6107     TreeNode        *u, *v, *w=NULL, *a, *b, *c, *deepestChild, *p;
6108     Tree            *t;
6109     Param           *subParm;
6110 
6111     /* get tree */
6112     t = GetTree (param, chain, state[chain]);
6113 
6114 #if defined (DEBUG_LOCAL)
6115     /* check branch lengths and node depths */
6116     for (i=0; i<t->nNodes-2; i++) {
6117         p = t->allDownPass[i];
6118         /* the two checkings don't consider ancestral fossil (brl=0) in fossilized bd tree */
6119         if (p->length < minV) {
6120             printf ("%s   ERROR when entering LocalClock: node %d has length %lf", spacer, p->index, p->length);
6121             return ERROR;
6122         }
6123         if (p->nodeDepth >= p->anc->nodeDepth) {
6124             printf ("%s   ERROR when entering LocalClock: node %d has depth %lf larger than its ancestor %d depth %lf", spacer, p->index, p->nodeDepth, p->anc->index, p->anc->nodeDepth);
6125             return ERROR;
6126         }
6127     }
6128 #endif
6129 
6130     topologyHasChanged = NO;    /* FIXME: Not used (from clang static analyzer) */
6131 
6132 #   if defined (DEBUG_LOCAL)
6133     printf ("Before:\n");
6134     ShowNodes (t->root, 2, YES);
6135 #   endif
6136 
6137     /* set up pointers */
6138     do
6139         {
6140         u = t->intDownPass[(int)(RandomNumber(seed)*(t->nIntNodes-1))];
6141         } while (u->anc->anc == NULL);
6142     v = u->anc;
6143     a = u->left;
6144     b = u->right;
6145     if (v->left == u)
6146         c = v->right;
6147     else
6148         c = v->left;
6149     vIsRoot = NO;
6150     if (v->anc->anc != NULL)
6151         w = v->anc;
6152     else
6153         vIsRoot = YES;
6154 
6155     oldALength = a->length;
6156     oldBLength = b->length;
6157     oldCLength = c->length;
6158     oldVLength = v->length;
6159     oldULength = u->length;
6160     oldTreeLength = TreeLength (param, chain);
6161 
6162     /* get distances from root of move (w or v) to nodes a, b, and c */
6163     if (vIsRoot == NO)
6164         h1 = h2 = h3 = v->length;
6165     else
6166         h1 = h2 = h3 = 0.0;
6167     h1 += u->length + a->length;
6168     h2 += u->length + b->length;
6169     h3 += c->length;
6170     h[0] = h1;
6171     h[1] = h2;
6172     h[2] = h3;
6173 
6174     /* we also need the distances between u <-> v and c <-> v to calculate the hastings' term */
6175     distUv = u->length;
6176     distCv = c->length;
6177 
6178     /* sort distances (simply make three comparisons and swap values, if necessary) */
6179     if (h[0] > h[1])
6180         {
6181         tempD = h[1];
6182         h[1] = h[0];
6183         h[0] = tempD;
6184         }
6185     if (h[0] > h[2])
6186         {
6187         tempD = h[2];
6188         h[2] = h[0];
6189         h[0] = tempD;
6190         }
6191     if (h[1] > h[2])
6192         {
6193         tempD = h[2];
6194         h[2] = h[1];
6195         h[1] = tempD;
6196         }
6197 
6198     /* Find the child node (a, b, or c) that is closest to the root (i.e., has smallest h_i; i=1,2,3). This
6199        part deals with the possibility that some of the nodes are at the same nodeDepth and randomly assigns
6200        a node to be deepest in case of ties. */
6201     if (AreDoublesEqual (h1, h2, 0.00000001) == YES && AreDoublesEqual (h1, h3, 0.00000001) == YES && AreDoublesEqual (h2, h3, 0.00000001) == YES)
6202         {
6203         ran = RandomNumber(seed);
6204         if (ran < 0.33333333)
6205             deepestChild = a;
6206         else if (ran > 0.66666666)
6207             deepestChild = b;
6208         else
6209             deepestChild = c;
6210         }
6211     else if (AreDoublesEqual (h1, h2, 0.00000001) == YES && AreDoublesEqual (h1, h3, 0.00000001) == NO && AreDoublesEqual (h2, h3, 0.00000001) == NO)
6212         {
6213         if (h1 < h3)
6214             {
6215             ran = RandomNumber(seed);
6216             if (ran < 0.5)
6217                 deepestChild = a;
6218             else
6219                 deepestChild = b;
6220             }
6221         else
6222             deepestChild = c;
6223         }
6224     else if (AreDoublesEqual (h1, h2, 0.00000001) == NO && AreDoublesEqual (h1, h3, 0.00000001) == YES && AreDoublesEqual (h2, h3, 0.00000001) == NO)
6225         {
6226         if (h1 < h2)
6227             {
6228             ran = RandomNumber(seed);
6229             if (ran < 0.5)
6230                 deepestChild = a;
6231             else
6232                 deepestChild = c;
6233             }
6234         else
6235             deepestChild = b;
6236         }
6237     else if (AreDoublesEqual (h1, h2, 0.00000001) == NO && AreDoublesEqual (h1, h3, 0.00000001) == NO && AreDoublesEqual (h2, h3, 0.00000001) == YES)
6238         {
6239         if (h2 < h1)
6240             {
6241             ran = RandomNumber(seed);
6242             if (ran < 0.5)
6243                 deepestChild = b;
6244             else
6245                 deepestChild = c;
6246             }
6247         else
6248             deepestChild = a;
6249         }
6250     else
6251         {
6252         if (h1 < h2 && h1 < h3)
6253             deepestChild = a;
6254         else if (h2 < h1 && h2 < h3)
6255             deepestChild = b;
6256         else
6257             deepestChild = c;
6258         }
6259 
6260     /* get x and y */
6261     /* for most of the branches, the proposal ratio is 0.0 so it makes sense to set this first */
6262     (*lnProposalRatio) = 0.0;
6263     if (u->isDated == YES && v->isDated == YES)
6264         {
6265         /* this proposal is wasted, change nothing */
6266         if (vIsRoot == NO)
6267             {
6268             y = v->length;
6269             x = y + u->length;
6270             }
6271         else
6272             {
6273             y = 0.0;
6274             x = u->length;
6275             }
6276         }
6277     else if (u->isDated == YES && v->isDated == NO)
6278         {
6279         /* we can only change the position of v */
6280         if (vIsRoot == NO)
6281             {
6282             /* the upper limit of v's height is determined either by u-length + v->length or by c->length + v->length (h[0]) */
6283             x = v->length + u->length;
6284             if (x > h[0])
6285                 x = h[0];
6286             y = RandomNumber(seed) * x;
6287             }
6288         else
6289             {
6290             /* v is root: we leave tree height unchanged so we cannot change anything */
6291             x = u->length;
6292             y = 0.0;
6293             }
6294         }
6295     else if (u->isDated == NO && v->isDated == YES)
6296         {
6297         /* we can only change the position of u */
6298         if (vIsRoot == NO)
6299             y = v->length;
6300         else
6301             y = 0.0;
6302         if (u->isLocked == YES)
6303             {
6304             if (h1 > h2)
6305                 {
6306                 x = y + RandomNumber(seed) * (h2 - y);
6307                 }
6308             else
6309                 {
6310                 x = y + RandomNumber(seed) * (h1 - y);
6311                 }
6312             }
6313         else
6314             {
6315             x = y + RandomNumber(seed) * (h[1] - y);
6316             }
6317         }
6318     /* if we reach the statements down here, neither u nor v is dated */
6319     else if (u->isLocked == YES)
6320         {
6321         if (h1 > h2)
6322             {
6323             y = RandomNumber(seed) * h[0];
6324             x = y + RandomNumber(seed) * (h2 - y);
6325             }
6326         else
6327             {
6328             y = RandomNumber(seed) * h[0];
6329             x = y + RandomNumber(seed) * (h1 - y);
6330             }
6331         }
6332     else if (vIsRoot == NO)
6333         {
6334         /* this is the standard variant for nonroot v */
6335         x = RandomNumber(seed) * h[1];
6336         y = RandomNumber(seed) * h[0];
6337         }
6338     else
6339         {
6340         /* this is the standard variant when v is the root */
6341         /*oldDepth = t->root->left->nodeDepth;
6342           factor = exp((RandomNumber(seed) - 0.5) * 2.0 * log(1.2));
6343           t->root->left->nodeDepth = newDepth =  factor * h[0] - h[0] + oldDepth;
6344           adjust h[0], h[1], and h[2]
6345           diff = newDepth - oldDepth;
6346           h[0] += diff;
6347           h[1] += diff;
6348           h[2] += diff;*/
6349         /* set y to 0.0 and select new x */
6350         y = 0.0;
6351         x = RandomNumber(seed) * h[1];
6352         /* Adjust proposal ratio. We deal with topology bias below. Note that this
6353            proposal ratio is very different from what appeared in Larget and Simon */
6354         /*(*lnProposalRatio) += (t->nIntNodes-1) * log(oldDepth / newDepth);*/
6355         /*(*lnProposalRatio) += 2.0 * log (factor);*/
6356         }
6357 
6358     /* decide which topology we will construct (cSister is what we started with) */
6359     aSister = bSister = cSister = NO;
6360     /* if u is locked then we cannot change topology */
6361     if (u->isLocked == YES)
6362         cSister = YES;
6363     else if (MaximumValue (x, y) < h[0])
6364         {
6365         ran = RandomNumber(seed);
6366         if (ran < 0.33333333)
6367             aSister = YES;
6368         else if (ran > 0.66666666)
6369             bSister = YES;
6370         else
6371             cSister = YES;
6372         }
6373     else
6374         {
6375         if (deepestChild == a)
6376             aSister = YES;
6377         else if (deepestChild == b)
6378             bSister = YES;
6379         else
6380             cSister = YES;
6381         }
6382 
6383     /* adjust lengths of nodes u and v */
6384     u->length = MaximumValue (x, y) - MinimumValue (x, y);
6385     v->length = MinimumValue (x, y);
6386     if (vIsRoot == NO)
6387         v->nodeDepth = w->nodeDepth - v->length;
6388     u->nodeDepth = v->nodeDepth - u->length;
6389 
6390     /* adjust pointers and lengths of nodes a, b, and c */
6391     topologyHasChanged = NO;
6392     if (cSister == YES)
6393         {
6394         if (v->left == u)
6395             v->right = c;
6396         else
6397             v->left = c;
6398         u->left = a;
6399         u->right = b;
6400         a->anc = b->anc = u;
6401         c->anc = v;
6402         a->length = u->nodeDepth - a->nodeDepth;
6403         b->length = u->nodeDepth - b->nodeDepth;
6404         c->length = v->nodeDepth - c->nodeDepth;
6405         }
6406     else if (bSister == YES)
6407         {
6408         if (v->left == u)
6409             v->right = b;
6410         else
6411             v->left = b;
6412         u->left = a;
6413         u->right = c;
6414         a->anc = c->anc = u;
6415         b->anc = v;
6416         a->length = u->nodeDepth - a->nodeDepth;
6417         b->length = v->nodeDepth - b->nodeDepth;
6418         c->length = u->nodeDepth - c->nodeDepth;
6419         topologyHasChanged = YES;
6420         }
6421     else if (aSister == YES)
6422         {
6423         if (v->left == u)
6424             v->right = a;
6425         else
6426             v->left = a;
6427         u->left = b;
6428         u->right = c;
6429         b->anc = c->anc = u;
6430         a->anc = v;
6431         a->length = v->nodeDepth - a->nodeDepth;
6432         b->length = u->nodeDepth - b->nodeDepth;
6433         c->length = u->nodeDepth - c->nodeDepth;
6434         topologyHasChanged = YES;
6435         }
6436 
6437     /* check that all branch lengths are good */
6438     if (a->length < 0.0 && b->length < 0.0 && c->length < 0.0 && u->length < 0.0 && v->length < 0.0)
6439         {
6440         abortMove = YES;
6441         return NO_ERROR;
6442         }
6443 
6444     /* calculate the proposal ratio due to asymmetric topology changes */
6445     if (u->isLocked == NO)
6446         {
6447         if (v->isDated == YES || vIsRoot == YES)
6448             {
6449             if (distUv > distCv && MaximumValue (x, y) < h[0])
6450                 (*lnProposalRatio) += log(3.0);
6451             else if (distUv < distCv && MaximumValue (x, y) > h[0])
6452                 (*lnProposalRatio) += log(1.0 / 3.0);
6453             }
6454         else
6455             {
6456             /* note that Larget and Simon did not have the correct Hastings ratio
6457                for this case */
6458             if (distUv > distCv && MaximumValue (x, y) < h[0])
6459                 (*lnProposalRatio) += log(3.0 / 2.0);
6460             else if (distUv < distCv && MaximumValue (x, y) > h[0])
6461                 (*lnProposalRatio) += log(2.0 / 3.0);
6462             }
6463         }
6464 
6465     /* set update of transition probs */
6466     a->upDateTi = b->upDateTi = c->upDateTi = u->upDateTi = YES;
6467     if (vIsRoot == NO)
6468         v->upDateTi = YES;
6469 
6470     /* set flags for update of cond likes from u down to root */
6471     p = u;
6472     while (p->anc != NULL)
6473         {
6474         p->upDateCl = YES;
6475         p = p->anc;
6476         }
6477 
6478     /* get downpass sequence if tree topology has changed */
6479     if (topologyHasChanged == YES)
6480         GetDownPass (t);
6481 
6482     /* adjust proposal and prior ratio for relaxed clock models */
6483     newTreeLength = TreeLength(param, chain);
6484     for (i=0; i<param->subParams[0]->nSubParams; i++)
6485         {
6486         subParm = param->subParams[0]->subParams[i];
6487         if (subParm->paramType == P_CPPEVENTS)
6488             {
6489             nEvents = subParm->nEvents[2*chain+state[chain]];
6490             lambda = *GetParamVals (modelSettings[subParm->relParts[0]].cppRate, chain, state[chain]);
6491             /* proposal ratio */
6492             (*lnProposalRatio) += nEvents[a->index] * log (a->length / oldALength);
6493             (*lnProposalRatio) += nEvents[b->index] * log (b->length / oldBLength);
6494             (*lnProposalRatio) += nEvents[c->index] * log (c->length / oldCLength);
6495             (*lnProposalRatio) += nEvents[u->index] * log (u->length / oldULength);
6496             if (v->anc->anc != NULL && v->isDated == NO)
6497                 (*lnProposalRatio) += nEvents[v->index] * log (v->length / oldVLength);
6498             /* prior ratio */
6499             (*lnPriorRatio) += lambda * ((oldTreeLength - newTreeLength)/t->root->left->nodeDepth);
6500             /* update effective evolutionary lengths */
6501             if (v->anc->anc == NULL || v->isDated == YES)
6502                 {
6503                 if (UpdateCppEvolLengths (subParm, v->left, chain) == ERROR ||
6504                     UpdateCppEvolLengths (subParm, v->right, chain) == ERROR)
6505                     {
6506                     abortMove = YES;
6507                     return (NO_ERROR);
6508                     }
6509                 }
6510             else
6511                 {
6512                 if (UpdateCppEvolLengths (subParm, v, chain) == ERROR)
6513                     {
6514                     abortMove = YES;
6515                     return (NO_ERROR);
6516                     }
6517                 }
6518             }
6519         else if ( subParm->paramType == P_TK02BRANCHRATES ||
6520                  (subParm->paramType == P_MIXEDBRCHRATES && *GetParamIntVals(subParm, chain, state[chain]) == RCL_TK02))
6521             {
6522             if (subParm->paramType == P_TK02BRANCHRATES)
6523                 nu = *GetParamVals (modelSettings[subParm->relParts[0]].tk02var, chain, state[chain]);
6524             else
6525                 nu = *GetParamVals (modelSettings[subParm->relParts[0]].mixedvar, chain, state[chain]);
6526             nu /= t->root->left->nodeDepth;     /* variance increase measured relative to tree height */
6527             tk02Rate = GetParamVals (subParm, chain, state[chain]);
6528             brlens = GetParamSubVals (subParm, chain, state[chain]);
6529             /* no proposal ratio effect */
6530             /* prior ratio and update of effective evolutionary lengths */
6531             (*lnPriorRatio) -= LnProbTK02LogNormal (tk02Rate[u->index], nu*oldALength, tk02Rate[a->index]);
6532             (*lnPriorRatio) += LnProbTK02LogNormal (tk02Rate[u->index], nu*u->left->length, tk02Rate[u->left->index]);
6533             (*lnPriorRatio) -= LnProbTK02LogNormal (tk02Rate[u->index], nu*oldBLength, tk02Rate[b->index]);
6534             (*lnPriorRatio) += LnProbTK02LogNormal (tk02Rate[u->index], nu*u->right->length, tk02Rate[u->right->index]);
6535             (*lnPriorRatio) -= LnProbTK02LogNormal (tk02Rate[v->index], nu*oldCLength, tk02Rate[c->index]);
6536             (*lnPriorRatio) -= LnProbTK02LogNormal (tk02Rate[v->index], nu*oldULength, tk02Rate[u->index]);
6537             (*lnPriorRatio) += LnProbTK02LogNormal (tk02Rate[v->index], nu*v->left->length, tk02Rate[v->left->index]);
6538             (*lnPriorRatio) += LnProbTK02LogNormal (tk02Rate[v->index], nu*v->right->length, tk02Rate[v->right->index]);
6539             brlens[a->index] = a->length * (tk02Rate[a->index] + tk02Rate[a->anc->index])/2.0;
6540             brlens[b->index] = a->length * (tk02Rate[a->index] + tk02Rate[a->anc->index])/2.0;
6541             brlens[c->index] = c->length * (tk02Rate[c->index] + tk02Rate[c->anc->index])/2.0;
6542             brlens[u->index] = u->length * (tk02Rate[u->index] + tk02Rate[u->anc->index])/2.0;
6543             if (v->anc->anc != NULL && v->isDated == NO)
6544                 {
6545                 (*lnPriorRatio) -= LnProbTK02LogNormal (tk02Rate[w->index], nu*oldVLength, tk02Rate[v->index]);
6546                 (*lnPriorRatio) += LnProbTK02LogNormal (tk02Rate[w->index], nu*v->length, tk02Rate[v->index]);
6547                 brlens[v->index] = v->length * (tk02Rate[v->index] + tk02Rate[v->anc->index])/2.0;
6548                 }
6549             }
6550         else if ( subParm->paramType == P_IGRBRANCHRATES ||
6551                  (subParm->paramType == P_MIXEDBRCHRATES && *GetParamIntVals(subParm, chain, state[chain]) == RCL_IGR))
6552             {
6553             /* to do */
6554             }
6555         }
6556 
6557     /* calculate and adjust prior ratio for clock tree */
6558     if (LogClockTreePriorRatio (param, chain, &x) == ERROR)
6559         return (ERROR);
6560     (*lnPriorRatio) += x;
6561 
6562 #   if defined (DEBUG_LOCAL)
6563     printf ("After:\n");
6564     ShowNodes (t->root, 2, YES);
6565     printf ("Has topology changed? %d\n",topologyHasChanged);
6566 
6567     /* check branch lengths and node depths */
6568     for (i=0; i<t->nNodes-2; i++) {
6569         p = t->allDownPass[i];
6570         if (p->length < minV) {
6571             printf ("%s   ERROR when leaving LocalClock: node %d has length %lf", spacer, p->index, p->length);
6572             return ERROR;
6573         }
6574         if (p->nodeDepth >= p->anc->nodeDepth) {
6575             printf ("%s   ERROR when leaving LocalClock: node %d has depth %lf larger than its ancestor %d depth %lf", spacer, p->index, p->nodeDepth, p->anc->index, p->anc->nodeDepth);
6576             return ERROR;
6577         }
6578     }
6579 #endif
6580 
6581     return (NO_ERROR);
6582 }
6583 
6584 
6585 #if 0
6586 /*--------------------------------------------------------------------
6587 |
6588 |   Move_LSPR: Change topology using move based on likelihood scores
6589 |
6590 |--------------------------------------------------------------------*/
6591 int Move_LSPR (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
6592 {
6593     /* Change branch lengths and topology (potentially) using SPR-type move
6594        biased according to likelihood scores. NOT work for constrained trees. */
6595 
6596     int         i, j, n, division, topologyHasChanged, isVPriorExp, nNodes;
6597     BitsLong    *pA, *pV, *pP;
6598     MrBFlt      x, minV, maxV, brlensExp=0.0, minLength=0.0, curLength=0.0, length=0.0,
6599                 cumulativeProb, warpFactor, sum, ran, tuning, increaseProb, decreaseProb,
6600                 divFactor, nStates, rateMult, temp;
6601     CLFlt       *nSitesOfPat, *globalNSitesOfPat, *tempCondLikes, **tempCondLikePtr;
6602     TreeNode    *p, *q, *a, *b, *u, *v, *c=NULL, *d, *candidateNodes[20], *vLeft, *vRight;
6603     Tree        *t;
6604     ModelParams *mp;
6605     ModelInfo   *m = NULL;
6606 
6607     temp = mvp[0];      /* tuning parameter determining how heavily to weight according to likelihood scores */
6608     var = mvp[1];       /* variance of lognormal for proposing branch lengths */
6609     increaseProb = decreaseProb = mvp[2];   /* reweighting probabilities */
6610 
6611     (*lnProposalRatio) = (*lnPriorRatio) = 0.0;
6612 
6613     /* get model params and model info */
6614     mp = &modelParams[param->relParts[0]];
6615     m = &modelSettings[param->relParts[0]];
6616 
6617     /* get tree */
6618     t = GetTree (param, chain, state[chain]);
6619 
6620     /* max and min brlen */
6621     if (param->subParams[0]->paramId == BRLENS_UNI)
6622         {
6623         minV = mp->brlensUni[0] > BRLENS_MIN ? mp->brlensUni[0] : BRLENS_MIN;
6624         maxV = mp->brlensUni[1];
6625         isVPriorExp = NO;
6626         }
6627     else
6628         {
6629         minV = BRLENS_MIN;
6630         maxV = BRLENS_MAX;
6631         brlensExp = mp->brlensExp;
6632         isVPriorExp = YES;
6633         }
6634 
6635 #   if defined (DEBUG_MLSPR)
6636     printf ("Before:\n");
6637     ShowNodes (t->root, 2, YES);
6638     getchar();
6639 #   endif
6640 
6641     /* set topologyHasChanged to NO */
6642     topologyHasChanged = NO;
6643 
6644     /* reset node variables that will be used */
6645     for (i=0; i<t->nNodes; i++)
6646         {
6647         p = t->allDownPass[i];
6648         p->marked = NO;
6649         p->x = 0;
6650         p->d = 0.0;
6651         }
6652 
6653     /* pick a random branch */
6654     do
6655         {
6656         p = t->allDownPass[(int)(RandomNumber(seed)*(t->nNodes - 1))];
6657         } while (p->anc->anc == NULL || p->anc->isLocked == YES);
6658 
6659     /* set up pointers for nodes around the picked branch */
6660     v = p;
6661     u = p->anc;
6662     if (u->left == v)
6663         a = u->right;
6664     else
6665         a = u->left;
6666     b = u->anc;
6667     vLeft = v->left;
6668     vRight = vRight;
6669 
6670     /* store the branch lengths */
6671     aLength = a->length;
6672     uLength = u->length;
6673     vLength = v->length;
6674     if (v->left != NULL)
6675         {
6676         vLeftLength = v->left->length;
6677         vRightLength = v->right->length;
6678         }
6679     else
6680         vLeftLength = vRightLength = 0.0;
6681 
6682     /* get the ML branch lengths */
6683     /* set initial branch lengths */
6684     /* cycle through using Newton Raphson and reoptimization a fixed number of iterations */
6685     for (i=0; i<5; i++)
6686         {
6687         }
6688 
6689     /* get variance of lognormal */
6690 
6691     /* clip tree */
6692     a->anc = b;
6693     if (b->left == u)
6694         b->left = a;
6695     else
6696         b->right = a;
6697 
6698     /* count distance to root */
6699     q = b;
6700     nNodes = 0;
6701     while (q->anc != NULL)
6702         {
6703         nNodes++;
6704         q = q->anc;
6705         }
6706 
6707     /* allocate space for temporary cond likes and condlike pointers */
6708     tempCondLikes = (CLFlt *) SafeCalloc (nNodes*m->numChars*m->numModelStates, sizeof (CLFlt));
6709     tempCondLikePtr = (CLFlt **) SafeCalloc (nNodes, sizeof (CLFlt *));
6710     if (!tempCondLikes || !tempCondLikePtr)
6711         {
6712         free (tempCondLikes);
6713         free (tempCondLikePtr);
6714         return (ERROR);
6715         }
6716 
6717     /* shift pointers over */
6718     q = b;
6719     j = 0;
6720     while (q->anc != NULL)
6721         {
6722         tempCondLikePtr[j] = m->condLike[chain][q->index][q->clSpace];
6723         m->condLike[chain][q->index][q->clSpace] = tempCondLikes + j*m->numChars*m->numModelStates;
6724         j++;
6725         q = q->anc;
6726         }
6727 
6728     /* set length to 0.1 for now; test ML brlen later */
6729     aLength = a->length;
6730     a->length = 0.1;
6731     uLength = u->length;
6732     u->length = 0.1;
6733     vLength = v->length;
6734     v->length = 0.1;
6735 
6736     /* get downpass cond likes for the root part */
6737     q = b;
6738     while (q->anc != NULL)
6739         m->condLikeDown (q, division, chain);
6740 
6741     /* get final pass cond likes for the root part */
6742     GetLikeFPRootPath (a);
6743 
6744     /* get downpass parsimony states for the crown part */
6745     GetParsDP (t, v, chain);
6746 
6747     /* mark all nodes in the root part of the tree */
6748     t->root->left->marked = YES;
6749     for (i=t->nNodes-3; i>=0; i--)
6750         {
6751         p = t->allDownPass[i];
6752         if (p->anc->marked == YES && p != u)
6753             p->marked = YES;
6754         }
6755 
6756     /* find number of site patterns and modify randomly */
6757     globalNSitesOfPat = numSitesOfPat + (chainId[chain] % chainParams.numChains) * numCompressedChars;
6758     nSitesOfPat = (CLFlt *) SafeCalloc (numCompressedChars, sizeof(CLFlt));
6759     if (!nSitesOfPat)
6760         {
6761         MrBayesPrint ("%s   Problem allocating nSitesOfPat in Move_LSPR\n", spacer);
6762         free (tempCondLikes);
6763         free (tempCondLikePtr);
6764         return (ERROR);
6765         }
6766     for (i=0; i<numCompressedChars; i++)
6767         {
6768         nSitesOfPat[i] = globalNSitesOfPat[i];
6769         for (j=0; j<globalNSitesOfPat[i]; j++)
6770             {
6771             ran = RandomNumber(seed);
6772             if (ran < decreaseProb)
6773                 nSitesOfPat[i]--;
6774             else if (ran > 1.0 - increaseProb)
6775                 nSitesOfPat[i]++;
6776             }
6777         }
6778 
6779     /* cycle through the possibilities and record ln likelihood of each in p->d */
6780     minLength = 0.0;
6781     for (i=0; i<t->nNodes; i++)
6782         {
6783         p = t->allDownPass[i];
6784         if (p->marked == NO)
6785             continue;
6786         /* find the parsimony length */
6787         p->d = 0.0;
6788         for (n=0; n<t->nRelParts; n++)
6789             {
6790             division = t->relParts[n];
6791 
6792             /* Find model settings */
6793             m = &modelSettings[division];
6794 
6795             nStates = m->numModelStates;
6796             if (m->dataType == STANDARD)
6797                 nStates = 2;
6798             rateMult = GetRate(division, chain);
6799 
6800             divFactor = warpFactor + log(nStates-1) - log (3) - log(rateMult);
6801 
6802             /* find downpass parsimony sets for the node and its environment */
6803             pP   = parsPtr[chain][p->index]      + m->parsMatrixStart + Bit(division, p->clSpace)      * parsMatrixRowSize;
6804             pA   = parsPtr[chain][p->anc->index] + m->parsMatrixStart + Bit(division, p->anc->clSpace) * parsMatrixRowSize;
6805             pV   = parsPtr[chain][v->index]      + m->parsMatrixStart + Bit(division, v->clSpace)      * parsMatrixRowSize;
6806 
6807             length = 0.0;
6808             for (j=0; j<m->numChars; j++)
6809                 {
6810                 x = (pP[j] | pA[j]) & pV[j];
6811                 if (x == 0)
6812                     length += nSitesOfPat[j];
6813                 }
6814             p->d += divFactor * length;
6815             }
6816         if (i == 0)
6817             minLength = p->d;
6818         else if (p->d < minLength)
6819             minLength = p->d;
6820         if (p == a)
6821             curLength = p->d;
6822         }
6823 
6824     /* find the sum given the warp factor */
6825     sum = 0.0;
6826     for (i=0; i<t->nNodes; i++)
6827         {
6828         p = t->allDownPass[i];
6829         if (p->marked == YES)
6830             {
6831             p->d = exp (minLength - p->d);
6832             sum += p->d;
6833             }
6834         }
6835 
6836     /* generate a random uniform */
6837     ran = RandomNumber(seed);
6838 
6839     /* select the appropriate reattachment point */
6840     cumulativeProb = 0.0;
6841     for (i=0; i<t->nNodes; i++)
6842         {
6843         p = t->allDownPass[i];
6844         if (p->marked == YES)
6845             {
6846             c = p;
6847             cumulativeProb += p->d / sum;
6848             if (cumulativeProb > ran)
6849                 break;
6850             }
6851         }
6852     if (c->marked != YES)
6853         {
6854         printf ("Could not select node\n");
6855         getchar();
6856         }
6857 
6858     /* calculate the proposal ratio */
6859     if (c == a)
6860         (*lnProposalRatio) = 0.0;
6861     else
6862         (*lnProposalRatio) = c->d - curLength;
6863 
6864     /* reattach */
6865     d = c->anc;
6866     c->anc = u;
6867     if (u->left == v)
6868         u->right = c;
6869     else
6870         u->left = c;
6871     if (d->left == c)
6872         d->left = u;
6873     else
6874         d->right = u;
6875     u->anc = d;
6876 
6877     /* reassign branch lengths */
6878     if (c != a)
6879         {
6880         topologyHasChanged = YES;
6881         if (RandomNumber(seed) < 0.5)
6882             {
6883             x = u->length;
6884             u->length = a->length;
6885             a->length = x;
6886             }
6887         if (RandomNumber(seed) < 0.5)
6888             {
6889             x = c->length;
6890             c->length = u->length;
6891             u->length = x;
6892             }
6893         /* hit c length with multiplier (a and u dealt with below) */
6894         x = c->length * exp(tuning * (RandomNumber(seed) - 0.5));
6895         while (x < minV || x > maxV)
6896             {
6897             if (x < minV)
6898                 x = minV * minV / x;
6899             else if (x > maxV)
6900                 x = maxV * maxV / x;
6901             }
6902         /* calculate proposal and prior ratio based on length modification */
6903         (*lnProposalRatio) += log (x / c->length);
6904         if (isVPriorExp == YES)
6905             (*lnPriorRatio) += brlensExp * (c->length - x);
6906         c->length = x;
6907         }
6908 
6909     /* hit a length with multiplier (even if no topology change was made) */
6910     x = a->length * exp(tuning * (RandomNumber(seed) - 0.5));
6911     while (x < minV || x > maxV)
6912         {
6913         if (x < minV)
6914             x = minV * minV / x;
6915         else if (x > maxV)
6916             x = maxV * maxV / x;
6917         }
6918 
6919     /* calculate proposal and prior ratio based on length modification */
6920     (*lnProposalRatio) += log (x / a->length);
6921     if (isVPriorExp == YES)
6922         (*lnPriorRatio) += brlensExp * (a->length - x);
6923     a->length = x;
6924 
6925     /* hit u length with multiplier (even if no topology change was made) */
6926     x = u->length * exp(tuning * (RandomNumber(seed) - 0.5));
6927     while (x < minV || x > maxV)
6928         {
6929         if (x < minV)
6930             x = minV * minV / x;
6931         else if (x > maxV)
6932             x = maxV * maxV / x;
6933         }
6934 
6935     /* calculate proposal and prior ratio based on length modification */
6936     (*lnProposalRatio) += log (x / u->length);
6937     if (isVPriorExp == YES)
6938         (*lnPriorRatio) += brlensExp * (u->length - x);
6939     u->length = x;
6940 
6941     /* set tiprobs update flags */
6942     a->upDateTi = YES;
6943     u->upDateTi = YES;
6944     c->upDateTi = YES;  /* could be same as a but that does not matter */
6945 
6946     /* set flags for update of cond likes from u and down to root */
6947     p = u;
6948     while (p->anc != NULL)
6949         {
6950         p->upDateCl = YES;
6951         p = p->anc;
6952         }
6953 
6954     /* set flags for update of cond likes from b and down to root */
6955     p = b;
6956     while (p->anc != NULL && p->upDateCl == NO)
6957         {
6958         p->upDateCl = YES;
6959         p = p->anc;
6960         }
6961 
6962     /* get down pass sequence if tree topology has changed */
6963     if (topologyHasChanged == YES)
6964         {
6965         GetDownPass (t);
6966         }
6967 
6968     free (nSitesOfPat);
6969 
6970 #   if defined (DEBUG_MLSPR)
6971     printf ("After:\n");
6972     ShowNodes (t->root, 2, YES);
6973     getchar();
6974     printf ("Proposal ratio: %f\n",(*lnProposalRatio));
6975     printf ("v: %d  u: %d  a: %d  b: %d\n",v->index, u->index, a->index, b->index);
6976     printf ("No. nodes moved in root subtree: %d\n",nRootNodes);
6977     printf ("Has topology changed? %d\n",topologyHasChanged);
6978     getchar();
6979 #   endif
6980 
6981     return (NO_ERROR);
6982 }
6983 
6984 
6985 /*--------------------------------------------------------------------
6986 |
6987 |  Move_LSPR1: Change topology using move based on likelihood scores
6988 |
6989 |--------------------------------------------------------------------*/
6990 int Move_LSPR1 (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
6991 {
6992     /* Change branch lengths and topology (potentially) using SPR-type move
6993        biased according to likelihood scores. NOT work for constrained trees. */
6994 
6995     int         i, j, n, division, topologyHasChanged, isVPriorExp, nNodes;
6996     BitsLong    *pA, *pV, *pP;
6997     MrBFlt      x, minV, maxV, brlensExp=0.0, minLength=0.0, curLength=0.0, length=0.0,
6998                 cumulativeProb, warpFactor, sum, ran, tuning, increaseProb, decreaseProb,
6999                 divFactor, nStates, rateMult, temp;
7000     CLFlt       *nSitesOfPat, *globalNSitesOfPat, *tempCondLikes, **tempCondLikePtr;
7001     TreeNode    *p, *q, *a, *b, *u, *v, *c=NULL, *d, *candidateNodes[20], *vLeft, *vRight;
7002     Tree        *t;
7003     ModelParams *mp;
7004     ModelInfo   *m = NULL;
7005 
7006     temp = mvp[0];      /* tuning parameter determining how heavily to weight according to likelihood scores */
7007     var = mvp[1];       /* variance of lognormal for proposing branch lengths */
7008     increaseProb = decreaseProb = mvp[2];   /* reweighting probabilities */
7009 
7010     (*lnProposalRatio) = (*lnPriorRatio) = 0.0;
7011 
7012     /* get model params and model info */
7013     mp = &modelParams[param->relParts[0]];
7014     m = &modelSettings[param->relParts[0]];
7015 
7016     /* get tree */
7017     t = GetTree (param, chain, state[chain]);
7018 
7019     /* max and min brlen */
7020     if (param->subParams[0]->paramId == BRLENS_UNI)
7021         {
7022         minV = mp->brlensUni[0] > BRLENS_MIN ? mp->brlensUni[0] : BRLENS_MIN;
7023         maxV = mp->brlensUni[1];
7024         isVPriorExp = NO;
7025         }
7026     else
7027         {
7028         minV = BRLENS_MIN;
7029         maxV = BRLENS_MAX;
7030         brlensExp = mp->brlensExp;
7031         isVPriorExp = YES;
7032         }
7033 
7034 #   if defined (DEBUG_MLSPR)
7035     printf ("Before:\n");
7036     ShowNodes (t->root, 2, YES);
7037     getchar();
7038 #   endif
7039 
7040     /* set topologyHasChanged to NO */
7041     topologyHasChanged = NO;
7042 
7043     /* reset node variables that will be used */
7044     for (i=0; i<t->nNodes; i++)
7045         {
7046         p = t->allDownPass[i];
7047         p->marked = NO;
7048         p->x = 0;
7049         p->d = 0.0;
7050         }
7051 
7052     /* pick a random branch */
7053     do
7054         {
7055         p = t->allDownPass[(int)(RandomNumber(seed)*(t->nNodes - 1))];
7056         } while (p->anc->anc == NULL || p->anc->isLocked == YES);
7057 
7058     /* set up pointers for nodes around the picked branch */
7059     v = p;
7060     u = p->anc;
7061     if (u->left == v)
7062         a = u->right;
7063     else
7064         a = u->left;
7065     b = u->anc;
7066     vLeft = v->left;
7067     vRight = vRight;
7068 
7069     /* store the branch lengths */
7070     aLength = a->length;
7071     uLength = u->length;
7072     vLength = v->length;
7073     if (v->left != NULL)
7074         {
7075         vLeftLength = v->left->length;
7076         vRightLength = v->right->length;
7077         }
7078     else
7079         vLeftLength = vRightLength = 0.0;
7080 
7081     /* save DP cond likes */
7082     /* count distance to root */
7083     q = b;
7084     nNodes = 0;
7085     while (q->anc != NULL)
7086         {
7087         nNodes++;
7088         q = q->anc;
7089         }
7090 
7091     /* allocate space for temporary cond likes and condlike pointers */
7092     tempCondLikes = (CLFlt *) SafeCalloc (nNodes*m->numChars*m->numModelStates, sizeof (CLFlt));
7093     tempCondLikePtr = (CLFlt **) SafeCalloc (nNodes, sizeof (CLFlt *));
7094     if (!tempCondLikes || !tempCondLikePtr)
7095         {
7096         free (tempCondLikes);
7097         free (tempCondLikePtr);
7098         return (ERROR);
7099         }
7100 
7101     /* shift pointers over */
7102     q = b;
7103     j = 0;
7104     while (q->anc != NULL)
7105         {
7106         tempCondLikePtr[j] = m->condLike[chain][q->index][q->clSpace];
7107         m->condLike[chain][q->index][q->clSpace] = tempCondLikes + j*m->numChars*m->numModelStates;
7108         j++;
7109         q = q->anc;
7110         }
7111 
7112     /* get cond like uppass up to b */
7113     getLikeUPRootPath (t, b);
7114 
7115     /* get ML branch lengths */
7116     NRBrlenOptimizer (t, v, 5, 3);
7117 
7118     /* cycle through using Newton Raphson and reoptimization a fixed number of iterations */
7119     for (i=0; i<numIterations; i++)
7120         {
7121         if (v->left != NULL)
7122             {
7123             getBaseLikeUpLeft (t, v);   /* store instead of DP */
7124             NewtonRaphsonBrlen (t, v->left, chain);
7125             getBaseLikeUpRight (t, v);
7126             GetNewtonRaphsonBrlen (t, v->right, chain);
7127             m->CondLikeDown (v);
7128             }
7129         if (u->left == v)
7130             getBaseLikeUpLeft (t, u);
7131         else
7132             getBaseLikeUpRight (t, u);
7133         NewtonRaphsonBrlen (t, v, chain);
7134         if (u->left == v)
7135             getBaseLikeUpRight (t, u);
7136         else
7137             getBaseLikeUpLeft (t, u);
7138         NewtonRaphsonBrlen (t, a->length, chain);
7139         m->CondLikeDown (t, u);
7140         if (b->left == u)
7141             getBaseLikeUpLeft (t, b);
7142         else
7143             getBaseLikeUpRight (t, b);
7144         NewtonRaphsonBrlen (t, u->length, chain);
7145         getLikeUp(t, u);
7146         getLikeUp(t, v);
7147         }
7148 
7149     /* get variance of lognormal for forward move */
7150     f = log (a->length) - log (aLength);
7151     fvar = f*f;
7152     f = log (v->length) - log (vLength);
7153     fvar += f*f;
7154     f = log (u->length) - log (uLength);
7155     fvar += f*f;
7156     if (v->left != NULL)
7157         {
7158         f = log (v->left->length) - log (vLeftLength);
7159         fvar += f*f;
7160         f = log (v->right->length) - log (vRightLength);
7161         fvar += f*f;
7162         fvar /= 5.0;
7163         }
7164     else
7165         fvar /= 3.0;
7166 
7167     /* clip tree */
7168     a->anc = b;
7169     if (b->left == u)
7170         b->left = a;
7171     else
7172         b->right = a;
7173 
7174     /* get ML branch length for a */
7175     NewtonRaphsonBrlen (t, a, chain, 3);
7176 
7177     /* propose new length for a */
7178     f = PointNormal(RandomNumber(seed));
7179     f *= fvar;
7180     f += log (a->length);
7181     a->length = f;
7182 
7183     /* get downpass cond likes for the root part */
7184     q = b;
7185     while (q->anc != NULL)
7186         m->condLikeDown (q, division, chain);
7187 
7188     /* get uppass cond likes for the root part */
7189     GetLikeUp (t, t->root->left);
7190 
7191     /* cycle through the possibilities and record ln likelihood of each in p->d */
7192     for (i=0; i<t->nNodes; i++)
7193         {
7194         p = t->allDownPass[i];
7195         if (p->marked == NO)
7196             continue;
7197         /* attach crown tree here */
7198         pLength = p->length;
7199         /* find ml branch lengths */
7200         NewtonRaphsonBrlens5 (t, v, chain, 5, 3);
7201         /* find score */
7202         m->CondLikeDown (t, v);
7203         m->CondLikeRoot (t, u);
7204         m->Likelihood (t, u, &lnL);
7205         p->d = lnL * warp;
7206         if (i == 0)
7207             maxLnL = p->d;
7208         else if (p->d > maxLnL)
7209             maxLnL = p->d;
7210         if (p == a)
7211             curLnL = p->d;
7212         /* detach crown tree */
7213         /* restore p->length */
7214         p->length = pLength;
7215         }
7216 
7217     /* find the sum given the warp factor */
7218     sum = 0.0;
7219     for (i=0; i<t->nNodes; i++)
7220         {
7221         p = t->allDownPass[i];
7222         if (p->marked == YES)
7223             {
7224             p->d = exp (maxLnL - p->d);
7225             sum += p->d;
7226             }
7227         }
7228 
7229     /* generate a random uniform */
7230     ran = RandomNumber(seed);
7231 
7232     /* select the appropriate reattachment point */
7233     cumulativeProb = 0.0;
7234     for (i=0; i<t->nNodes; i++)
7235         {
7236         p = t->allDownPass[i];
7237         if (p->marked == YES)
7238             {
7239             c = p;
7240             cumulativeProb += p->d / sum;
7241             if (cumulativeProb > ran)
7242                 break;
7243             }
7244         }
7245     if (c->marked != YES)
7246         {
7247         printf ("Could not select node\n");
7248         getchar();
7249         }
7250 
7251     /* calculate the proposal ratio based on biased reattachment */
7252     if (c == a)
7253         (*lnProposalRatio) = 0.0;
7254     else
7255         (*lnProposalRatio) = (maxLnL - log(c->d)) - curLnL;
7256 
7257     /* reattach */
7258     if (c != a)
7259         topologyHasChanged = YES;
7260     d = c->anc;
7261     c->anc = u;
7262     if (u->left == v)
7263         u->right = c;
7264     else
7265         u->left = c;
7266     if (d->left == c)
7267         d->left = u;
7268     else
7269         d->right = u;
7270     u->anc = d;
7271 
7272     /* optimize branch lengths */
7273     NewtonRaphsonBrlens5 (t, v, chain, 5, 5);
7274 
7275     /* calculate variance of lognormal for back move */
7276     f = log (a->length) - log (aLength);
7277     fvarNew = f*f;
7278     f = log (v->length) - log (vLength);
7279     fvarNew += f*f;
7280     f = log (u->length) - log (uLength);
7281     fvarNew += f*f;
7282     if (v->left != NULL)
7283         {
7284         f = log (v->left->length) - log (vLeftLength);
7285         fvarNew += f*f;
7286         f = log (v->right->length) - log (vRightLength);
7287         fvarNew += f*f;
7288         fvarNew /= 5.0;
7289         }
7290     else
7291         fvarNew /= 3.0;
7292 
7293     /* draw new branch lengths */
7294     c->length = fvar * PointNormal(RandomNumber(seed)) + log(c->length);
7295     u->length = fvar * PointNormal(RandomNumber(seed)) + log(u->length);
7296     v->length = fvar * PointNormal(RandomNumber(seed)) + log(v->length);
7297     if (v->left != NULL)
7298         {
7299         v->left->length = fvar * PointNormal(RandomNumber(seed)) + log(v->left->length);
7300         v->right->length = fvar * PointNormal(RandomNumber(seed)) + log(v->right->length);
7301         }
7302 
7303     /* calculate proposal ratio for branch lengths */
7304 
7305     /* set tiprobs update flags */
7306     a->upDateTi = YES;
7307     u->upDateTi = YES;
7308     c->upDateTi = YES;  /* could be same as a but that does not matter */
7309     v->upDateTi = YES;
7310     if (v->left != NULL)
7311         {
7312         v->left->upDateTi = YES;
7313         v->right->upDateTi = YES;
7314         }
7315 
7316     /* set flags for update of cond likes from v and down to root */
7317     q = v;
7318     while (q->anc != NULL)
7319         {
7320         q->upDateCl = YES;
7321         q = q->anc;
7322         }
7323 
7324     /* set flags for update of cond likes from b and down to root */
7325     q = b;
7326     while (q->anc != NULL && q->upDateCl == NO)
7327         {
7328         q->upDateCl = YES;
7329         q = q->anc;
7330         }
7331 
7332     /* get down pass sequence if tree topology has changed */
7333     if (topologyHasChanged == YES)
7334         {
7335         GetDownPass (t);
7336         }
7337 
7338     /* restore old conditional likelihoods */
7339 
7340 #   if defined (DEBUG_MLSPR)
7341     printf ("After:\n");
7342     ShowNodes (t->root, 2, YES);
7343     getchar();
7344     printf ("Proposal ratio: %f\n",(*lnProposalRatio));
7345     printf ("v: %d  u: %d  a: %d  b: %d\n",v->index, u->index, a->index, b->index);
7346     printf ("No. nodes moved in root subtree: %d\n",nRootNodes);
7347     printf ("Has topology changed? %d\n",topologyHasChanged);
7348     getchar();
7349 #   endif
7350 
7351     return (NO_ERROR);
7352 }
7353 #endif
7354 
7355 
7356 /**---------------------------------------------------------------
7357  |
7358  |   Move_MixtureRates
7359  |
7360  |   Change component rates of site rate mixture using a Dirichlet
7361  |   proposal. The logic is the same as for the Move_Statefreqs
7362  |   proposal.
7363  |
7364  |   Added by Fredrik Ronquist 2016-07-15.
7365  |
7366  ----------------------------------------------------------------*/
Move_MixtureRates(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)7367 int Move_MixtureRates (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
7368 {
7369     /* change mixture rates */
7370     int         i, nStates, isValid;
7371     MrBFlt      dirichletParameters[MAX_RATE_CATS], *newRates, *oldRates, *priorAlpha, sum, alphaPi, x, y, nStatesMrBFlt;
7372 
7373     /* get the values we need */
7374     nStates       = param->nSubValues;
7375     nStatesMrBFlt = (MrBFlt)(nStates);
7376     priorAlpha    = GetParamVals (param, chain, state[chain]);
7377     newRates      = GetParamSubVals (param, chain, state[chain]);
7378     oldRates      = GetParamSubVals (param, chain, state[chain] ^ 1);
7379 
7380     /* tuning parameter */
7381     alphaPi = mvp[0]*nStates;
7382 
7383     /* multiply old values with some large number to get new values close to the old ones */
7384     /* we normalize the values in the process so we get a standard simplex                */
7385     for (i=0; i<nStates; i++)
7386         dirichletParameters[i] = oldRates[i] * alphaPi / nStatesMrBFlt;
7387 
7388     do  {
7389         DirichletRandomVariable (dirichletParameters, newRates, nStates, seed);
7390         isValid = YES;
7391         for (i=0; i<nStates; i++)
7392         {
7393             if (newRates[i] * nStatesMrBFlt < RATE_MIN)
7394             {
7395                 isValid = NO;
7396                 break;
7397             }
7398         }
7399     } while (isValid == NO);
7400 
7401     /* now we order the new rates and then multiply with number of mixture components to get the new rates */
7402     qsort(newRates, (size_t)nStates, sizeof(MrBFlt), &cmpMrBFlt);
7403     for (i=0; i<nStates; i++)
7404         newRates[i] = newRates[i] * nStatesMrBFlt;
7405 
7406     /* get proposal ratio */
7407     /* we ignore the ordering factor, which is the same for new and old states */
7408     sum = 0.0;
7409     for (i=0; i<nStates; i++)
7410         sum += newRates[i]*alphaPi/nStatesMrBFlt;
7411     x = LnGamma(sum);
7412     for (i=0; i<nStates; i++)
7413         x -= LnGamma(newRates[i]*alphaPi/nStatesMrBFlt);
7414     for (i=0; i<nStates; i++)
7415         x += (newRates[i]*alphaPi/nStatesMrBFlt-1.0)*log(oldRates[i]/nStatesMrBFlt);
7416     sum = 0.0;
7417     for (i=0; i<nStates; i++)
7418         sum += oldRates[i]*alphaPi/nStatesMrBFlt;
7419     y = LnGamma(sum);
7420     for (i=0; i<nStates; i++)
7421         y -= LnGamma(oldRates[i]*alphaPi/nStatesMrBFlt);
7422     for (i=0; i<nStates; i++)
7423         y += (oldRates[i]*alphaPi/nStatesMrBFlt-1.0)*log(newRates[i]/nStatesMrBFlt);
7424     (*lnProposalRatio) = x - y;
7425 
7426     /* get prior ratio */
7427     /* we ignore the ordering factor, which is the same for new and old states */
7428     y = x = 0.0;                    /* the Gamma part of the prior is the same */
7429     for (i=0; i<nStates; i++)
7430         x += (priorAlpha[i]-1.0)*log(newRates[i]/nStatesMrBFlt);
7431     for (i=0; i<nStates; i++)
7432         y += (priorAlpha[i]-1.0)*log(oldRates[i]/nStatesMrBFlt);
7433     (*lnPriorRatio) = x - y;
7434 
7435     /* Touch the entire tree */
7436     for (i=0; i<param->nRelParts; i++)
7437         TouchAllTreeNodes(&modelSettings[param->relParts[i]],chain);
7438 
7439     /* Set update flags for cijks for all affected partitions. If this is a simple 4 X 4 model,
7440      we don't take any hit, because we will never go into a general transition probability
7441      calculator. However, for many models we do want to update the cijk flag, as the transition
7442      probability matrices require diagonalizing the rate matrix. */
7443     for (i=0; i<param->nRelParts; i++)
7444         modelSettings[param->relParts[i]].upDateCijk = YES;
7445 
7446     return (NO_ERROR);
7447 }
7448 
7449 
7450 /**---------------------------------------------------------------
7451  |
7452  |   Move_MixtureRates_Slider
7453  |
7454  |   Change component rates of site rate mixture using sliding
7455  |   window mechanism. The logic is the same as for the
7456  |   Move_StateFreqs_Slider. See that move for more detailed
7457  |   description.
7458  |
7459  |   Added by Fredrik Ronquist 2016-07-15.
7460  |
7461  ----------------------------------------------------------------*/
Move_MixtureRates_Slider(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)7462 int Move_MixtureRates_Slider (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
7463 {
7464     int         i, j, nStates, isValid;
7465     MrBFlt      delta, *newRates, *oldRates, *priorAlpha, x, y, sum, min, max, nStatesMrBFlt;
7466 
7467     /* get the values we need */
7468     nStates = param->nSubValues;
7469     nStatesMrBFlt = (MrBFlt)(nStates);
7470     priorAlpha = GetParamVals(param, chain, state[chain]);
7471     newRates = GetParamSubVals (param, chain, state[chain]);
7472     oldRates = GetParamSubVals (param, chain, state[chain] ^ 1);
7473 
7474     /* get window size */
7475     delta = mvp[0];
7476 
7477     /* choose a pair to change */
7478     i = (int) (RandomNumber(seed) * nStates);
7479     j = (int) (RandomNumber(seed) * (nStates-1));
7480     if (i == j)
7481         j = nStates-1;
7482 
7483     /* find the sum of these proportions */
7484     sum = oldRates[i] + oldRates[j];
7485 
7486     /* reflect */
7487     isValid = NO;
7488     min = RATE_MIN;
7489     max = 1.0 - min;
7490 
7491     x   = oldRates[i] / sum;
7492     if (delta > max-min) /* we do it to avoid following long while loop in case if delta is high */
7493     {
7494         delta = max-min;
7495     }
7496     y = x + delta * (RandomNumber(seed) - 0.5);
7497 
7498     do {
7499         if (y < min)
7500             y = 2.0 * min - y;
7501         else if (y > max)
7502             y = 2.0 * max - y;
7503         else
7504             isValid = YES;
7505     } while (isValid == NO);
7506 
7507     /* set the new values */
7508     newRates[i] = y * sum;
7509     newRates[j] = sum - newRates[i];
7510 
7511     /* get proposal ratio */
7512     *lnProposalRatio = 0.0;
7513 
7514     /* get prior ratio */
7515     /* (the Gamma part of the prior is the same) */
7516     x = (priorAlpha[i]-1.0)*log(newRates[i]/nStatesMrBFlt);
7517     x += (priorAlpha[j]-1.0)*log(newRates[j]/nStatesMrBFlt);
7518     y = (priorAlpha[i]-1.0)*log(oldRates[i]/nStatesMrBFlt);
7519     y += (priorAlpha[j]-1.0)*log(oldRates[j]/nStatesMrBFlt);
7520     (*lnPriorRatio) = x - y;
7521 
7522     /* Set update for entire tree */
7523     for (i=0; i<param->nRelParts; i++)
7524         TouchAllTreeNodes(&modelSettings[param->relParts[i]],chain);
7525 
7526     /* Set update flags for cijks for all affected partitions. If this is a simple 4 X 4 model,
7527      we don't take any hit, because we will never go into a general transition probability
7528      calculator. However, for many models we do want to update the cijk flag, as the transition
7529      probability matrices require diagonalizing the rate matrix. */
7530     for (i=0; i<param->nRelParts; i++)
7531         modelSettings[param->relParts[i]].upDateCijk = YES;
7532 
7533     return (NO_ERROR);
7534 }
7535 
7536 
7537 /* Move_NNI, change topology using NNI move */
Move_NNI(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)7538 int Move_NNI (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
7539 {
7540     TreeNode    *p, *u, *v, *a, *b, *c;
7541     Tree        *t;
7542 
7543     (*lnProposalRatio) = (*lnPriorRatio) = 0.0;
7544 
7545     /* get tree */
7546     t = GetTree (param, chain, state[chain]);
7547 
7548     /* pick an internal branch */
7549     do  {
7550         p = t->intDownPass[(int)(RandomNumber(seed) * t->nIntNodes)];
7551         }
7552     while (p->anc->anc == NULL || p->isLocked == YES);
7553 
7554     /* set up area of rearrangement */
7555     u = p;
7556     v = u->anc;
7557     a = u->left;
7558     b = u->right;
7559     if (v->left == u)
7560         c = v->right;
7561     else
7562         c = v->left;
7563 
7564     /* change topology */
7565     if (RandomNumber(seed) < 0.5)
7566         {
7567         if (v->left == u)
7568             v->right = b;
7569         else
7570             v->left = b;
7571         u->left = a;
7572         u->right = c;
7573         a->anc = c->anc = u;
7574         b->anc = v;
7575         }
7576     else
7577         {
7578         if (v->left == u)
7579             v->right = a;
7580         else
7581             v->left = a;
7582         u->left = b;
7583         u->right = c;
7584         b->anc = c->anc = u;
7585         a->anc = v;
7586         }
7587 
7588     /* set update of cond likes */
7589     while (p->anc != NULL)
7590         {
7591         p->upDateCl = YES;
7592         p = p->anc;
7593         }
7594 
7595     GetDownPass (t);
7596 
7597     return (NO_ERROR);
7598 }
7599 
7600 
Move_NNIClock(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)7601 int Move_NNIClock (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
7602 {
7603     /* Change clock tree using NNI move */
7604 
7605     int         i, *nEvents, numFreeOld, numFreeNew;
7606     MrBFlt      x, *tk02Rate=NULL, *brlens, *igrRate=NULL, igrvar=0.0, nu=0.0, oldALength, oldCLength;
7607     TreeNode    *p, *q, *a, *c, *u, *v;
7608     Tree        *t;
7609     Param       *subParm;
7610 
7611     /* no tuning parameter */
7612 
7613     /* make absolutely sure the proposal ratio and prior ratio are reset */
7614     (*lnProposalRatio) = (*lnPriorRatio) = 0.0;
7615 
7616     /* get tree */
7617     t = GetTree (param, chain, state[chain]);
7618 
7619 #   if defined (DEBUG_NNIClock)
7620     printf ("Before:\n");
7621     ShowNodes (t->root, 2, YES);
7622     getchar();
7623 #   endif
7624 
7625     /* count number of free interior branches */
7626     numFreeOld = 0;
7627     for (i=0; i<t->nIntNodes-1; i++)
7628         {
7629         p = t->intDownPass[i];
7630         if (p->anc->left == p)
7631             q = p->anc->right;
7632         else
7633             q = p->anc->left;
7634         if (p->isLocked == NO && p->nodeDepth >= q->nodeDepth + BRLENS_MIN)
7635             numFreeOld++;
7636         }
7637 
7638     /* In extremely constrained trees, it might be impossible to change the tree before nodes have changed in position */
7639     if (numFreeOld == 0)
7640         {
7641         abortMove = YES;
7642         return (NO_ERROR);
7643         }
7644 
7645     /* pick an interior branch, around which it is possible to make an NNI */
7646     do  {
7647         p = t->intDownPass[(int)(RandomNumber(seed) * (t->nIntNodes-1))];
7648         if (p->anc->left == p)
7649             q = p->anc->right;
7650         else
7651             q = p->anc->left;
7652         }
7653     while (p->isLocked == YES || p->nodeDepth < q->nodeDepth + BRLENS_MIN);
7654 
7655     /* set up pointers for nodes around the picked branch */
7656     /* consider ancestral fossil (brl=0) in fossilized bd tree */
7657     if (p->left->length < TIME_MIN)
7658         a = p->right;
7659     else if (p->right->length < TIME_MIN)
7660         a = p->left;
7661     else if (RandomNumber(seed) < 0.5)
7662         a = p->left;
7663     else
7664         a = p->right;
7665     v = p;
7666     u = p->anc;
7667     if (u->left == v)
7668         c = u->right;
7669     else
7670         c = u->left;
7671 
7672     /* record branch lengths */
7673     oldALength = a->length;
7674     oldCLength = c->length;
7675 
7676     /* make topology change */
7677     a->anc = u;
7678     c->anc = v;
7679     if (v->left == a)
7680         v->left = c;
7681     else
7682         v->right = c;
7683     if (u->left == c)
7684         u->left = a;
7685     else
7686         u->right = a;
7687 
7688     /* adjust branch lengths */
7689     a->length = u->nodeDepth - a->nodeDepth;
7690     c->length = v->nodeDepth - c->nodeDepth;
7691     assert (a->length > BRLENS_MIN);
7692     assert (c->length > BRLENS_MIN);
7693 
7694     /* no reassignment of CPP events or branch rates necessary */
7695 
7696     /* set tiprobs update flags */
7697     a->upDateTi = YES;
7698     c->upDateTi = YES;
7699 
7700     /* set flags for update of cond likes from v and down to root */
7701     p = v;
7702     while (p->anc != NULL)
7703         {
7704         p->upDateCl = YES;
7705         p = p->anc;
7706         }
7707 
7708     /* get down pass sequence */
7709     GetDownPass (t);
7710 
7711     /* count number of free interior branches after the move */
7712     numFreeNew = 0;
7713     for (i=0; i<t->nIntNodes-1; i++)
7714         {
7715         p = t->intDownPass[i];
7716         if (p->anc->left == p)
7717             q = p->anc->right;
7718         else
7719             q = p->anc->left;
7720         if (p->isLocked == NO && p->nodeDepth >= q->nodeDepth + BRLENS_MIN)
7721             numFreeNew++;
7722         }
7723 
7724     /* get proposal ratio if number of free branches has changed */
7725     if (numFreeNew != numFreeOld)
7726         (*lnProposalRatio) = log((MrBFlt)numFreeOld / (MrBFlt)numFreeNew);
7727 
7728     /* calculate and adjust prior ratio for clock trees */
7729     if (LogClockTreePriorRatio(param, chain, &x) == ERROR)
7730         return (ERROR);
7731     (*lnPriorRatio) += x;
7732 
7733     /* adjust proposal and prior ratio for relaxed clock models */
7734     for (i=0; i<param->subParams[0]->nSubParams; i++)
7735         {
7736         subParm = param->subParams[0]->subParams[i];
7737         if (subParm->paramType == P_CPPEVENTS)
7738             {
7739             nEvents = subParm->nEvents[2*chain+state[chain]];
7740             /* proposal ratio */
7741             (*lnProposalRatio) += nEvents[a->index] * log (a->length / oldALength);
7742             (*lnProposalRatio) += nEvents[c->index] * log (c->length / oldCLength);
7743             /* prior ratio: no effect because tree length is the same */
7744             /* update effective evolutionary lengths */
7745             if (UpdateCppEvolLengths (subParm, a, chain) == ERROR || UpdateCppEvolLengths (subParm, c, chain) == ERROR)
7746                 {
7747                 abortMove = YES;
7748                 return (NO_ERROR);
7749                 }
7750             }
7751         else if ( subParm->paramType == P_TK02BRANCHRATES ||
7752                  (subParm->paramType == P_MIXEDBRCHRATES && *GetParamIntVals(subParm, chain, state[chain]) == RCL_TK02))
7753             {
7754             if (subParm->paramType == P_TK02BRANCHRATES)
7755                 nu = *GetParamVals (modelSettings[subParm->relParts[0]].tk02var, chain, state[chain]);
7756             else
7757                 nu = *GetParamVals (modelSettings[subParm->relParts[0]].mixedvar, chain, state[chain]);
7758             tk02Rate = GetParamVals (subParm, chain, state[chain]);
7759             /* prior ratio and update of effective evolutionary lengths */
7760             (*lnPriorRatio) -= LnProbTK02LogNormal (tk02Rate[v->index], nu*oldALength, tk02Rate[a->index]);
7761             (*lnPriorRatio) += LnProbTK02LogNormal (tk02Rate[u->index], nu* a->length, tk02Rate[a->index]);
7762             (*lnPriorRatio) -= LnProbTK02LogNormal (tk02Rate[u->index], nu*oldCLength, tk02Rate[c->index]);
7763             (*lnPriorRatio) += LnProbTK02LogNormal (tk02Rate[v->index], nu* c->length, tk02Rate[c->index]);
7764             brlens = GetParamSubVals (subParm, chain, state[chain]);
7765             brlens[a->index] = a->length * (tk02Rate[a->index] + tk02Rate[a->anc->index])/2.0;
7766             brlens[c->index] = c->length * (tk02Rate[c->index] + tk02Rate[c->anc->index])/2.0;
7767             }
7768         else if ( subParm->paramType == P_IGRBRANCHRATES ||
7769                  (subParm->paramType == P_MIXEDBRCHRATES && *GetParamIntVals(subParm, chain, state[chain]) == RCL_IGR))
7770             {
7771             if (subParm->paramType == P_IGRBRANCHRATES)
7772                 igrvar = *GetParamVals (modelSettings[subParm->relParts[0]].igrvar, chain, state[chain]);
7773             else
7774                 igrvar = *GetParamVals (modelSettings[subParm->relParts[0]].mixedvar, chain, state[chain]);
7775             igrRate = GetParamVals (subParm, chain, state[chain]);
7776             /* prior ratio and update of effective evolutionary lengths */
7777             (*lnPriorRatio) -= LnProbGamma (oldALength/igrvar, oldALength/igrvar, igrRate[a->index]);
7778             (*lnPriorRatio) -= LnProbGamma (oldCLength/igrvar, oldCLength/igrvar, igrRate[c->index]);
7779             (*lnPriorRatio) += LnProbGamma (a->length /igrvar, a->length /igrvar, igrRate[a->index]);
7780             (*lnPriorRatio) += LnProbGamma (c->length /igrvar, c->length /igrvar, igrRate[c->index]);
7781             brlens = GetParamSubVals (subParm, chain, state[chain]);
7782             brlens[a->index] = igrRate[a->index] * a->length;
7783             brlens[c->index] = igrRate[c->index] * c->length;
7784             }
7785         }
7786 
7787 #   if defined (DEBUG_NNIClock)
7788     printf ("After:\n");
7789     ShowNodes (t->root, 2, YES);
7790     getchar();
7791     printf ("Proposal ratio: %f\n",(*lnProposalRatio));
7792     printf ("v: %d  u: %d  a: %d  b: %d\n",v->index, u->index, a->index, b->index);
7793     printf ("Has topology changed? %d\n",topologyHasChanged);
7794     getchar();
7795 #   endif
7796 
7797     return (NO_ERROR);
7798 }
7799 
7800 
7801 /* Move_NNI_Hetero, change topology with unlinked brlens using NNI */
Move_NNI_Hetero(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)7802 int Move_NNI_Hetero (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
7803 {
7804     int         i, brIndex, moveType;
7805     TreeNode    *p, *u, *v, *a, *b, *c;
7806     Tree        *t;
7807 
7808     (*lnPriorRatio) = (*lnProposalRatio) = 0.0;
7809 
7810     /* get first tree */
7811     t = GetTree (param, chain, state[chain]);
7812 
7813     /* pick an internal branch */
7814     do
7815         {
7816         brIndex = (int) (RandomNumber(seed) * t->nIntNodes);
7817         p = t->intDownPass[brIndex];
7818         } while (p->anc->anc == NULL || p->isLocked == YES);
7819 
7820     /* decide on how to change the tree */
7821     if (RandomNumber(seed) < 0.5)
7822         moveType = 0;
7823     else
7824         moveType = 1;
7825 
7826     /* cycle through trees */
7827     for (i=0; i<param->nSubParams; i++)
7828         {
7829         /* get tree */
7830         t = GetTree (param->subParams[i], chain, state[chain]);
7831 
7832         /* find p */
7833         p = t->intDownPass[brIndex];
7834 
7835         /* set up area of rearrangement */
7836         u = p;
7837         v = u->anc;
7838         a = u->left;
7839         b = u->right;
7840         if (v->left == u)
7841             c = v->right;
7842         else
7843             c = v->left;
7844 
7845         /* change topology */
7846         if (moveType == 0)
7847             {
7848             if (v->left == u)
7849                 v->right = b;
7850             else
7851                 v->left = b;
7852             u->left = a;
7853             u->right = c;
7854             a->anc = c->anc = u;
7855             b->anc = v;
7856             }
7857         else if (moveType == 1)
7858             {
7859             if (v->left == u)
7860                 v->right = a;
7861             else
7862                 v->left = a;
7863             u->left = b;
7864             u->right = c;
7865             b->anc = c->anc = u;
7866             a->anc = v;
7867             }
7868 
7869         /* set update of ti probs */
7870         a->upDateTi = YES;
7871         b->upDateTi = YES;
7872         c->upDateTi = YES;
7873         u->upDateTi = YES;
7874         v->upDateTi = YES;
7875 
7876         /* set update of conditional likelihoods */
7877         while (p->anc != NULL)
7878             {
7879             p->upDateCl = YES;
7880             p = p->anc;
7881             }
7882 
7883         /* reset tree downpass sequences */
7884         GetDownPass (t);
7885 
7886         }
7887 
7888     return (NO_ERROR);
7889 }
7890 
7891 
7892 /*-----------------------------------------------------------------------------------
7893 |
7894 |   Move_NodeSlider: move the position of one node without changing topology
7895 |
7896 -------------------------------------------------------------------------------------*/
Move_NodeSlider(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)7897 int Move_NodeSlider (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
7898 {
7899     MrBFlt      tuning, maxV, minV, oldM, newM, brlensPrExp=0.0, newMin, newMax, oldMin, oldMax;
7900     TreeNode    *p, *q;
7901     ModelParams *mp;
7902     Tree        *t;
7903     int isVPriorExp;
7904 
7905     tuning = mvp[0]; /* Larget & Simon's tuning parameter lambda */
7906 
7907     mp = &modelParams[param->relParts[0]];
7908 
7909     /* max and min brlen (time) */
7910     if (param->paramId == BRLENS_UNI)
7911         {
7912         minV = mp->brlensUni[0] > BRLENS_MIN ? mp->brlensUni[0] : BRLENS_MIN;
7913         maxV = mp->brlensUni[1];
7914         isVPriorExp = NO;
7915         }
7916     else if (param->paramId == BRLENS_GamDir)
7917         {
7918         minV = BRLENS_MIN;
7919         maxV = BRLENS_MAX;
7920         isVPriorExp = 2;
7921         }
7922     else if (param->paramId == BRLENS_iGmDir)
7923         {
7924         minV = BRLENS_MIN;
7925         maxV = BRLENS_MAX;
7926         isVPriorExp = 3;
7927         }
7928     else if (param->paramId == BRLENS_twoExp)
7929         {
7930         minV = BRLENS_MIN;
7931         maxV = BRLENS_MAX;
7932         isVPriorExp = 4;
7933         }
7934     else
7935         {
7936         minV = BRLENS_MIN;
7937         maxV = BRLENS_MAX;
7938         brlensPrExp = mp->brlensExp;
7939         isVPriorExp = YES;
7940         }
7941 
7942     /* get tree */
7943     t = GetTree (param, chain, state[chain]);
7944 
7945     /* Dirichlet or twoExp prior */
7946     if (isVPriorExp > 1)
7947         (*lnPriorRatio) = -LogDirPrior(t, mp, isVPriorExp);
7948 
7949     /* pick an interior branch */
7950     do  {
7951         p = t->intDownPass[(int)(RandomNumber(seed) * t->nIntNodes)];
7952         }
7953     while (p->anc == NULL || (t->isRooted == YES && p->anc->anc == NULL));
7954 
7955     /* pick one descendant branch */
7956     if (RandomNumber(seed) < 0.5)
7957         q = p->left;
7958     else
7959         q = p->right;
7960 
7961     /* determine new length */
7962     oldM = (q->length + p->length);
7963     newM = oldM * exp(tuning * (RandomNumber(seed) - 0.5));
7964     while (newM < 2.0 * minV || newM > 2.0 * maxV)
7965         {
7966         if (newM < 2.0 * minV)
7967             newM = 4.0 * minV * minV / newM;
7968         else if (newM > 2.0 * maxV)
7969             newM = 4.0 * maxV * maxV / newM;
7970         }
7971 
7972     /* determine new lengths of p and q */
7973     newMin = minV > newM - maxV ? minV : newM - maxV;
7974     newMax = maxV < newM - minV ? maxV : newM - minV;
7975     oldMin = minV > oldM - maxV ? minV : oldM - maxV;
7976     oldMax = maxV < oldM - minV ? maxV : oldM - minV;
7977 
7978     q->length = newMin + RandomNumber(seed) * (newMax - newMin);
7979     p->length = newM - q->length;
7980 
7981     /* the proposal ratio for two sliding windows */
7982     (*lnProposalRatio) = log ((newMax - newMin) / (oldMax - oldMin));
7983 
7984     /* The proposal ratio for shrinking/expanding two variables (x1 = p->length, x2 = q->length)
7985        by the same factor c = newM/oldM is c^2. This can be derived by variable transformation:
7986        y1 = x1, y2 = x2/x1. The proposal ratio in the transformed variables is c, the Jacobian is y1,
7987        so the proposal ratio in the original variables is c*c = c^2.
7988        (see Move_TreeLen for m variables and Yang 2006 CME P171 S5.4.4 for details) */
7989     (*lnProposalRatio) += 2.0 * log(newM / oldM);
7990 
7991     /* set flags for update of transition probabilities at p and q */
7992     p->upDateTi = YES;
7993     q->upDateTi = YES;
7994     p->upDateCl = YES;
7995 
7996     /* set flags for update of cond likes from p->anc and down to root */
7997     while (p->anc->anc != NULL)
7998         {
7999         p = p->anc;
8000         p->upDateCl = YES;
8001         }
8002 
8003     /* update prior if exponential prior on branch lengths */
8004     if (param->paramId == BRLENS_EXP)
8005         (*lnPriorRatio) = brlensPrExp * (oldM - newM);
8006     /* Dirichlet or twoExp prior */
8007     else if (isVPriorExp > 1)
8008         (*lnPriorRatio) += LogDirPrior(t, mp, isVPriorExp);
8009 
8010     return (NO_ERROR);
8011 
8012 }
8013 
8014 
8015 /*-----------------------------------------------------------------------------------
8016 |
8017 |   Move_NodeSliderClock: Move the position of one (root or nonroot) node in clock tree.
8018 |      In calibrated trees, we need to move also calibrated terminal nodes.
8019 |
8020 -------------------------------------------------------------------------------------*/
Move_NodeSliderClock(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)8021 int Move_NodeSliderClock (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
8022 {
8023     int         i, *nEvents;
8024     MrBFlt      window, minDepth, maxDepth, oldDepth, newDepth, minL, minR,
8025                 oldLeftLength=0.0, oldRightLength=0.0, oldPLength=0.0, x, clockRate,
8026                 lambda=0.0, nu=0.0, igrvar=0.0, *brlens=NULL, *tk02Rate=NULL, *igrRate=NULL;
8027     TreeNode    *p, *q;
8028     ModelParams *mp;
8029     ModelInfo   *m;
8030     Tree        *t;
8031     Param       *subParm;
8032     Calibration *calibrationPtr;
8033 
8034     window = mvp[0]; /* window size */
8035 
8036     m = &modelSettings[param->relParts[0]];
8037     mp = &modelParams[param->relParts[0]];
8038 
8039     /* get tree */
8040     t = GetTree (param, chain, state[chain]);
8041 
8042     /* get clock rate */
8043     if (m->clockRate == NULL)
8044         clockRate = 1.0;
8045     else
8046         clockRate = *GetParamVals (m->clockRate, chain, state[chain]);
8047 
8048     /* check whether or not we can change root */
8049     if ((t->root->left->isDated == YES && t->root->left->calibration->prior == fixed) ||
8050         ((!strcmp(mp->clockPr, "Uniform") || !strcmp(mp->clockPr, "Birthdeath") || !strcmp(mp->clockPr, "Fossilization")) && mp->treeAgePr.prior == fixed))
8051         i = t->nNodes - 2;
8052     else
8053         i = t->nNodes - 1;
8054 
8055     /* pick a node that can be changed in position */
8056     do  {
8057         p = t->allDownPass[(int)(RandomNumber(seed) * i)];
8058         }
8059     while ((p->left == NULL && p->isDated == NO) ||
8060            (p->left == NULL && p->length < TIME_MIN) ||
8061            (p->isDated == YES && p->calibration->prior == fixed));
8062 
8063 #if defined (DEBUG_CSLIDER)
8064     printf ("Before node slider (clock):\n");
8065     printf ("Picked branch with index %d and depth %f\n", p->index, p->nodeDepth);
8066     if (p->anc->anc == NULL)
8067         printf ("Old clock rate: %f\n", clockRate);
8068     ShowNodes (t->root, 0, t->isRooted);
8069     getchar();
8070 #endif
8071 
8072     /* store values needed later for prior calculation (relaxed clocks) */
8073     oldPLength = p->length;
8074     if (p->left != NULL)
8075         {
8076         oldLeftLength = p->left->length;
8077         oldRightLength = p->right->length;
8078         }
8079     else
8080         oldLeftLength = oldRightLength = 0.0;
8081 
8082     /* determine lower and upper bound */
8083     if (p->left == NULL)
8084         minDepth = 0.0;
8085     else      // internal node
8086         {
8087         if (p->left->length > 0.0)
8088             minL = p->left->nodeDepth + BRLENS_MIN;
8089         else  // ancestral fossil
8090             {
8091             assert (p->left->calibration != NULL);
8092             minL = p->left->calibration->min * clockRate;
8093             }
8094         if (p->right->length > 0.0)
8095             minR = p->right->nodeDepth + BRLENS_MIN;
8096         else  // ancestral fossil
8097             {
8098             assert (p->right->calibration != NULL);
8099             minR = p->right->calibration->min * clockRate;
8100             }
8101         if (minL > minR)
8102             minDepth = minL;
8103         else
8104             minDepth = minR;
8105         }
8106 
8107     if (p->anc->anc == NULL)
8108         maxDepth = TREEHEIGHT_MAX;
8109     else
8110         maxDepth = p->anc->nodeDepth - BRLENS_MIN;
8111     if (p->left != NULL && p->left->length < TIME_MIN)
8112         {
8113         assert (p->left->calibration != NULL);
8114         if (maxDepth > p->left->calibration->max * clockRate)
8115             maxDepth = p->left->calibration->max * clockRate;
8116         }
8117     if (p->right != NULL && p->right->length < TIME_MIN)
8118         {
8119         assert (p->right->calibration != NULL);
8120         if (maxDepth > p->right->calibration->max * clockRate)
8121             maxDepth = p->right->calibration->max * clockRate;
8122         }
8123 
8124     if (p->isDated == YES)
8125         calibrationPtr = p->calibration;
8126     else if (p->anc->anc == NULL && (!strcmp(mp->clockPr, "Uniform") ||
8127                                      !strcmp(mp->clockPr, "Birthdeath")||
8128                                      !strcmp(mp->clockPr, "Fossilization")))
8129         calibrationPtr = &mp->treeAgePr;
8130     else
8131         calibrationPtr = NULL;
8132     if (calibrationPtr != NULL)
8133         {
8134         if (maxDepth > calibrationPtr->max * clockRate)
8135             maxDepth = calibrationPtr->max * clockRate;
8136         if (minDepth < calibrationPtr->min * clockRate)
8137             minDepth = calibrationPtr->min * clockRate;
8138         }
8139 
8140     /* abort if impossible */
8141     if (minDepth > maxDepth -BRLENS_MIN)
8142         {
8143         abortMove = YES;
8144         return (NO_ERROR);
8145         }
8146 
8147     /* save some reflection time */
8148     if (maxDepth-minDepth < window)
8149         {
8150         window = maxDepth-minDepth;
8151         }
8152 
8153     /* pick the new node depth */
8154     oldDepth = p->nodeDepth;
8155     newDepth = oldDepth + (RandomNumber(seed) - 0.5) * window;
8156 
8157     /* reflect the new node depth */
8158     while (newDepth < minDepth || newDepth > maxDepth)
8159         {
8160         if (newDepth < minDepth)
8161             newDepth = 2.0 * minDepth - newDepth;
8162         if (newDepth > maxDepth)
8163             newDepth = 2.0 * maxDepth - newDepth;
8164         }
8165 
8166     p->nodeDepth = newDepth;
8167 
8168     /* determine new branch lengths around p and set update of transition probabilities */
8169     if (p->left != NULL)
8170         {
8171         if (p->left->length > 0.0) {
8172             p->left->length = p->nodeDepth - p->left->nodeDepth;
8173             p->left->upDateTi = YES;
8174             }
8175         else
8176             p->left->nodeDepth = p->nodeDepth;
8177         if (p->right->length > 0.0) {
8178             p->right->length = p->nodeDepth - p->right->nodeDepth;
8179             p->right->upDateTi = YES;
8180             }
8181         else
8182             p->right->nodeDepth = p->nodeDepth;
8183         }
8184     if (p->anc->anc != NULL)
8185         {
8186         p->length = p->anc->nodeDepth - p->nodeDepth;
8187         p->upDateTi = YES;
8188         }
8189 
8190     /* adjust age of p if dated */
8191     if (calibrationPtr != NULL)
8192         p->age = p->nodeDepth / clockRate;
8193     if ((p->left != NULL) && (p->left->length < TIME_MIN))
8194         p->left->age = p->nodeDepth / clockRate;
8195     if ((p->right != NULL) && (p->right->length < TIME_MIN))
8196         p->right->age = p->nodeDepth / clockRate;
8197 
8198     /* set flags for update of cond likes from p and down to root */
8199     q = p;
8200     while (q->anc != NULL)
8201         {
8202         q->upDateCl = YES;
8203         q = q->anc;
8204         }
8205 
8206     /* calculate proposal ratio */
8207     (*lnProposalRatio) = (*lnPriorRatio) = 0.0;
8208 
8209     /* calculate and adjust prior ratio for clock tree */
8210     if (LogClockTreePriorRatio (param, chain, &x) == ERROR)
8211         return (ERROR);
8212     (*lnPriorRatio) += x;
8213 
8214     /* adjust proposal and prior ratio for relaxed clock models */
8215     for (i=0; i<param->nSubParams; i++)
8216         {
8217         subParm = param->subParams[i];
8218         if (subParm->paramType == P_CPPEVENTS)
8219             {
8220             nEvents = subParm->nEvents[2*chain+state[chain]];
8221             lambda = *GetParamVals (modelSettings[subParm->relParts[0]].cppRate, chain, state[chain]);
8222             /* proposal ratio */
8223             if (p->left != NULL)
8224                 {
8225                 (*lnProposalRatio) += nEvents[p->left->index ] * log (p->left->length  / oldLeftLength);
8226                 (*lnProposalRatio) += nEvents[p->right->index] * log (p->right->length / oldRightLength);
8227                 }
8228             if (p->anc->anc != NULL)
8229                 (*lnProposalRatio) += nEvents[p->index] * log (p->length / oldPLength);
8230 
8231             /* prior ratio */
8232             if (p->anc->anc == NULL) // two branches changed in same direction
8233                 (*lnPriorRatio) += lambda * (2.0 * (oldDepth - newDepth));
8234             else if (p->left != NULL) // two branches changed in one direction, one branch in the other direction
8235                 (*lnPriorRatio) += lambda * (oldDepth - newDepth);
8236             else /* if (p->left == NULL) */ // one branch changed
8237                 (*lnPriorRatio) += lambda * (newDepth - oldDepth);
8238 
8239             /* update effective evolutionary lengths */
8240             if (UpdateCppEvolLengths (subParm, p, chain) == ERROR)
8241                 {
8242                 abortMove = YES;
8243                 return (NO_ERROR);
8244                 }
8245             }
8246         else if ( subParm->paramType == P_TK02BRANCHRATES ||
8247                  (subParm->paramType == P_MIXEDBRCHRATES && *GetParamIntVals(subParm, chain, state[chain]) == RCL_TK02))
8248             {
8249             if (subParm->paramType == P_TK02BRANCHRATES)
8250                 nu = *GetParamVals (modelSettings[subParm->relParts[0]].tk02var, chain, state[chain]);
8251             else
8252                 nu = *GetParamVals (modelSettings[subParm->relParts[0]].mixedvar, chain, state[chain]);
8253             tk02Rate = GetParamVals (subParm, chain, state[chain]);
8254             brlens = GetParamSubVals (subParm, chain, state[chain]);
8255 
8256             /* prior ratio & update effective evolutionary lengths */
8257             if (p->left != NULL)
8258                 {
8259                 if (p->left->length > 0.0)
8260                     {
8261                     (*lnPriorRatio) -= LnProbTK02LogNormal (tk02Rate[p->index], nu*oldLeftLength, tk02Rate[p->left->index]);
8262                     (*lnPriorRatio) += LnProbTK02LogNormal (tk02Rate[p->index], nu*p->left->length, tk02Rate[p->left->index]);
8263                     brlens[p->left->index] = p->left->length * (tk02Rate[p->left->index]+tk02Rate[p->index])/2.0;
8264                     }
8265                 if (p->right->length > 0.0)
8266                     {
8267                     (*lnPriorRatio) -= LnProbTK02LogNormal (tk02Rate[p->index], nu*oldRightLength, tk02Rate[p->right->index]);
8268                     (*lnPriorRatio) += LnProbTK02LogNormal (tk02Rate[p->index], nu*p->right->length, tk02Rate[p->right->index]);
8269                     brlens[p->right->index] = p->right->length * (tk02Rate[p->right->index]+tk02Rate[p->index])/2.0;
8270                     }
8271                 }
8272             if (p->anc->anc != NULL)
8273                 {
8274                 (*lnPriorRatio) -= LnProbTK02LogNormal (tk02Rate[p->anc->index], nu*oldPLength, tk02Rate[p->index]);
8275                 (*lnPriorRatio) += LnProbTK02LogNormal (tk02Rate[p->anc->index], nu*p->length, tk02Rate[p->index]);
8276                 brlens[p->index] = p->length * (tk02Rate[p->index]+tk02Rate[p->anc->index])/2.0;
8277                 }
8278             }
8279         else if ( subParm->paramType == P_IGRBRANCHRATES ||
8280                  (subParm->paramType == P_MIXEDBRCHRATES && *GetParamIntVals(subParm, chain, state[chain]) == RCL_IGR))
8281             {
8282             if (subParm->paramType == P_IGRBRANCHRATES)
8283                 igrvar = *GetParamVals (modelSettings[subParm->relParts[0]].igrvar, chain, state[chain]);
8284             else
8285                 igrvar = *GetParamVals (modelSettings[subParm->relParts[0]].mixedvar, chain, state[chain]);
8286             igrRate = GetParamVals (subParm, chain, state[chain]);
8287             brlens = GetParamSubVals (subParm, chain, state[chain]);
8288 
8289             /* prior ratio & update effective evolutionary lengths */
8290             if (p->left != NULL)
8291                 {
8292                 if (p->left->length > 0.0)
8293                     {
8294                     (*lnPriorRatio) -= LnProbGamma (oldLeftLength/igrvar, oldLeftLength/igrvar, igrRate[p->left->index ]);
8295                     (*lnPriorRatio) += LnProbGamma (p->left->length/igrvar, p->left->length/igrvar, igrRate[p->left->index ]);
8296                     brlens[p->left->index ] = igrRate[p->left->index ] * p->left->length;
8297                     }
8298                 if (p->right->length > 0.0)
8299                     {
8300                     (*lnPriorRatio) -= LnProbGamma (oldRightLength/igrvar, oldRightLength/igrvar, igrRate[p->right->index]);
8301                     (*lnPriorRatio) += LnProbGamma (p->right->length/igrvar, p->right->length/igrvar, igrRate[p->right->index]);
8302                     brlens[p->right->index] = igrRate[p->right->index] * p->right->length;
8303                     }
8304                 }
8305             if (p->anc->anc != NULL)
8306                 {
8307                 (*lnPriorRatio) -= LnProbGamma (oldPLength/igrvar, oldPLength/igrvar, igrRate[p->index]);
8308                 (*lnPriorRatio) += LnProbGamma (p->length /igrvar, p->length /igrvar, igrRate[p->index]);
8309                 brlens[p->index] = igrRate[p->index] * p->length;
8310                 }
8311             }
8312         }
8313 
8314 #if defined (DEBUG_CSLIDER)
8315     printf ("After node slider (clock):\n");
8316     printf ("Old depth: %f -- New depth: %f -- LnPriorRatio %f -- LnProposalRatio %f\n",
8317         oldDepth, newDepth, (*lnPriorRatio), (*lnProposalRatio));
8318     ShowNodes (t->root, 0, t->isRooted);
8319     getchar();
8320 #endif
8321 
8322     return (NO_ERROR);
8323 }
8324 
8325 
Move_Nu(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)8326 int Move_Nu (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
8327 {
8328     /* move the variance of the TK02 relaxed clock lognormal using multiplier */
8329 
8330     int         i, j;
8331     MrBFlt      oldNu, newNu, minNu, maxNu, tuning, *tk02Rate;
8332     Model       *mp;
8333     TreeNode    *p;
8334     Tree        *t;
8335 
8336     /* get tuning parameter */
8337     tuning = mvp[0];
8338 
8339     /* get model params */
8340     mp = &modelParams[param->relParts[0]];
8341 
8342     /* get the min and max values */
8343     minNu = TK02VAR_MIN;
8344     maxNu = TK02VAR_MAX;
8345     if (!strcmp(mp->tk02varPr,"Uniform"))
8346         {
8347         minNu = (mp->tk02varUni[0] < TK02VAR_MIN) ? TK02VAR_MIN : mp->tk02varUni[0];
8348         maxNu = (mp->tk02varUni[1] > TK02VAR_MAX) ? TK02VAR_MAX : mp->tk02varUni[1];
8349         }
8350 
8351     /* get the TK02 lognormal variance */
8352     oldNu = *GetParamVals (param, chain, state[chain]);
8353 
8354     /* set new value */
8355     newNu = oldNu * exp ((0.5 - RandomNumber(seed))*tuning);
8356 
8357     /* reflect if necessary */
8358     while (newNu < minNu || newNu > maxNu)
8359         {
8360         if (newNu < minNu)
8361             newNu = minNu * minNu / newNu;
8362         if (newNu > maxNu)
8363             newNu = maxNu * maxNu / newNu;
8364         }
8365 
8366     /* store new value */
8367     (*GetParamVals (param, chain, state[chain])) = newNu;
8368 
8369     /* calculate prior ratio */
8370     for (i=0; i<param->nSubParams; i++)
8371         {
8372         tk02Rate = GetParamVals (param->subParams[i], chain, state[chain]);
8373         t = GetTree (param->subParams[i], chain, state[chain]);
8374         for (j=0; j<t->nNodes-2; j++)
8375             {
8376             p = t->allDownPass[j];
8377             if (p->length > 0.0)  // not ancestral fossil
8378                 {
8379                 (*lnPriorRatio) -= LnProbTK02LogNormal (tk02Rate[p->anc->index], oldNu*p->length, tk02Rate[p->index]);
8380                 (*lnPriorRatio) += LnProbTK02LogNormal (tk02Rate[p->anc->index], newNu*p->length, tk02Rate[p->index]);
8381                 }
8382             }
8383         }
8384 
8385     /* take prior on nu into account */
8386     if (!strcmp(mp->tk02varPr,"Exponential"))
8387         (*lnPriorRatio) += mp->tk02varExp * (oldNu - newNu);
8388 
8389     /* calculate proposal ratio */
8390     (*lnProposalRatio) = log (newNu / oldNu);
8391 
8392     /* we do not need to update likelihoods */
8393     for (i=0; i<param->nRelParts; i++)
8394         {
8395         modelSettings[param->relParts[i]].upDateCl = NO;
8396         }
8397 
8398     return (NO_ERROR);
8399 }
8400 
8401 
8402 /*----------------------------------------------------------------
8403 |
8404 |   Move_Omega: Change the nonysnonymous/synonymous rate ratio
8405 |      Note that this is appropriate when omegavar=equal
8406 |
8407 ----------------------------------------------------------------*/
Move_Omega(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)8408 int Move_Omega (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
8409 {
8410     /* change omega using sliding window */
8411 
8412     int         i, isValidO;
8413     MrBFlt      oldO, newO, window, minO, maxO, ran, *alphaDir, oldPropRatio, newPropRatio, x, y;
8414     ModelParams *mp;
8415 
8416     /* get size of window, centered on current omega value */
8417     window = mvp[0];
8418 
8419     /* get model params */
8420     mp = &modelParams[param->relParts[0]];
8421 
8422     /* get minimum and maximum values for omega */
8423     minO = OMEGA_MIN;
8424     maxO = OMEGA_MAX;
8425 
8426     /* get old value of omega */
8427     oldO = *GetParamVals(param, chain, state[chain]);
8428 
8429     /* get Dirichlet parameters */
8430     alphaDir = mp->tRatioDir;
8431 
8432     /* change value for omega */
8433     ran = RandomNumber(seed);
8434     if (maxO-minO < window)
8435         {
8436         window = maxO-minO;
8437         }
8438     newO = oldO + window * (ran - 0.5);
8439 
8440     /* check that new value is valid */
8441     isValidO = NO;
8442     do  {
8443         if (newO < minO)
8444             newO = 2.0 * minO - newO;
8445         else if (newO > maxO)
8446             newO = 2.0 * maxO - newO;
8447         else
8448             isValidO = YES;
8449         }
8450     while (isValidO == NO);
8451 
8452     /* get proposal ratio */
8453     *lnProposalRatio = 0.0;
8454 
8455     /* get prior ratio from Dirichlet */
8456     oldPropRatio = oldO / (oldO + 1.0);
8457     newPropRatio = newO / (newO + 1.0);
8458     x = ((alphaDir[0] - 1.0) * log(newPropRatio)) + ((alphaDir[1] - 1.0) * log (1.0 - newPropRatio));
8459     y = ((alphaDir[0] - 1.0) * log(oldPropRatio)) + ((alphaDir[1] - 1.0) * log (1.0 - oldPropRatio));
8460     (*lnPriorRatio) = x - y;
8461 
8462     /* copy new omega value back */
8463     *GetParamVals(param, chain, state[chain]) = newO;
8464 
8465     /* Set update flags for all partitions that share this kappa. Note that the conditional
8466        likelihood update flags have been set before we even call this function. */
8467     for (i=0; i<param->nRelParts; i++)
8468         TouchAllTreeNodes(&modelSettings[param->relParts[i]],chain);
8469 
8470     /* Set update flags for cijks for all affected partitions. If this is a simple 4 X 4 model,
8471        we don't take any hit, because we will never go into a general transition probability
8472        calculator. However, for covarion, doublet, and codon models, we do want to update
8473        the cijk flag. */
8474     for (i=0; i<param->nRelParts; i++)
8475         modelSettings[param->relParts[i]].upDateCijk = YES;
8476 
8477     return (NO_ERROR);
8478 }
8479 
8480 
8481 /*----------------------------------------------------------------
8482 |
8483 |   Move_Omega_M: Change the nonysnonymous/synonymous rate ratio
8484 |      using multiplier. Note that this is appropriate when
8485 |      omegavar=equal
8486 |
8487 ----------------------------------------------------------------*/
Move_Omega_M(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)8488 int Move_Omega_M (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
8489 {
8490     /* change omega using multiplier */
8491 
8492     int         i, isValidO;
8493     MrBFlt      oldO, newO, minO, maxO, tuning, ran, factor, *alphaDir, oldPropRatio, newPropRatio, x, y;
8494     ModelParams *mp;
8495 
8496     /* get model params */
8497     mp = &modelParams[param->relParts[0]];
8498 
8499     /* get tuning parameter */
8500     tuning = mvp[0];
8501 
8502     /* get minimum and maximum values for omega */
8503     minO = OMEGA_MIN;
8504     maxO = OMEGA_MAX;
8505 
8506     /* get old value of omega */
8507     oldO = *GetParamVals(param, chain, state[chain]);
8508 
8509     /* get Dirichlet parameters */
8510     alphaDir = mp->omegaDir;
8511 
8512     /* change value for omega */
8513     ran = RandomNumber(seed);
8514     factor = exp(tuning * (ran - 0.5));
8515     newO = oldO * factor;
8516 
8517     /* check that new value is valid */
8518     isValidO = NO;
8519     do
8520         {
8521         if (newO < minO)
8522             newO = minO * minO / newO;
8523         else if (newO > maxO)
8524             newO = maxO * maxO / newO;
8525         else
8526             isValidO = YES;
8527         } while (isValidO == NO);
8528 
8529     /* get proposal ratio */
8530     *lnProposalRatio = log(newO / oldO);
8531 
8532     /* get prior ratio from Dirichlet */
8533     oldPropRatio = oldO / (oldO + 1.0);
8534     newPropRatio = newO / (newO + 1.0);
8535     x = ((alphaDir[0] - 1.0) * log(newPropRatio)) + ((alphaDir[1] - 1.0) * log (1.0 - newPropRatio));
8536     y = ((alphaDir[0] - 1.0) * log(oldPropRatio)) + ((alphaDir[1] - 1.0) * log (1.0 - oldPropRatio));
8537     (*lnPriorRatio) = x - y;
8538 
8539     /* copy new omega value back */
8540     *GetParamVals(param, chain, state[chain]) = newO;
8541 
8542     /* Set update flags for all partitions that share this omega. Note that the conditional
8543        likelihood update flags have been set before we even call this function. */
8544     for (i=0; i<param->nRelParts; i++)
8545         TouchAllTreeNodes(&modelSettings[param->relParts[i]],chain);
8546 
8547     /* Set update flags for cijks for all affected partitions. If this is a simple 4 X 4 model,
8548        we don't take any hit, because we will never go into a general transition probability
8549        calculator. However, for covarion, doublet, and codon models, we do want to update
8550        the cijk flag. */
8551     for (i=0; i<param->nRelParts; i++)
8552         modelSettings[param->relParts[i]].upDateCijk = YES;
8553 
8554     return (NO_ERROR);
8555 }
8556 
8557 
8558 /*----------------------------------------------------------------
8559 |
8560 |   Move_OmegaBeta_M: Change parameters of the beta distribution
8561 |      using multiplier for the M10 model. Note that this is
8562 |      appropriate when omegavar=M10
8563 |
8564 ----------------------------------------------------------------*/
Move_OmegaBeta_M(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)8565 int Move_OmegaBeta_M (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
8566 {
8567     int         i, isValidVal, whichParam;
8568     MrBFlt      oldVal, newVal, minVal, maxVal, *vals, *subVals, tuning, ran, factor;
8569     ModelParams *mp;
8570 
8571     /* do we pick alpha or beta of the Beta distribution to change */
8572     if (RandomNumber(seed) < 0.5)
8573         whichParam = 0;
8574     else
8575         whichParam = 1;
8576 
8577     /* get model params */
8578     mp = &modelParams[param->relParts[0]];
8579 
8580     /* get tuning parameter */
8581     tuning = mvp[0];
8582 
8583     /* get minimum and maximum values for omega */
8584     minVal = 0.05;
8585     maxVal = 100.0;
8586 
8587     /* get old value of omega */
8588     vals = GetParamVals(param, chain, state[chain]);
8589     subVals = GetParamSubVals(param, chain, state[chain]);
8590     oldVal = subVals[mp->numM10BetaCats + mp->numM10GammaCats + 4 + whichParam];
8591 
8592     /* change value for alpha/beta */
8593     ran = RandomNumber(seed);
8594     factor = exp(tuning * (ran - 0.5));
8595     newVal = oldVal * factor;
8596 
8597     /* check that new value is valid */
8598     isValidVal = NO;
8599     do
8600         {
8601         if (newVal < minVal)
8602             newVal = minVal * minVal / newVal;
8603         else if (newVal > maxVal)
8604             newVal = maxVal * maxVal / newVal;
8605         else
8606             isValidVal = YES;
8607         } while (isValidVal == NO);
8608 
8609     /* get proposal ratio */
8610     *lnProposalRatio = log(newVal / oldVal);
8611 
8612     /* get prior ratio */
8613     if (!strcmp(mp->m10betapr, "Exponential"))
8614         (*lnPriorRatio) = (log(mp->m10betaExp) - newVal * mp->m10betaExp) - (log(mp->m10betaExp) - oldVal * mp->m10betaExp);
8615     else
8616         (*lnPriorRatio) = 0.0;
8617 
8618     /* copy new omega value back */
8619     subVals[mp->numM10BetaCats + mp->numM10GammaCats + 4 + whichParam] = newVal;
8620 
8621     /* update the omega values */
8622     BetaBreaks (subVals[mp->numM10BetaCats + mp->numM10GammaCats + 4], subVals[mp->numM10BetaCats + mp->numM10GammaCats + 5], &vals[0], mp->numM10BetaCats);
8623 
8624     /* Set update flags for all partitions that share this kappa. Note that the conditional
8625        likelihood update flags have been set before we even call this function. */
8626     for (i=0; i<param->nRelParts; i++)
8627         TouchAllTreeNodes(&modelSettings[param->relParts[i]],chain);
8628 
8629     /* Set update flags for cijks for all affected partitions. If this is a simple 4 X 4 model,
8630        we don't take any hit, because we will never go into a general transition probability
8631        calculator. However, for covarion, doublet, and codon models, we do want to update
8632        the cijk flag. */
8633     for (i=0; i<param->nRelParts; i++)
8634         modelSettings[param->relParts[i]].upDateCijk = YES;
8635 
8636     return (NO_ERROR);
8637 }
8638 
8639 
8640 /*----------------------------------------------------------------
8641 |
8642 |   Move_OmegaGamma_M: Change parameters of the gamma distribution
8643 |      using multiplier for the M10 model. Note that this is
8644 |      appropriate whenomegavar=M10
8645 |
8646 ----------------------------------------------------------------*/
Move_OmegaGamma_M(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)8647 int Move_OmegaGamma_M (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
8648 {
8649     int         i, isValidVal, whichParam;
8650     MrBFlt      oldVal, newVal, minVal, maxVal, *vals, *subVals, tuning, ran, factor, quantile95;
8651     ModelParams *mp;
8652 
8653     /* do we pick alpha or beta of the Gamma distribution to change */
8654     if (RandomNumber(seed) < 0.5)
8655         whichParam = 0;
8656     else
8657         whichParam = 1;
8658 
8659     /* get model params */
8660     mp = &modelParams[param->relParts[0]];
8661 
8662     /* get tuning parameter */
8663     tuning = mvp[0];
8664 
8665     /* get minimum and maximum values for omega */
8666     minVal = 0.05;
8667     maxVal = 100.0;
8668 
8669     /* get values */
8670     vals = GetParamVals(param, chain, state[chain]);
8671     subVals = GetParamSubVals(param, chain, state[chain]);
8672     oldVal = subVals[mp->numM10BetaCats + mp->numM10GammaCats + 6 + whichParam];
8673 
8674     /* change value for alpha/beta */
8675     do
8676         {
8677         ran = RandomNumber(seed);
8678         factor = exp(tuning * (ran - 0.5));
8679         newVal = oldVal * factor;
8680 
8681         /* check that new value is valid */
8682         isValidVal = NO;
8683         do
8684             {
8685             if (newVal < minVal)
8686                 newVal = minVal * minVal / newVal;
8687             else if (newVal > maxVal)
8688                 newVal = maxVal * maxVal / newVal;
8689             else
8690                 isValidVal = YES;
8691             } while (isValidVal == NO);
8692 
8693         /* check that the distribution does not go too far to the right */
8694         if (whichParam == 0)
8695             quantile95 = QuantileGamma (0.95, newVal, subVals[mp->numM10BetaCats + mp->numM10GammaCats + 7]);
8696         else
8697             quantile95 = QuantileGamma (0.95, subVals[mp->numM10BetaCats + mp->numM10GammaCats + 6], newVal);
8698 
8699         } while (quantile95 > 100.0);
8700 
8701     /* get proposal ratio */
8702     *lnProposalRatio = log(newVal / oldVal);
8703 
8704     /* get prior ratio */
8705     if (!strcmp(mp->m10gammapr, "Exponential"))
8706         (*lnPriorRatio) = (log(mp->m10gammaExp) - newVal * mp->m10gammaExp) - (log(mp->m10gammaExp) - oldVal * mp->m10gammaExp);
8707     else
8708         (*lnPriorRatio) = 0.0;
8709 
8710     /* copy new value back */
8711     subVals[mp->numM10BetaCats + mp->numM10GammaCats + 6 + whichParam] = newVal;
8712 
8713     /* update the omega values */
8714     if (DiscreteGamma (&vals[mp->numM10BetaCats], subVals[mp->numM10BetaCats + mp->numM10GammaCats + 6],
8715                        subVals[mp->numM10BetaCats + mp->numM10GammaCats + 7], mp->numM10GammaCats, 0) == ERROR)
8716         return (ERROR);
8717     for (i=0; i<mp->numM10GammaCats; i++)
8718         vals[mp->numM10BetaCats + i] += 1.0;
8719 
8720     /* Set update flags for all partitions that share this kappa. Note that the conditional
8721        likelihood update flags have been set before we even call this function. */
8722     for (i=0; i<param->nRelParts; i++)
8723         TouchAllTreeNodes(&modelSettings[param->relParts[i]],chain);
8724 
8725     /* Set update flags for cijks for all affected partitions. If this is a simple 4 X 4 model,
8726        we don't take any hit, because we will never go into a general transition probability
8727        calculator. However, for covarion, doublet, and codon models, we do want to update
8728        the cijk flag. */
8729     for (i=0; i<param->nRelParts; i++)
8730         modelSettings[param->relParts[i]].upDateCijk = YES;
8731 
8732     return (NO_ERROR);
8733 }
8734 
8735 
Move_OmegaCat(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)8736 int Move_OmegaCat (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
8737 {
8738     int         i, localNumCats, numBetaAndGammaCats;
8739     MrBFlt      dirichletParameters[3], *newSubVals, *oldSubVals, *newFreqs, *oldFreqs, *priorParams, sum, alpha, x, y;
8740     ModelParams *mp;
8741 
8742     /* get model params */
8743     mp = &modelParams[param->relParts[0]];
8744 
8745     /* how many categories are there */
8746     localNumCats = 3;
8747     numBetaAndGammaCats = 0;
8748     if (!strcmp(mp->omegaVar, "M10"))
8749         {
8750         localNumCats = 2;
8751         numBetaAndGammaCats = mp->numM10BetaCats + mp->numM10GammaCats;
8752         }
8753 
8754     /* get the values we need */
8755     newSubVals = GetParamSubVals (param, chain, state[chain]);
8756     oldSubVals = GetParamSubVals (param, chain, state[chain] ^ 1);
8757     if (!strcmp(mp->omegaVar, "M10"))
8758         {
8759         newFreqs = newSubVals + numBetaAndGammaCats;
8760         oldFreqs = oldSubVals + numBetaAndGammaCats;
8761         priorParams = newSubVals + (numBetaAndGammaCats + 2);
8762         }
8763     else
8764         {
8765         newFreqs = newSubVals + 0;
8766         oldFreqs = oldSubVals + 0;
8767         priorParams = newFreqs + 3;
8768         }
8769 
8770     /* get parameter of proposal mechanism */
8771     alpha = mvp[0];
8772 
8773     /* multiply old values with some large number to get new values close to the old ones */
8774     for (i=0; i<localNumCats; i++)
8775         dirichletParameters[i] = oldFreqs[i] * alpha;
8776 
8777     /* get the new category frequencies */
8778     DirichletRandomVariable (dirichletParameters, newFreqs, localNumCats, seed);
8779     sum = 0.0;
8780     for (i=0; i<localNumCats; i++)
8781         {
8782         if (newFreqs[i] < 0.0001)
8783             newFreqs[i] = 0.0001;
8784         sum += newFreqs[i];
8785         }
8786     for (i=0; i<localNumCats; i++)
8787         newFreqs[i] /= sum;
8788 
8789     /* and get the new frequencies of the omega values, if we have another
8790        distribution for omega too */
8791     if (!strcmp(mp->omegaVar, "M10"))
8792         {
8793         for (i=0; i<mp->numM10BetaCats; i++)
8794             newSubVals[i] = newFreqs[0] / mp->numM10BetaCats;
8795         for (i=mp->numM10BetaCats; i<mp->numM10BetaCats+mp->numM10GammaCats; i++)
8796             newSubVals[i] = newFreqs[1] / mp->numM10GammaCats;
8797         }
8798 
8799     /* get proposal ratio */
8800     sum = 0.0;
8801     for (i=0; i<localNumCats; i++)
8802         sum += newFreqs[i]*alpha;
8803     x = LnGamma(sum);
8804     for (i=0; i<localNumCats; i++)
8805         x -= LnGamma(newFreqs[i]*alpha);
8806     for (i=0; i<localNumCats; i++)
8807         x += (newFreqs[i]*alpha-1.0)*log(oldFreqs[i]);
8808     sum = 0.0;
8809     for (i=0; i<localNumCats; i++)
8810         sum += oldFreqs[i]*alpha;
8811     y = LnGamma(sum);
8812     for (i=0; i<localNumCats; i++)
8813         y -= LnGamma(oldFreqs[i]*alpha);
8814     for (i=0; i<localNumCats; i++)
8815         y += (oldFreqs[i]*alpha-1.0)*log(newFreqs[i]);
8816     (*lnProposalRatio) = x - y;
8817 
8818     /* get prior ratio */
8819     x = y = 0.0;        /* ignore the gamma part, it is identical */
8820     for (i=0; i<localNumCats; i++)
8821         x += (priorParams[i]-1.0)*log(newFreqs[i]);
8822     for (i=0; i<localNumCats; i++)
8823         y += (priorParams[i]-1.0)*log(oldFreqs[i]);
8824     (*lnPriorRatio) = x - y;
8825 
8826     /* Set update flags for all partitions that share this omega. Note that the conditional
8827        likelihood update flags have been set before we even call this function. */
8828     for (i=0; i<param->nRelParts; i++)
8829         TouchAllTreeNodes(&modelSettings[param->relParts[i]],chain);
8830 
8831     /* Set update flags for cijks for all affected partitions. */
8832     for (i=0; i<param->nRelParts; i++)
8833         modelSettings[param->relParts[i]].upDateCijk = YES;
8834 
8835     return (NO_ERROR);
8836 }
8837 
8838 
8839 /*----------------------------------------------------------------
8840 |
8841 |   Move_OmegaM3: Change the nonysnonymous/synonymous rate ratio
8842 |      of one class of the M3 model
8843 |
8844 ----------------------------------------------------------------*/
Move_OmegaM3(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)8845 int Move_OmegaM3 (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
8846 {
8847     int         i, isValidO, whichOmega;
8848     MrBFlt      newO, window, minO, maxO, ran, *value, *oldValue, x, y;
8849 
8850     /* get size of window, centered on current omega value */
8851     window = mvp[0];
8852 
8853     /* get old value of omega */
8854     value = GetParamVals(param, chain, state[chain]);
8855     oldValue = GetParamVals(param, chain, state[chain] ^ 1);
8856     whichOmega = (int) (RandomNumber(seed)*3.0);
8857 
8858     /* get minimum and maximum values for omega */
8859     if (whichOmega == 0)
8860         minO = 0.0;
8861     else
8862         minO = value[whichOmega-1];
8863     if (whichOmega == 2)
8864         maxO = OMEGA_MAX;
8865     else
8866         maxO = value[whichOmega+1];
8867 
8868     /* change value for omega */
8869     ran = RandomNumber(seed);
8870      if (maxO-minO < window)
8871         {
8872         window = maxO-minO;
8873         }
8874     newO = oldValue[whichOmega] + window * (ran - 0.5);
8875 
8876     /* check that new value is valid */
8877     isValidO = NO;
8878     do
8879         {
8880         if (newO < minO)
8881             newO = 2* minO - newO;
8882         else if (newO > maxO)
8883             newO = 2 * maxO - newO;
8884         else
8885             isValidO = YES;
8886         } while (isValidO == NO);
8887 
8888     /* copy new omega value back */
8889     value[whichOmega] = newO;
8890 
8891     /* get proposal ratio */
8892     *lnProposalRatio = 0.0;
8893 
8894     /* get prior ratio */
8895     x = LogOmegaPrior (value[0], value[1], value[2]);
8896     y = LogOmegaPrior (oldValue[0], oldValue[1], oldValue[2]);
8897     *lnPriorRatio = x - y;
8898 
8899     /* Set update flags for all partitions that share this omega. Note that the conditional
8900        likelihood update flags have been set before we even call this function. */
8901     for (i=0; i<param->nRelParts; i++)
8902         TouchAllTreeNodes(&modelSettings[param->relParts[i]],chain);
8903 
8904     /* Set update flags for cijks for all affected partitions. */
8905     for (i=0; i<param->nRelParts; i++)
8906         modelSettings[param->relParts[i]].upDateCijk = YES;
8907 
8908     return (NO_ERROR);
8909 }
8910 
8911 
8912 /*----------------------------------------------------------------
8913 |
8914 |   Move_OmegaNeu: Change the nonysnonymous/synonymous rate ratio
8915 |      for neutral sites
8916 |
8917 ----------------------------------------------------------------*/
Move_OmegaNeu(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)8918 int Move_OmegaNeu (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
8919 {
8920     int         i, isOPriorExp, isValidO;
8921     MrBFlt      oldO, newO, window, minO, maxO, ran, *value, x, y;
8922 
8923     /* get size of window, centered on current omega value */
8924     window = mvp[0];
8925 
8926     /* get old value of omega */
8927     value = GetParamVals(param, chain, state[chain]);
8928     oldO = value[1];
8929 
8930     /* get minimum and maximum values for omega */
8931     minO = value[0];
8932     maxO = value[2];
8933 
8934     /* the only way we would be updating the middle category (omega2) is
8935        if we have an exponential prior on all three omegas */
8936     isOPriorExp = YES;
8937 
8938     /* change value for omega */
8939     ran = RandomNumber(seed);
8940     if (maxO-minO < window)
8941         {
8942         window = maxO-minO;
8943         }
8944     newO = oldO + window * (ran - 0.5);
8945 
8946     /* check that new value is valid */
8947     isValidO = NO;
8948     do
8949         {
8950         if (newO < minO)
8951             newO = 2 * minO - newO;
8952         else if (newO > maxO)
8953             newO = 2 * maxO - newO;
8954         else
8955             isValidO = YES;
8956         } while (isValidO == NO);
8957 
8958     /* get proposal ratio */
8959     *lnProposalRatio = 0.0;
8960 
8961     /* copy new omega value back */
8962     value[1] = newO;
8963 
8964     /* get prior ratio */
8965     if (isOPriorExp == NO)
8966         {
8967         *lnPriorRatio = 0.0;
8968         }
8969     else
8970         {
8971         x = LogOmegaPrior (value[0], newO, value[2]);
8972         y = LogOmegaPrior (value[0], oldO, value[2]);
8973         *lnPriorRatio = x - y;
8974         }
8975 
8976     /* Set update flags for all partitions that share this omega. Note that the conditional
8977        likelihood update flags have been set before we even call this function. */
8978     for (i=0; i<param->nRelParts; i++)
8979         TouchAllTreeNodes(&modelSettings[param->relParts[i]],chain);
8980 
8981     /* Set update flags for cijks for all affected partitions. */
8982     for (i=0; i<param->nRelParts; i++)
8983         modelSettings[param->relParts[i]].upDateCijk = YES;
8984 
8985     return (NO_ERROR);
8986 }
8987 
8988 
8989 /*----------------------------------------------------------------
8990 |
8991 |   Move_OmegaPos: Change the nonysnonymous/synonymous rate ratio
8992 |      for positively selected sites
8993 |
8994 ----------------------------------------------------------------*/
Move_OmegaPos(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)8995 int Move_OmegaPos (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
8996 {
8997     int         i, isValidO, omegaUni, omegaExp1, omegaExp2;
8998     MrBFlt      oldO, newO, window, minO=0.0, maxO=0.0, ran, *value, x, y;
8999     ModelParams *mp;
9000 
9001     /* get size of window, centered on current omega value */
9002     window = mvp[0];
9003 
9004     /* get model params */
9005     mp = &modelParams[param->relParts[0]];
9006 
9007     /* get old value of omega */
9008     value = GetParamVals(param, chain, state[chain]);
9009     oldO = value[2];
9010 
9011     /* determine prior for omega */
9012     omegaUni = omegaExp1 = omegaExp2 = NO;
9013     if (param->paramId == OMEGA_BUD || param->paramId == OMEGA_BUF || param->paramId == OMEGA_FUD || param->paramId == OMEGA_FUF)
9014         omegaUni = YES;
9015     else if (param->paramId == OMEGA_BED || param->paramId == OMEGA_BEF || param->paramId == OMEGA_FED || param->paramId == OMEGA_FEF)
9016         omegaExp1 = YES;
9017     else if (param->paramId == OMEGA_ED || param->paramId == OMEGA_EF)
9018         omegaExp2 = YES;
9019 
9020     /* get minimum and maximum values for omega */
9021     if (omegaUni == YES)
9022         {
9023         minO = mp->ny98omega3Uni[0];
9024         if (minO < value[1])
9025             minO = value[1];
9026         maxO = mp->ny98omega3Uni[1];
9027         if (maxO > KAPPA_MAX)
9028             maxO = KAPPA_MAX;
9029         }
9030     else if (omegaExp1 == YES || omegaExp2 == YES)
9031         {
9032         minO = value[1];
9033         maxO = KAPPA_MAX;
9034         }
9035 
9036     /* change value for omega */
9037     ran = RandomNumber(seed);
9038     if (maxO-minO < window)
9039         {
9040         window = maxO-minO;
9041         }
9042     newO = oldO + window * (ran - 0.5);
9043 
9044     /* check that new value is valid */
9045     isValidO = NO;
9046     do
9047         {
9048         if (newO < minO)
9049             newO = 2* minO - newO;
9050         else if (newO > maxO)
9051             newO = 2 * maxO - newO;
9052         else
9053             isValidO = YES;
9054         } while (isValidO == NO);
9055 
9056     /* get proposal ratio */
9057     *lnProposalRatio = 0.0;
9058 
9059     /* copy new omega value back */
9060     value[2] = newO;
9061 
9062     /* get prior ratio (part 2) */
9063     if (omegaUni == YES)
9064         {
9065         *lnPriorRatio = 0.0;
9066         }
9067     else if (omegaExp1 == YES)
9068         {
9069         *lnPriorRatio = mp->ny98omega3Exp * (oldO - newO);
9070         }
9071     else if (omegaExp2 == YES)
9072         {
9073         x = LogOmegaPrior (value[0], value[1], newO);
9074         y = LogOmegaPrior (value[0], value[1], oldO);
9075         *lnPriorRatio = x - y;
9076         }
9077 
9078     /* Set update flags for all partitions that share this omega. Note that the conditional
9079        likelihood update flags have been set before we even call this function. */
9080     for (i=0; i<param->nRelParts; i++)
9081         TouchAllTreeNodes(&modelSettings[param->relParts[i]],chain);
9082 
9083     /* Set update flags for cijks for all affected partitions. */
9084     for (i=0; i<param->nRelParts; i++)
9085         modelSettings[param->relParts[i]].upDateCijk = YES;
9086 
9087     return (NO_ERROR);
9088 }
9089 
9090 
9091 /*----------------------------------------------------------------
9092 |
9093 |   Move_OmegaPur: Change the nonysnonymous/synonymous rate ratio
9094 |      for purifying selection sites
9095 |
9096 ----------------------------------------------------------------*/
Move_OmegaPur(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)9097 int Move_OmegaPur (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
9098 {
9099     int         i, isOPriorExp, isValidO;
9100     MrBFlt      oldO, newO, window, minO, maxO, ran, *value, x, y;
9101 
9102     /* get size of window, centered on current omega value */
9103     window = mvp[0];
9104 
9105     /* get old value of omega */
9106     value = GetParamVals(param, chain, state[chain]);
9107     oldO = value[0];
9108 
9109     /* get minimum and maximum values for omega */
9110     minO = 0.0;
9111     maxO = value[1];
9112 
9113     /* get prior for omega */
9114     if (param->paramId == OMEGA_BUD || param->paramId == OMEGA_BUF || param->paramId == OMEGA_BED ||
9115         param->paramId == OMEGA_BEF || param->paramId == OMEGA_BFD || param->paramId == OMEGA_BFF)
9116         isOPriorExp = NO;
9117     else
9118         isOPriorExp = YES;
9119 
9120     /* change value for omega */
9121     ran = RandomNumber(seed);
9122     if (maxO-minO < window)
9123         {
9124         window = maxO-minO;
9125         }
9126     newO = oldO + window * (ran - 0.5);
9127 
9128     /* check that new value is valid */
9129     isValidO = NO;
9130     do
9131         {
9132         if (newO < minO)
9133             newO = 2* minO - newO;
9134         else if (newO > maxO)
9135             newO = 2 * maxO - newO;
9136         else
9137             isValidO = YES;
9138         } while (isValidO == NO);
9139 
9140     /* get proposal ratio */
9141     *lnProposalRatio = 0.0;
9142 
9143     /* copy new omega value back */
9144     value[0] = newO;
9145 
9146     /* get prior ratio (part 2) */
9147     if (isOPriorExp == NO)
9148         {
9149         *lnPriorRatio = 0.0;
9150         }
9151     else
9152         {
9153         x = LogOmegaPrior (newO, value[1], value[2]);
9154         y = LogOmegaPrior (oldO, value[1], value[2]);
9155         *lnPriorRatio = x - y;
9156         }
9157 
9158     /* Set update flags for all partitions that share this omega. Note that the conditional
9159        likelihood update flags have been set before we even call this function. */
9160     for (i=0; i<param->nRelParts; i++)
9161         TouchAllTreeNodes(&modelSettings[param->relParts[i]],chain);
9162 
9163     /* Set update flags for cijks for all affected partitions. */
9164     for (i=0; i<param->nRelParts; i++)
9165         modelSettings[param->relParts[i]].upDateCijk = YES;
9166 
9167     return (NO_ERROR);
9168 }
9169 
9170 
9171 /*----------------------------------------------------------------
9172 |
9173 |   Move_ParsEraser1: This proposal mechanism changes the topology and
9174 |      branch lengths of an unrooted tree. A randomly chosen region of
9175 |      the tree is erased. Parsimony is used to guide the selection of
9176 |      a new topology for the erased part of the tree. The parsimony
9177 |      branch lengths are used to guide the proposal of new branch
9178 |      lengths. This variant (1) uses exhaustive enumeration.
9179 |
9180 |      Programmed by FR 2004-10-23--
9181 |
9182 ----------------------------------------------------------------*/
Move_ParsEraser1(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)9183 int Move_ParsEraser1 (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
9184 {
9185     int         i, j, isVPriorExp, nSubTerminals, nEmbeddedTrees;
9186     MrBFlt      alphaPi, warp, minV, maxV, minP, maxP, brlensExp=0.0, newM, oldM, maxLen,
9187                 *brlensCur, *brlensNew, *parslensCur, *parslensNew,
9188                 curLength, newLength, lnJacobian, lnRandomRatio, alpha[2], prob[2],
9189                 minLenCur, minLenNew, f;
9190     TreeNode    *p=NULL;
9191     Tree        *t, *subtree, *subtree1, memTree[2];
9192     ModelParams *mp;
9193     ModelInfo   *m;
9194     TreeInfo    tInfo;
9195 
9196     /* set pointers to NULL */
9197     subtree = subtree1 = NULL;
9198     brlensCur = NULL;
9199     for (i=0; i<2; i++)
9200         {
9201         memTree[i].allDownPass = NULL;
9202         memTree[i].intDownPass = NULL;
9203         memTree[i].nodes = NULL;
9204         }
9205     tInfo.leaf = NULL;
9206 
9207     /* Set alpha Pi for Dirichlet p generator */
9208     alphaPi = mvp[0];   /* FIXME: Not used (from clang static analyzer) */
9209     alphaPi = 0.05;
9210 
9211     /* Set the parsimony warp factor */
9212     warp = mvp[1];  /* FIXME: Not used (from clang static analyzer) */
9213     warp = 0.2;
9214 
9215     /* Set the number of terminals (nSubTerminals, column 3) in erased tree */
9216     /* Erased Nodes => Leaves => Terminals => Embedded trees => Embedded histories => New trees
9217                   2 => 3      => 4         => 2              => 2 = 2!             => 3 = 1*3
9218                   3 => 4      => 5         => 5              => 6 = 3!             => 15 = 1*3*5
9219                   4 => 5      => 6         => 14             => 24 = 4!            => 105 = 1*3*5*7
9220                   5 => 6      => 7         => 42             => 120 = 5!           => 945 = 1*3*5*7*9
9221                   etc               */
9222     nSubTerminals = (int) (RandomNumber(seed) * 4) + 4; /* FIXME: Not used (from clang static analyzer) */
9223     nSubTerminals = 7;
9224 
9225     /* initialize log prior and log proposal probabilities */
9226     *lnPriorRatio = *lnProposalRatio = 0.0;
9227 
9228     /* get tree */
9229     t = GetTree (param, chain, state[chain]);
9230 
9231     /* get model params */
9232     mp = &modelParams[param->relParts[0]];
9233 
9234     /* max and min brlen */
9235     if (param->subParams[0]->paramId == BRLENS_UNI)
9236         {
9237         minV = mp->brlensUni[0] > BRLENS_MIN ? mp->brlensUni[0] : BRLENS_MIN;
9238         maxV = mp->brlensUni[1];
9239         isVPriorExp = NO;
9240         }
9241     else
9242         {
9243         minV = BRLENS_MIN;
9244         maxV = BRLENS_MAX;
9245         brlensExp = mp->brlensExp;
9246         isVPriorExp = YES;
9247         }
9248     minP = 3.0 * ((1.0 / 4.0) - ((1.0 / 4.0) * exp (-4.0 * minV / 3.0)));
9249     maxP = 3.0 * ((1.0 / 4.0) - ((1.0 / 4.0) * exp (-4.0 * maxV / 3.0)));
9250 
9251     /* allocate some memory for this move */
9252     brlensCur = (MrBFlt *) SafeMalloc (8 * nSubTerminals * sizeof (MrBFlt));
9253     if (!brlensCur)
9254         {
9255         MrBayesPrint ("%s   ERROR: Could not allocate brlensCur\n", spacer);
9256         goto errorExit;
9257         }
9258     brlensNew = brlensCur + 2*nSubTerminals;
9259     parslensCur = brlensCur + 4 * nSubTerminals;
9260     parslensNew = brlensCur + 6 * nSubTerminals;
9261 
9262     subtree = &memTree[0];
9263     subtree->nNodes = 2 * nSubTerminals - 2;
9264     subtree->nIntNodes = nSubTerminals - 2;
9265     subtree->nodes = (TreeNode *) SafeCalloc (subtree->nNodes, sizeof (TreeNode));
9266     subtree->allDownPass = (TreeNode **) SafeCalloc (subtree->nNodes, sizeof (TreeNode *));
9267     subtree->intDownPass = (TreeNode **) SafeCalloc (subtree->nIntNodes, sizeof (TreeNode *));
9268     if (!subtree->nodes || !subtree->intDownPass || !subtree->allDownPass)
9269         {
9270         MrBayesPrint ("%s   ERROR: Could not allocate subtree\n", spacer);
9271         goto errorExit;
9272         }
9273 
9274     subtree1 = &memTree[1];
9275     subtree1->nNodes = 2 * nSubTerminals - 2;
9276     subtree1->nIntNodes = nSubTerminals - 2;
9277     subtree1->nodes = (TreeNode *) SafeCalloc (subtree1->nNodes, sizeof (TreeNode));
9278     subtree1->allDownPass = (TreeNode **) SafeCalloc (subtree1->nNodes, sizeof (TreeNode *));
9279     subtree1->intDownPass = (TreeNode **) SafeCalloc (subtree1->nIntNodes, sizeof (TreeNode *));
9280     if (!subtree1->nodes || !subtree1->intDownPass || !subtree1->allDownPass)
9281         {
9282         MrBayesPrint ("%s   ERROR: Could not allocate subtree1\n", spacer);
9283         goto errorExit;
9284         }
9285 
9286     tInfo.leaf = (TreeNode **) SafeCalloc (t->nNodes, sizeof(TreeNode *));
9287     if (!tInfo.leaf)
9288         {
9289         MrBayesPrint ("%s   ERROR: Could not allocate tInfo.leaf\n", spacer);
9290         goto errorExit;
9291         }
9292     tInfo.vertex = tInfo.leaf + t->nNodes - t->nIntNodes;
9293 
9294     /* Select a random embedded subtree with nSubTerminals terminals */
9295     if (GetRandomEmbeddedSubtree (t, nSubTerminals, seed, &nEmbeddedTrees) == ERROR)
9296         {
9297         MrBayesPrint ("%s   ERROR: Could not get subtree\n", spacer);
9298         goto errorExit;
9299         }
9300 
9301     /* Set update flags (We'd better do it before the marked nodes disappear) */
9302     for (i=0; i<t->nIntNodes; i++)
9303         {
9304         p = t->intDownPass[i];
9305         if (p->marked == YES)
9306             {
9307             p->upDateCl = YES;
9308             p->upDateTi = YES;
9309             }
9310         else if (p->left->upDateCl == YES || p->right->upDateCl == YES)
9311                 p->upDateCl = YES;
9312         }
9313 
9314     /* Fill in subtrees */
9315     CopyTreeToSubtree (t, subtree);
9316     CopyTreeToSubtree (t, subtree1);
9317 
9318     /* Calculate downstates and upstate of root node of subtree */
9319     GetParsDP (t, t->root->left, chain);
9320     for (i=0; i<t->nIntNodes; i++)
9321         {
9322         p = t->intDownPass[i];
9323         if (p->marked == YES && p->anc->marked == NO)
9324             break;
9325         }
9326     GetParsimonySubtreeRootstate (t, p->anc, chain);
9327 
9328     /* Get parsimony length of current tree */
9329     curLength = GetParsimonyLength (subtree, chain);
9330 
9331     /* Get the Markov and parsimony branch lengths of the current subtree */
9332     GetParsimonyBrlens (subtree, chain, parslensCur);
9333     for (i=0; i<subtree->nNodes-1; i++)
9334         brlensCur[i] = subtree->allDownPass[i]->length;
9335 
9336     /* Calculate parsimony score of all trees relative to shortest tree (1.0) */
9337     tInfo.totalScore = 0.0;
9338     tInfo.stopScore = -1.0;
9339     tInfo.minScore = curLength;
9340     tInfo.warp = warp;
9341     ExhaustiveParsimonySearch (subtree, chain, &tInfo);
9342 
9343     /* Choose one of these trees randomly based on its score */
9344     tInfo.stopScore = RandomNumber(seed) * tInfo.totalScore;
9345     tInfo.totalScore = 0.0;
9346     ExhaustiveParsimonySearch (subtree1, chain, &tInfo);
9347     /* ShowNodes (subtree1->root, 0 , NO); */
9348     /* getchar(); */
9349 
9350     /* Get length of that tree */
9351 
9352     newLength = GetParsimonyLength (subtree1, chain);
9353 
9354     /* Get the parsimony branch lengths of the new subtree */
9355     GetParsimonyBrlens (subtree1, chain, parslensNew);
9356 
9357     /* Find the maximum length of a branch */
9358     maxLen = 0.0;
9359     for (i=0; i<t->nRelParts; i++)
9360         {
9361         j = t->relParts[i];
9362         m = &modelSettings[j];
9363         maxLen += m->numUncompressedChars;
9364         }
9365 
9366     /* Find the Markov branch lengths of the new subtree */
9367     /* Calculate Jacobian and prob ratio for the Dirichlet random number generator */
9368     lnJacobian = lnRandomRatio = 0.0;
9369     minLenCur = minLenNew = 0.0;
9370     for (i=0; i<subtree1->nNodes-1; i++)
9371         {
9372         minLenCur += parslensCur[i];
9373         minLenNew += parslensNew[i];
9374         }
9375     for (i=0; i<subtree1->nNodes-1; i++)
9376         {
9377         p = subtree1->allDownPass[i];
9378         f = newLength / minLenNew;
9379         alpha[0] = parslensNew[i] * f * alphaPi + 1.0;
9380         alpha[1] = (maxLen - parslensNew[i] * f) * alphaPi + 1.0;
9381         DirichletRandomVariable (alpha, prob, 2, seed);
9382         if (prob[0] >= maxP || prob[0] <= minP)
9383             {
9384             abortMove = YES;
9385             return NO_ERROR;
9386             }
9387 
9388         p->length = (-3.0 / 4.0) * log (1.0 - 4.0 * prob[0] / 3.0);
9389         lnJacobian += (-4.0 * brlensCur[i] / 3.0) - log (1.0 - 4.0 * prob[0] / 3.0);
9390         lnRandomRatio -= log (pow (prob[0], alpha[0] - 1.0) * pow (prob[1], alpha[1] - 1.0));
9391         f = curLength / minLenNew;
9392         alpha[0] = parslensCur[i] * f * alphaPi + 1.0;
9393         alpha[1] = (maxLen - parslensCur[i] * f) * alphaPi + 1.0;
9394         prob[0] = 3.0 * ((1.0 / 4.0) - ((1.0 / 4.0) * exp (-4.0 * brlensCur[i] / 3.0)));
9395         prob[1] = 1.0 - prob[0];
9396         lnRandomRatio += log (pow (prob[0], alpha[0] - 1.0) * pow (prob[1], alpha[1] - 1.0));
9397         }
9398 
9399     /* Store the new Markov branch lengths */
9400     for (i=0; i<subtree1->nNodes-1; i++)
9401         brlensNew[i] = subtree1->allDownPass[i]->length;
9402 
9403     /* Calculate the proposal ratio */
9404     (*lnProposalRatio) = lnJacobian + lnRandomRatio + log (warp/3.0) * (curLength - newLength) + log (1.0-warp) * (newLength - curLength);
9405 
9406     /* Calculate the prior ratio */
9407     if (isVPriorExp == YES)
9408         {
9409         newM = oldM = 0.0;
9410         for (i=0; i<subtree->nNodes-1; i++)
9411             {
9412             oldM += brlensCur[i];
9413             newM += brlensNew[i];
9414             }
9415         (*lnPriorRatio) += brlensExp * (oldM - newM);
9416         }
9417 
9418     /* Copy subtree into tree */
9419     CopySubtreeToTree (subtree1, t);
9420     /* ShowNodes (subtree1->root, 0, NO); */
9421     /* ShowNodes (t->root, 0, NO); */
9422 
9423     /* Update node sequences */
9424     GetDownPass (t);
9425 
9426     /* correct for difference in number of embedded subtrees */
9427     if (GetRandomEmbeddedSubtree (t, nSubTerminals, seed, &i) == ERROR)
9428         {
9429         MrBayesPrint ("%s   Could not count number of subtrees in Move_ParsEraser1\n", spacer);
9430         goto errorExit;
9431         }
9432     if (i != nEmbeddedTrees)
9433         (*lnProposalRatio) += log ((MrBFlt) nEmbeddedTrees / (MrBFlt) i);
9434 
9435     /* Free memory allocated for this move */
9436     free (subtree->allDownPass);
9437     free (subtree->intDownPass);
9438     free (subtree->nodes);
9439     free (subtree1->allDownPass);
9440     free (subtree1->intDownPass);
9441     free (subtree1->nodes);
9442     free (brlensCur);
9443     free (tInfo.leaf);
9444 
9445     return (NO_ERROR);
9446 
9447 errorExit:
9448 
9449     if (subtree != NULL)
9450         {
9451         free (subtree->allDownPass);
9452         free (subtree->intDownPass);
9453         free (subtree->nodes);
9454         }
9455     if (subtree1 != NULL)
9456         {
9457         free (subtree1->allDownPass);
9458         free (subtree1->intDownPass);
9459         free (subtree1->nodes);
9460         }
9461     free (brlensCur);
9462     free (tInfo.leaf);
9463 
9464     return (ERROR);
9465 }
9466 
9467 
Move_ParsFossilSPRClock(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)9468 int Move_ParsFossilSPRClock (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
9469 {
9470     /* Change branch lengths and topology (potentially) using SPR-type move, parsimony-biased */
9471 
9472     /* This move is identical to ParsSPRClock except that it uses s/n weighting and it only picks fossil subtrees. */
9473 
9474     int         i, j, n, division, n1=0, n2=0, n3=0, n4=0, n5=0, *nEvents, numMovableNodesOld, numMovableNodesNew;
9475     BitsLong    *pA, *pV, *pP, y[2];
9476     MrBFlt      x, oldBrlen=0.0, newBrlen=0.0, v1=0.0, v2=0.0, v3=0.0, v4=0.0, v5=0.0,
9477     v3new=0.0, lambda, **position=NULL, **rateMultiplier=NULL, *brlens,
9478     igrvar, *igrRate=NULL, nu, *tk02Rate=NULL, minLength=0.0, length=0.0,
9479     cumulativeProb, warpFactor, sum1, sum2, ran, increaseProb, decreaseProb,
9480     divFactor, nStates, v_approx, minV;
9481     CLFlt       *nSitesOfPat, *nSites, *globalNSitesOfPat;
9482     TreeNode    *p, *a, *b, *u, *v, *c=NULL, *d;
9483     Tree        *t;
9484     ModelInfo   *m=NULL;
9485     Param       *subParm;
9486 
9487     warpFactor = mvp[0];                  /* tuning parameter determining how heavily to weight according to parsimony scores */
9488     increaseProb = decreaseProb = mvp[1]; /* reweighting probabilities */
9489 
9490     (*lnProposalRatio) = (*lnPriorRatio) = 0.0;
9491 
9492     /* get tree */
9493     t = GetTree (param, chain, state[chain]);
9494 
9495     /* get model params and model info */
9496     m = &modelSettings[param->relParts[0]];
9497 
9498     /* get min and max brlen in relative time and subst units */
9499     minV = BRLENS_MIN;
9500 
9501 #   if defined (DEBUG_ParsSPRClock)
9502     printf ("Before:\n");
9503     ShowNodes (t->root, 2, YES);
9504     getchar();
9505 #   endif
9506 
9507     /* mark all nodes that only have fossil children with YES and count number movable nodes in current tree */
9508     numMovableNodesOld=0;
9509     for (i=0; i<t->nNodes-2; ++i)
9510     {
9511         p = t->allDownPass[i];
9512         if (p->left == NULL)
9513         {
9514             if (p->calibration == NULL)
9515                 p->x = NO;
9516             else
9517             {
9518                 p->x = YES;
9519             }
9520         }
9521         else
9522         {
9523             if (p->left->x == YES && p->right->x == YES)
9524             {
9525                 p->x = YES;
9526             }
9527             else
9528                 p->x = NO;
9529         }
9530         a = p->anc->left;
9531         b = p->anc->right;
9532         if (p->anc->isLocked == YES || p->anc->anc->anc == NULL
9533             || (p == b && a->length < TIME_MIN) || (p == a && b->length < TIME_MIN) || p->x == NO)
9534             numMovableNodesOld++;
9535     }
9536 
9537     if (numMovableNodesOld==0)
9538         return (NO_ERROR);
9539 
9540     /* pick a branch */
9541     do  {
9542         p = t->allDownPass[(int)(RandomNumber(seed) * (t->nNodes - 2))];
9543         a = p->anc->left;
9544         b = p->anc->right;
9545     }
9546     while (p->anc->isLocked == YES || p->anc->anc->anc == NULL
9547            || (p == b && a->length < TIME_MIN) || (p == a && b->length < TIME_MIN) || p->x == NO);
9548     /* skip constraints, siblings of root (and root); and consider ancestral fossils in fbd tree;
9549      skip all nodes that subtend extant terminals */
9550 
9551     /* set up pointers for nodes around the picked branch */
9552     v = p;
9553     u = p->anc;
9554     if (u->left == v)
9555         a = u->right;
9556     else
9557         a = u->left;
9558     b = u->anc;
9559 
9560     /* record branch length for insertion in back move */
9561     if (v->length > 0.0)  /* side branch, not anc fossil */
9562     {
9563         if (v->nodeDepth > a->nodeDepth)
9564             oldBrlen = b->nodeDepth - v->nodeDepth - 2.0*minV;
9565         else
9566             oldBrlen = b->nodeDepth - a->nodeDepth - 2.0*minV;
9567     }
9568     v1 = a->length;
9569     v2 = u->length;
9570     v3 = v->length;
9571 
9572     /* reassign events for CPP and adjust prior and proposal ratios for relaxed clock models */
9573     for (i=0; i<param->subParams[0]->nSubParams; i++)
9574     {
9575         subParm = param->subParams[0]->subParams[i];
9576         if (subParm->paramType == P_CPPEVENTS)
9577         {
9578             nEvents = subParm->nEvents[2*chain+state[chain]];
9579             position = subParm->position[2*chain+state[chain]];
9580             rateMultiplier = subParm->rateMult[2*chain+state[chain]];
9581             n1 = nEvents[a->index];
9582             n2 = nEvents[u->index];
9583             n3 = nEvents[v->index];
9584             if (n2 > 0)
9585             {
9586                 position[a->index] = (MrBFlt *) SafeRealloc ((void *) position[a->index], (n1+n2) * sizeof (MrBFlt));
9587                 rateMultiplier[a->index] = (MrBFlt *) SafeRealloc ((void *) rateMultiplier[a->index], (n1+n2) * sizeof (MrBFlt));
9588             }
9589             for (j=0; j<n1; j++)
9590                 position[a->index][j] *= v1 / (v1+v2);
9591             for (j=n1; j<n1+n2; j++)
9592             {
9593                 position[a->index][j] = (position[u->index][j-n1] * v2 + v1) / (v1+v2);
9594                 rateMultiplier[a->index][j] = rateMultiplier[u->index][j-n1];
9595             }
9596             nEvents[a->index] = n1+n2;
9597             nEvents[u->index] = 0;
9598             if (n2 > 0)
9599             {
9600                 free (position[u->index]);
9601                 free (rateMultiplier[u->index]);
9602                 position[u->index] = rateMultiplier[u->index] = NULL;
9603             }
9604             /* adjust effective branch lengths */
9605             brlens = GetParamSubVals (subParm, chain, state[chain]);
9606             brlens[a->index] += brlens[u->index];   /* only change in effective branch lengths so far */
9607         }   /* end CPP events parm */
9608         else if ( subParm->paramType == P_TK02BRANCHRATES ||
9609                  (subParm->paramType == P_MIXEDBRCHRATES && *GetParamIntVals(subParm, chain, state[chain]) == RCL_TK02))
9610         {
9611             /* adjust prior ratio */
9612             if (subParm->paramType == P_TK02BRANCHRATES)
9613                 nu = *GetParamVals (modelSettings[subParm->relParts[0]].tk02var, chain, state[chain]);
9614             else
9615                 nu = *GetParamVals (modelSettings[subParm->relParts[0]].mixedvar, chain, state[chain]);
9616             tk02Rate = GetParamVals (subParm, chain, state[chain]);
9617             if (v->length > 0.0)
9618                 (*lnPriorRatio) -= LnProbTK02LogNormal(tk02Rate[v->anc->index], nu*v->length, tk02Rate[v->index]);
9619             (*lnPriorRatio) -= LnProbTK02LogNormal(tk02Rate[a->anc->index], nu*a->length, tk02Rate[a->index]);
9620             (*lnPriorRatio) -= LnProbTK02LogNormal(tk02Rate[u->anc->index], nu*u->length, tk02Rate[u->index]);
9621             (*lnPriorRatio) += LnProbTK02LogNormal(tk02Rate[u->anc->index], nu*(a->length+u->length), tk02Rate[a->index]);
9622 
9623             /* adjust effective branch lengths */
9624             brlens = GetParamSubVals (subParm, chain, state[chain]);
9625             brlens[a->index] = (tk02Rate[a->index] + tk02Rate[b->index]) / 2.0 * (a->length + u->length);
9626         }   /* end tk02 branch rate parameter */
9627         else if ( subParm->paramType == P_IGRBRANCHRATES ||
9628                  (subParm->paramType == P_MIXEDBRCHRATES && *GetParamIntVals(subParm, chain, state[chain]) == RCL_IGR))
9629         {
9630             if (subParm->paramType == P_IGRBRANCHRATES)
9631                 igrvar = *GetParamVals (modelSettings[subParm->relParts[0]].igrvar, chain, state[chain]);
9632             else
9633                 igrvar = *GetParamVals (modelSettings[subParm->relParts[0]].mixedvar, chain, state[chain]);
9634             igrRate = GetParamVals (subParm, chain, state[chain]);
9635 
9636             /* adjust prior ratio for old branches */
9637             if (v->length > 0.0)
9638                 (*lnPriorRatio) -= LnProbGamma(v->length/igrvar, v->length/igrvar, igrRate[v->index]);
9639             (*lnPriorRatio) -= LnProbGamma(a->length/igrvar, a->length/igrvar, igrRate[a->index]);
9640             (*lnPriorRatio) -= LnProbGamma(u->length/igrvar, u->length/igrvar, igrRate[u->index]);
9641             (*lnPriorRatio) += LnProbGamma((a->length+u->length)/igrvar, (a->length+u->length)/igrvar, igrRate[a->index]);
9642 
9643             /* adjust effective branch lengths */
9644             brlens = GetParamSubVals (subParm, chain, state[chain]);
9645             brlens[a->index] = igrRate[a->index] * (a->length + u->length);
9646         }   /* end igr branch rate parameter */
9647     }   /* next subparameter */
9648 
9649     /* cut tree */
9650     a->anc = b;
9651     if (b->left == u)
9652         b->left = a;
9653     else
9654         b->right = a;
9655     a->length += u->length;
9656     a->upDateTi = YES;
9657 
9658     /* get final parsimony states for the root part */
9659     GetParsDP (t, t->root->left, chain);
9660     GetParsFP (t, t->root->left->left, chain);
9661     GetParsFP (t, t->root->left->right, chain);
9662 
9663     /* get downpass parsimony states for the crown part */
9664     GetParsDP (t, v, chain);
9665 
9666     /* reset node variables that will be used */
9667     for (i=0; i<t->nNodes; i++)
9668     {
9669         p = t->allDownPass[i];
9670         p->marked = NO;
9671         p->d = 0.0;
9672     }
9673 
9674     /* mark nodes in the root part of the tree, first mark a */
9675     a->marked = YES;
9676     /* then move down towards root taking constraints into account */
9677     p = b;
9678     while (p->isLocked == NO && p->anc->anc != NULL)
9679     {
9680         p->marked = YES;
9681         p = p->anc;
9682     }
9683     /* make sure sisters of last node are marked otherwise it will not be marked in the uppass */
9684     p->left->marked = YES;
9685     p->right->marked = YES;
9686     /* finally move up, skip constraints and ancestral fossil */
9687     for (i=t->nNodes-2; i>=0; i--)
9688     {
9689         p = t->allDownPass[i];
9690         if (p != u && p->marked == NO && p->anc->marked == YES && p->anc->isLocked == NO
9691             && p->anc->nodeDepth > v->nodeDepth + minV && p->length > 0.0)
9692             p->marked = YES;
9693     }
9694 
9695     /* unmark nodes if the picked branch is 0 (ancestral fossil) */
9696     if (v->length < TIME_MIN)
9697     {
9698         n = 0;
9699         for (i=0; i<t->nNodes-1; i++)
9700         {
9701             p = t->allDownPass[i];
9702             if (p->nodeDepth > v->nodeDepth - minV || p->anc->nodeDepth < v->nodeDepth + minV)
9703                 p->marked = NO;
9704             if (p->marked == YES)
9705                 n++;
9706         }
9707         if (n < 2)  /* no new position to move */
9708         {
9709             abortMove = YES;
9710             return (NO_ERROR);
9711         }
9712     }
9713 
9714     /* find number of site patterns and modify randomly */
9715     globalNSitesOfPat = numSitesOfPat + ((chainId[chain] % chainParams.numChains) * numCompressedChars) + m->compCharStart;
9716     nSitesOfPat = (CLFlt *) SafeCalloc (numCompressedChars, sizeof(CLFlt));
9717     if (!nSitesOfPat)
9718     {
9719         MrBayesPrint ("%s   Problem allocating nSitesOfPat in Move_ParsSPRClock\n", spacer);
9720         return (ERROR);
9721     }
9722     for (i=0; i<numCompressedChars; i++)
9723     {
9724         nSitesOfPat[i] = globalNSitesOfPat[i];
9725         for (j=0; j<globalNSitesOfPat[i]; j++)
9726         {
9727             ran = RandomNumber(seed);
9728             if (ran < decreaseProb)
9729                 nSitesOfPat[i]--;
9730             else if (ran > 1.0 - increaseProb)
9731                 nSitesOfPat[i]++;
9732         }
9733     }
9734 
9735     /* cycle through the possibilities and record the parsimony length */
9736     for (i=0; i<t->nNodes; i++)
9737     {
9738         p = t->allDownPass[i];
9739         if (p->marked == NO)
9740             continue;
9741         /* find the parsimony length */
9742         p->d = 0.0;
9743         for (n=0; n<t->nRelParts; n++)
9744         {
9745             division = t->relParts[n];
9746 
9747             /* Find model settings */
9748             m = &modelSettings[division];
9749 
9750             /* find nSitesOfPat */
9751             nSites = nSitesOfPat + m->compCharStart;
9752 
9753             /* find downpass parsimony sets for the node and its environment */
9754             pP   = m->parsSets[p->index     ];
9755             pA   = m->parsSets[p->anc->index];
9756             pV   = m->parsSets[v->index     ];
9757 
9758             length = 0.0;
9759             if (m->nParsIntsPerSite == 1)
9760             {
9761                 for (j=0; j<m->numChars; j++)
9762                 {
9763                     y[0] = (pP[j] | pA[j]) & pV[j];
9764                     if (y[0] == 0)
9765                         length += nSites[j];
9766                 }
9767             }
9768             else /* if (m->nParsIntsPerSite == 2) */
9769             {
9770                 for (j=0; j<2*m->numChars; j+=2)
9771                 {
9772                     y[0] = (pP[j] | pA[j]) & pV[j];
9773                     y[1] = (pP[j+1] | pA[j+1]) & pV[j+1];
9774                     if ((y[0] | y[1]) == 0)
9775                         length += nSites[j/2];
9776                 }
9777             }
9778 
9779             /* find nStates and v approximation using parsimony-based s/n approximation */
9780             nStates = m->numModelStates;
9781             if (m->dataType == STANDARD)
9782                 nStates = 2;
9783             v_approx = length/m->numUncompressedChars + 0.0001;
9784 
9785             /* get division warp factor (prop. to prob. of change) */
9786             divFactor = - warpFactor * log(1.0/nStates - exp(-nStates/(nStates-1)*v_approx)/nStates);
9787 
9788             p->d += divFactor * length;
9789         }
9790     }
9791 
9792     /* find the min length and the sum for the forward move */
9793     minLength = -1.0;
9794     for (i=0; i<t->nNodes; i++)
9795     {
9796         p = t->allDownPass[i];
9797         if (p->marked == NO || p == a)
9798             continue;
9799         if (minLength < 0.0 || p->d < minLength)
9800             minLength = p->d;
9801     }
9802     sum1 = 0.0;
9803     for (i=0; i<t->nNodes; i++)
9804     {
9805         p = t->allDownPass[i];
9806         if (p->marked == YES && p != a)
9807             sum1 += exp (minLength - p->d);
9808     }
9809 
9810     /* generate a random uniform */
9811     ran = RandomNumber(seed) * sum1;
9812 
9813     /* select the appropriate reattachment point (not a!) */
9814     cumulativeProb = 0.0;
9815     for (i=0; i<t->nNodes; i++)
9816     {
9817         p = t->allDownPass[i];
9818         if (p->marked == YES && p != a)
9819         {
9820             c = p;
9821             cumulativeProb += exp (minLength - p->d);
9822             if (cumulativeProb > ran)
9823                 break;
9824         }
9825     }
9826 
9827     /* calculate the proposal ratio */
9828     (*lnProposalRatio) = c->d - minLength + log(sum1);
9829 
9830     /* find the min length and the sum for the backward move */
9831     minLength = -1.0;
9832     for (i=0; i<t->nNodes; i++)
9833     {
9834         p = t->allDownPass[i];
9835         if (p->marked == NO || p == c)
9836             continue;
9837         if (minLength < 0.0 || p->d < minLength)
9838             minLength = p->d;
9839     }
9840     sum2 = 0.0;
9841     for (i=0; i<t->nNodes; i++)
9842     {
9843         p = t->allDownPass[i];
9844         if (p->marked == YES && p != c)
9845             sum2 += exp (minLength - p->d);
9846     }
9847 
9848     /* calculate the proposal ratio */
9849     (*lnProposalRatio) += minLength - a->d - log(sum2);
9850 
9851     /* reattach u */
9852     d = c->anc;
9853     c->anc = u;
9854     if (u->left == v)
9855         u->right = c;
9856     else
9857         u->left = c;
9858     u->anc = d;
9859     if (d->left == c)
9860         d->left = u;
9861     else
9862         d->right = u;
9863 
9864     if (v->length > 0.0)  /* side branch, not anc fossil */
9865     {
9866         if (c->nodeDepth > v->nodeDepth)
9867             newBrlen = d->nodeDepth - c->nodeDepth - 2.0*minV;
9868         else
9869             newBrlen = d->nodeDepth - v->nodeDepth - 2.0*minV;
9870         if (newBrlen <= 0.0)
9871         {
9872             abortMove = YES;
9873             free (nSitesOfPat);
9874             return (NO_ERROR);
9875         }
9876 
9877         /* adjust lengths */
9878         u->nodeDepth = d->nodeDepth - minV - RandomNumber(seed) * newBrlen;
9879         v->length = u->nodeDepth - v->nodeDepth;
9880 
9881         /* calculate proposal ratio for tree change */
9882         (*lnProposalRatio) += log (newBrlen / oldBrlen);
9883     }
9884     u->length = d->nodeDepth - u->nodeDepth;
9885     c->length = u->nodeDepth - c->nodeDepth;
9886 
9887     v3new = v->length;
9888     v4 = c->length;
9889     v5 = u->length;
9890 
9891     /* reassign events for CPP and adjust prior and proposal ratios for relaxed clock models */
9892     for (i=0; i<param->subParams[0]->nSubParams; i++)
9893     {
9894         subParm = param->subParams[0]->subParams[i];
9895         if (subParm->paramType == P_CPPEVENTS)
9896         {
9897             nEvents = subParm->nEvents[2*chain+state[chain]];
9898             position = subParm->position[2*chain+state[chain]];
9899             rateMultiplier = subParm->rateMult[2*chain+state[chain]];
9900             for (j=0; j<nEvents[c->index]; j++)
9901             {
9902                 if (position[c->index][j] > v4 / (v4+v5))
9903                     break;
9904             }
9905             n4 = j;
9906             n5 = nEvents[c->index] - j;
9907             nEvents[u->index] = n5;
9908             if (n5 > 0)
9909             {
9910                 position[u->index] = (MrBFlt *) SafeRealloc ((void *) position[u->index], n5 * sizeof (MrBFlt));
9911                 rateMultiplier[u->index] = (MrBFlt *) SafeRealloc ((void *) rateMultiplier[u->index], n5 * sizeof (MrBFlt));
9912                 for (j=n4; j<nEvents[c->index]; j++)
9913                 {
9914                     position[u->index][j-n4] = (position[c->index][j] * (v4+v5) - v4) / v5;
9915                     rateMultiplier[u->index][j-n4] = rateMultiplier[c->index][j];
9916                 }
9917                 if (n4 > 0)
9918                 {
9919                     position[c->index] = (MrBFlt *) SafeRealloc ((void *) position[c->index], n4 * sizeof (MrBFlt));
9920                     rateMultiplier[c->index] = (MrBFlt *) SafeRealloc ((void *) rateMultiplier[c->index], n4 * sizeof (MrBFlt));
9921                     for (j=0; j<n4; j++)
9922                         position[c->index][j] *= ((v4+v5) / v4);
9923                 }
9924                 else
9925                 {
9926                     free (position[c->index]);
9927                     free (rateMultiplier[c->index]);
9928                     position[c->index] = rateMultiplier[c->index] = NULL;
9929                 }
9930                 nEvents[c->index] = n4;
9931             }
9932             else
9933             {
9934                 for (j=0; j<nEvents[c->index]; j++)
9935                     position[c->index][j] *= ((v4+v5) / v4);
9936             }
9937 
9938             /* adjust proposal ratio */
9939             (*lnProposalRatio) += n3 * log (v3new / v3);
9940 
9941             /* adjust prior ratio */
9942             lambda = *GetParamVals (modelSettings[subParm->relParts[0]].cppRate, chain, state[chain]);
9943             (*lnPriorRatio) += lambda * (v3 - v3new);
9944 
9945             /* update effective branch lengths */
9946             if (UpdateCppEvolLengths (subParm, a, chain) == ERROR)
9947             {
9948                 abortMove = YES;
9949                 free (nSitesOfPat);
9950                 return (NO_ERROR);
9951             }
9952 
9953             if (UpdateCppEvolLengths (subParm, u, chain) == ERROR)
9954             {
9955                 abortMove = YES;
9956                 free (nSitesOfPat);
9957                 return (NO_ERROR);
9958             }
9959         }   /* end cpp events parameter */
9960         else if ( subParm->paramType == P_TK02BRANCHRATES ||
9961                  (subParm->paramType == P_MIXEDBRCHRATES && *GetParamIntVals(subParm, chain, state[chain]) == RCL_TK02))
9962         {
9963             /* adjust prior ratio */
9964             if (subParm->paramType == P_TK02BRANCHRATES)
9965                 nu = *GetParamVals (modelSettings[subParm->relParts[0]].tk02var, chain, state[chain]);
9966             else
9967                 nu = *GetParamVals (modelSettings[subParm->relParts[0]].mixedvar, chain, state[chain]);
9968             tk02Rate = GetParamVals (subParm, chain, state[chain]);
9969             (*lnPriorRatio) -= LnProbTK02LogNormal(tk02Rate[u->anc->index], nu*(c->length+u->length), tk02Rate[c->index]);
9970             (*lnPriorRatio) += LnProbTK02LogNormal(tk02Rate[c->anc->index], nu*c->length, tk02Rate[c->index]);
9971             (*lnPriorRatio) += LnProbTK02LogNormal(tk02Rate[u->anc->index], nu*u->length, tk02Rate[u->index]);
9972             if (v->length > 0.0)
9973                 (*lnPriorRatio) += LnProbTK02LogNormal(tk02Rate[v->anc->index], nu*v->length, tk02Rate[v->index]);
9974 
9975             /* adjust effective branch lengths */
9976             brlens = GetParamSubVals (subParm, chain, state[chain]);
9977             brlens[c->index] = c->length * (tk02Rate[c->index] + tk02Rate[c->anc->index]) / 2.0;
9978             brlens[v->index] = v->length * (tk02Rate[v->index] + tk02Rate[v->anc->index]) / 2.0;
9979             brlens[u->index] = u->length * (tk02Rate[u->index] + tk02Rate[u->anc->index]) / 2.0;
9980         }   /* end tk02 branch rate parameter */
9981         else if ( subParm->paramType == P_IGRBRANCHRATES ||
9982                  (subParm->paramType == P_MIXEDBRCHRATES && *GetParamIntVals(subParm, chain, state[chain]) == RCL_IGR))
9983         {
9984             /* adjust prior ratio */
9985             if (subParm->paramType == P_IGRBRANCHRATES)
9986                 igrvar = *GetParamVals (modelSettings[subParm->relParts[0]].igrvar, chain, state[chain]);
9987             else
9988                 igrvar = *GetParamVals (modelSettings[subParm->relParts[0]].mixedvar, chain, state[chain]);
9989             igrRate = GetParamVals (subParm, chain, state[chain]);
9990 
9991             (*lnPriorRatio) -= LnProbGamma ((c->length+u->length)/igrvar, (c->length+u->length)/igrvar, igrRate[c->index]);
9992             (*lnPriorRatio) += LnProbGamma (c->length/igrvar, c->length/igrvar, igrRate[c->index]);
9993             (*lnPriorRatio) += LnProbGamma (u->length/igrvar, u->length/igrvar, igrRate[u->index]);
9994             if (v->length > 0.0)
9995                 (*lnPriorRatio) += LnProbGamma (v->length/igrvar, v->length/igrvar, igrRate[v->index]);
9996 
9997             /* adjust effective branch lengths */
9998             brlens = GetParamSubVals (subParm, chain, state[chain]);
9999             brlens[v->index] = igrRate[v->index] * v->length;
10000             brlens[u->index] = igrRate[u->index] * u->length;
10001             brlens[c->index] = igrRate[c->index] * c->length;
10002         }   /* end igr branch rate parameter */
10003     }   /* next subparameter */
10004 
10005     /* set tiprobs update flags */
10006     c->upDateTi = YES;
10007     u->upDateTi = YES;
10008     v->upDateTi = YES;
10009 
10010     /* set flags for update of cond likes down to root */
10011     p = u;
10012     while (p->anc != NULL)
10013     {
10014         p->upDateCl = YES;
10015         p = p->anc;
10016     }
10017     p = b;
10018     while (p->anc != NULL)
10019     {
10020         p->upDateCl = YES;
10021         p = p->anc;
10022     }
10023 
10024     /* get down pass sequence */
10025     GetDownPass (t);
10026 
10027     /* adjust prior ratio for clock tree */
10028     if (LogClockTreePriorRatio (param, chain, &x) == ERROR)
10029     {
10030         free (nSitesOfPat);
10031         return (ERROR);
10032     }
10033     (*lnPriorRatio) += x;
10034 
10035     /* adjust proposal prob for number movable nodes in new tree */
10036     numMovableNodesNew=0;
10037     for (i=0; i<t->nNodes-2; ++i)
10038     {
10039         p = t->allDownPass[i];
10040         if (p->left == NULL)
10041         {
10042             if (p->calibration == NULL)
10043                 p->x = NO;
10044             else
10045             {
10046                 p->x = YES;
10047             }
10048         }
10049         else
10050         {
10051             if (p->left->x == YES && p->right->x == YES)
10052             {
10053                 p->x = YES;
10054             }
10055             else
10056                 p->x = NO;
10057         }
10058         a = p->anc->left;
10059         b = p->anc->right;
10060         if (p->anc->isLocked == YES || p->anc->anc->anc == NULL
10061             || (p == b && a->length < TIME_MIN) || (p == a && b->length < TIME_MIN) || p->x == NO)
10062             numMovableNodesNew++;
10063     }
10064 
10065     if (numMovableNodesNew!=numMovableNodesOld)
10066     {
10067         (*lnProposalRatio) += log (numMovableNodesOld / numMovableNodesNew);
10068     }
10069 
10070 #   if defined (DEBUG_ParsSPRClock)
10071     ShowNodes (t->root, 2, YES);
10072     printf ("After\nProposal ratio: %f\n",(*lnProposalRatio));
10073     printf ("v: %d  u: %d  a: %d  b: %d c: %d\n",v->index, u->index, a->index, b->index, c->index);
10074     getchar();
10075 #   endif
10076 
10077     free (nSitesOfPat);
10078     return (NO_ERROR);
10079 }
10080 
10081 
Move_ParsSPR(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)10082 int Move_ParsSPR (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
10083 {
10084     /* Change topology (and branch lengths) using SPR (asymmetric) biased according to parsimony scores. */
10085 
10086     int         i, j, n, division, topologyHasChanged, isVPriorExp;
10087     BitsLong    *pA, *pV, *pP, y[2];
10088     MrBFlt      x, minV, maxV, brlensExp=0.0, minLength=0.0, length=0.0,
10089                 cumulativeProb, warpFactor, ran, tuning, increaseProb, decreaseProb,
10090                 divFactor, nStates, rateMult, v_typical, sum1, sum2, tempsum, tempc, tempy;
10091     CLFlt       *nSitesOfPat, *nSites, *globalNSitesOfPat;
10092     TreeNode    *p, *q, *a, *b, *u, *v, *c=NULL, *d;
10093     Tree        *t;
10094     ModelParams *mp;
10095     ModelInfo   *m = NULL;
10096 
10097     warpFactor = mvp[0];                  /* tuning parameter determining how heavily to weight according to parsimony scores */
10098     increaseProb = decreaseProb = mvp[1]; /* reweighting probabilities */
10099     v_typical = mvp[2];                   /* typical branch length for conversion of parsimony score to log prob ratio */
10100     tuning = mvp[3];                      /* multiplier tuning parameter */
10101 
10102     (*lnProposalRatio) = (*lnPriorRatio) = 0.0;
10103 
10104     /* get model params and model info */
10105     mp = &modelParams[param->relParts[0]];
10106     m = &modelSettings[param->relParts[0]];
10107 
10108     /* get tree */
10109     t = GetTree (param, chain, state[chain]);
10110 
10111     /* max and min brlen */
10112     if (param->subParams[0]->paramId == BRLENS_UNI)
10113         {
10114         minV = mp->brlensUni[0] > BRLENS_MIN ? mp->brlensUni[0] : BRLENS_MIN;
10115         maxV = mp->brlensUni[1] < BRLENS_MAX ? mp->brlensUni[1] : BRLENS_MAX;
10116         isVPriorExp = NO;
10117         }
10118     else if (param->subParams[0]->paramId == BRLENS_GamDir)
10119         {
10120         minV = BRLENS_MIN;
10121         maxV = BRLENS_MAX;
10122         isVPriorExp = 2;
10123         }
10124     else if (param->subParams[0]->paramId == BRLENS_iGmDir)
10125         {
10126         minV = BRLENS_MIN;
10127         maxV = BRLENS_MAX;
10128         isVPriorExp = 3;
10129         }
10130     else if (param->subParams[0]->paramId == BRLENS_twoExp)
10131         {
10132         minV = BRLENS_MIN;
10133         maxV = BRLENS_MAX;
10134         isVPriorExp = 4;
10135         }
10136     else
10137         {
10138         minV = BRLENS_MIN;
10139         maxV = BRLENS_MAX;
10140         brlensExp = mp->brlensExp;
10141         isVPriorExp = YES;
10142         }
10143 
10144     /* Dirichlet or twoExp prior */
10145     if (isVPriorExp > 1)
10146         (*lnPriorRatio) = -LogDirPrior(t, mp, isVPriorExp);
10147 
10148 #   if defined (DEBUG_ParsSPR)
10149     // WriteTopologyToFile (stdout, t->root->left, t->isRooted);  fprintf (stdout, ";\t");
10150     printf ("Before:\n");
10151     ShowNodes (t->root, 2, YES);
10152     getchar();
10153 #   endif
10154 
10155     /* set topologyHasChanged to NO */
10156     topologyHasChanged = NO;    /* FIXME: Not used (from clang static analyzer) */
10157 
10158     /* reset node variables that will be used */
10159     for (i=0; i<t->nNodes; i++)
10160         {
10161         p = t->allDownPass[i];
10162         p->marked = NO;
10163         p->d = 0;
10164         }
10165 
10166     /* pick a random branch */
10167     p = t->allDownPass[(int)(RandomNumber(seed) * (t->nNodes -2))];
10168     q = p->anc->right;
10169     if (q == p)
10170         q = p->anc->left;
10171     if ((p->anc->anc->anc == NULL || p->anc->isLocked == YES) && (q->left == NULL || q->isLocked == YES))
10172         {
10173         abortMove = YES;
10174         return (NO_ERROR);
10175         }
10176 
10177     /* set up pointers for nodes around the picked branch */
10178     v = p;
10179     u = p->anc;
10180     if (u->left == v)
10181         a = u->right;
10182     else
10183         a = u->left;
10184     b = u->anc;
10185 
10186     /* clip tree */
10187     a->anc = b;
10188     if (b->left == u)
10189         b->left = a;
10190     else
10191         b->right = a;
10192 
10193     /* get final parsimony states for the root part */
10194     GetParsDP (t, t->root->left, chain);
10195     GetParsFP (t, t->root->left, chain);
10196 
10197     /* get downpass parsimony states for the crown part */
10198     GetParsDP (t, v, chain);
10199 
10200     /* mark all nodes in the root part of the tree, taking constraints into account */
10201     /* first mark a */
10202     a->marked = YES;
10203     /* then move down towards root */
10204     if (u->isLocked == NO)
10205         {
10206         p = a->anc;
10207         while (p->anc != NULL)
10208             {
10209             p->marked = YES;
10210             if (p->isLocked == YES)
10211                 break;
10212             p = p->anc;
10213             }
10214         }
10215 
10216     /* finally move up */
10217     for (i=t->nNodes-2; i>=0; i--)
10218         {
10219         p = t->allDownPass[i];
10220         if (p->marked == NO && p->anc->marked == YES && p->anc->isLocked == NO && p != u)
10221             p->marked = YES;
10222         }
10223 
10224     /* find number of site patterns and modify randomly */
10225     globalNSitesOfPat = numSitesOfPat + (chainId[chain] % chainParams.numChains) * numCompressedChars;
10226     nSitesOfPat = (CLFlt *) SafeCalloc (numCompressedChars, sizeof(CLFlt));
10227     if (!nSitesOfPat)
10228         {
10229         MrBayesPrint ("%s   Problem allocating nSitesOfPat in Move_ParsSPR\n", spacer);
10230         return (ERROR);
10231         }
10232     for (i=0; i<numCompressedChars; i++)
10233         {
10234         nSitesOfPat[i] = globalNSitesOfPat[i];
10235         for (j=0; j<globalNSitesOfPat[i]; j++)
10236             {
10237             ran = RandomNumber(seed);
10238             if (ran < decreaseProb)
10239                 nSitesOfPat[i]--;
10240             else if (ran > 1.0 - increaseProb)
10241                 nSitesOfPat[i]++;
10242             }
10243         }
10244 
10245     /* cycle through the possibilities and record the parsimony length */
10246     for (i=0; i<t->nNodes; i++)
10247         {
10248         p = t->allDownPass[i];
10249         if (p->marked == NO)
10250             continue;
10251         /* find the parsimony length */
10252         p->d = 0.0;
10253         for (n=0; n<t->nRelParts; n++)
10254             {
10255             division = t->relParts[n];
10256 
10257             /* Find model settings */
10258             m = &modelSettings[division];
10259 
10260             /* find nSitesOfPat */
10261             nSites = nSitesOfPat + m->compCharStart;
10262 
10263             /* find downpass parsimony sets for the node and its environment */
10264             pP   = m->parsSets[p->index];
10265             pA   = m->parsSets[p->anc->index];
10266             pV   = m->parsSets[v->index];
10267 
10268             length = 0.0;
10269             if (m->nParsIntsPerSite == 1)
10270                 {
10271                 for (j=0; j<m->numChars; j++)
10272                     {
10273                     y[0] = (pP[j] | pA[j]) & pV[j];
10274                     if (y[0] == 0)
10275                         length += nSites[j];
10276                     }
10277                 }
10278             else /* if (m->nParsIntsPerSite == 2) */
10279                 {
10280                 for (j=0; j<2*m->numChars; j+=2)
10281                     {
10282                     y[0] = (pP[j] | pA[j]) & pV[j];
10283                     y[1] = (pP[j+1] | pA[j+1]) & pV[j+1];
10284                     if ((y[0] | y[1]) == 0)
10285                         length += nSites[j/2];
10286                     }
10287                 }
10288 
10289             /* find nStates and ratemult */
10290             nStates = m->numModelStates;
10291             if (m->dataType == STANDARD)
10292                 nStates = 2;
10293             rateMult = GetRate(division, chain);
10294 
10295             /* get division warp factor */
10296             divFactor = - warpFactor * log((1.0/nStates) - exp(-nStates/(nStates-1)*v_typical*rateMult)/nStates);
10297 
10298             p->d += divFactor * length;
10299             }
10300         }
10301 
10302     /* find the min length and the sum for the forward move */
10303     minLength = -1.0;
10304     for (i=0; i<t->nNodes; i++)
10305         {
10306         p = t->allDownPass[i];
10307         if (p->marked == NO || p == a)
10308             continue;
10309         if (minLength < 0.0 || p->d < minLength)
10310             minLength = p->d;
10311         }
10312     sum1 = 0.0; tempc = 0.0;
10313     for (i=0; i<t->nNodes; i++)
10314         {
10315         p = t->allDownPass[i];
10316         if (p->marked == YES && p != a)
10317             {
10318             /* Kahan summation to reduce numerical error */
10319             tempy = exp (minLength - p->d) - tempc;
10320             tempsum = sum1 + tempy;
10321             tempc = (tempsum - sum1) - tempy;
10322             sum1 = tempsum;
10323             }
10324         }
10325 
10326     /* generate a random uniform */
10327     ran = RandomNumber(seed) * sum1;
10328 
10329     /* select the appropriate reattachment point */
10330     cumulativeProb = 0.0; tempc = 0.0;
10331     for (i=0; i<t->nNodes; i++)
10332         {
10333         p = t->allDownPass[i];
10334         if (p->marked == YES && p != a)
10335             {
10336             c = p;
10337             /* Kahan summation to reduce numerical error */
10338             tempy = exp (minLength - p->d) - tempc;
10339             tempsum = cumulativeProb + tempy;
10340             tempc = (tempsum - cumulativeProb) - tempy;
10341             cumulativeProb = tempsum;
10342             if (cumulativeProb > ran)
10343                 break;
10344             }
10345         }
10346 
10347     /* calculate the proposal ratio */
10348     (*lnProposalRatio) = c->d - minLength + log(sum1);
10349 
10350     /* find the min length and the sum for the backward move */
10351     minLength = -1.0;
10352     for (i=0; i<t->nNodes; i++)
10353         {
10354         p = t->allDownPass[i];
10355         if (p->marked == NO || p == c)
10356             continue;
10357         if (minLength < 0.0 || p->d < minLength)
10358             minLength = p->d;
10359         }
10360     sum2 = 0.0; tempc = 0.0;
10361     for (i=0; i<t->nNodes; i++)
10362         {
10363         p = t->allDownPass[i];
10364         if (p->marked == YES && p != c)
10365             {
10366             /* Kahan summation to reduce numerical error */
10367             tempy = exp (minLength - p->d) - tempc;
10368             tempsum = sum2 + tempy;
10369             tempc = (tempsum - sum2) - tempy;
10370             sum2 = tempsum;
10371             }
10372         }
10373 
10374     /* calculate the proposal ratio */
10375     (*lnProposalRatio) += minLength - a->d - log(sum2);
10376 
10377     /* reattach */
10378     d = c->anc;
10379     c->anc = u;
10380     if (u->left == v)
10381         u->right = c;
10382     else
10383         u->left = c;
10384     if (d->left == c)
10385         d->left = u;
10386     else
10387         d->right = u;
10388     u->anc = d;
10389 
10390     /* c cannot be a, as a is skiped in the selection for reattachment point */
10391     assert (c != a);
10392     /* transfer lock if necessary */
10393     /* if u is locked, then we have moved upwards and need to leave the u lock behind */
10394     if (u->isLocked == YES)
10395         {
10396         u->isLocked = NO;
10397         a->isLocked = YES;
10398         a->lockID = u->lockID;
10399         u->lockID = -1;
10400         }
10401     /* if c is on root path and locked, we need to transfer lock to u */
10402     p = b;
10403     while (p != NULL)
10404         {
10405         if (p == c)
10406             break;
10407         p = p->anc;
10408         }
10409     if (p == c && c->isLocked == YES)
10410         {
10411         u->isLocked = YES;
10412         u->lockID = c->lockID;
10413         c->isLocked = NO;
10414         c->lockID = -1;
10415         }
10416 
10417     /* reassign branch lengths */
10418     p = c;
10419     while (p->anc->anc != NULL)
10420         {
10421         if (p == a)
10422             break;
10423         p = p->anc;
10424         }
10425     if (p == a)
10426         {
10427         /* c is descendant to a so move a->length and not u->length */
10428         x = u->length;
10429         u->length = a->length;
10430         a->length = x;
10431         }
10432     p = a;
10433     while (p->anc->anc != NULL)
10434         {
10435         if (p == c)
10436             break;
10437         p = p->anc;
10438         }
10439     if (p == c)
10440         {
10441         /* c is ancestor to a so insert above instead of below */
10442         x = c->length;
10443         c->length = u->length;
10444         u->length = x;
10445         }
10446 
10447     topologyHasChanged = YES;
10448 
10449     /* hit c length with multiplier (a and u dealt with below) */
10450     x = c->length * exp(tuning * (RandomNumber(seed) - 0.5));
10451     while (x < minV || x > maxV)
10452         {
10453         if (x < minV)
10454             x = minV * minV / x;
10455         else if (x > maxV)
10456             x = maxV * maxV / x;
10457         }
10458     /* calculate proposal and prior ratio based on length modification */
10459     (*lnProposalRatio) += log (x / c->length);
10460     if (isVPriorExp == YES)
10461         (*lnPriorRatio) += brlensExp * (c->length - x);
10462     c->length = x;
10463 
10464     /* hit a length with multiplier */
10465     x = a->length * exp(tuning * (RandomNumber(seed) - 0.5));
10466     while (x < minV || x > maxV)
10467         {
10468         if (x < minV)
10469             x = minV * minV / x;
10470         else if (x > maxV)
10471             x = maxV * maxV / x;
10472         }
10473     /* calculate proposal and prior ratio based on length modification */
10474     (*lnProposalRatio) += log (x / a->length);
10475     if (isVPriorExp == YES)
10476         (*lnPriorRatio) += brlensExp * (a->length - x);
10477     a->length = x;
10478 
10479     /* hit u length with multiplier */
10480     x = u->length * exp(tuning * (RandomNumber(seed) - 0.5));
10481     while (x < minV || x > maxV)
10482         {
10483         if (x < minV)
10484             x = minV * minV / x;
10485         else if (x > maxV)
10486             x = maxV * maxV / x;
10487         }
10488     /* calculate proposal and prior ratio based on length modification */
10489     (*lnProposalRatio) += log (x / u->length);
10490     if (isVPriorExp == YES)
10491         (*lnPriorRatio) += brlensExp * (u->length - x);
10492     u->length = x;
10493 
10494     /* set tiprobs update flags */
10495     a->upDateTi = YES;
10496     u->upDateTi = YES;
10497     c->upDateTi = YES;  /* could be same as a but that does not matter */
10498 
10499     /* set flags for update of cond likes from u and down to root */
10500     p = u;
10501     while (p->anc != NULL)
10502         {
10503         p->upDateCl = YES;
10504         p = p->anc;
10505         }
10506 
10507     /* set flags for update of cond likes from b and down to root */
10508     p = b;
10509     while (p->anc != NULL && p->upDateCl == NO)
10510         {
10511         p->upDateCl = YES;
10512         p = p->anc;
10513         }
10514 
10515     /* get down pass sequence if tree topology has changed */
10516     if (topologyHasChanged == YES)
10517         {
10518         GetDownPass (t);
10519         }
10520 
10521     /* Dirichlet or twoExp prior */
10522     if (isVPriorExp > 1)
10523         (*lnPriorRatio) += LogDirPrior(t, mp, isVPriorExp);
10524 
10525 #   if defined (DEBUG_ParsSPR)
10526     // WriteTopologyToFile (stdout, t->root->left, t->isRooted);
10527     // fprintf (stdout, ";\t");  fprintf (stdout, "%lf\n", *lnProposalRatio);
10528     printf ("After:\n");
10529     ShowNodes (t->root, 2, YES);
10530     getchar();
10531     printf ("Proposal ratio: %f\n",(*lnProposalRatio));
10532     printf ("v: %d  u: %d  a: %d  b: %d\n",v->index, u->index, a->index, b->index);
10533     printf ("Has topology changed? %d\n",topologyHasChanged);
10534     getchar();
10535 #   endif
10536 
10537     free (nSitesOfPat);
10538 
10539     return (NO_ERROR);
10540 }
10541 
10542 
Move_ParsSPR1(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)10543 int Move_ParsSPR1 (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
10544 {
10545     /* Change topology (and branch lengths) using SPR (symmetric) biased according to parsimony scores,
10546        controlled by a window defined by a certain node distance radius. Note: w = e^{-S} */
10547 
10548     int         i, j, k, n, division, topologyHasChanged, moveInRoot, nNeighbor, nRoot, nCrown, iA, jC, isVPriorExp;
10549     BitsLong    *pA, *pB, *pP, *pC, *pD, y[2];
10550     MrBFlt      x, minV, maxV, brlensExp=0.0, minLength=0.0, length=0.0, *parLength=NULL, prob, ran, tuning, warpFactor,
10551                 sum1, sum2, tempsum, tempc, tempy;
10552     CLFlt       *nSites, *nSitesOfPat=NULL, *globalNSitesOfPat;
10553     TreeNode    *p, *q, *r, *a, *b, *u, *v, *c, *d, *newB, *newA, *newC, **pRoot=NULL, **pCrown=NULL;
10554     Tree        *t;
10555     ModelParams *mp;
10556     ModelInfo   *m=NULL;
10557 
10558     warpFactor = mvp[0];                  /* tuning parameter determining how heavily to weight according to parsimony scores */
10559 //  increaseProb = decreaseProb = mvp[1]; /* reweighting probabilities */
10560 //  v_typical = mvp[2];                   /* typical branch length for conversion of parsimony score to log prob ratio */
10561     tuning = mvp[3];                      /* multiplier tuning parameter */
10562     nNeighbor = (int)mvp[4];              /* distance to move picked branch in root and crown part */
10563 
10564     (*lnProposalRatio) = (*lnPriorRatio) = 0.0;
10565 
10566     /* get model params and model info */
10567     mp = &modelParams[param->relParts[0]];
10568     m = &modelSettings[param->relParts[0]];
10569 
10570     /* get tree */
10571     t = GetTree (param, chain, state[chain]);
10572 
10573     /* max and min brlen */
10574     if (param->subParams[0]->paramId == BRLENS_UNI)
10575         {
10576         minV = mp->brlensUni[0] > BRLENS_MIN ? mp->brlensUni[0] : BRLENS_MIN;
10577         maxV = mp->brlensUni[1] < BRLENS_MAX ? mp->brlensUni[1] : BRLENS_MAX;
10578         isVPriorExp = NO;
10579         }
10580     else if (param->subParams[0]->paramId == BRLENS_GamDir)
10581         {
10582         minV = BRLENS_MIN;
10583         maxV = BRLENS_MAX;
10584         isVPriorExp = 2;
10585         }
10586     else if (param->subParams[0]->paramId == BRLENS_iGmDir)
10587         {
10588         minV = BRLENS_MIN;
10589         maxV = BRLENS_MAX;
10590         isVPriorExp = 3;
10591         }
10592     else if (param->subParams[0]->paramId == BRLENS_twoExp)
10593         {
10594         minV = BRLENS_MIN;
10595         maxV = BRLENS_MAX;
10596         isVPriorExp = 4;
10597         }
10598     else
10599         {
10600         minV = BRLENS_MIN;
10601         maxV = BRLENS_MAX;
10602         brlensExp = mp->brlensExp;
10603         isVPriorExp = YES;
10604         }
10605 
10606     /* Dirichlet or twoExp prior */
10607     if (isVPriorExp > 1)
10608         (*lnPriorRatio) = -LogDirPrior(t, mp, isVPriorExp);
10609 
10610     /* set topologyHasChanged to NO */
10611     topologyHasChanged = NO;    /* FIXME: Not used (from clang static analyzer) */
10612 
10613     /* pick a random branch */
10614     do  {
10615         p = t->allDownPass[(int)(RandomNumber(seed) * (t->nNodes -1))];
10616         q = p->anc->right;  if (q == p) q = p->anc->left;
10617         i = j = 0;
10618         if (p->left == NULL)
10619             j = 2;
10620         if (p->anc->anc == NULL)
10621             i = 2;
10622         if (p->anc->anc != NULL && (p->anc->isLocked == YES || p->anc->anc->anc == NULL))
10623             i++;
10624         if (p->anc->anc != NULL && (q->isLocked == YES || q->left == NULL))
10625             i++;
10626         if (p->left != NULL && (p->left->isLocked == YES || p->left->left == NULL))
10627             j++;
10628         if (p->left != NULL && (p->right->isLocked == YES || p->right->left == NULL))
10629             j++;
10630         } while (i == 2 && j == 2);
10631 
10632     /* determine moving direction */
10633     if (j == 2)
10634         moveInRoot = YES;
10635     else if (i == 2)
10636         moveInRoot = NO;
10637     else if (RandomNumber(seed) < 0.5)
10638         moveInRoot = YES;
10639     else
10640         moveInRoot = NO;
10641 
10642     /* set up pointers for nodes around the picked branch */
10643     /* should never change u, v, a, b, c, d pointers */
10644     v = p;
10645     u = p->anc;
10646     if (u->left == v)
10647         a = u->right;
10648     else
10649         a = u->left;
10650     b = u->anc;
10651     c = v->left;
10652     d = v->right;
10653 
10654     /* reset node variables that will be used */
10655     for (i=0; i<t->nNodes; i++)
10656         {
10657         p = t->allDownPass[i];
10658         p->x = 0;
10659         p->marked = NO;
10660         }
10661 
10662     /* mark nodes nNeighbor away in root (negative) or crown (positive) respecting constraints */
10663     nRoot = nCrown = 1;
10664     if (moveInRoot == YES)
10665         {
10666         /* clip root part of tree */
10667         a->anc = b;
10668         if (b->left == u)
10669             b->left = a;
10670         else
10671             b->right = a;
10672 
10673         /* mark the root part */
10674         if (u->isLocked == NO )
10675             {
10676             p = a; q = b; n = 0;
10677             while (q->anc != NULL)
10678                 {
10679                 q->marked = YES;
10680                 q->x = n;    // temporary, for MarkDistance below
10681                 if (q->left == p)
10682                     MarkDistance(q->right, YES, nNeighbor, &nRoot);
10683                 else
10684                     MarkDistance(q->left,  YES, nNeighbor, &nRoot);
10685                 q->x = --n;  // final
10686                 nRoot++;
10687                 if (q->isLocked == YES || abs(q->x) >= nNeighbor)
10688                     break;
10689                 p = q; q = q->anc;
10690                 }
10691             }
10692         if (a->isLocked == NO)
10693             {
10694             MarkDistance(a->left,  YES, nNeighbor, &nRoot);
10695             MarkDistance(a->right, YES, nNeighbor, &nRoot);
10696             }
10697 
10698         /* get final parsimony states for the root part */
10699         GetParsDP (t, t->root->left, chain);
10700         GetParsFP (t, t->root->left, chain);
10701         /* get final parsimony states for the crown part */
10702         GetParsDP (t, v, chain);
10703         GetParsFP (t, v, chain);
10704         }
10705     else  /* moveInRoot == NO */
10706         {
10707         /* clip crown part of tree */
10708         c->anc = d;
10709         d->anc = c;
10710 
10711         /* mark the crown part */
10712         if (c->isLocked == NO)
10713             {
10714             MarkDistance(c->left,  NO, nNeighbor, &nCrown);
10715             MarkDistance(c->right, NO, nNeighbor, &nCrown);
10716             }
10717         if (d->isLocked == NO)
10718             {
10719             MarkDistance(d->left,  NO, nNeighbor, &nCrown);
10720             MarkDistance(d->right, NO, nNeighbor, &nCrown);
10721             }
10722 
10723         /* get final parsimony states for the root part */
10724         if (u->anc != NULL) {
10725             a->anc = b;  /* clip */
10726             if (b->left == u) b->left = a;
10727             else             b->right = a;
10728             GetParsDP (t, t->root->left, chain);
10729             GetParsFP (t, t->root->left, chain);
10730             a->anc = u;  /* change back */
10731             if (b->left == a) b->left = u;
10732             else             b->right = u;
10733             }
10734         /* get final parsimony states for the crown part */
10735         GetParsDP (t, c, chain);
10736         GetParsDP (t, d, chain);
10737         GetParsFP (t, c, chain);
10738         GetParsFP (t, d, chain);
10739         }
10740 
10741     /* find number of site patterns and modify randomly */
10742     globalNSitesOfPat = numSitesOfPat + (chainId[chain] % chainParams.numChains) * numCompressedChars;
10743     nSitesOfPat = (CLFlt *) SafeCalloc (numCompressedChars, sizeof(CLFlt));
10744     if (!nSitesOfPat)  goto errorExit;
10745     for (i=0; i<numCompressedChars; i++)
10746         {
10747         nSitesOfPat[i] = globalNSitesOfPat[i];
10748     /*  for (j=0; j<globalNSitesOfPat[i]; j++)
10749             {
10750             ran = RandomNumber(seed);
10751             if (ran < decreaseProb)
10752                 nSitesOfPat[i]--;
10753             else if (ran > 1.0 - increaseProb)
10754                 nSitesOfPat[i]++;
10755             }  // this is slow at the moment */
10756         }
10757 
10758     /* need to alloc a matrix for parsimony lengths, an array of pointers to crown part,
10759        and an array of pointers to root part. */
10760     parLength = (MrBFlt *) SafeCalloc ((size_t)nRoot * (size_t)nCrown, sizeof(MrBFlt));
10761     pRoot  = (TreeNode **) SafeCalloc(nRoot,  sizeof(TreeNode *));
10762     pCrown = (TreeNode **) SafeCalloc(nCrown, sizeof(TreeNode *));
10763     if (!parLength || !pRoot || !pCrown)  goto errorExit;
10764 
10765     /* starting position */
10766     pRoot[0] = a; pCrown[0] = c;
10767     for (i=j=1, n=t->nNodes-2; n>=0; n--)
10768         {  /* and the rest */
10769         p = t->allDownPass[n];
10770         if (p->marked == YES && p->x < 0)
10771             pRoot[i++] = p;
10772         if (p->marked == YES && p->x > 0)
10773             pCrown[j++] = p;
10774         }
10775     assert (i==nRoot && j==nCrown);
10776 
10777     /* cycle through the possibilities and record the parsimony length */
10778     for (j=0; j<nCrown; j++)
10779         {
10780         for (i=0; i<nRoot; i++)
10781             {
10782             parLength[i+j*nRoot] = 0.0;
10783             for (n=0; n<t->nRelParts; n++)
10784                 {
10785                 division = t->relParts[n];
10786 
10787                 /* Find model settings */
10788                 m = &modelSettings[division];
10789 
10790                 /* find nSitesOfPat */
10791                 nSites = nSitesOfPat + m->compCharStart;
10792 
10793                 /* find parsimony length for each candidate position */
10794                 length = 0.0;
10795                 if (moveInRoot == YES)
10796                     {
10797                     pA = m->parsSets[pRoot[i]->index];
10798                     pB = m->parsSets[pRoot[i]->anc->index];
10799                     pP = m->parsSets[v->index];
10800 
10801                     if (m->nParsIntsPerSite == 1)
10802                         {
10803                         for (k=0; k<m->numChars; k++)
10804                             {
10805                             y[0] = (pA[k] | pB[k]) & pP[k];
10806                             if (y[0] == 0)
10807                                 length += nSites[k];
10808                             }
10809                         }
10810                     else /* if (m->nParsIntsPerSite == 2) */
10811                         {
10812                         for (k=0; k<2*m->numChars; k+=2)
10813                             {
10814                             y[0] = (pA[k] | pB[k]) & pP[k];
10815                             y[1] = (pA[k+1] | pB[k+1]) & pP[k+1];
10816                             if ((y[0] | y[1]) == 0)
10817                                 length += nSites[k/2];
10818                             }
10819                         }
10820                     }
10821                 else if (u->anc == NULL)
10822                     {
10823                     pP = m->parsSets[u->index];
10824                     pC = m->parsSets[pCrown[j]->index];
10825                     pD = m->parsSets[pCrown[j]->anc->index];
10826 
10827                     if (m->nParsIntsPerSite == 1)
10828                         {
10829                         for (k=0; k<m->numChars; k++)
10830                             {
10831                             y[0] = pP[k] & (pC[k] | pD[k]);
10832                             if (y[0] == 0)
10833                                 length += nSites[k];
10834                             }
10835                         }
10836                     else /* if (m->nParsIntsPerSite == 2) */
10837                         {
10838                         for (k=0; k<2*m->numChars; k+=2)
10839                             {
10840                             y[0] = pP[k] & (pC[k] | pD[k]);
10841                             y[1] = pP[k+1] & (pC[k+1] | pD[k+1]);
10842                             if ((y[0] | y[1]) == 0)
10843                                 length += nSites[k/2];
10844                             }
10845                         }
10846                     }
10847                 else
10848                     {
10849                     pA = m->parsSets[a->index];
10850                     pB = m->parsSets[b->index];
10851                     pC = m->parsSets[pCrown[j]->index];
10852                     pD = m->parsSets[pCrown[j]->anc->index];
10853 
10854                     if (m->nParsIntsPerSite == 1)
10855                         {
10856                         for (k=0; k<m->numChars; k++)
10857                             {
10858                             y[0] = (pA[k] | pB[k]) & (pC[k] | pD[k]);
10859                             if (y[0] == 0)
10860                                 length += nSites[k];
10861                             }
10862                         }
10863                     else /* if (m->nParsIntsPerSite == 2) */
10864                         {
10865                         for (k=0; k<2*m->numChars; k+=2)
10866                             {
10867                             y[0] = (pA[k] | pB[k]) & (pC[k] | pD[k]);
10868                             y[1] = (pA[k+1] | pB[k+1]) & (pC[k+1] | pD[k+1]);
10869                             if ((y[0] | y[1]) == 0)
10870                                 length += nSites[k/2];
10871                             }
10872                         }
10873                     }
10874 
10875                 /* get division warp factor */
10876                 parLength[i+j*nRoot] += warpFactor * length;
10877                 }
10878             }
10879         }
10880 
10881     /* find the min length and the sum for the forward move */
10882     minLength = -1.0;
10883     for (j=0; j<nCrown; j++)
10884         for (i=0; i<nRoot; i++)
10885             {
10886             if (i == 0 && j == 0)  // exclude original position
10887                 continue;
10888             if (minLength > parLength[i+j*nRoot] || minLength < 0.0)
10889                 minLength = parLength[i+j*nRoot];
10890             }
10891     sum1 = 0.0; tempc = 0.0;
10892     for (j=0; j<nCrown; j++)
10893         for (i=0; i<nRoot; i++)
10894             {
10895             if (i == 0 && j == 0)  // exclude original position
10896                 continue;
10897             /* Kahan summation to reduce numerical error */
10898             tempy = exp(minLength - parLength[i+j*nRoot]) - tempc;
10899             tempsum = sum1 + tempy;  tempc = (tempsum - sum1) - tempy;
10900             sum1 = tempsum;
10901             // sum1 += exp(minLength - parLength[i+j*nRoot]);
10902             // printf("%d %d %lf\n", i, j, exp(minLength - parLength[i+j*nRoot]));
10903             }
10904 
10905     /* generate a random uniform */
10906     ran = RandomNumber(seed) * sum1;
10907 
10908     /* select the appropriate reattachment point */
10909     newA = a; newC = c;
10910     prob = 0.0; tempc = 0.0;
10911     for (j=0; j<nCrown; j++)
10912         for (i=0; i<nRoot; i++)
10913             {
10914             if (i == 0 && j == 0)  // exclude original position
10915                 continue;
10916             // prob += exp (minLength - parLength[i+j*nRoot]);
10917             /* Kahan summation to reduce numerical error */
10918             tempy = exp(minLength - parLength[i+j*nRoot]) - tempc;
10919             tempsum = prob + tempy;  tempc = (tempsum - prob) - tempy;
10920             prob = tempsum;
10921             if (prob > ran) {
10922                 /* proposed new attaching position */
10923                 newA = pRoot[i];
10924                 newC = pCrown[j];
10925                 goto outLoop;
10926                 }
10927             }
10928 outLoop:;
10929     iA = i; jC = j;
10930 
10931     /* calculate the proposal ratio */
10932     (*lnProposalRatio) = parLength[i+j*nRoot] - minLength + log(sum1);
10933 
10934     /* find the min length and the sum for the backward move */
10935     minLength = -1.0;
10936     for (j=0; j<nCrown; j++)
10937         for (i=0; i<nRoot; i++)
10938             {
10939             if (i == iA && j == jC)  // exclude new position
10940                 continue;
10941             if (minLength > parLength[i+j*nRoot] || minLength < 0.0)
10942                 minLength = parLength[i+j*nRoot];
10943             }
10944     sum2 = 0.0; tempc = 0.0;
10945     for (j=0; j<nCrown; j++)
10946         for (i=0; i<nRoot; i++)
10947             {
10948             if (i == iA && j == jC)  // exclude new position
10949                 continue;
10950             /* Kahan summation to reduce numerical error */
10951             tempy = exp(minLength - parLength[i+j*nRoot]) - tempc;
10952             tempsum = sum2 + tempy;  tempc = (tempsum - sum2) - tempy;
10953             sum2 = tempsum;
10954             // sum2 += exp (minLength - parLength[i+j*nRoot]);
10955             // printf("%d %d %lf\n", i, j, exp(minLength - parLength[i+j*nRoot]));
10956             }
10957 
10958     /* calculate the proposal ratio */
10959     (*lnProposalRatio) += minLength - parLength[0] - log(sum2);
10960 
10961     if (moveInRoot == YES)  /* root part has changed */
10962         {
10963         /* reattach the root part */
10964         newB = newA->anc;
10965         newA->anc = u;
10966         if (u->left == v)
10967             u->right = newA;
10968         else
10969             u->left = newA;
10970         u->anc = newB;
10971         if (newB->left == newA)
10972             newB->left = u;
10973         else
10974             newB->right = u;
10975 
10976         /* if u is locked, then we have moved upwards and need to leave the u lock behind */
10977         if (u->isLocked == YES)
10978             {
10979             u->isLocked = NO;
10980             a->isLocked = YES;
10981             a->lockID = u->lockID;
10982             u->lockID = -1;
10983             }
10984 
10985         p = newA;
10986         while (p->anc != NULL)
10987             {
10988             if (p == a) break;
10989             p = p->anc;
10990             }
10991         if (p == a)
10992             {
10993             /* newA is descendant to a so move a->length not u->length */
10994             x = u->length;
10995             u->length = a->length;
10996             a->length = x;
10997             }
10998 
10999         p = b;
11000         while (p->anc != NULL)
11001             {
11002             if (p == newA) break;
11003             p = p->anc;
11004             }
11005         if (p == newA)
11006             {
11007             /* newA is ancestor to a so insert above instead of below */
11008             x = newA->length;
11009             newA->length = u->length;
11010             u->length = x;
11011             /* newA is on root path and locked, we need to transfer lock to u */
11012             if (newA->isLocked == YES) {
11013                 u->isLocked = YES;
11014                 u->lockID = newA->lockID;
11015                 newA->isLocked = NO;
11016                 newA->lockID = -1;
11017                 }
11018             }
11019 
11020         /* hit a length with multiplier */
11021         x = a->length * exp(tuning * (RandomNumber(seed) - 0.5));
11022         while (x < minV || x > maxV)
11023             {
11024             if (x < minV) x = minV * minV / x;
11025             if (x > maxV) x = maxV * maxV / x;
11026             }
11027         /* calculate proposal and prior ratio based on length modification */
11028         (*lnProposalRatio) += log (x / a->length);
11029         if (isVPriorExp == YES)
11030             (*lnPriorRatio) += brlensExp * (a->length - x);
11031         a->length = x;
11032 
11033         /* hit u length with multiplier */
11034         x = u->length * exp(tuning * (RandomNumber(seed) - 0.5));
11035         while (x < minV || x > maxV)
11036             {
11037             if (x < minV) x = minV * minV / x;
11038             if (x > maxV) x = maxV * maxV / x;
11039             }
11040         /* calculate proposal and prior ratio based on length modification */
11041         (*lnProposalRatio) += log (x / u->length);
11042         if (isVPriorExp == YES)
11043             (*lnPriorRatio) += brlensExp * (u->length - x);
11044         u->length = x;
11045 
11046         /* hit newA length with multiplier */
11047         x = newA->length * exp(tuning * (RandomNumber(seed) - 0.5));
11048         while (x < minV || x > maxV)
11049             {
11050             if (x < minV) x = minV * minV / x;
11051             if (x > maxV) x = maxV * maxV / x;
11052             }
11053         /* calculate proposal and prior ratio based on length modification */
11054         (*lnProposalRatio) += log (x / newA->length);
11055         if (isVPriorExp == YES)
11056             (*lnPriorRatio) += brlensExp * (newA->length - x);
11057         newA->length = x;
11058 
11059         /* set tiprobs update flags */
11060         newA->upDateTi = YES;
11061         a->upDateTi = YES;
11062         u->upDateTi = YES;
11063 
11064         /* set flags for update of cond likes */
11065         p = u;
11066         while (p->anc != NULL)
11067             {
11068             p->upDateCl = YES;
11069             p = p->anc;
11070             }
11071         p = b;
11072         while (p->anc != NULL)
11073             {
11074             p->upDateCl = YES;
11075             p = p->anc;
11076             }
11077         }
11078 
11079     if (moveInRoot == NO)  /* crown part has changed */
11080         {
11081         r = newC;
11082         q = newB = newC->anc;
11083         /* rotate nodes from newC to c or d (whichever is closest) */
11084         tempc = r->length;
11085         while (r != c && r != d)
11086             {
11087             p = q->anc;
11088             /* rotate pointers of q */
11089             if (q->left == r)
11090                 q->left = p;
11091             else
11092                 q->right = p;
11093             q->anc = r;
11094             /* swap q and old */
11095             tempy = q->length;
11096             q->length = tempc;
11097             q->upDateTi = YES;
11098             tempc = tempy;
11099             /* make sure we get q and r initialized for next round */
11100             r = q;
11101             q = p;
11102             }
11103         newB->length = tempc;
11104 
11105         /* hit q length with multiplier while we are at it */
11106         x = q->length * exp(tuning * (RandomNumber(seed) - 0.5));
11107         while (x < minV || x > maxV)
11108             {
11109             if (x < minV) x = minV * minV / x;
11110             if (x > maxV) x = maxV * maxV / x;
11111             }
11112         /* calculate proposal and prior ratio based on length modification */
11113         (*lnProposalRatio) += log (x / q->length);
11114         if (isVPriorExp == YES)
11115             (*lnPriorRatio) += brlensExp * (q->length - x);
11116         q->length = x;
11117         q->upDateTi = YES;
11118 
11119         /* hit newB length with multiplier */
11120         x = newB->length * exp(tuning * (RandomNumber(seed) - 0.5));
11121         while (x < minV || x > maxV)
11122             {
11123             if (x < minV) x = minV * minV / x;
11124             if (x > maxV) x = maxV * maxV / x;
11125             }
11126         /* calculate proposal and prior ratio based on length modification */
11127         (*lnProposalRatio) += log (x / newB->length);
11128         if (isVPriorExp == YES)
11129             (*lnPriorRatio) += brlensExp * (newB->length - x);
11130         newB->length = x;
11131         newB->upDateTi = YES;
11132 
11133         /* hit newC length with multiplier */
11134         x = newC->length * exp(tuning * (RandomNumber(seed) - 0.5));
11135         while (x < minV || x > maxV)
11136             {
11137             if (x < minV) x = minV * minV / x;
11138             if (x > maxV) x = maxV * maxV / x;
11139             }
11140         /* calculate proposal and prior ratio based on length modification */
11141         (*lnProposalRatio) += log (x / newC->length);
11142         if (isVPriorExp == YES)
11143             (*lnPriorRatio) += brlensExp * (newC->length - x);
11144         newC->length = x;
11145         newC->upDateTi = YES;
11146 
11147         /* reattach the crown part */
11148         v->left = newC;
11149         v->right = newB;
11150         newC->anc = newB->anc = v;
11151 
11152         /* set flags for update of cond likes */
11153         p = newC;
11154         while (p->anc != NULL)
11155             {
11156             p->upDateCl = YES;
11157             p = p->anc;
11158             }
11159         p = r;
11160         while (p->anc != NULL)
11161             {
11162             p->upDateCl = YES;
11163             p = p->anc;
11164             }
11165         }
11166 
11167     topologyHasChanged = YES;
11168 
11169     /* get down pass sequence if tree topology has changed */
11170     if (topologyHasChanged == YES)
11171         {
11172         GetDownPass (t);
11173         }
11174 
11175     /* Dirichlet or twoExp prior */
11176     if (isVPriorExp > 1)
11177         (*lnPriorRatio) += LogDirPrior(t, mp, isVPriorExp);
11178 
11179     /* free up local memory */
11180     free (parLength); free (pRoot); free (pCrown); free (nSitesOfPat);
11181 
11182     return (NO_ERROR);
11183 
11184 errorExit:
11185     MrBayesPrint ("%s   Problem allocating memory in Move_ParsSPR\n", spacer);
11186     free (parLength); free (pRoot); free (pCrown); free (nSitesOfPat);
11187 
11188     return (ERROR);
11189 }
11190 
11191 
Move_ParsSPR2(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)11192 int Move_ParsSPR2 (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
11193 {
11194     /* Change topology (and branch lengths) using SPR (symmetric) biased according to parsimony scores,
11195        controlled by a window defined by a certain node distance radius. Note: S/N */
11196 
11197     int         i, j, k, n, division, topologyHasChanged, moveInRoot, nNeighbor, nRoot, nCrown, iA, jC, isVPriorExp;
11198     BitsLong    *pA, *pB, *pP, *pC, *pD, y[2];
11199     MrBFlt      x, minV, maxV, brlensExp=0.0, minLength=0.0, length=0.0, *parLength=NULL, prob, ran, tuning, warpFactor,
11200                 v_typical, divFactor, nStates, sum1, sum2, tempsum, tempc, tempy;
11201     CLFlt       *nSites, *nSitesOfPat=NULL, *globalNSitesOfPat;
11202     TreeNode    *p, *q, *r, *a, *b, *u, *v, *c, *d, *newB, *newA, *newC, **pRoot=NULL, **pCrown=NULL;
11203     Tree        *t;
11204     ModelParams *mp;
11205     ModelInfo   *m=NULL;
11206 
11207     warpFactor = mvp[0];                  /* tuning parameter determining how heavily to weight according to parsimony scores */
11208 //  increaseProb = decreaseProb = mvp[1]; /* reweighting probabilities */
11209     v_typical = mvp[2];                   /* typical branch length for conversion of parsimony score to log prob ratio */
11210     tuning = mvp[3];                      /* multiplier tuning parameter */
11211     nNeighbor = (int)mvp[4];              /* distance to move picked branch in root and crown part */
11212 
11213     (*lnProposalRatio) = (*lnPriorRatio) = 0.0;
11214 
11215     /* get model params and model info */
11216     mp = &modelParams[param->relParts[0]];
11217     m = &modelSettings[param->relParts[0]];
11218 
11219     /* get tree */
11220     t = GetTree (param, chain, state[chain]);
11221 
11222     /* max and min brlen */
11223     if (param->subParams[0]->paramId == BRLENS_UNI)
11224         {
11225         minV = mp->brlensUni[0] > BRLENS_MIN ? mp->brlensUni[0] : BRLENS_MIN;
11226         maxV = mp->brlensUni[1] < BRLENS_MAX ? mp->brlensUni[1] : BRLENS_MAX;
11227         isVPriorExp = NO;
11228         }
11229     else if (param->subParams[0]->paramId == BRLENS_GamDir)
11230         {
11231         minV = BRLENS_MIN;
11232         maxV = BRLENS_MAX;
11233         isVPriorExp = 2;
11234         }
11235     else if (param->subParams[0]->paramId == BRLENS_iGmDir)
11236         {
11237         minV = BRLENS_MIN;
11238         maxV = BRLENS_MAX;
11239         isVPriorExp = 3;
11240         }
11241     else if (param->subParams[0]->paramId == BRLENS_twoExp)
11242         {
11243         minV = BRLENS_MIN;
11244         maxV = BRLENS_MAX;
11245         isVPriorExp = 4;
11246         }
11247     else
11248         {
11249         minV = BRLENS_MIN;
11250         maxV = BRLENS_MAX;
11251         brlensExp = mp->brlensExp;
11252         isVPriorExp = YES;
11253         }
11254 
11255     /* Dirichlet or twoExp prior */
11256     if (isVPriorExp > 1)
11257         (*lnPriorRatio) = -LogDirPrior(t, mp, isVPriorExp);
11258 
11259     /* set topologyHasChanged to NO */
11260     topologyHasChanged = NO;    /* FIXME: Not used (from clang static analyzer) */
11261 
11262     /* pick a random branch */
11263     do  {
11264         p = t->allDownPass[(int)(RandomNumber(seed) * (t->nNodes -1))];
11265         q = p->anc->right;  if (q == p) q = p->anc->left;
11266         i = j = 0;
11267         if (p->left == NULL)
11268             j = 2;
11269         if (p->anc->anc == NULL)
11270             i = 2;
11271         if (p->anc->anc != NULL && (p->anc->isLocked == YES || p->anc->anc->anc == NULL))
11272             i++;
11273         if (p->anc->anc != NULL && (q->isLocked == YES || q->left == NULL))
11274             i++;
11275         if (p->left != NULL && (p->left->isLocked == YES || p->left->left == NULL))
11276             j++;
11277         if (p->left != NULL && (p->right->isLocked == YES || p->right->left == NULL))
11278             j++;
11279         } while (i == 2 && j == 2);
11280 
11281     /* pick an internal branch
11282     do  {
11283         p = t->intDownPass[(int)(RandomNumber(seed)*(t->nIntNodes-1))];
11284         q = p->anc->left;  if (q == p)  q = p->anc->right;
11285         i = j = 0;
11286         if (q->isLocked == YES || q->left == NULL)
11287             i++;
11288         if (p->anc->isLocked == YES || p->anc->anc->anc == NULL)
11289             i++;
11290         if (p->left->isLocked == YES || p->left->left == NULL)
11291             j++;
11292         if (p->right->isLocked == YES || p->right->left == NULL)
11293             j++;
11294         } while (i == 2 && j == 2);
11295     */
11296 
11297     /* determine moving direction */
11298     if (j == 2)
11299         moveInRoot = YES;
11300     else if (i == 2)
11301         moveInRoot = NO;
11302     else if (RandomNumber(seed) < 0.5)
11303         moveInRoot = YES;
11304     else
11305         moveInRoot = NO;
11306 
11307     /* set up pointers for nodes around the picked branch */
11308     /* should never change u, v, a, b, c, d pointers */
11309     v = p;
11310     u = p->anc;
11311     if (u->left == v)
11312         a = u->right;
11313     else
11314         a = u->left;
11315     b = u->anc;
11316     c = v->left;
11317     d = v->right;
11318 
11319     /* reset node variables that will be used */
11320     for (i=0; i<t->nNodes; i++)
11321         {
11322         p = t->allDownPass[i];
11323         p->x = 0;
11324         p->marked = NO;
11325         }
11326 
11327     /* mark nodes nNeighbor away in root (negative) or crown (positive) respecting constraints */
11328     nRoot = nCrown = 1;
11329     if (moveInRoot == YES)
11330         {
11331         /* clip root part of tree */
11332         a->anc = b;
11333         if (b->left == u)
11334             b->left = a;
11335         else
11336             b->right = a;
11337 
11338         /* mark the root part */
11339         if (u->isLocked == NO )
11340             {
11341             p = a; q = b; n = 0;
11342             while (q->anc != NULL)
11343                 {
11344                 q->marked = YES;
11345                 q->x = n;    // temporary, for MarkDistance below
11346                 if (q->left == p)
11347                     MarkDistance(q->right, YES, nNeighbor, &nRoot);
11348                 else
11349                     MarkDistance(q->left,  YES, nNeighbor, &nRoot);
11350                 q->x = --n;  // final
11351                 nRoot++;
11352                 if (q->isLocked == YES || abs(q->x) >= nNeighbor)
11353                     break;
11354                 p = q; q = q->anc;
11355                 }
11356             }
11357         if (a->isLocked == NO)
11358             {
11359             MarkDistance(a->left,  YES, nNeighbor, &nRoot);
11360             MarkDistance(a->right, YES, nNeighbor, &nRoot);
11361             }
11362 
11363         /* get final parsimony states for the root part */
11364         GetParsDP (t, t->root->left, chain);
11365         GetParsFP (t, t->root->left, chain);
11366         /* get final parsimony states for the crown part */
11367         GetParsDP (t, v, chain);
11368         GetParsFP (t, v, chain);
11369         }
11370     else  /* moveInRoot == NO */
11371         {
11372         /* clip crown part of tree */
11373         c->anc = d;
11374         d->anc = c;
11375 
11376         /* mark the crown part */
11377         if (c->isLocked == NO)
11378             {
11379             MarkDistance(c->left,  NO, nNeighbor, &nCrown);
11380             MarkDistance(c->right, NO, nNeighbor, &nCrown);
11381             }
11382         if (d->isLocked == NO)
11383             {
11384             MarkDistance(d->left,  NO, nNeighbor, &nCrown);
11385             MarkDistance(d->right, NO, nNeighbor, &nCrown);
11386             }
11387 
11388         /* get final parsimony states for the root part */
11389         if (u->anc != NULL) {
11390             a->anc = b;  /* clip */
11391             if (b->left == u) b->left = a;
11392             else             b->right = a;
11393             GetParsDP (t, t->root->left, chain);
11394             GetParsFP (t, t->root->left, chain);
11395             a->anc = u;  /* change back */
11396             if (b->left == a) b->left = u;
11397             else             b->right = u;
11398             }
11399         /* get final parsimony states for the crown part */
11400         GetParsDP (t, c, chain);
11401         GetParsDP (t, d, chain);
11402         GetParsFP (t, c, chain);
11403         GetParsFP (t, d, chain);
11404         }
11405 
11406     /* find number of site patterns and modify randomly */
11407     globalNSitesOfPat = numSitesOfPat + (chainId[chain] % chainParams.numChains) * numCompressedChars;
11408     nSitesOfPat = (CLFlt *) SafeCalloc (numCompressedChars, sizeof(CLFlt));
11409     if (!nSitesOfPat)  goto errorExit;
11410     for (i=0; i<numCompressedChars; i++)
11411         {
11412         nSitesOfPat[i] = globalNSitesOfPat[i];
11413     /*  for (j=0; j<globalNSitesOfPat[i]; j++)
11414             {
11415             ran = RandomNumber(seed);
11416             if (ran < decreaseProb)
11417                 nSitesOfPat[i]--;
11418             else if (ran > 1.0 - increaseProb)
11419                 nSitesOfPat[i]++;
11420             }  // this is slow at the moment */
11421         }
11422 
11423     /* need to alloc a matrix for parsimony lengths, an array of pointers to crown part,
11424        and an array of pointers to root part. */
11425     parLength = (MrBFlt *) SafeCalloc ((size_t)nRoot * (size_t)nCrown, sizeof(MrBFlt));
11426     pRoot  = (TreeNode **) SafeCalloc(nRoot,  sizeof(TreeNode *));
11427     pCrown = (TreeNode **) SafeCalloc(nCrown, sizeof(TreeNode *));
11428     if (!parLength || !pRoot || !pCrown)  goto errorExit;
11429 
11430     /* starting position */
11431     pRoot[0] = a; pCrown[0] = c;
11432     for (i=j=1, n=t->nNodes-2; n>=0; n--)
11433         {  /* and the rest */
11434         p = t->allDownPass[n];
11435         if (p->marked == YES && p->x < 0)
11436             pRoot[i++] = p;
11437         if (p->marked == YES && p->x > 0)
11438             pCrown[j++] = p;
11439         }
11440     assert (i==nRoot && j==nCrown);
11441 
11442     /* cycle through the possibilities and record the parsimony length */
11443     for (j=0; j<nCrown; j++)
11444         {
11445         for (i=0; i<nRoot; i++)
11446             {
11447             parLength[i+j*nRoot] = 0.0;
11448             for (n=0; n<t->nRelParts; n++)
11449                 {
11450                 division = t->relParts[n];
11451 
11452                 /* Find model settings */
11453                 m = &modelSettings[division];
11454 
11455                 /* find nSitesOfPat */
11456                 nSites = nSitesOfPat + m->compCharStart;
11457 
11458                 /* find parsimony length for each candidate position */
11459                 length = 0.0;
11460                 if (moveInRoot == YES)
11461                     {
11462                     pA = m->parsSets[pRoot[i]->index];
11463                     pB = m->parsSets[pRoot[i]->anc->index];
11464                     pP = m->parsSets[v->index];
11465 
11466                     if (m->nParsIntsPerSite == 1)
11467                         {
11468                         for (k=0; k<m->numChars; k++)
11469                             {
11470                             y[0] = (pA[k] | pB[k]) & pP[k];
11471                             if (y[0] == 0)
11472                                 length += nSites[k];
11473                             }
11474                         }
11475                     else /* if (m->nParsIntsPerSite == 2) */
11476                         {
11477                         for (k=0; k<2*m->numChars; k+=2)
11478                             {
11479                             y[0] = (pA[k] | pB[k]) & pP[k];
11480                             y[1] = (pA[k+1] | pB[k+1]) & pP[k+1];
11481                             if ((y[0] | y[1]) == 0)
11482                                 length += nSites[k/2];
11483                             }
11484                         }
11485                     }
11486                 else if (u->anc == NULL)
11487                     {
11488                     pP = m->parsSets[u->index];
11489                     pC = m->parsSets[pCrown[j]->index];
11490                     pD = m->parsSets[pCrown[j]->anc->index];
11491 
11492                     if (m->nParsIntsPerSite == 1)
11493                         {
11494                         for (k=0; k<m->numChars; k++)
11495                             {
11496                             y[0] = pP[k] & (pC[k] | pD[k]);
11497                             if (y[0] == 0)
11498                                 length += nSites[k];
11499                             }
11500                         }
11501                     else /* if (m->nParsIntsPerSite == 2) */
11502                         {
11503                         for (k=0; k<2*m->numChars; k+=2)
11504                             {
11505                             y[0] = pP[k] & (pC[k] | pD[k]);
11506                             y[1] = pP[k+1] & (pC[k+1] | pD[k+1]);
11507                             if ((y[0] | y[1]) == 0)
11508                                 length += nSites[k/2];
11509                             }
11510                         }
11511                     }
11512                 else
11513                     {
11514                     pA = m->parsSets[a->index];
11515                     pB = m->parsSets[b->index];
11516                     pC = m->parsSets[pCrown[j]->index];
11517                     pD = m->parsSets[pCrown[j]->anc->index];
11518 
11519                     if (m->nParsIntsPerSite == 1)
11520                         {
11521                         for (k=0; k<m->numChars; k++)
11522                             {
11523                             y[0] = (pA[k] | pB[k]) & (pC[k] | pD[k]);
11524                             if (y[0] == 0)
11525                                 length += nSites[k];
11526                             }
11527                         }
11528                     else /* if (m->nParsIntsPerSite == 2) */
11529                         {
11530                         for (k=0; k<2*m->numChars; k+=2)
11531                             {
11532                             y[0] = (pA[k] | pB[k]) & (pC[k] | pD[k]);
11533                             y[1] = (pA[k+1] | pB[k+1]) & (pC[k+1] | pD[k+1]);
11534                             if ((y[0] | y[1]) == 0)
11535                                 length += nSites[k/2];
11536                             }
11537                         }
11538                     }
11539 
11540                 /* find nStates and ratemult */
11541                 nStates = m->numModelStates;
11542                 if (m->dataType == STANDARD)
11543                     nStates = 2;
11544                 v_typical = length/m->numUncompressedChars + 0.0001;
11545 
11546                 /* get division warp factor (prop. to prob. of change) */
11547                 divFactor = - warpFactor * log(1.0/nStates - exp(-nStates/(nStates-1)*v_typical)/nStates);
11548                 parLength[i+j*nRoot] += divFactor * length;
11549                 }
11550             }
11551         }
11552 
11553     /* find the min length and the sum for the forward move */
11554     minLength = -1.0;
11555     for (j=0; j<nCrown; j++)
11556         for (i=0; i<nRoot; i++)
11557             {
11558             if (i == 0 && j == 0)  // exclude original position
11559                 continue;
11560             if (minLength > parLength[i+j*nRoot] || minLength < 0.0)
11561                 minLength = parLength[i+j*nRoot];
11562             }
11563     sum1 = 0.0; tempc = 0.0;
11564     for (j=0; j<nCrown; j++)
11565         for (i=0; i<nRoot; i++)
11566             {
11567             if (i == 0 && j == 0)  // exclude original position
11568                 continue;
11569             /* Kahan summation to reduce numerical error */
11570             tempy = exp(minLength - parLength[i+j*nRoot]) - tempc;
11571             tempsum = sum1 + tempy;  tempc = (tempsum - sum1) - tempy;
11572             sum1 = tempsum;
11573             // sum1 += exp(minLength - parLength[i+j*nRoot]);
11574             // printf("%d %d %lf\n", i, j, exp(minLength - parLength[i+j*nRoot]));
11575             }
11576 
11577     /* generate a random uniform */
11578     ran = RandomNumber(seed) * sum1;
11579 
11580     /* select the appropriate reattachment point */
11581     newA = a; newC = c;
11582     prob = 0.0; tempc = 0.0;
11583     for (j=0; j<nCrown; j++)
11584         for (i=0; i<nRoot; i++)
11585             {
11586             if (i == 0 && j == 0)  // exclude original position
11587                 continue;
11588             // prob += exp (minLength - parLength[i+j*nRoot]);
11589             /* Kahan summation to reduce numerical error */
11590             tempy = exp(minLength - parLength[i+j*nRoot]) - tempc;
11591             tempsum = prob + tempy;  tempc = (tempsum - prob) - tempy;
11592             prob = tempsum;
11593             if (prob > ran) {
11594                 /* proposed new attaching position */
11595                 newA = pRoot[i];
11596                 newC = pCrown[j];
11597                 goto outLoop;
11598                 }
11599             }
11600 outLoop:;
11601     iA = i; jC = j;
11602 
11603     /* calculate the proposal ratio */
11604     (*lnProposalRatio) = parLength[i+j*nRoot] - minLength + log(sum1);
11605 
11606     /* find the min length and the sum for the backward move */
11607     minLength = -1.0;
11608     for (j=0; j<nCrown; j++)
11609         for (i=0; i<nRoot; i++)
11610             {
11611             if (i == iA && j == jC)  // exclude new position
11612                 continue;
11613             if (minLength > parLength[i+j*nRoot] || minLength < 0.0)
11614                 minLength = parLength[i+j*nRoot];
11615             }
11616     sum2 = 0.0; tempc = 0.0;
11617     for (j=0; j<nCrown; j++)
11618         for (i=0; i<nRoot; i++)
11619             {
11620             if (i == iA && j == jC)  // exclude new position
11621                 continue;
11622             /* Kahan summation to reduce numerical error */
11623             tempy = exp(minLength - parLength[i+j*nRoot]) - tempc;
11624             tempsum = sum2 + tempy;  tempc = (tempsum - sum2) - tempy;
11625             sum2 = tempsum;
11626             // sum2 += exp (minLength - parLength[i+j*nRoot]);
11627             // printf("%d %d %lf\n", i, j, exp(minLength - parLength[i+j*nRoot]));
11628             }
11629 
11630     /* calculate the proposal ratio */
11631     (*lnProposalRatio) += minLength - parLength[0] - log(sum2);
11632 
11633     if (moveInRoot == YES)  /* root part has changed */
11634         {
11635         /* reattach the root part */
11636         newB = newA->anc;
11637         newA->anc = u;
11638         if (u->left == v)
11639             u->right = newA;
11640         else
11641             u->left = newA;
11642         u->anc = newB;
11643         if (newB->left == newA)
11644             newB->left = u;
11645         else
11646             newB->right = u;
11647 
11648         /* if u is locked, then we have moved upwards and need to leave the u lock behind */
11649         if (u->isLocked == YES)
11650             {
11651             u->isLocked = NO;
11652             a->isLocked = YES;
11653             a->lockID = u->lockID;
11654             u->lockID = -1;
11655             }
11656 
11657         p = newA;
11658         while (p->anc != NULL)
11659             {
11660             if (p == a) break;
11661             p = p->anc;
11662             }
11663         if (p == a)
11664             {
11665             /* newA is descendant to a so move a->length not u->length */
11666             x = u->length;
11667             u->length = a->length;
11668             a->length = x;
11669             }
11670 
11671         p = b;
11672         while (p->anc != NULL)
11673             {
11674             if (p == newA) break;
11675             p = p->anc;
11676             }
11677         if (p == newA)
11678             {
11679             /* newA is ancestor to a so insert above instead of below */
11680             x = newA->length;
11681             newA->length = u->length;
11682             u->length = x;
11683             /* newA is on root path and locked, we need to transfer lock to u */
11684             if (newA->isLocked == YES) {
11685                 u->isLocked = YES;
11686                 u->lockID = newA->lockID;
11687                 newA->isLocked = NO;
11688                 newA->lockID = -1;
11689                 }
11690             }
11691 
11692         /* hit a length with multiplier */
11693         x = a->length * exp(tuning * (RandomNumber(seed) - 0.5));
11694         while (x < minV || x > maxV)
11695             {
11696             if (x < minV) x = minV * minV / x;
11697             if (x > maxV) x = maxV * maxV / x;
11698             }
11699         /* calculate proposal and prior ratio based on length modification */
11700         (*lnProposalRatio) += log (x / a->length);
11701         if (isVPriorExp == YES)
11702             (*lnPriorRatio) += brlensExp * (a->length - x);
11703         a->length = x;
11704 
11705         /* hit u length with multiplier */
11706         x = u->length * exp(tuning * (RandomNumber(seed) - 0.5));
11707         while (x < minV || x > maxV)
11708             {
11709             if (x < minV) x = minV * minV / x;
11710             if (x > maxV) x = maxV * maxV / x;
11711             }
11712         /* calculate proposal and prior ratio based on length modification */
11713         (*lnProposalRatio) += log (x / u->length);
11714         if (isVPriorExp == YES)
11715             (*lnPriorRatio) += brlensExp * (u->length - x);
11716         u->length = x;
11717 
11718         /* hit newA length with multiplier */
11719         x = newA->length * exp(tuning * (RandomNumber(seed) - 0.5));
11720         while (x < minV || x > maxV)
11721             {
11722             if (x < minV) x = minV * minV / x;
11723             if (x > maxV) x = maxV * maxV / x;
11724             }
11725         /* calculate proposal and prior ratio based on length modification */
11726         (*lnProposalRatio) += log (x / newA->length);
11727         if (isVPriorExp == YES)
11728             (*lnPriorRatio) += brlensExp * (newA->length - x);
11729         newA->length = x;
11730 
11731         /* set tiprobs update flags */
11732         newA->upDateTi = YES;
11733         a->upDateTi = YES;
11734         u->upDateTi = YES;
11735 
11736         /* set flags for update of cond likes */
11737         p = u;
11738         while (p->anc != NULL)
11739             {
11740             p->upDateCl = YES;
11741             p = p->anc;
11742             }
11743         p = b;
11744         while (p->anc != NULL)
11745             {
11746             p->upDateCl = YES;
11747             p = p->anc;
11748             }
11749         }
11750 
11751     if (moveInRoot == NO)  /* crown part has changed */
11752         {
11753         r = newC;
11754         q = newB = newC->anc;
11755         /* rotate nodes from newC to c or d (whichever is closest) */
11756         tempc = r->length;
11757         while (r != c && r != d)
11758             {
11759             p = q->anc;
11760             /* rotate pointers of q */
11761             if (q->left == r)
11762                 q->left = p;
11763             else
11764                 q->right = p;
11765             q->anc = r;
11766             /* swap q and old */
11767             tempy = q->length;
11768             q->length = tempc;
11769             q->upDateTi = YES;
11770             tempc = tempy;
11771             /* make sure we get q and r initialized for next round */
11772             r = q;
11773             q = p;
11774             }
11775         newB->length = tempc;
11776 
11777         /* hit q length with multiplier while we are at it */
11778         x = q->length * exp(tuning * (RandomNumber(seed) - 0.5));
11779         while (x < minV || x > maxV)
11780             {
11781             if (x < minV) x = minV * minV / x;
11782             if (x > maxV) x = maxV * maxV / x;
11783             }
11784         /* calculate proposal and prior ratio based on length modification */
11785         (*lnProposalRatio) += log (x / q->length);
11786         if (isVPriorExp == YES)
11787             (*lnPriorRatio) += brlensExp * (q->length - x);
11788         q->length = x;
11789         q->upDateTi = YES;
11790 
11791         /* hit newB length with multiplier */
11792         x = newB->length * exp(tuning * (RandomNumber(seed) - 0.5));
11793         while (x < minV || x > maxV)
11794             {
11795             if (x < minV) x = minV * minV / x;
11796             if (x > maxV) x = maxV * maxV / x;
11797             }
11798         /* calculate proposal and prior ratio based on length modification */
11799         (*lnProposalRatio) += log (x / newB->length);
11800         if (isVPriorExp == YES)
11801             (*lnPriorRatio) += brlensExp * (newB->length - x);
11802         newB->length = x;
11803         newB->upDateTi = YES;
11804 
11805         /* hit newC length with multiplier */
11806         x = newC->length * exp(tuning * (RandomNumber(seed) - 0.5));
11807         while (x < minV || x > maxV)
11808             {
11809             if (x < minV) x = minV * minV / x;
11810             if (x > maxV) x = maxV * maxV / x;
11811             }
11812         /* calculate proposal and prior ratio based on length modification */
11813         (*lnProposalRatio) += log (x / newC->length);
11814         if (isVPriorExp == YES)
11815             (*lnPriorRatio) += brlensExp * (newC->length - x);
11816         newC->length = x;
11817         newC->upDateTi = YES;
11818 
11819         /* reattach the crown part */
11820         v->left = newC;
11821         v->right = newB;
11822         newC->anc = newB->anc = v;
11823 
11824         /* set flags for update of cond likes */
11825         p = newC;
11826         while (p->anc != NULL)
11827             {
11828             p->upDateCl = YES;
11829             p = p->anc;
11830             }
11831         p = r;
11832         while (p->anc != NULL)
11833             {
11834             p->upDateCl = YES;
11835             p = p->anc;
11836             }
11837         }
11838 
11839     topologyHasChanged = YES;
11840 
11841     /* get down pass sequence if tree topology has changed */
11842     if (topologyHasChanged == YES)
11843         {
11844         GetDownPass (t);
11845         }
11846 
11847     /* Dirichlet or twoExp prior */
11848     if (isVPriorExp > 1)
11849         (*lnPriorRatio) += LogDirPrior(t, mp, isVPriorExp);
11850 
11851     /* free up local memory */
11852     free (parLength); free (pRoot); free (pCrown); free (nSitesOfPat);
11853 
11854     return (NO_ERROR);
11855 
11856 errorExit:
11857     MrBayesPrint ("%s   Problem allocating memory in Move_ParsSPR\n", spacer);
11858     free (parLength); free (pRoot); free (pCrown); free (nSitesOfPat);
11859 
11860     return (ERROR);
11861 }
11862 
11863 
Move_ParsSPRClock(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)11864 int Move_ParsSPRClock (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
11865 {
11866     /* Change branch lengths and topology (potentially) using SPR-type move, parsimony-biased */
11867 
11868     /* This move picks a branch and then chooses a reattachment point based on
11869        the parsimony score. On the ending branch, the attachment point is reinserted
11870        randomly along the branch (below the minimum age of the node). Since 2010-11-02
11871        the move is Metropolized to improve efficiency. */
11872 
11873     /* Since 2015-11-06, this move uses the s/n brlen approximation */
11874 
11875     int         i, j, n, division, n1=0, n2=0, n3=0, n4=0, n5=0, *nEvents, numMovableNodesOld, numMovableNodesNew;
11876     BitsLong    *pA, *pV, *pP, y[2];
11877     MrBFlt      x, oldBrlen=0.0, newBrlen=0.0, v1=0.0, v2=0.0, v3=0.0, v4=0.0, v5=0.0,
11878                 v3new=0.0, lambda, **position=NULL, **rateMultiplier=NULL, *brlens,
11879                 igrvar, *igrRate=NULL, nu, *tk02Rate=NULL, minLength=0.0, length=0.0,
11880                 cumulativeProb, warpFactor, sum1, sum2, ran, divFactor, nStates, v_approx, minV;
11881     CLFlt       *nSitesOfPat, *nSites, *globalNSitesOfPat;
11882     TreeNode    *p, *a, *b, *u, *v, *c=NULL, *d;
11883     Tree        *t;
11884     ModelInfo   *m=NULL;
11885     Param       *subParm;
11886 
11887     warpFactor = mvp[0];                  /* tuning parameter determining how heavily to weight according to parsimony scores */
11888 
11889     (*lnProposalRatio) = (*lnPriorRatio) = 0.0;
11890 
11891     /* get tree */
11892     t = GetTree (param, chain, state[chain]);
11893 
11894     /* get model params and model info */
11895     m = &modelSettings[param->relParts[0]];
11896 
11897     /* get min and max brlen in relative time and subst units */
11898     minV = BRLENS_MIN;
11899 
11900 #   if defined (DEBUG_ParsSPRClock)
11901     printf ("Before:\n");
11902     ShowNodes (t->root, 2, YES);
11903     getchar();
11904 #   endif
11905 
11906     numMovableNodesOld=0;
11907     for (i=0; i<t->nNodes-2; ++i)
11908         {
11909         p = t->allDownPass[i];
11910         a = p->anc->left;
11911         b = p->anc->right;
11912         if (p->anc->isLocked == YES || p->anc->anc->anc == NULL
11913             || (p == b && a->length < TIME_MIN) || (p == a && b->length < TIME_MIN))
11914             ++numMovableNodesOld;
11915         }
11916 
11917     /* pick a branch */
11918     do  {
11919         p = t->allDownPass[(int)(RandomNumber(seed) * (t->nNodes - 2))];
11920         a = p->anc->left;
11921         b = p->anc->right;
11922         }
11923     while (p->anc->isLocked == YES || p->anc->anc->anc == NULL
11924            || (p == b && a->length < TIME_MIN) || (p == a && b->length < TIME_MIN));
11925     /* skip constraints, siblings of root (and root); and consider ancestral fossils in fbd tree */
11926 
11927     /* set up pointers for nodes around the picked branch */
11928     v = p;
11929     u = p->anc;
11930     if (u->left == v)
11931         a = u->right;
11932     else
11933         a = u->left;
11934     b = u->anc;
11935 
11936     /* record branch length for insertion in back move */
11937     if (v->length > 0.0)  /* side branch, not anc fossil */
11938         {
11939         if (v->nodeDepth > a->nodeDepth)
11940             oldBrlen = b->nodeDepth - v->nodeDepth - 2.0*minV;
11941         else
11942             oldBrlen = b->nodeDepth - a->nodeDepth - 2.0*minV;
11943         }
11944     v1 = a->length;
11945     v2 = u->length;
11946     v3 = v->length;
11947 
11948     /* reassign events for CPP and adjust prior and proposal ratios for relaxed clock models */
11949     for (i=0; i<param->subParams[0]->nSubParams; i++)
11950         {
11951         subParm = param->subParams[0]->subParams[i];
11952         if (subParm->paramType == P_CPPEVENTS)
11953             {
11954             nEvents = subParm->nEvents[2*chain+state[chain]];
11955             position = subParm->position[2*chain+state[chain]];
11956             rateMultiplier = subParm->rateMult[2*chain+state[chain]];
11957             n1 = nEvents[a->index];
11958             n2 = nEvents[u->index];
11959             n3 = nEvents[v->index];
11960             if (n2 > 0)
11961                 {
11962                 position[a->index] = (MrBFlt *) SafeRealloc ((void *) position[a->index], (n1+n2) * sizeof (MrBFlt));
11963                 rateMultiplier[a->index] = (MrBFlt *) SafeRealloc ((void *) rateMultiplier[a->index], (n1+n2) * sizeof (MrBFlt));
11964                 }
11965             for (j=0; j<n1; j++)
11966                 position[a->index][j] *= v1 / (v1+v2);
11967             for (j=n1; j<n1+n2; j++)
11968                 {
11969                 position[a->index][j] = (position[u->index][j-n1] * v2 + v1) / (v1+v2);
11970                 rateMultiplier[a->index][j] = rateMultiplier[u->index][j-n1];
11971                 }
11972             nEvents[a->index] = n1+n2;
11973             nEvents[u->index] = 0;
11974             if (n2 > 0)
11975                 {
11976                 free (position[u->index]);
11977                 free (rateMultiplier[u->index]);
11978                 position[u->index] = rateMultiplier[u->index] = NULL;
11979                 }
11980             /* adjust effective branch lengths */
11981             brlens = GetParamSubVals (subParm, chain, state[chain]);
11982             brlens[a->index] += brlens[u->index];   /* only change in effective branch lengths so far */
11983             }   /* end CPP events parm */
11984         else if ( subParm->paramType == P_TK02BRANCHRATES ||
11985                  (subParm->paramType == P_MIXEDBRCHRATES && *GetParamIntVals(subParm, chain, state[chain]) == RCL_TK02))
11986             {
11987             /* adjust prior ratio */
11988             if (subParm->paramType == P_TK02BRANCHRATES)
11989                 nu = *GetParamVals (modelSettings[subParm->relParts[0]].tk02var, chain, state[chain]);
11990             else
11991                 nu = *GetParamVals (modelSettings[subParm->relParts[0]].mixedvar, chain, state[chain]);
11992             tk02Rate = GetParamVals (subParm, chain, state[chain]);
11993             if (v->length > 0.0)
11994                 (*lnPriorRatio) -= LnProbTK02LogNormal(tk02Rate[v->anc->index], nu*v->length, tk02Rate[v->index]);
11995             (*lnPriorRatio) -= LnProbTK02LogNormal(tk02Rate[a->anc->index], nu*a->length, tk02Rate[a->index]);
11996             (*lnPriorRatio) -= LnProbTK02LogNormal(tk02Rate[u->anc->index], nu*u->length, tk02Rate[u->index]);
11997             (*lnPriorRatio) += LnProbTK02LogNormal(tk02Rate[u->anc->index], nu*(a->length+u->length), tk02Rate[a->index]);
11998 
11999             /* adjust effective branch lengths */
12000             brlens = GetParamSubVals (subParm, chain, state[chain]);
12001             brlens[a->index] = (tk02Rate[a->index] + tk02Rate[b->index]) / 2.0 * (a->length + u->length);
12002             }   /* end tk02 branch rate parameter */
12003         else if ( subParm->paramType == P_IGRBRANCHRATES ||
12004                  (subParm->paramType == P_MIXEDBRCHRATES && *GetParamIntVals(subParm, chain, state[chain]) == RCL_IGR))
12005             {
12006             if (subParm->paramType == P_IGRBRANCHRATES)
12007                 igrvar = *GetParamVals (modelSettings[subParm->relParts[0]].igrvar, chain, state[chain]);
12008             else
12009                 igrvar = *GetParamVals (modelSettings[subParm->relParts[0]].mixedvar, chain, state[chain]);
12010             igrRate = GetParamVals (subParm, chain, state[chain]);
12011 
12012             /* adjust prior ratio for old branches */
12013             if (v->length > 0.0)
12014                 (*lnPriorRatio) -= LnProbGamma(v->length/igrvar, v->length/igrvar, igrRate[v->index]);
12015             (*lnPriorRatio) -= LnProbGamma(a->length/igrvar, a->length/igrvar, igrRate[a->index]);
12016             (*lnPriorRatio) -= LnProbGamma(u->length/igrvar, u->length/igrvar, igrRate[u->index]);
12017             (*lnPriorRatio) += LnProbGamma((a->length+u->length)/igrvar, (a->length+u->length)/igrvar, igrRate[a->index]);
12018 
12019             /* adjust effective branch lengths */
12020             brlens = GetParamSubVals (subParm, chain, state[chain]);
12021             brlens[a->index] = igrRate[a->index] * (a->length + u->length);
12022             } /* end igr branch rate parameter */
12023         }   /* next subparameter */
12024 
12025     /* cut tree */
12026     a->anc = b;
12027     if (b->left == u)
12028         b->left = a;
12029     else
12030         b->right = a;
12031     a->length += u->length;
12032     a->upDateTi = YES;
12033 
12034     /* get final parsimony states for the root part */
12035     GetParsDP (t, t->root->left, chain);
12036     GetParsFP (t, t->root->left->left, chain);
12037     GetParsFP (t, t->root->left->right, chain);
12038 
12039     /* get downpass parsimony states for the crown part */
12040     GetParsDP (t, v, chain);
12041 
12042     /* reset node variables that will be used */
12043     for (i=0; i<t->nNodes; i++)
12044         {
12045         p = t->allDownPass[i];
12046         p->marked = NO;
12047         p->d = 0.0;
12048         }
12049 
12050     /* mark nodes in the root part of the tree, first mark a */
12051     a->marked = YES;
12052     /* then move down towards root taking constraints into account */
12053     p = b;
12054     while (p->isLocked == NO && p->anc->anc != NULL)
12055         {
12056         p->marked = YES;
12057         p = p->anc;
12058         }
12059     /* make sure sisters of last node are marked otherwise it will not be marked in the uppass */
12060     p->left->marked = YES;
12061     p->right->marked = YES;
12062     /* finally move up, skip constraints and ancestral fossil */
12063     for (i=t->nNodes-2; i>=0; i--)
12064         {
12065         p = t->allDownPass[i];
12066         if (p != u && p->marked == NO && p->anc->marked == YES && p->anc->isLocked == NO
12067             && p->anc->nodeDepth > v->nodeDepth + minV && p->length > 0.0)
12068             p->marked = YES;
12069         }
12070 
12071     /* unmark nodes if the picked branch is 0 (ancestral fossil) */
12072     if (v->length < TIME_MIN)
12073         {
12074         n = 0;
12075         for (i=0; i<t->nNodes-1; i++)
12076             {
12077             p = t->allDownPass[i];
12078             if (p->nodeDepth > v->nodeDepth - minV || p->anc->nodeDepth < v->nodeDepth + minV)
12079                 p->marked = NO;
12080             if (p->marked == YES)
12081                 n++;
12082             }
12083         if (n < 2)  /* no new position to move */
12084             {
12085             abortMove = YES;
12086             return (NO_ERROR);
12087             }
12088         }
12089 
12090     /* find number of site patterns and modify randomly */
12091     globalNSitesOfPat = numSitesOfPat + (chainId[chain] % chainParams.numChains) * numCompressedChars;
12092     nSitesOfPat = (CLFlt *) SafeCalloc (numCompressedChars, sizeof(CLFlt));
12093     if (!nSitesOfPat)
12094         {
12095         MrBayesPrint ("%s   Problem allocating nSitesOfPat in Move_ParsSPRClock\n", spacer);
12096         return (ERROR);
12097         }
12098     for (i=0; i<numCompressedChars; i++)
12099         {
12100         nSitesOfPat[i] = globalNSitesOfPat[i];
12101         // for (j=0; j<globalNSitesOfPat[i]; j++)
12102         //    {
12103         //    ran = RandomNumber(seed);
12104         //    if (ran < decreaseProb)
12105         //        nSitesOfPat[i]--;
12106         //    else if (ran > 1.0 - increaseProb)
12107         //        nSitesOfPat[i]++;
12108         //    }
12109         }
12110 
12111     /* cycle through the possibilities and record the parsimony length */
12112     for (i=0; i<t->nNodes; i++)
12113         {
12114         p = t->allDownPass[i];
12115         if (p->marked == NO)
12116             continue;
12117         /* find the parsimony length */
12118         p->d = 0.0;
12119         for (n=0; n<t->nRelParts; n++)
12120             {
12121             division = t->relParts[n];
12122 
12123             /* Find model settings */
12124             m = &modelSettings[division];
12125 
12126             /* find nSitesOfPat */
12127             nSites = nSitesOfPat + m->compCharStart;
12128 
12129             /* find downpass parsimony sets for the node and its environment */
12130             pP   = m->parsSets[p->index     ];
12131             pA   = m->parsSets[p->anc->index];
12132             pV   = m->parsSets[v->index     ];
12133 
12134             length = 0.0;
12135             if (m->nParsIntsPerSite == 1)
12136                 {
12137                 for (j=0; j<m->numChars; j++)
12138                     {
12139                     y[0] = (pP[j] | pA[j]) & pV[j];
12140                     if (y[0] == 0)
12141                         length += nSites[j];
12142                     }
12143                 }
12144             else /* if (m->nParsIntsPerSite == 2) */
12145                 {
12146                 for (j=0; j<2*m->numChars; j+=2)
12147                     {
12148                     y[0] = (pP[j] | pA[j]) & pV[j];
12149                     y[1] = (pP[j+1] | pA[j+1]) & pV[j+1];
12150                     if ((y[0] | y[1]) == 0)
12151                         length += nSites[j/2];
12152                     }
12153                 }
12154 
12155             /* find nStates and v approximation using parsimony-based s/n approximation */
12156             nStates = m->numModelStates;
12157             if (m->dataType == STANDARD)
12158                 nStates = 2;
12159             v_approx = length/m->numUncompressedChars + 0.0001;
12160 
12161             /* get division warp factor (prop. to prob. of change) */
12162             divFactor = - warpFactor * log(1.0/nStates - exp(-nStates/(nStates-1)*v_approx)/nStates);
12163 
12164             p->d += divFactor * length;
12165             }
12166         }
12167 
12168     /* find the min length and the sum for the forward move */
12169     minLength = -1.0;
12170     for (i=0; i<t->nNodes; i++)
12171         {
12172         p = t->allDownPass[i];
12173         if (p->marked == NO || p == a)
12174             continue;
12175         if (minLength < 0.0 || p->d < minLength)
12176             minLength = p->d;
12177         }
12178     sum1 = 0.0;
12179     for (i=0; i<t->nNodes; i++)
12180         {
12181         p = t->allDownPass[i];
12182         if (p->marked == YES && p != a)
12183             sum1 += exp (minLength - p->d);
12184         }
12185 
12186     /* generate a random uniform */
12187     ran = RandomNumber(seed) * sum1;
12188 
12189     /* select the appropriate reattachment point (not a!) */
12190     cumulativeProb = 0.0;
12191     for (i=0; i<t->nNodes; i++)
12192         {
12193         p = t->allDownPass[i];
12194         if (p->marked == YES && p != a)
12195             {
12196             c = p;
12197             cumulativeProb += exp (minLength - p->d);
12198             if (cumulativeProb > ran)
12199                 break;
12200             }
12201         }
12202 
12203     /* calculate the proposal ratio */
12204     (*lnProposalRatio) = c->d - minLength + log(sum1);
12205 
12206     /* find the min length and the sum for the backward move */
12207     minLength = -1.0;
12208     for (i=0; i<t->nNodes; i++)
12209         {
12210         p = t->allDownPass[i];
12211         if (p->marked == NO || p == c)
12212             continue;
12213         if (minLength < 0.0 || p->d < minLength)
12214             minLength = p->d;
12215         }
12216     sum2 = 0.0;
12217     for (i=0; i<t->nNodes; i++)
12218         {
12219         p = t->allDownPass[i];
12220         if (p->marked == YES && p != c)
12221             sum2 += exp (minLength - p->d);
12222         }
12223 
12224     /* calculate the proposal ratio */
12225     (*lnProposalRatio) += minLength - a->d - log(sum2);
12226 
12227     /* reattach u */
12228     d = c->anc;
12229     c->anc = u;
12230     if (u->left == v)
12231         u->right = c;
12232     else
12233         u->left = c;
12234     u->anc = d;
12235     if (d->left == c)
12236         d->left = u;
12237     else
12238         d->right = u;
12239 
12240     if (v->length > 0.0)  /* side branch, not anc fossil */
12241         {
12242         if (c->nodeDepth > v->nodeDepth)
12243             newBrlen = d->nodeDepth - c->nodeDepth - 2.0*minV;
12244         else
12245             newBrlen = d->nodeDepth - v->nodeDepth - 2.0*minV;
12246         if (newBrlen <= 0.0)
12247             {
12248             abortMove = YES;
12249             free (nSitesOfPat);
12250             return (NO_ERROR);
12251             }
12252 
12253         /* adjust lengths */
12254         u->nodeDepth = d->nodeDepth - minV - RandomNumber(seed) * newBrlen;
12255         v->length = u->nodeDepth - v->nodeDepth;
12256 
12257         /* calculate proposal ratio for tree change */
12258         (*lnProposalRatio) += log (newBrlen / oldBrlen);
12259         }
12260     u->length = d->nodeDepth - u->nodeDepth;
12261     c->length = u->nodeDepth - c->nodeDepth;
12262 
12263     v3new = v->length;
12264     v4 = c->length;
12265     v5 = u->length;
12266 
12267     /* reassign events for CPP and adjust prior and proposal ratios for relaxed clock models */
12268     for (i=0; i<param->subParams[0]->nSubParams; i++)
12269         {
12270         subParm = param->subParams[0]->subParams[i];
12271         if (subParm->paramType == P_CPPEVENTS)
12272             {
12273             nEvents = subParm->nEvents[2*chain+state[chain]];
12274             position = subParm->position[2*chain+state[chain]];
12275             rateMultiplier = subParm->rateMult[2*chain+state[chain]];
12276             for (j=0; j<nEvents[c->index]; j++)
12277                 {
12278                 if (position[c->index][j] > v4 / (v4+v5))
12279                     break;
12280                 }
12281             n4 = j;
12282             n5 = nEvents[c->index] - j;
12283             nEvents[u->index] = n5;
12284             if (n5 > 0)
12285                 {
12286                 position[u->index] = (MrBFlt *) SafeRealloc ((void *) position[u->index], n5 * sizeof (MrBFlt));
12287                 rateMultiplier[u->index] = (MrBFlt *) SafeRealloc ((void *) rateMultiplier[u->index], n5 * sizeof (MrBFlt));
12288                 for (j=n4; j<nEvents[c->index]; j++)
12289                     {
12290                     position[u->index][j-n4] = (position[c->index][j] * (v4+v5) - v4) / v5;
12291                     rateMultiplier[u->index][j-n4] = rateMultiplier[c->index][j];
12292                     }
12293                 if (n4 > 0)
12294                     {
12295                     position[c->index] = (MrBFlt *) SafeRealloc ((void *) position[c->index], n4 * sizeof (MrBFlt));
12296                     rateMultiplier[c->index] = (MrBFlt *) SafeRealloc ((void *) rateMultiplier[c->index], n4 * sizeof (MrBFlt));
12297                     for (j=0; j<n4; j++)
12298                         position[c->index][j] *= ((v4+v5) / v4);
12299                     }
12300                 else
12301                     {
12302                     free (position[c->index]);
12303                     free (rateMultiplier[c->index]);
12304                     position[c->index] = rateMultiplier[c->index] = NULL;
12305                     }
12306                 nEvents[c->index] = n4;
12307                 }
12308             else
12309                 {
12310                 for (j=0; j<nEvents[c->index]; j++)
12311                     position[c->index][j] *= ((v4+v5) / v4);
12312                 }
12313 
12314             /* adjust proposal ratio */
12315             (*lnProposalRatio) += n3 * log (v3new / v3);
12316 
12317             /* adjust prior ratio */
12318             lambda = *GetParamVals (modelSettings[subParm->relParts[0]].cppRate, chain, state[chain]);
12319             (*lnPriorRatio) += lambda * (v3 - v3new);
12320 
12321             /* update effective branch lengths */
12322             if (UpdateCppEvolLengths (subParm, a, chain) == ERROR)
12323                 {
12324                 abortMove = YES;
12325                 free (nSitesOfPat);
12326                 return (NO_ERROR);
12327                 }
12328 
12329             if (UpdateCppEvolLengths (subParm, u, chain) == ERROR)
12330                 {
12331                 abortMove = YES;
12332                 free (nSitesOfPat);
12333                 return (NO_ERROR);
12334                 }
12335             }   /* end cpp events parameter */
12336         else if ( subParm->paramType == P_TK02BRANCHRATES ||
12337                  (subParm->paramType == P_MIXEDBRCHRATES && *GetParamIntVals(subParm, chain, state[chain]) == RCL_TK02))
12338             {
12339             /* adjust prior ratio */
12340             if (subParm->paramType == P_TK02BRANCHRATES)
12341                 nu = *GetParamVals (modelSettings[subParm->relParts[0]].tk02var, chain, state[chain]);
12342             else
12343                 nu = *GetParamVals (modelSettings[subParm->relParts[0]].mixedvar, chain, state[chain]);
12344             tk02Rate = GetParamVals (subParm, chain, state[chain]);
12345             (*lnPriorRatio) -= LnProbTK02LogNormal(tk02Rate[u->anc->index], nu*(c->length+u->length), tk02Rate[c->index]);
12346             (*lnPriorRatio) += LnProbTK02LogNormal(tk02Rate[c->anc->index], nu*c->length, tk02Rate[c->index]);
12347             (*lnPriorRatio) += LnProbTK02LogNormal(tk02Rate[u->anc->index], nu*u->length, tk02Rate[u->index]);
12348             if (v->length > 0.0)
12349                 (*lnPriorRatio) += LnProbTK02LogNormal(tk02Rate[v->anc->index], nu*v->length, tk02Rate[v->index]);
12350 
12351             /* adjust effective branch lengths */
12352             brlens = GetParamSubVals (subParm, chain, state[chain]);
12353             brlens[c->index] = c->length * (tk02Rate[c->index] + tk02Rate[c->anc->index]) / 2.0;
12354             brlens[v->index] = v->length * (tk02Rate[v->index] + tk02Rate[v->anc->index]) / 2.0;
12355             brlens[u->index] = u->length * (tk02Rate[u->index] + tk02Rate[u->anc->index]) / 2.0;
12356             }   /* end tk02 branch rate parameter */
12357         else if ( subParm->paramType == P_IGRBRANCHRATES ||
12358                  (subParm->paramType == P_MIXEDBRCHRATES && *GetParamIntVals(subParm, chain, state[chain]) == RCL_IGR))
12359             {
12360             /* adjust prior ratio */
12361             if (subParm->paramType == P_IGRBRANCHRATES)
12362                 igrvar = *GetParamVals (modelSettings[subParm->relParts[0]].igrvar, chain, state[chain]);
12363             else
12364                 igrvar = *GetParamVals (modelSettings[subParm->relParts[0]].mixedvar, chain, state[chain]);
12365             igrRate = GetParamVals (subParm, chain, state[chain]);
12366             (*lnPriorRatio) -= LnProbGamma ((c->length+u->length)/igrvar, (c->length+u->length)/igrvar, igrRate[c->index]);
12367             (*lnPriorRatio) += LnProbGamma (c->length/igrvar, c->length/igrvar, igrRate[c->index]);
12368             (*lnPriorRatio) += LnProbGamma (u->length/igrvar, u->length/igrvar, igrRate[u->index]);
12369             if (v->length > 0.0)
12370                 (*lnPriorRatio) += LnProbGamma (v->length/igrvar, v->length/igrvar, igrRate[v->index]);
12371 
12372             /* adjust effective branch lengths */
12373             brlens = GetParamSubVals (subParm, chain, state[chain]);
12374             brlens[v->index] = igrRate[v->index] * v->length;
12375             brlens[u->index] = igrRate[u->index] * u->length;
12376             brlens[c->index] = igrRate[c->index] * c->length;
12377             }   /* end igr branch rate parameter */
12378         }   /* next subparameter */
12379 
12380     /* set tiprobs update flags */
12381     c->upDateTi = YES;
12382     u->upDateTi = YES;
12383     v->upDateTi = YES;
12384 
12385     /* set flags for update of cond likes down to root */
12386     p = u;
12387     while (p->anc != NULL)
12388         {
12389         p->upDateCl = YES;
12390         p = p->anc;
12391         }
12392     p = b;
12393     while (p->anc != NULL)
12394         {
12395         p->upDateCl = YES;
12396         p = p->anc;
12397         }
12398 
12399     /* get down pass sequence */
12400     GetDownPass (t);
12401 
12402     /* adjust proposal ratio for number of movable nodes */
12403     numMovableNodesNew=0;
12404     for (i=0; i<t->nNodes-2; ++i)
12405         {
12406         p = t->allDownPass[i];
12407         a = p->anc->left;
12408         b = p->anc->right;
12409         if (p->anc->isLocked == YES || p->anc->anc->anc == NULL
12410             || (p == b && a->length < TIME_MIN) || (p == a && b->length < TIME_MIN))
12411             ++numMovableNodesNew;
12412         }
12413     if (numMovableNodesOld != numMovableNodesNew)
12414         (*lnProposalRatio) += log(numMovableNodesOld/numMovableNodesNew);
12415 
12416     /* adjust prior ratio for clock tree */
12417     if (LogClockTreePriorRatio (param, chain, &x) == ERROR)
12418         {
12419         free (nSitesOfPat);
12420         return (ERROR);
12421         }
12422     (*lnPriorRatio) += x;
12423 
12424 #   if defined (DEBUG_ParsSPRClock)
12425     ShowNodes (t->root, 2, YES);
12426     printf ("After\nProposal ratio: %f\n",(*lnProposalRatio));
12427     printf ("v: %d  u: %d  a: %d  b: %d c: %d\n",v->index, u->index, a->index, b->index, c->index);
12428     getchar();
12429 #   endif
12430 
12431     free (nSitesOfPat);
12432     return (NO_ERROR);
12433 }
12434 
12435 
Move_ParsTBR1(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)12436 int Move_ParsTBR1 (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
12437 {
12438     /* Change topology and map branch lengths using TBR-type move biased according to parsimony scores,
12439        controlled by a window defined by a certain node distance radius. */
12440 
12441     int         i, j, k, n, division, topologyHasChanged, nNeighbor, nRoot, nCrown, iA, jC, isVPriorExp;
12442     BitsLong    *pA, *pB, *pC, *pD, y[2];
12443     MrBFlt      x, minV, maxV, brlensExp=0.0, minLength=0.0, length=0.0, *parLength=NULL, prob, ran, tuning, warpFactor,
12444                 sum1, sum2, tempsum, tempc, tempy;
12445     CLFlt       *nSites, *nSitesOfPat=NULL, *globalNSitesOfPat;
12446     TreeNode    *p, *q, *r, *a, *b, *u, *v, *c, *d, *newB, *newA, *newC, **pRoot=NULL, **pCrown=NULL;
12447     Tree        *t;
12448     ModelParams *mp;
12449     ModelInfo   *m=NULL;
12450 
12451     warpFactor = mvp[0];                  /* tuning parameter determining how heavily to weight according to parsimony scores */
12452 //  increaseProb = decreaseProb = mvp[1]; /* reweighting probabilities */
12453 //  v_typical = mvp[2];                   /* typical branch length for conversion of parsimony score to log prob ratio */
12454     tuning = mvp[3];                      /* multiplier tuning parameter */
12455     nNeighbor = (int)mvp[4];              /* distance to move picked branch in root and crown part */
12456 
12457     (*lnProposalRatio) = (*lnPriorRatio) = 0.0;
12458 
12459     /* get model params and model info */
12460     mp = &modelParams[param->relParts[0]];
12461     m = &modelSettings[param->relParts[0]];
12462 
12463     /* get tree */
12464     t = GetTree (param, chain, state[chain]);
12465 
12466     /* max and min brlen */
12467     if (param->subParams[0]->paramId == BRLENS_UNI)
12468         {
12469         minV = mp->brlensUni[0] > BRLENS_MIN ? mp->brlensUni[0] : BRLENS_MIN;
12470         maxV = mp->brlensUni[1] < BRLENS_MAX ? mp->brlensUni[1] : BRLENS_MAX;
12471         isVPriorExp = NO;
12472         }
12473     else if (param->subParams[0]->paramId == BRLENS_GamDir)
12474         {
12475         minV = BRLENS_MIN;
12476         maxV = BRLENS_MAX;
12477         isVPriorExp = 2;
12478         }
12479     else if (param->subParams[0]->paramId == BRLENS_iGmDir)
12480         {
12481         minV = BRLENS_MIN;
12482         maxV = BRLENS_MAX;
12483         isVPriorExp = 3;
12484         }
12485     else if (param->subParams[0]->paramId == BRLENS_twoExp)
12486         {
12487         minV = BRLENS_MIN;
12488         maxV = BRLENS_MAX;
12489         isVPriorExp = 4;
12490         }
12491     else
12492         {
12493         minV = BRLENS_MIN;
12494         maxV = BRLENS_MAX;
12495         brlensExp = mp->brlensExp;
12496         isVPriorExp = YES;
12497         }
12498 
12499     /* Dirichlet or twoExp prior */
12500     if (isVPriorExp > 1)
12501         (*lnPriorRatio) = -LogDirPrior(t, mp, isVPriorExp);
12502 
12503     /* set topologyHasChanged to NO */
12504     topologyHasChanged = NO; /* FIXME: Not used (from clang static analyzer) */
12505 
12506     /* reset node variables that will be used */
12507     for (i=0; i<t->nNodes; i++)
12508         {
12509         p = t->allDownPass[i];
12510         p->x = 0;
12511         p->marked = NO;
12512         }
12513 
12514     /* pick an internal branch */
12515     do  {
12516         p = t->intDownPass[(int)(RandomNumber(seed)*(t->nIntNodes-1))];
12517         q = p->anc->left;
12518         if (q == p)  q = p->anc->right;
12519         i = j = 0;
12520         if (q->isLocked == YES || q->left == NULL)
12521             i++;
12522         if (p->anc->isLocked == YES || p->anc->anc->anc == NULL)
12523             i++;
12524         if (p->left->isLocked == YES || p->left->left == NULL)
12525             j++;
12526         if (p->right->isLocked == YES || p->right->left == NULL)
12527             j++;
12528         }
12529     while (i == 2 && j == 2);
12530 
12531     /* set up pointers for nodes around the picked branch */
12532     v = p;            u = p->anc;
12533     c = p->left;      d = p->right;
12534     if (u->left == v) a = u->right;
12535     else              a = u->left;
12536     b = u->anc;
12537     /* clip root part of tree */
12538     a->anc = b;
12539     if (b->left == u) b->left = a;
12540     else              b->right = a;
12541     /* clip crown part of tree */
12542     c->anc = d;
12543     d->anc = c;
12544     /* should never change u, v, a, b, c, d pointers */
12545 
12546     /* mark nodes nNeighbor away in root (negative) and crown (positive) respecting constraints */
12547     /* first move down towards root */
12548     nRoot = nCrown = 0;
12549     if (u->isLocked == NO)
12550         {
12551         p = a; q = b; n = 0;
12552         while (q->anc != NULL)
12553             {
12554             q->marked = YES;
12555             q->x = n;    // temporary, for MarkDistance below
12556             if (q->left == p)
12557                 MarkDistance(q->right, YES, nNeighbor, &nRoot);
12558             else
12559                 MarkDistance(q->left,  YES, nNeighbor, &nRoot);
12560             q->x = --n;  // final
12561             nRoot++;
12562             if (q->isLocked == YES || abs(q->x) >= nNeighbor)
12563                 break;
12564             p = q; q = q->anc;
12565             }
12566         }
12567     /* then move up in root part */
12568     a->marked = YES; nRoot++;
12569     if (a->isLocked == NO)
12570         {
12571         MarkDistance(a->left,  YES, nNeighbor, &nRoot);
12572         MarkDistance(a->right, YES, nNeighbor, &nRoot);
12573         }
12574     /* finally in crown part */
12575     c->marked = YES; nCrown++;
12576     if (c->isLocked == NO)
12577         {
12578         MarkDistance(c->left,  NO, nNeighbor, &nCrown);
12579         MarkDistance(c->right, NO, nNeighbor, &nCrown);
12580         }
12581     if (d->isLocked == NO)
12582         {
12583         MarkDistance(d->left,  NO, nNeighbor, &nCrown);
12584         MarkDistance(d->right, NO, nNeighbor, &nCrown);
12585         }
12586 
12587     /* need to alloc a matrix for parsimony lengths, an array of pointers to crown part,
12588        and an array of pointers to root part. */
12589     parLength = (MrBFlt *) SafeCalloc ((size_t)nRoot * (size_t)nCrown, sizeof(MrBFlt));
12590     pRoot  = (TreeNode **) SafeCalloc(nRoot,  sizeof(TreeNode *));
12591     pCrown = (TreeNode **) SafeCalloc(nCrown, sizeof(TreeNode *));
12592     if (!parLength || !pRoot || !pCrown)  goto errorExit;
12593     /* starting position */
12594     pRoot[0] = a; pCrown[0] = c;
12595     for (i=j=1, n=t->nNodes-2; n>=0; n--)
12596         {  /* and the rest */
12597         p = t->allDownPass[n];
12598         if (p->marked == YES && p->x < 0)
12599             pRoot[i++] = p;
12600         if (p->marked == YES && p->x > 0)
12601             pCrown[j++] = p;
12602         }
12603     assert (i==nRoot && j==nCrown);
12604 
12605     /* get final parsimony state sets for the root part */
12606     GetParsDP (t, t->root->left, chain);
12607     GetParsFP (t, t->root->left, chain);
12608     /* get final parsimony state sets for the crown part */
12609     GetParsDP (t, c, chain);
12610     GetParsDP (t, d, chain);
12611     GetParsFP (t, c, chain);
12612     GetParsFP (t, d, chain);
12613 
12614     /* find number of site patterns and modify randomly */
12615     globalNSitesOfPat = numSitesOfPat + (chainId[chain] % chainParams.numChains) * numCompressedChars;
12616     nSitesOfPat = (CLFlt *) SafeCalloc (numCompressedChars, sizeof(CLFlt));
12617     if (!nSitesOfPat)  goto errorExit;
12618     for (i=0; i<numCompressedChars; i++)
12619         {
12620         nSitesOfPat[i] = globalNSitesOfPat[i];
12621     /*  for (j=0; j<globalNSitesOfPat[i]; j++)
12622             {
12623             ran = RandomNumber(seed);
12624             if (ran < decreaseProb)
12625                 nSitesOfPat[i]--;
12626             else if (ran > 1.0 - increaseProb)
12627                 nSitesOfPat[i]++;
12628             }  // this is not used at the moment */
12629         }
12630 
12631     /* cycle through the possibilities and record the parsimony length */
12632     for (j=0; j<nCrown; j++)
12633         {
12634         for (i=0; i<nRoot; i++)
12635             {
12636             parLength[i+j*nRoot] = 0.0;
12637             for (n=0; n<t->nRelParts; n++)
12638                 {
12639                 division = t->relParts[n];
12640 
12641                 /* Find model settings */
12642                 m = &modelSettings[division];
12643 
12644                 /* find nSitesOfPat */
12645                 nSites = nSitesOfPat + m->compCharStart;
12646 
12647                 /* find downpass parsimony sets for the potential new connection nodes and their environment */
12648                 pA = m->parsSets[pRoot[i]->index];
12649                 pB = m->parsSets[pRoot[i]->anc->index];
12650                 pC = m->parsSets[pCrown[j]->index];
12651                 pD = m->parsSets[pCrown[j]->anc->index];
12652 
12653                 length = 0.0;
12654                 if (m->nParsIntsPerSite == 1)
12655                     {
12656                     for (k=0; k<m->numChars; k++)
12657                         {
12658                         y[0] = (pC[k] | pD[k]) & (pA[k] | pB[k]);
12659                         if (y[0] == 0)
12660                             length += nSites[k];
12661                         }
12662                     }
12663                 else /* if (m->nParsIntsPerSite == 2) */
12664                     {
12665                     for (k=0; k<2*m->numChars; k+=2)
12666                         {
12667                         y[0] = (pC[k] | pD[k]) & (pA[k] | pB[k]);
12668                         y[1] = (pC[k+1] | pD[k+1]) & (pA[k+1] | pB[k+1]);;
12669                         if ((y[0] | y[1]) == 0)
12670                             length += nSites[k/2];
12671                         }
12672                     }
12673                 parLength[i+j*nRoot] += warpFactor * length;
12674                 }
12675             }
12676         }
12677 
12678     /* find the min length and the sum for the forward move */
12679     minLength = -1.0;
12680     for (j=0; j<nCrown; j++)
12681         for (i=0; i<nRoot; i++)
12682             {
12683             if (i == 0 && j == 0)  // exclude original position
12684                 continue;
12685             if (minLength > parLength[i+j*nRoot] || minLength < 0.0)
12686                 minLength = parLength[i+j*nRoot];
12687             }
12688     sum1 = 0.0; tempc = 0.0;
12689     for (j=0; j<nCrown; j++)
12690         for (i=0; i<nRoot; i++)
12691             {
12692             if (i == 0 && j == 0)  // exclude original position
12693                 continue;
12694             /* Kahan summation to reduce numerical error */
12695             tempy = exp(minLength - parLength[i+j*nRoot]) - tempc;
12696             tempsum = sum1 + tempy;  tempc = (tempsum - sum1) - tempy;
12697             sum1 = tempsum;
12698             // sum1 += exp(minLength - parLength[i+j*nRoot]);
12699             // printf("%d %d %lf\n", i, j, exp(minLength - parLength[i+j*nRoot]));
12700             }
12701 
12702     /* generate a random uniform */
12703     ran = RandomNumber(seed) * sum1;
12704 
12705     /* select the appropriate reattachment point */
12706     newA = a; newC = c;
12707     prob = 0.0; tempc = 0.0;
12708     for (j=0; j<nCrown; j++)
12709         for (i=0; i<nRoot; i++)
12710             {
12711             if (i == 0 && j == 0)  // exclude original position
12712                 continue;
12713             // prob += exp (minLength - parLength[i+j*nRoot]);
12714             /* Kahan summation to reduce numerical error */
12715             tempy = exp(minLength - parLength[i+j*nRoot]) - tempc;
12716             tempsum = prob + tempy;  tempc = (tempsum - prob) - tempy;
12717             prob = tempsum;
12718             if (prob > ran) {
12719                 /* proposed new attaching position */
12720                 newA = pRoot[i];
12721                 newC = pCrown[j];
12722                 goto outLoop;
12723                 }
12724             }
12725 outLoop:;
12726     iA = i; jC = j;
12727 
12728     /* calculate the proposal ratio */
12729     (*lnProposalRatio) = parLength[i+j*nRoot] - minLength + log(sum1);
12730 
12731     /* find the min length and the sum for the backward move */
12732     minLength = -1.0;
12733     for (j=0; j<nCrown; j++)
12734         for (i=0; i<nRoot; i++)
12735             {
12736             if (i == iA && j == jC)  // exclude new position
12737                 continue;
12738             if (minLength > parLength[i+j*nRoot] || minLength < 0.0)
12739                 minLength = parLength[i+j*nRoot];
12740             }
12741     sum2 = 0.0; tempc = 0.0;
12742     for (j=0; j<nCrown; j++)
12743         for (i=0; i<nRoot; i++)
12744             {
12745             if (i == iA && j == jC)  // exclude new position
12746                 continue;
12747             /* Kahan summation to reduce numerical error */
12748             tempy = exp(minLength - parLength[i+j*nRoot]) - tempc;
12749             tempsum = sum2 + tempy;  tempc = (tempsum - sum2) - tempy;
12750             sum2 = tempsum;
12751             // sum2 += exp (minLength - parLength[i+j*nRoot]);
12752             // printf("%d %d %lf\n", i, j, exp(minLength - parLength[i+j*nRoot]));
12753             }
12754 
12755     /* calculate the proposal ratio */
12756     (*lnProposalRatio) += minLength - parLength[0] - log(sum2);
12757 
12758     /* reattach the root part */
12759     newB = newA->anc;
12760     newA->anc = u;
12761     if (u->left == v)
12762         u->right = newA;
12763     else
12764         u->left = newA;
12765     u->anc = newB;
12766     if (newB->left == newA)
12767         newB->left = u;
12768     else
12769         newB->right = u;
12770 
12771     /* transfer lock and reassign branch lengths, if necessary */
12772     if (newA != a)
12773         {
12774         /* if u is locked, then we have moved upwards and need to leave the u lock behind */
12775         if (u->isLocked == YES)
12776             {
12777             u->isLocked = NO;
12778             a->isLocked = YES;
12779             a->lockID = u->lockID;
12780             u->lockID = -1;
12781             }
12782 
12783         p = newA;
12784         while (p->anc != NULL)
12785             {
12786             if (p == a) break;
12787             p = p->anc;
12788             }
12789         if (p == a)
12790             {
12791             /* newA is descendant to a so move a->length not u->length */
12792             x = u->length;
12793             u->length = a->length;
12794             a->length = x;
12795             }
12796 
12797         p = b;
12798         while (p->anc != NULL)
12799             {
12800             if (p == newA) break;
12801             p = p->anc;
12802             }
12803         if (p == newA)
12804             {
12805             /* newA is ancestor to a so insert above instead of below */
12806             x = newA->length;
12807             newA->length = u->length;
12808             u->length = x;
12809             /* newA is on root path and locked, we need to transfer lock to u */
12810             if (newA->isLocked == YES) {
12811                 u->isLocked = YES;
12812                 u->lockID = newA->lockID;
12813                 newA->isLocked = NO;
12814                 newA->lockID = -1;
12815                 }
12816             }
12817 
12818         /* hit u length with multiplier */
12819         x = u->length * exp(tuning * (RandomNumber(seed) - 0.5));
12820         while (x < minV || x > maxV)
12821             {
12822             if (x < minV) x = minV * minV / x;
12823             if (x > maxV) x = maxV * maxV / x;
12824             }
12825         /* calculate proposal and prior ratio based on length modification */
12826         (*lnProposalRatio) += log (x / u->length);
12827         if (isVPriorExp == YES)
12828             (*lnPriorRatio) += brlensExp * (u->length - x);
12829         u->length = x;
12830 
12831         /* set tiprobs update flags */
12832         u->upDateTi = YES;
12833         newA->upDateTi = YES;
12834         a->upDateTi = YES;
12835         }
12836 
12837     r = newC;
12838     q = newB = newC->anc;
12839     if (newC != c)  // crown part has changed
12840         {
12841         /* rotate nodes from newC to c or d (whichever is closest) */
12842         tempc = r->length;
12843         while (r != c && r != d)
12844             {
12845             p = q->anc;
12846             /* rotate pointers of q */
12847             if (q->left == r)
12848                 q->left = p;
12849             else
12850                 q->right = p;
12851             q->anc = r;
12852             /* swap q and old */
12853             tempy = q->length;
12854             q->length = tempc;
12855             q->upDateTi = YES;
12856             tempc = tempy;
12857             /* make sure we get q and r initialized for next round */
12858             r = q;
12859             q = p;
12860             }
12861         newB->length = tempc;
12862 
12863         /* hit newB length with multiplier */
12864         x = newB->length * exp(tuning * (RandomNumber(seed) - 0.5));
12865         while (x < minV || x > maxV)
12866             {
12867             if (x < minV) x = minV * minV / x;
12868             if (x > maxV) x = maxV * maxV / x;
12869             }
12870         /* calculate proposal and prior ratio based on length modification */
12871         (*lnProposalRatio) += log (x / newB->length);
12872         if (isVPriorExp == YES)
12873             (*lnPriorRatio) += brlensExp * (newB->length - x);
12874         newB->length = x;
12875         newB->upDateTi = YES;
12876         }
12877 
12878     /* reattach the crown part */
12879     v->left = newC;
12880     v->right = newB;
12881     newC->anc = newB->anc = v;
12882 
12883     topologyHasChanged = YES;
12884 
12885     /* hit v length with multiplier */
12886     x = v->length * exp(tuning * (RandomNumber(seed) - 0.5));
12887     while (x < minV || x > maxV)
12888         {
12889         if (x < minV) x = minV * minV / x;
12890         if (x > maxV) x = maxV * maxV / x;
12891         }
12892     /* calculate proposal and prior ratio based on length modification */
12893     (*lnProposalRatio) += log (x / v->length);
12894     if (isVPriorExp == YES)
12895         (*lnPriorRatio) += brlensExp * (v->length - x);
12896     v->length = x;
12897     v->upDateTi = YES;
12898 
12899     /* set flags for update of cond likes */
12900     p = u;
12901     while (p->anc != NULL)
12902         {
12903         p->upDateCl = YES;
12904         p = p->anc;
12905         }
12906     p = b;
12907     while (p->anc != NULL)
12908         {
12909         p->upDateCl = YES;
12910         p = p->anc;
12911         }
12912     p = newC;
12913     while (p->anc != NULL)
12914         {
12915         p->upDateCl = YES;
12916         p = p->anc;
12917         }
12918     p = r;
12919     while (p->anc != NULL)
12920         {
12921         p->upDateCl = YES;
12922         p = p->anc;
12923         }
12924 
12925     /* get down pass sequence if tree topology has changed */
12926     if (topologyHasChanged == YES)
12927         {
12928         GetDownPass (t);
12929         }
12930 
12931     /* Dirichlet or twoExp prior */
12932     if (isVPriorExp > 1)
12933         (*lnPriorRatio) += LogDirPrior(t, mp, isVPriorExp);
12934 
12935     /* free up local memory */
12936     free (parLength); free (pRoot); free (pCrown); free (nSitesOfPat);
12937 
12938     return (NO_ERROR);
12939 
12940 errorExit:
12941     MrBayesPrint ("%s   Problem allocating memory in Move_ParsTBR\n", spacer);
12942     free (parLength); free (pRoot); free (pCrown); free (nSitesOfPat);
12943 
12944     return (ERROR);
12945 }
12946 
12947 
Move_ParsTBR2(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)12948 int Move_ParsTBR2 (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
12949 {
12950     /* Change topology and map branch lengths using TBR-type move biased according to parsimony scores,
12951        controlled by a window defined by a certain node distance radius. */
12952 
12953     int         i, j, k, n, division, topologyHasChanged, nNeighbor, nRoot, nCrown, iA, jC, isVPriorExp;
12954     BitsLong    *pA, *pB, *pC, *pD, y[2];
12955     MrBFlt      x, minV, maxV, brlensExp=0.0, minLength=0.0, length=0.0, *parLength=NULL, prob, ran, tuning, warpFactor,
12956                 v_typical, divFactor, nStates, sum1, sum2, tempsum, tempc, tempy;
12957     CLFlt       *nSites, *nSitesOfPat=NULL, *globalNSitesOfPat;
12958     TreeNode    *p, *q, *r, *a, *b, *u, *v, *c, *d, *newB, *newA, *newC, **pRoot=NULL, **pCrown=NULL;
12959     Tree        *t;
12960     ModelParams *mp;
12961     ModelInfo   *m=NULL;
12962 
12963     warpFactor = mvp[0];                  /* tuning parameter determining how heavily to weight according to parsimony scores */
12964 //  increaseProb = decreaseProb = mvp[1]; /* reweighting probabilities */
12965     tuning = mvp[3];                      /* multiplier tuning parameter */
12966     nNeighbor = (int)mvp[4];              /* distance to move picked branch in root and crown part */
12967 
12968     (*lnProposalRatio) = (*lnPriorRatio) = 0.0;
12969 
12970     /* get model params and model info */
12971     mp = &modelParams[param->relParts[0]];
12972     m = &modelSettings[param->relParts[0]];
12973 
12974     /* get tree */
12975     t = GetTree (param, chain, state[chain]);
12976 
12977     /* max and min brlen */
12978     if (param->subParams[0]->paramId == BRLENS_UNI)
12979         {
12980         minV = mp->brlensUni[0] > BRLENS_MIN ? mp->brlensUni[0] : BRLENS_MIN;
12981         maxV = mp->brlensUni[1] < BRLENS_MAX ? mp->brlensUni[1] : BRLENS_MAX;
12982         isVPriorExp = NO;
12983         }
12984     else if (param->subParams[0]->paramId == BRLENS_GamDir)
12985         {
12986         minV = BRLENS_MIN;
12987         maxV = BRLENS_MAX;
12988         isVPriorExp = 2;
12989         }
12990     else if (param->subParams[0]->paramId == BRLENS_iGmDir)
12991         {
12992         minV = BRLENS_MIN;
12993         maxV = BRLENS_MAX;
12994         isVPriorExp = 3;
12995         }
12996     else if (param->subParams[0]->paramId == BRLENS_twoExp)
12997         {
12998         minV = BRLENS_MIN;
12999         maxV = BRLENS_MAX;
13000         isVPriorExp = 4;
13001         }
13002     else
13003         {
13004         minV = BRLENS_MIN;
13005         maxV = BRLENS_MAX;
13006         brlensExp = mp->brlensExp;
13007         isVPriorExp = YES;
13008         }
13009 
13010     /* Dirichlet or twoExp prior */
13011     if (isVPriorExp > 1)
13012         (*lnPriorRatio) = -LogDirPrior(t, mp, isVPriorExp);
13013 
13014     /* set topologyHasChanged to NO */
13015     topologyHasChanged = NO; /* FIXME: Not used (from clang static analyzer) */
13016 
13017     /* reset node variables that will be used */
13018     for (i=0; i<t->nNodes; i++)
13019         {
13020         p = t->allDownPass[i];
13021         p->x = 0;
13022         p->marked = NO;
13023         }
13024 
13025     /* pick an internal branch */
13026     do  {
13027         p = t->intDownPass[(int)(RandomNumber(seed)*(t->nIntNodes-1))];
13028         q = p->anc->left;
13029         if (q == p)  q = p->anc->right;
13030         i = j = 0;
13031         if (q->isLocked == YES || q->left == NULL)
13032             i++;
13033         if (p->anc->isLocked == YES || p->anc->anc->anc == NULL)
13034             i++;
13035         if (p->left->isLocked == YES || p->left->left == NULL)
13036             j++;
13037         if (p->right->isLocked == YES || p->right->left == NULL)
13038             j++;
13039         }
13040     while (i == 2 && j == 2);
13041 
13042     /* set up pointers for nodes around the picked branch */
13043     v = p;            u = p->anc;
13044     c = p->left;      d = p->right;
13045     if (u->left == v) a = u->right;
13046     else              a = u->left;
13047     b = u->anc;
13048     /* clip root part of tree */
13049     a->anc = b;
13050     if (b->left == u) b->left = a;
13051     else              b->right = a;
13052     /* clip crown part of tree */
13053     c->anc = d;
13054     d->anc = c;
13055     /* should never change u, v, a, b, c, d pointers */
13056 
13057     /* mark nodes nNeighbor away in root (negative) and crown (positive) respecting constraints */
13058     /* first move down towards root */
13059     nRoot = nCrown = 0;
13060     if (u->isLocked == NO)
13061         {
13062         p = a; q = b; n = 0;
13063         while (q->anc != NULL)
13064             {
13065             q->marked = YES;
13066             q->x = n;    // temporary, for MarkDistance below
13067             if (q->left == p)
13068                 MarkDistance(q->right, YES, nNeighbor, &nRoot);
13069             else
13070                 MarkDistance(q->left,  YES, nNeighbor, &nRoot);
13071             q->x = --n;  // final
13072             nRoot++;
13073             if (q->isLocked == YES || abs(q->x) >= nNeighbor)
13074                 break;
13075             p = q; q = q->anc;
13076             }
13077         }
13078     /* then move up in root part */
13079     a->marked = YES; nRoot++;
13080     if (a->isLocked == NO)
13081         {
13082         MarkDistance(a->left,  YES, nNeighbor, &nRoot);
13083         MarkDistance(a->right, YES, nNeighbor, &nRoot);
13084         }
13085     /* finally in crown part */
13086     c->marked = YES; nCrown++;
13087     if (c->isLocked == NO)
13088         {
13089         MarkDistance(c->left,  NO, nNeighbor, &nCrown);
13090         MarkDistance(c->right, NO, nNeighbor, &nCrown);
13091         }
13092     if (d->isLocked == NO)
13093         {
13094         MarkDistance(d->left,  NO, nNeighbor, &nCrown);
13095         MarkDistance(d->right, NO, nNeighbor, &nCrown);
13096         }
13097 
13098     /* need to alloc a matrix for parsimony lengths, an array of pointers to crown part,
13099        and an array of pointers to root part. */
13100     parLength = (MrBFlt *) SafeCalloc ((size_t)nRoot * (size_t)nCrown, sizeof(MrBFlt));
13101     pRoot  = (TreeNode **) SafeCalloc(nRoot,  sizeof(TreeNode *));
13102     pCrown = (TreeNode **) SafeCalloc(nCrown, sizeof(TreeNode *));
13103     if (!parLength || !pRoot || !pCrown)  goto errorExit;
13104     /* starting position */
13105     pRoot[0] = a; pCrown[0] = c;
13106     for (i=j=1, n=t->nNodes-2; n>=0; n--)
13107         {  /* and the rest */
13108         p = t->allDownPass[n];
13109         if (p->marked == YES && p->x < 0)
13110             pRoot[i++] = p;
13111         if (p->marked == YES && p->x > 0)
13112             pCrown[j++] = p;
13113         }
13114     assert (i==nRoot && j==nCrown);
13115 
13116     /* get final parsimony state sets for the root part */
13117     GetParsDP (t, t->root->left, chain);
13118     GetParsFP (t, t->root->left, chain);
13119     /* get final parsimony state sets for the crown part */
13120     GetParsDP (t, c, chain);
13121     GetParsDP (t, d, chain);
13122     GetParsFP (t, c, chain);
13123     GetParsFP (t, d, chain);
13124 
13125     /* find number of site patterns and modify randomly */
13126     globalNSitesOfPat = numSitesOfPat + (chainId[chain] % chainParams.numChains) * numCompressedChars;
13127     nSitesOfPat = (CLFlt *) SafeCalloc (numCompressedChars, sizeof(CLFlt));
13128     if (!nSitesOfPat)  goto errorExit;
13129     for (i=0; i<numCompressedChars; i++)
13130         {
13131         nSitesOfPat[i] = globalNSitesOfPat[i];
13132     /*  for (j=0; j<globalNSitesOfPat[i]; j++)
13133             {
13134             ran = RandomNumber(seed);
13135             if (ran < decreaseProb)
13136                 nSitesOfPat[i]--;
13137             else if (ran > 1.0 - increaseProb)
13138                 nSitesOfPat[i]++;
13139             }  // this is not used at the moment */
13140         }
13141 
13142     /* cycle through the possibilities and record the parsimony length */
13143     for (j=0; j<nCrown; j++)
13144         {
13145         for (i=0; i<nRoot; i++)
13146             {
13147             parLength[i+j*nRoot] = 0.0;
13148             for (n=0; n<t->nRelParts; n++)
13149                 {
13150                 division = t->relParts[n];
13151 
13152                 /* Find model settings */
13153                 m = &modelSettings[division];
13154 
13155                 /* find nSitesOfPat */
13156                 nSites = nSitesOfPat + m->compCharStart;
13157 
13158                 /* find downpass parsimony sets for the potential new connection nodes and their environment */
13159                 pA = m->parsSets[pRoot[i]->index];
13160                 pB = m->parsSets[pRoot[i]->anc->index];
13161                 pC = m->parsSets[pCrown[j]->index];
13162                 pD = m->parsSets[pCrown[j]->anc->index];
13163 
13164                 length = 0.0;
13165                 if (m->nParsIntsPerSite == 1)
13166                     {
13167                     for (k=0; k<m->numChars; k++)
13168                         {
13169                         y[0] = (pC[k] | pD[k]) & (pA[k] | pB[k]);
13170                         if (y[0] == 0)
13171                             length += nSites[k];
13172                         }
13173                     }
13174                 else /* if (m->nParsIntsPerSite == 2) */
13175                     {
13176                     for (k=0; k<2*m->numChars; k+=2)
13177                         {
13178                         y[0] = (pC[k] | pD[k]) & (pA[k] | pB[k]);
13179                         y[1] = (pC[k+1] | pD[k+1]) & (pA[k+1] | pB[k+1]);;
13180                         if ((y[0] | y[1]) == 0)
13181                             length += nSites[k/2];
13182                         }
13183                     }
13184 
13185                 /* find nStates and ratemult */
13186                 nStates = m->numModelStates;
13187                 if (m->dataType == STANDARD)
13188                     nStates = 2;
13189                 v_typical = length/m->numUncompressedChars + 0.0001;
13190 
13191                 /* get division warp factor (prop. to prob. of change) */
13192                 divFactor = - warpFactor * log(1.0/nStates - exp(-nStates/(nStates-1)*v_typical)/nStates);
13193                 parLength[i+j*nRoot] += divFactor * length;
13194                 }
13195             }
13196         }
13197 
13198     /* find the min length and the sum for the forward move */
13199     minLength = -1.0;
13200     for (j=0; j<nCrown; j++)
13201         for (i=0; i<nRoot; i++)
13202             {
13203             if (i == 0 && j == 0)  // exclude original position
13204                 continue;
13205             if (minLength > parLength[i+j*nRoot] || minLength < 0.0)
13206                 minLength = parLength[i+j*nRoot];
13207             }
13208     sum1 = 0.0; tempc = 0.0;
13209     for (j=0; j<nCrown; j++)
13210         for (i=0; i<nRoot; i++)
13211             {
13212             if (i == 0 && j == 0)  // exclude original position
13213                 continue;
13214             /* Kahan summation to reduce numerical error */
13215             tempy = exp(minLength - parLength[i+j*nRoot]) - tempc;
13216             tempsum = sum1 + tempy;  tempc = (tempsum - sum1) - tempy;
13217             sum1 = tempsum;
13218             // sum1 += exp(minLength - parLength[i+j*nRoot]);
13219             // printf("%d %d %lf\n", i, j, exp(minLength - parLength[i+j*nRoot]));
13220             }
13221 
13222     /* generate a random uniform */
13223     ran = RandomNumber(seed) * sum1;
13224 
13225     /* select the appropriate reattachment point */
13226     newA = a; newC = c;
13227     prob = 0.0; tempc = 0.0;
13228     for (j=0; j<nCrown; j++)
13229         for (i=0; i<nRoot; i++)
13230             {
13231             if (i == 0 && j == 0)  // exclude original position
13232                 continue;
13233             // prob += exp (minLength - parLength[i+j*nRoot]);
13234             /* Kahan summation to reduce numerical error */
13235             tempy = exp(minLength - parLength[i+j*nRoot]) - tempc;
13236             tempsum = prob + tempy;  tempc = (tempsum - prob) - tempy;
13237             prob = tempsum;
13238             if (prob > ran) {
13239                 /* proposed new attaching position */
13240                 newA = pRoot[i];
13241                 newC = pCrown[j];
13242                 goto outLoop;
13243                 }
13244             }
13245 outLoop:;
13246     iA = i; jC = j;
13247 
13248     /* calculate the proposal ratio */
13249     (*lnProposalRatio) = parLength[i+j*nRoot] - minLength + log(sum1);
13250 
13251     /* find the min length and the sum for the backward move */
13252     minLength = -1.0;
13253     for (j=0; j<nCrown; j++)
13254         for (i=0; i<nRoot; i++)
13255             {
13256             if (i == iA && j == jC)  // exclude new position
13257                 continue;
13258             if (minLength > parLength[i+j*nRoot] || minLength < 0.0)
13259                 minLength = parLength[i+j*nRoot];
13260             }
13261     sum2 = 0.0; tempc = 0.0;
13262     for (j=0; j<nCrown; j++)
13263         for (i=0; i<nRoot; i++)
13264             {
13265             if (i == iA && j == jC)  // exclude new position
13266                 continue;
13267             /* Kahan summation to reduce numerical error */
13268             tempy = exp(minLength - parLength[i+j*nRoot]) - tempc;
13269             tempsum = sum2 + tempy;  tempc = (tempsum - sum2) - tempy;
13270             sum2 = tempsum;
13271             // sum2 += exp (minLength - parLength[i+j*nRoot]);
13272             // printf("%d %d %lf\n", i, j, exp(minLength - parLength[i+j*nRoot]));
13273             }
13274 
13275     /* calculate the proposal ratio */
13276     (*lnProposalRatio) += minLength - parLength[0] - log(sum2);
13277 
13278     /* reattach the root part */
13279     newB = newA->anc;
13280     newA->anc = u;
13281     if (u->left == v)
13282         u->right = newA;
13283     else
13284         u->left = newA;
13285     u->anc = newB;
13286     if (newB->left == newA)
13287         newB->left = u;
13288     else
13289         newB->right = u;
13290 
13291     /* transfer lock and reassign branch lengths, if necessary */
13292     if (newA != a)
13293         {
13294         /* if u is locked, then we have moved upwards and need to leave the u lock behind */
13295         if (u->isLocked == YES)
13296             {
13297             u->isLocked = NO;
13298             a->isLocked = YES;
13299             a->lockID = u->lockID;
13300             u->lockID = -1;
13301             }
13302 
13303         p = newA;
13304         while (p->anc != NULL)
13305             {
13306             if (p == a) break;
13307             p = p->anc;
13308             }
13309         if (p == a)
13310             {
13311             /* newA is descendant to a so move a->length not u->length */
13312             x = u->length;
13313             u->length = a->length;
13314             a->length = x;
13315             }
13316 
13317         p = b;
13318         while (p->anc != NULL)
13319             {
13320             if (p == newA) break;
13321             p = p->anc;
13322             }
13323         if (p == newA)
13324             {
13325             /* newA is ancestor to a so insert above instead of below */
13326             x = newA->length;
13327             newA->length = u->length;
13328             u->length = x;
13329             /* newA is on root path and locked, we need to transfer lock to u */
13330             if (newA->isLocked == YES) {
13331                 u->isLocked = YES;
13332                 u->lockID = newA->lockID;
13333                 newA->isLocked = NO;
13334                 newA->lockID = -1;
13335                 }
13336             }
13337 
13338         /* hit u length with multiplier */
13339         x = u->length * exp(tuning * (RandomNumber(seed) - 0.5));
13340         while (x < minV || x > maxV)
13341             {
13342             if (x < minV) x = minV * minV / x;
13343             if (x > maxV) x = maxV * maxV / x;
13344             }
13345         /* calculate proposal and prior ratio based on length modification */
13346         (*lnProposalRatio) += log (x / u->length);
13347         if (isVPriorExp == YES)
13348             (*lnPriorRatio) += brlensExp * (u->length - x);
13349         u->length = x;
13350 
13351         /* set tiprobs update flags */
13352         u->upDateTi = YES;
13353         newA->upDateTi = YES;
13354         a->upDateTi = YES;
13355         }
13356 
13357     r = newC;
13358     q = newB = newC->anc;
13359     if (newC != c)  // crown part has changed
13360         {
13361         /* rotate nodes from newC to c or d (whichever is closest) */
13362         tempc = r->length;
13363         while (r != c && r != d)
13364             {
13365             p = q->anc;
13366             /* rotate pointers of q */
13367             if (q->left == r)
13368                 q->left = p;
13369             else
13370                 q->right = p;
13371             q->anc = r;
13372             /* swap q and old */
13373             tempy = q->length;
13374             q->length = tempc;
13375             q->upDateTi = YES;
13376             tempc = tempy;
13377             /* make sure we get q and r initialized for next round */
13378             r = q;
13379             q = p;
13380             }
13381         newB->length = tempc;
13382 
13383         /* hit newB length with multiplier */
13384         x = newB->length * exp(tuning * (RandomNumber(seed) - 0.5));
13385         while (x < minV || x > maxV)
13386             {
13387             if (x < minV) x = minV * minV / x;
13388             if (x > maxV) x = maxV * maxV / x;
13389             }
13390         /* calculate proposal and prior ratio based on length modification */
13391         (*lnProposalRatio) += log (x / newB->length);
13392         if (isVPriorExp == YES)
13393             (*lnPriorRatio) += brlensExp * (newB->length - x);
13394         newB->length = x;
13395         newB->upDateTi = YES;
13396         }
13397 
13398     /* reattach the crown part */
13399     v->left = newC;
13400     v->right = newB;
13401     newC->anc = newB->anc = v;
13402 
13403     topologyHasChanged = YES;
13404 
13405     /* hit v length with multiplier */
13406     x = v->length * exp(tuning * (RandomNumber(seed) - 0.5));
13407     while (x < minV || x > maxV)
13408         {
13409         if (x < minV) x = minV * minV / x;
13410         if (x > maxV) x = maxV * maxV / x;
13411         }
13412     /* calculate proposal and prior ratio based on length modification */
13413     (*lnProposalRatio) += log (x / v->length);
13414     if (isVPriorExp == YES)
13415         (*lnPriorRatio) += brlensExp * (v->length - x);
13416     v->length = x;
13417     v->upDateTi = YES;
13418 
13419     /* set flags for update of cond likes */
13420     p = u;
13421     while (p->anc != NULL)
13422         {
13423         p->upDateCl = YES;
13424         p = p->anc;
13425         }
13426     p = b;
13427     while (p->anc != NULL)
13428         {
13429         p->upDateCl = YES;
13430         p = p->anc;
13431         }
13432     p = newC;
13433     while (p->anc != NULL)
13434         {
13435         p->upDateCl = YES;
13436         p = p->anc;
13437         }
13438     p = r;
13439     while (p->anc != NULL)
13440         {
13441         p->upDateCl = YES;
13442         p = p->anc;
13443         }
13444 
13445     /* get down pass sequence if tree topology has changed */
13446     if (topologyHasChanged == YES)
13447         {
13448         GetDownPass (t);
13449         }
13450 
13451     /* Dirichlet or twoExp prior */
13452     if (isVPriorExp > 1)
13453         (*lnPriorRatio) += LogDirPrior(t, mp, isVPriorExp);
13454 
13455     /* free up local memory */
13456     free (parLength); free (pRoot); free (pCrown); free (nSitesOfPat);
13457 
13458     return (NO_ERROR);
13459 
13460 errorExit:
13461     MrBayesPrint ("%s   Problem allocating memory in Move_ParsTBR\n", spacer);
13462     free (parLength); free (pRoot); free (pCrown); free (nSitesOfPat);
13463 
13464     return (ERROR);
13465 }
13466 
13467 
Move_Pinvar(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)13468 int Move_Pinvar (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
13469 {
13470     /* change proportion of invariable sites (pInvar) */
13471 
13472     int             i, c, isValidP, *rateCat, nGammaCats;
13473     MrBFlt          oldP, newP, window, minP, maxP, ran, lnInvarRatio, lnVarRatio;
13474     CLFlt           *nSitesOfPat;
13475     ModelParams     *mp;
13476     ModelInfo       *m;
13477 
13478     /* get size of window, centered on current pInvar value */
13479     window = mvp[0];
13480 
13481     /* get model params */
13482     mp = &modelParams[param->relParts[0]];
13483 
13484     /* get minimum and maximum values for pInvar */
13485     minP = mp->pInvarUni[0];
13486     maxP = mp->pInvarUni[1];
13487 
13488     /* get old value of pInvar */
13489     oldP = *GetParamVals(param, chain, state[chain]);
13490 
13491     /* change value for pInvar */
13492     ran = RandomNumber(seed);
13493     if (maxP-minP < window)
13494         {
13495         window = maxP-minP;
13496         }
13497 
13498     newP = oldP + window * (ran - 0.5);
13499 
13500     /* check validity */
13501     isValidP = NO;
13502     do
13503         {
13504         if (newP < minP)
13505             newP = 2* minP - newP;
13506         else if (newP > maxP)
13507             newP = 2 * maxP - newP;
13508         else
13509             isValidP = YES;
13510         } while (isValidP == NO);
13511 
13512     /* get proposal ratio */
13513     *lnProposalRatio = 0.0;
13514 
13515     /* get prior ratio */
13516     *lnPriorRatio = 0.0;
13517     lnInvarRatio = log(newP) - log(oldP);
13518     lnVarRatio = log(1.0-newP) - log(1.0-oldP);
13519     for (i=0; i<param->nRelParts; i++)
13520         {
13521         m = &modelSettings[param->relParts[i]];
13522         if (m->gibbsGamma == YES)
13523             {
13524             /* find rate category index and number of gamma categories */
13525             rateCat = m->tiIndex + chain * m->numChars;
13526             nGammaCats = m->numRateCats;
13527 
13528             /* find nSitesOfPat */
13529             nSitesOfPat = numSitesOfPat + (chainId[chain] % chainParams.numChains)*numCompressedChars + m->compCharStart;
13530 
13531             /* loop over characters */
13532             for (c=0; c<m->numChars; c++)
13533                 {
13534                 if (rateCat[c] < nGammaCats)
13535                     *lnPriorRatio += lnVarRatio * nSitesOfPat[c];
13536                 else
13537                     *lnPriorRatio += lnInvarRatio * nSitesOfPat[c];
13538                 }
13539             }
13540         }
13541 
13542     /* copy new pInvar value back */
13543     *GetParamVals(param, chain, state[chain]) = newP;
13544 
13545     /* Set update flags for all partitions that share this pInvar. Note that the conditional
13546        likelihood update flags for divisions have been set before we even call this function. */
13547     for (i=0; i<param->nRelParts; i++)
13548         TouchAllTreeNodes(&modelSettings[param->relParts[i]],chain);
13549 
13550     /* However, you do need to update cijk flags if this is a covarion model */
13551     /* TO DO */
13552 
13553     return (NO_ERROR);
13554 }
13555 
13556 
Move_PopSize_M(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)13557 int Move_PopSize_M (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
13558 {
13559     int             isValidN, valIndex;
13560     MrBFlt          *valPtr, oldN, newN, tuning, minN, maxN, ran, oldLnPrior=0.0, newLnPrior=0.0, growth,
13561                     oldT, newT, clockRate;
13562     ModelParams     *mp;
13563     ModelInfo       *m;
13564     Tree            *t;
13565 
13566     /* get multiplier tuning parameter */
13567     tuning = mvp[0];
13568 
13569     /* get model params */
13570     mp = &modelParams[param->relParts[0]];
13571 
13572     /* get model settings */
13573     m = &modelSettings[param->relParts[0]];
13574 
13575     /* get minimum and maximum values for population size */
13576     if (param->paramId == POPSIZE_UNI)
13577         {
13578         minN = mp->popSizeUni[0];
13579         maxN = mp->popSizeUni[1];
13580         }
13581     else
13582         {
13583         minN = 0.00000001;
13584         maxN = 10000000;
13585         }
13586 
13587     /* get pointer to value to be changed */
13588     valIndex = (int)(RandomNumber(seed) * param->nValues);
13589     valPtr = GetParamVals(param, chain, state[chain]) + valIndex;
13590 
13591     /* get old value of population size */
13592     oldN = *valPtr;
13593 
13594     /* get old prior for species tree coalescence */
13595     if (m->brlens->paramId == BRLENS_CLOCK_SPCOAL)
13596         {
13597         oldLnPrior = LnSpeciesTreeProb(chain);
13598         }
13599 
13600     /* change value for theta */
13601     ran = RandomNumber(seed);
13602     newN = oldN * exp(tuning * (ran - 0.5));
13603 
13604     /* check that new value is valid */
13605     isValidN = NO;
13606     do {
13607         if (newN < minN)
13608             newN = 2* minN - newN;
13609         else if (newN > maxN)
13610             newN = 2 * maxN - newN;
13611         else
13612             isValidN = YES;
13613         }
13614     while (isValidN == NO);
13615 
13616     /* copy new population size value back */
13617     (*valPtr) = newN;
13618 
13619     /* get proposal ratio */
13620     *lnProposalRatio = log (newN / oldN);
13621 
13622     /* get prior ratio */
13623     if (m->brlens->paramId == BRLENS_CLOCK_SPCOAL)
13624         {
13625         newLnPrior = LnSpeciesTreeProb(chain);
13626         }
13627     else
13628         {
13629         t = GetTree(modelSettings[param->relParts[0]].brlens,chain,state[chain]);
13630         m = &modelSettings[param->relParts[0]];
13631         clockRate = *GetParamVals(m->clockRate, chain, state[chain]);
13632         if (!strcmp(mp->ploidy, "Diploid"))
13633             clockRate *= 4.0;
13634         else if (!strcmp(mp->ploidy, "Zlinked"))
13635             clockRate *= 3.0;
13636         else
13637             clockRate *= 2.0;
13638         newT = newN * clockRate;
13639         oldT = oldN * clockRate;
13640         if (!strcmp(mp->growthPr, "Fixed"))
13641             growth = mp->growthFix;
13642         else
13643             growth = *(GetParamVals (m->growthRate, chain, state[chain]));
13644         if (LnCoalescencePriorPr (t, &oldLnPrior, oldT, growth) == ERROR)
13645             {
13646             MrBayesPrint ("%s   Problem calculating prior for coalescent process\n", spacer);
13647             return (ERROR);
13648             }
13649         if (LnCoalescencePriorPr (t, &newLnPrior, newT, growth) == ERROR)
13650             {
13651             MrBayesPrint ("%s   Problem calculating prior for coalescent process\n", spacer);
13652             return (ERROR);
13653             }
13654         }
13655 
13656     (*lnPriorRatio) = param->LnPriorRatio(newN, oldN, param->priorParams);
13657     (*lnPriorRatio) += newLnPrior - oldLnPrior;
13658 
13659     return (NO_ERROR);
13660 }
13661 
13662 
13663 /* Generalized lognormal move for positive real random variables */
Move_PosRealLognormal(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)13664 int Move_PosRealLognormal (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
13665 {
13666     int         i;
13667     MrBFlt      oldX, newX, minX, maxX, tuning, u, z;
13668 
13669     /* get tuning parameter */
13670     tuning = mvp[0];
13671 
13672     /* get minimum and maximum values for X */
13673     minX = param->min;
13674     maxX = param->max;
13675 
13676     /* get old value of X */
13677     oldX = *GetParamVals(param, chain, state[chain]);
13678 
13679     /* change value of X */
13680     u = RandomNumber(seed);
13681     z = PointNormal(u);
13682 
13683     newX = exp (log(oldX) + z * tuning);
13684 
13685     /* check that new value is valid */
13686     if (newX < minX || newX > maxX) {
13687         abortMove = YES;
13688         return (NO_ERROR);
13689     }
13690 
13691     /* get proposal ratio */
13692     (*lnProposalRatio) = log (newX / oldX);
13693 
13694     /* get prior ratio */
13695     (*lnPriorRatio) = param->LnPriorRatio(newX, oldX, param->priorParams);
13696 
13697     /* copy new value back */
13698     (*GetParamVals(param, chain, state[chain])) = newX;
13699 
13700     /* Set update flags for tree nodes if relevant */
13701     if (param->affectsLikelihood == YES)
13702         {
13703         for (i=0; i<param->nRelParts; i++)
13704             TouchAllTreeNodes(&modelSettings[param->relParts[i]],chain);
13705         }
13706 
13707     return (NO_ERROR);
13708 }
13709 
13710 
13711 /* Generalized multiplier move for positive real random variables */
Move_PosRealMultiplier(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)13712 int Move_PosRealMultiplier (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
13713 {
13714     int         i, isValid;
13715     MrBFlt      oldX, newX, minX, maxX, tuning, ran, factor;
13716 
13717     /* get tuning parameter */
13718     tuning = mvp[0];
13719 
13720     /* get minimum and maximum values for X */
13721     minX = param->min;
13722     maxX = param->max;
13723 
13724     /* get old value of X */
13725     oldX = *GetParamVals(param, chain, state[chain]);
13726 
13727     /* change value of X */
13728     ran = RandomNumber(seed);
13729     factor = exp(tuning * (ran - 0.5));
13730     newX = oldX * factor;
13731 
13732     /* check that new value is valid */
13733     isValid = NO;
13734     do
13735         {
13736         if (newX < minX)
13737             newX = minX * minX / newX;
13738         else if (newX > maxX)
13739             newX = maxX * maxX / newX;
13740         else
13741             isValid = YES;
13742         } while (isValid == NO);
13743 
13744     /* get proposal ratio */
13745     (*lnProposalRatio) = log (newX / oldX);
13746 
13747     /* get prior ratio */
13748     (*lnPriorRatio) = param->LnPriorRatio(newX, oldX, param->priorParams);
13749 
13750     /* copy new value back */
13751     *(GetParamVals(param, chain, state[chain])) = newX;
13752 
13753     /* Set update flags for tree nodes if relevant */
13754     if (param->affectsLikelihood == YES)
13755         {
13756         for (i=0; i<param->nRelParts; i++)
13757             TouchAllTreeNodes(&modelSettings[param->relParts[i]],chain);
13758         }
13759 
13760     return (NO_ERROR);
13761 }
13762 
13763 
13764 /*----------------------------------------------------------------
13765 |
13766 |   Move_RateMult_Dir: Change rate multiplier using Dirichlet
13767 |      proposal.
13768 |
13769 ----------------------------------------------------------------*/
Move_RateMult_Dir(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)13770 int Move_RateMult_Dir (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
13771 {
13772     int         i, nRates, isValid;
13773     MrBFlt      alphaPi, *value, *subValue, numSites, *alphaDir, x, y, sum,
13774                 rate_pot, *dirParm, *oldRate, *newRate;
13775 
13776     /* allocate memory */
13777     dirParm = (MrBFlt *) SafeCalloc (3*numCurrentDivisions, sizeof(MrBFlt));
13778     oldRate = dirParm + numCurrentDivisions;
13779     newRate = dirParm + 2*numCurrentDivisions;
13780 
13781     /* get number of rates */
13782     nRates = param->nValues;
13783 
13784     /* get pointer to rates and number of uncompressed chars */
13785     value = GetParamVals(param, chain, state[chain]);
13786     subValue = GetParamSubVals(param, chain, state[chain]);
13787 
13788     /* get Dirichlet parameters */
13789     alphaDir = subValue + nRates;
13790 
13791     /* calculate old ratesum proportions */
13792     numSites = 0.0;
13793     for (i=0; i<nRates; i++)
13794         numSites += subValue[i];  /* numSites should be equal to the number of sites */
13795     for (i=0; i<nRates; i++)
13796         oldRate[i] = value[i] * subValue[i] / numSites;
13797 
13798     /* get alphaPi tuning parameter */
13799     alphaPi = mvp[0] * nRates;
13800 
13801     /* multiply old ratesum proportions with some large number to get new values close to the old ones */
13802     for (i=0; i<nRates; i++)
13803         dirParm[i] = oldRate[i] * alphaPi;
13804 
13805     /* get new values */
13806     DirichletRandomVariable (dirParm, newRate, nRates, seed);
13807 
13808     /* check new values. we rely on newRate be already normalized  */
13809     while (1)
13810         {
13811         sum = 0.0;
13812         rate_pot = 1.0;
13813         isValid=1;
13814         for (i=0; i<nRates; i++)
13815             {
13816             if (newRate[i] <= DIR_MIN)
13817                 {
13818                 if (newRate[i] < DIR_MIN)
13819                     {
13820                     newRate[i] = DIR_MIN;
13821                     isValid=0;
13822                     }
13823                 rate_pot -= DIR_MIN;
13824                 }
13825             else
13826                 sum += newRate[i];
13827             }
13828         if (isValid==1) break;
13829         for (i=0; i<nRates; i++)
13830             {
13831             if (newRate[i]!=DIR_MIN)
13832                 newRate[i] = rate_pot * newRate[i] / sum;
13833             }
13834         }
13835 
13836     /* calculate and copy new rate ratio values back */
13837     for (i=0; i<nRates; i++)
13838         value[i] = newRate[i] * (numSites / subValue[i]);
13839 
13840     /* get proposal ratio */
13841     sum = 0.0;
13842     for (i=0; i<nRates; i++)
13843         sum += newRate[i]*alphaPi;
13844     x = LnGamma(sum);
13845     for (i=0; i<nRates; i++)
13846         x -= LnGamma(newRate[i]*alphaPi);
13847     for (i=0; i<nRates; i++)
13848         x += (newRate[i]*alphaPi-1.0)*log(oldRate[i]);
13849     sum = 0.0;
13850     for (i=0; i<nRates; i++)
13851         sum += oldRate[i]*alphaPi;
13852     y = LnGamma(sum);
13853     for (i=0; i<nRates; i++)
13854         y -= LnGamma(oldRate[i]*alphaPi);
13855     for (i=0; i<nRates; i++)
13856         y += (oldRate[i]*alphaPi-1.0)*log(newRate[i]);
13857     (*lnProposalRatio) = x - y;
13858 
13859     /* get prior ratio */
13860     x = y = 0.0;
13861     for (i=0; i<nRates; i++)
13862         x += (alphaDir[i]-1.0)*log(newRate[i]);
13863     for (i=0; i<nRates; i++)
13864         y += (alphaDir[i]-1.0)*log(oldRate[i]);
13865     (*lnPriorRatio) = x - y;
13866 
13867     /* Set update flags for all partitions that share the rate multiplier. Note that the conditional
13868        likelihood update flags have been set before we even call this function. */
13869     for (i=0; i<param->nRelParts; i++)
13870         TouchAllTreeNodes(&modelSettings[param->relParts[i]],chain);
13871 
13872     /* may need to hit update flag for cijks when you have a covarion model */
13873     for (i=0; i<param->nRelParts; i++)
13874         if (modelSettings[param->relParts[i]].nCijkParts > 1)
13875             modelSettings[param->relParts[i]].upDateCijk = YES;
13876 
13877     free (dirParm);
13878 
13879     return (NO_ERROR);
13880 }
13881 
13882 
13883 /*----------------------------------------------------------------
13884 |
13885 |   Move_RateMult_Slider: Change rate multiplier using slider
13886 |      proposal.
13887 |
13888 ----------------------------------------------------------------*/
Move_RateMult_Slider(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)13889 int Move_RateMult_Slider (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
13890 {
13891     int         i, indexI, indexJ, nRates;
13892     MrBFlt      delta, *value, *subValue, sum, numSites, *alphaDir, x, y,
13893                 oldRate[2], newRate[2], min, max;
13894 
13895     /* get number of rates */
13896     nRates = param->nValues;
13897 
13898     /* get pointer to rates and number of uncompressed chars */
13899     value = GetParamVals(param, chain, state[chain]);
13900     subValue = GetParamSubVals(param, chain, state[chain]);
13901 
13902     /* get Dirichlet prior parameters */
13903     alphaDir = subValue + nRates;
13904 
13905     /* randomly select two rates */
13906     indexI = (int) (RandomNumber(seed) * nRates);
13907     indexJ = (int) (RandomNumber(seed) * (nRates - 1));
13908     if (indexJ == indexI)
13909         indexJ = nRates - 1;
13910 
13911     /* calculate old ratesum proportions */
13912     numSites = 0.0;
13913     for (i=0; i<nRates; i++)
13914         numSites += subValue[i];  /* numSites should be equal to the number of sites */
13915     oldRate[0] = value[indexI] * subValue[indexI] / numSites;
13916     oldRate[1] = value[indexJ] * subValue[indexJ] / numSites;
13917     sum = oldRate[0] + oldRate[1];
13918 
13919     /* get delta tuning parameter */
13920     delta = mvp[0];
13921 
13922     /* reflect */
13923     min = DIR_MIN / sum;
13924     max = 1.0 - min;
13925     if (delta > max-min) /* we do it to avoid following long while loop in case if delta is high */
13926         delta = max-min;
13927 
13928     x = oldRate[0] / sum;
13929     y = x + delta * (RandomNumber(seed) - 0.5);
13930     while (y < min || y > max)
13931         {
13932         if (y < min)
13933             y = 2.0 * min - y;
13934         if (y > max)
13935             y = 2.0 * max - y;
13936         }
13937 
13938     /* set the new values */
13939     newRate[0] = y * sum;
13940     newRate[1] = sum - newRate[0];
13941     value[indexI] = newRate[0] * numSites / subValue[indexI];
13942     value[indexJ] = newRate[1] * numSites / subValue[indexJ];
13943 
13944     /* get proposal ratio */
13945     (*lnProposalRatio) = 0.0;
13946 
13947     /* get prior ratio */
13948     (*lnPriorRatio)  = (alphaDir[indexI]-1.0) * (log(newRate[0]) - log(oldRate[0]));
13949     (*lnPriorRatio) += (alphaDir[indexJ]-1.0) * (log(newRate[1]) - log(oldRate[1]));
13950 
13951     /* Set update flags for all partitions that share the rate multiplier. Note that the conditional
13952        likelihood update flags have been set before we even call this function. */
13953     for (i=0; i<param->nRelParts; i++)
13954         TouchAllTreeNodes(&modelSettings[param->relParts[i]],chain);
13955 
13956     /* may need to hit update flag for cijks when you have a covarion model */
13957     for (i=0; i<param->nRelParts; i++)
13958         if (modelSettings[param->relParts[i]].nCijkParts > 1)
13959             modelSettings[param->relParts[i]].upDateCijk = YES;
13960 
13961     return (NO_ERROR);
13962 }
13963 
13964 
Move_RateShape_M(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)13965 int Move_RateShape_M (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
13966 {
13967     /* change gamma/lnorm shape parameter using multiplier */
13968 
13969     int         i, isAPriorExp, isValidA;
13970     MrBFlt      oldA, newA, minA, maxA, alphaExp=0.0, ran, factor, tuning, *rates;
13971     ModelParams *mp;
13972 
13973     /* get tuning parameter */
13974     tuning = mvp[0];
13975 
13976     /* get model params */
13977     mp = &modelParams[param->relParts[0]];
13978 
13979     /* get minimum and maximum values for alpha */
13980     if (param->paramId == SHAPE_UNI)
13981     {
13982         minA = mp->shapeUni[0];
13983         maxA = mp->shapeUni[1];
13984         if (minA < MIN_SHAPE_PARAM)
13985             minA = MIN_SHAPE_PARAM;
13986         if (maxA > MAX_SHAPE_PARAM)
13987             maxA = MAX_SHAPE_PARAM;
13988         isAPriorExp = NO;
13989     }
13990     else
13991     {
13992         minA = MIN_SHAPE_PARAM;
13993         maxA = MAX_SHAPE_PARAM;
13994         alphaExp = mp->shapeExp;
13995         isAPriorExp = YES;
13996     }
13997 
13998     /* get old value of alpha */
13999     oldA = *GetParamVals(param, chain, state[chain]);
14000 
14001     /* change value for alpha */
14002     ran = RandomNumber(seed);
14003     factor = exp(tuning * (ran - 0.5));
14004     newA = oldA * factor;
14005 
14006     /* check validity */
14007     isValidA = NO;
14008     do  {
14009         if (newA < minA)
14010             newA = minA * minA / newA;
14011         else if (newA > maxA)
14012             newA = maxA * maxA / newA;
14013         else
14014             isValidA = YES;
14015     } while (isValidA == NO);
14016 
14017     /* get proposal ratio */
14018     *lnProposalRatio = log(newA / oldA);
14019 
14020     /* get prior ratio */
14021     if (isAPriorExp == NO)
14022         *lnPriorRatio = 0.0;
14023     else
14024         *lnPriorRatio = -alphaExp * (newA - oldA);
14025 
14026     /* copy new alpha value back */
14027     *GetParamVals(param, chain, state[chain]) = newA;
14028 
14029     /* now, update rate category information */
14030     rates = GetParamSubVals (param, chain, state[chain]);
14031 
14032     if(!strcmp(mp->ratesModel, "LNorm"))
14033     {
14034         if (DiscreteLogNormal (rates, newA, mp->numGammaCats, 1) == ERROR)
14035             return (ERROR);
14036     }
14037     else  /* gamma rate */
14038     {
14039         if (DiscreteGamma (rates, newA, newA, mp->numGammaCats, 0) == ERROR)
14040             return (ERROR);
14041     }
14042 
14043     /* Set update flags for all partitions that share this alpha. Note that the conditional
14044      likelihood update flags have been set before we even call this function. */
14045     for (i=0; i<param->nRelParts; i++)
14046         TouchAllTreeNodes(&modelSettings[param->relParts[i]],chain);
14047 
14048     /* We need to update flags when we have a covarion model */
14049     for (i=0; i<param->nRelParts; i++)
14050         if (modelSettings[param->relParts[i]].nCijkParts > 1)
14051             modelSettings[param->relParts[i]].upDateCijk = YES;
14052 
14053     return (NO_ERROR);
14054 }
14055 
14056 
14057 /*----------------------------------------------------------------
14058 |
14059 |   Move_Revmat_Dir: Change rate matrix using Dirichlet proposal
14060 |      mechanism.
14061 |
14062 ----------------------------------------------------------------*/
Move_Revmat_Dir(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)14063 int Move_Revmat_Dir (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
14064 {
14065     /* change revMat using Dirichlet proposal */
14066 
14067     int             i, nRates,isValid;
14068     MrBFlt          oldRate[200], newRate[200], dirParm[200], *value, sum, x, y, rate_pot, *alphaDir, alphaPi;
14069     ModelParams     *mp;
14070     ModelInfo       *m;
14071 
14072     /* get model params and settings */
14073     mp = &modelParams[param->relParts[0]];
14074     m  = &modelSettings[param->relParts[0]];
14075 
14076     /* get rates and nRates */
14077     value = GetParamVals(param, chain, state[chain]);
14078     nRates = param->nValues;
14079 
14080     /* get so called alpha_pi parameter and adjust for number of components */
14081     alphaPi = mvp[0] * nRates;
14082 
14083     /* get Dirichlet parameters */
14084     if (m->dataType == PROTEIN)
14085         alphaDir = mp->aaRevMatDir;
14086     else
14087         alphaDir = mp->revMatDir;
14088 
14089     /* copy old rates */
14090     for (i=0; i<nRates; i++)
14091         oldRate[i] = value[i];
14092 
14093     /* multiply old ratesum props with some large number to get new values close to the old ones */
14094     for (i=0; i<nRates; i++)
14095         dirParm[i] = oldRate[i] * alphaPi;
14096 
14097     /* get new values */
14098     DirichletRandomVariable (dirParm, newRate, nRates, seed);
14099 
14100     /* check new values. we rely on newRate be already normalized  */
14101     while (1)
14102         {
14103         sum = 0.0;
14104         rate_pot = 1.0;
14105         isValid=1;
14106         for (i=0; i<nRates; i++)
14107             {
14108             if (newRate[i] <= RATE_MIN)
14109                 {
14110                 if (newRate[i] < RATE_MIN)
14111                     {
14112                     newRate[i] = RATE_MIN;
14113                     isValid=0;
14114                     }
14115                 rate_pot -= RATE_MIN;
14116                 }
14117             else
14118                 sum += newRate[i];
14119             }
14120         if (isValid==1) break;
14121         for (i=0; i<nRates; i++)
14122             {
14123             if (newRate[i]!=RATE_MIN)
14124                 newRate[i] = rate_pot * newRate[i] / sum;
14125             }
14126         }
14127 
14128     /* copy new rate ratio values back */
14129     for (i=0; i<nRates; i++)
14130         value[i] = newRate[i];
14131 
14132     /* get proposal ratio */
14133     sum = 0.0;
14134     for (i=0; i<nRates; i++)
14135         sum += newRate[i]*alphaPi;
14136     x = LnGamma(sum);
14137     for (i=0; i<nRates; i++)
14138         x -= LnGamma(newRate[i]*alphaPi);
14139     for (i=0; i<nRates; i++)
14140         x += (newRate[i]*alphaPi-1.0)*log(oldRate[i]);
14141     sum = 0.0;
14142     for (i=0; i<nRates; i++)
14143         sum += oldRate[i]*alphaPi;
14144     y = LnGamma(sum);
14145     for (i=0; i<nRates; i++)
14146         y -= LnGamma(oldRate[i]*alphaPi);
14147     for (i=0; i<nRates; i++)
14148         y += (oldRate[i]*alphaPi-1.0)*log(newRate[i]);
14149     (*lnProposalRatio) = x - y;
14150 
14151     /* get prior ratio */
14152     x = y = 0.0;
14153     for (i=0; i<nRates; i++)
14154         x += (alphaDir[i]-1.0)*log(newRate[i]);
14155     for (i=0; i<nRates; i++)
14156         y += (alphaDir[i]-1.0)*log(oldRate[i]);
14157     (*lnPriorRatio) = x - y;
14158 
14159     /* Set update flags for all partitions that share this revmat. Note that the conditional
14160        likelihood update flags have been set before we even call this function. */
14161     for (i=0; i<param->nRelParts; i++)
14162         TouchAllTreeNodes(&modelSettings[param->relParts[i]],chain);
14163 
14164     /* Set update flags for cijks for all affected partitions */
14165     for (i=0; i<param->nRelParts; i++)
14166         modelSettings[param->relParts[i]].upDateCijk = YES;
14167 
14168     return (NO_ERROR);
14169 }
14170 
14171 
14172 /*----------------------------------------------------------------
14173 |
14174 |   Move_Revmat_DirMix: Dirichlet proposal for REVMAT_MIX. From
14175 |      Huelsenbeck et al. (2004), but note that the prior density
14176 |      is different in that paper because they set the rate sum
14177 |      to 6, not to 1.
14178 |
14179 ----------------------------------------------------------------*/
Move_Revmat_DirMix(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)14180 int Move_Revmat_DirMix (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
14181 {
14182     int         i, j, k, isValid, *growthFxn, nRates, groupSize[6];
14183     MrBFlt      *value, dirParm[6], newRate[6], oldRate[6], alphaPi, symDir, sum, rate_pot, x, y;
14184     ModelParams *mp;
14185 
14186     /* get model params and settings */
14187     mp = &modelParams[param->relParts[0]];
14188 
14189     /* get growthFunction and nRates */
14190     value     = GetParamVals (param, chain, state[chain]);
14191     growthFxn = GetParamIntVals (param, chain, state[chain]);
14192     nRates    = GetKFromGrowthFxn(growthFxn);
14193 
14194     /* we can't do anything if there is only one rate */
14195     if (nRates == 1)
14196         {
14197         abortMove = YES;
14198         return (NO_ERROR);
14199         }
14200 
14201     /* extract unique rates from value vector */
14202     for (i=0; i<nRates; i++)
14203         oldRate[i] = 0.0;
14204     for (i=0; i<6; i++)
14205         oldRate[growthFxn[i]] += value[i];
14206 
14207     /* get so called alpha_pi parameter and adjust for number of components */
14208     alphaPi = mvp[0] * nRates;
14209 
14210     /* get symmetric dirichlet parameter */
14211     symDir  = mp->revMatSymDir;
14212 
14213     /* multiply old ratesum props with some large number to get new values close to the old ones */
14214     for (i=0; i<nRates; i++)
14215         dirParm[i] = oldRate[i] * alphaPi;
14216 
14217     /* get new values */
14218     DirichletRandomVariable (dirParm, newRate, nRates, seed);
14219 
14220     /* check new values. we rely on newRate be already normalized  */
14221     while (1)
14222         {
14223         sum = 0.0;
14224         rate_pot = 1.0;
14225         isValid=1;
14226         for (i=0; i<nRates; i++)
14227             {
14228             if (newRate[i] <= RATE_MIN)
14229                 {
14230                 if (newRate[i] < RATE_MIN)
14231                     {
14232                     newRate[i] = RATE_MIN;
14233                     isValid=0;
14234                     }
14235                 rate_pot -= RATE_MIN;
14236                 }
14237             else
14238                 sum += newRate[i];
14239             }
14240         if (isValid==1) break;
14241         for (i=0; i<nRates; i++)
14242             {
14243             if (newRate[i]!=RATE_MIN)
14244                 newRate[i] = rate_pot * newRate[i] / sum;
14245             }
14246         }
14247 
14248     /* copy new unique rate ratio values back into the value array */
14249     for (i=0; i<nRates; i++)
14250         {
14251         k = 0;
14252         for (j=i; j<6; j++)
14253             {
14254             if (growthFxn[j] == i)
14255                 k++;
14256             }
14257         for (j=i; j<6; j++)
14258             {
14259             if (growthFxn[j] == i)
14260                 value[j] = newRate[i] / (MrBFlt) k;
14261             }
14262         }
14263 
14264     /* get proposal ratio */
14265     sum = 0.0;
14266     for (i=0; i<nRates; i++)
14267         sum += newRate[i]*alphaPi;
14268     x = LnGamma(sum);
14269     for (i=0; i<nRates; i++)
14270         x -= LnGamma(newRate[i]*alphaPi);
14271     for (i=0; i<nRates; i++)
14272         x += (newRate[i]*alphaPi-1.0)*log(oldRate[i]);
14273     sum = 0.0;
14274     for (i=0; i<nRates; i++)
14275         sum += oldRate[i]*alphaPi;
14276     y = LnGamma(sum);
14277     for (i=0; i<nRates; i++)
14278         y -= LnGamma(oldRate[i]*alphaPi);
14279     for (i=0; i<nRates; i++)
14280         y += (oldRate[i]*alphaPi-1.0)*log(newRate[i]);
14281     (*lnProposalRatio) = x - y;
14282 
14283     /* get group sizes, needed for prior ratio */
14284     for (i=0; i<nRates; i++)
14285         groupSize[i] = 0;
14286     for (i=0; i<6; i++)
14287         groupSize[growthFxn[i]]++;
14288 
14289     /* get prior ratio */
14290     x = y = 0.0;
14291     for (i=0; i<nRates; i++)
14292         x += (groupSize[i]*symDir-1.0)*log(newRate[i]);
14293     for (i=0; i<nRates; i++)
14294         y += (groupSize[i]*symDir-1.0)*log(oldRate[i]);
14295     (*lnPriorRatio) = x - y;
14296 
14297     /* Set update flags for all partitions that share this revmat. Note that the conditional
14298        likelihood update flags have been set before we even call this function. */
14299     for (i=0; i<param->nRelParts; i++)
14300         TouchAllTreeNodes(&modelSettings[param->relParts[i]],chain);
14301 
14302     /* Set update flags for cijks for all affected partitions */
14303     for (i=0; i<param->nRelParts; i++)
14304         modelSettings[param->relParts[i]].upDateCijk = YES;
14305 
14306     return (NO_ERROR);
14307 }
14308 
14309 
14310 /*----------------------------------------------------------------
14311 |
14312 |   Move_Revmat_Slider: Change rate matrix using sliding window
14313 |       move. Choose a pair of rates (e.g. r(A<>C), and r(A<>G)) at
14314 |       random and denote them rA, and rB. Let oldProp = rA/(rA + rB)
14315 |       and newProp = oldProp + delta(U - 0.5), where U is a uniform
14316 |       random variable on the interval (0, 1] and delta is a tuning
14317 |       parameter. Values that fall outside the boundaries are reflected
14318 |       back in. Then set new_rA = newProp*(rA+rB) and new_rB =
14319 |       (1-newProp)*(piA+piB). The Hastings ratio of this move is 1.0.
14320 |
14321 ----------------------------------------------------------------*/
Move_Revmat_Slider(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)14322 int Move_Revmat_Slider (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
14323 {
14324     int         i, j, nRates;
14325     MrBFlt      delta, *newRate, *oldRate, *priorAlpha, x, y, sum, min, max;
14326     ModelParams *mp;
14327     ModelInfo   *m;
14328 
14329     /* get model params and settings */
14330     mp = &modelParams[param->relParts[0]];
14331     m  = &modelSettings[param->relParts[0]];
14332 
14333     /* get Dirichlet parameters */
14334     if (m->dataType == PROTEIN)
14335         priorAlpha = mp->aaRevMatDir;
14336     else
14337         priorAlpha = mp->revMatDir;
14338 
14339     /* get the values we need */
14340     nRates = param->nValues;
14341     newRate = GetParamVals (param, chain, state[chain]);
14342     oldRate = GetParamVals (param, chain, state[chain] ^ 1);
14343 
14344     /* choose a pair to change */
14345     i = (int) (RandomNumber(seed) * nRates);
14346     j = (int) (RandomNumber(seed) * (nRates-1));
14347     if (i == j)
14348         j = nRates-1;
14349 
14350     /* find new proportion */
14351     sum = oldRate[i] + oldRate[j];
14352 
14353     /* get window size */
14354     delta = mvp[0];
14355 
14356     /* reflect */
14357     min = RATE_MIN / sum;
14358     max = 1.0 - min;
14359     if (delta > max-min) /* we do it to avoid following long while loop in case if delta is high */
14360         delta = max-min;
14361 
14362     x = oldRate[i] / sum;
14363     y = x + delta * (RandomNumber(seed) - 0.5);
14364     while (y < min || y > max)
14365         {
14366         if (y < min)
14367             y = 2.0 * min - y;
14368         if (y > max)
14369             y = 2.0 * max - y;
14370         }
14371 
14372     /* set the new values */
14373     newRate[i] = y * sum;
14374     newRate[j] = sum - newRate[i];
14375 
14376     /* get proposal ratio */
14377     (*lnProposalRatio) = 0.0;
14378 
14379     /* get prior ratio */
14380     (*lnPriorRatio)  = (priorAlpha[i]-1.0) * (log(newRate[i]) - log(oldRate[i]));
14381     (*lnPriorRatio) += (priorAlpha[j]-1.0) * (log(newRate[j]) - log(oldRate[j]));
14382 
14383     /* Set update for entire tree */
14384     for (i=0; i<param->nRelParts; i++)
14385         TouchAllTreeNodes(&modelSettings[param->relParts[i]],chain);
14386 
14387     /* Set update flags for cijks for all affected partitions. If this is a simple 4 X 4 model,
14388        we don't take any hit, because we will never go into a general transition probability
14389        calculator. However, for many models we do want to update the cijk flag, as the transition
14390        probability matrices require diagonalizing the rate matrix. */
14391     for (i=0; i<param->nRelParts; i++)
14392         modelSettings[param->relParts[i]].upDateCijk = YES;
14393 
14394     return (NO_ERROR);
14395 }
14396 
14397 
14398 /*----------------------------------------------------------------
14399 |
14400 |   Move_Revmat_SplitMerge1: Split or merge rates of rate matrix.
14401 |      See Huelsenbeck et al. (2004). Note that the prior used
14402 |      here is different from theirs. Also, a Beta proposal is
14403 |      used instead of a uniform to propose new rate proportions.
14404 |
14405 ----------------------------------------------------------------*/
Move_Revmat_SplitMerge1(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)14406 int Move_Revmat_SplitMerge1 (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
14407 {
14408     int         i, j, k, index_i, index_j, n_i, n_j, foundFirstI, foundFirstJ,
14409                 *newGrowthFxn, *oldGrowthFxn, nOldRates, nNewRates, merge,
14410                 groupSize[6], nCompositeRates;
14411     MrBFlt      R, R_i, R_j, *newValue, *oldValue, newRate[6], oldRate[6], symDir,
14412                 prob_split, prob_merge, dirParm[2], rateProps[2], x, alphaPi;
14413     ModelParams *mp;
14414 
14415     /* get model params and settings */
14416     mp = &modelParams[param->relParts[0]];
14417 
14418     /* get the values we need */
14419     oldValue     = GetParamVals(param, chain, state[chain] ^ 1);
14420     newValue     = GetParamVals(param, chain, state[chain]);
14421     oldGrowthFxn = GetParamIntVals(param, chain, state[chain] ^ 1);
14422     newGrowthFxn = GetParamIntVals (param, chain, state[chain]);
14423     nOldRates    = GetKFromGrowthFxn(oldGrowthFxn);
14424     symDir       = mp->revMatSymDir;
14425     alphaPi      = mvp[0];      /* tuning parameter alpha */
14426 
14427     /* get the old rates */
14428     for (i=0; i<nOldRates; i++)
14429         oldRate[i] = 0.0;
14430     for (i=0; i<6; i++)
14431         oldRate[oldGrowthFxn[i]] += oldValue[i];
14432 
14433     /* decide whether to split or merge */
14434     if (nOldRates == 1)
14435         merge = NO;
14436     else if (nOldRates == 6)
14437         merge = YES;
14438     else if (RandomNumber(seed) < 0.5)
14439         merge = YES;
14440     else
14441         merge = NO;
14442 
14443     /* now split or merge */
14444     if (merge == YES)
14445         {
14446         /* merge two rates */
14447         nNewRates = nOldRates - 1;
14448 
14449         /* determine split and merge probs */
14450         if (nNewRates == 1)
14451             prob_split = 1.0;
14452         else
14453             prob_split = 0.5;
14454         if (nOldRates == 6)
14455             prob_merge = 1.0;
14456         else
14457             prob_merge = 0.5;
14458 
14459         /* select two rates randomly */
14460         index_i = (int) (RandomNumber(seed) * nOldRates);
14461         index_j = (int) (RandomNumber(seed) * (nOldRates - 1));
14462         if (index_j == index_i)
14463             index_j = nOldRates - 1;
14464 
14465         /* make sure index_i is lower index */
14466         if (index_i > index_j)
14467             {
14468             i = index_i;
14469             index_i = index_j;
14470             index_j = i;
14471             }
14472 
14473         /* find group sizes */
14474         n_i = n_j = 0;
14475         for (i=0; i<6; i++)
14476             {
14477             if (oldGrowthFxn[i] == index_i)
14478                 n_i++;
14479             else if (oldGrowthFxn[i] == index_j)
14480                 n_j++;
14481             }
14482 
14483         /* adjust growth function */
14484         for (i=0; i<6; i++)
14485             {
14486             if (oldGrowthFxn[i] == index_j)
14487                 newGrowthFxn[i] = index_i;
14488             else if (oldGrowthFxn[i] > index_j)
14489                 newGrowthFxn[i] = oldGrowthFxn[i] - 1;
14490             else
14491                 newGrowthFxn[i] = oldGrowthFxn[i];
14492             }
14493 
14494         /* find the new rates */
14495         for (i=0; i<nNewRates; i++)
14496             {
14497             if (i == index_i)
14498                 newRate[i] = (oldRate[index_i] + oldRate[index_j]);
14499             else if (i < index_j)
14500                 newRate[i] = oldRate[i];
14501             else if (i >= index_j)
14502                 newRate[i] = oldRate[i+1];
14503             }
14504 
14505         /* copy new unique rate values back into the value array */
14506         for (i=0; i<nNewRates; i++)
14507             {
14508             k = 0;
14509             for (j=i; j<6; j++)
14510                 {
14511                 if (newGrowthFxn[j] == i)
14512                     k++;
14513                 }
14514             for (j=i; j<6; j++)
14515                 {
14516                 if (newGrowthFxn[j] == i)
14517                     newValue[j] = newRate[i] / (MrBFlt) k;
14518                 }
14519             }
14520 
14521         /* get the new and old rates (sum over parts) */
14522         R_i = oldRate[index_i];
14523         R_j = oldRate[index_j];
14524         R   = R_i + R_j;
14525 
14526         /* check group sizes after merge (before split in back move) */
14527         for (i=0; i<nNewRates; i++)
14528             groupSize[i] = 0;
14529         for (i=0; i<6; i++)
14530             groupSize[newGrowthFxn[i]]++;
14531         nCompositeRates = 0;
14532         for (i=0; i<nNewRates; i++)
14533             {
14534             if (groupSize[i] > 1)
14535                 nCompositeRates++;
14536             }
14537 
14538         /* calculate prior ratio (different in the paper) */
14539         (*lnPriorRatio) = LnGamma(n_i * symDir) + LnGamma(n_j * symDir) - LnGamma ((n_i + n_j) * symDir);
14540         (*lnPriorRatio) += ((n_i + n_j) * symDir - 1.0) * log(R) - (n_i * symDir - 1.0) * log(R_i) - (n_j * symDir - 1.0) * log(R_j);
14541 
14542         /* calculate proposal ratio */
14543         (*lnProposalRatio) = log ((prob_split / prob_merge) * ((nOldRates * (nOldRates - 1)) / (2.0 * nCompositeRates)) * (1.0 / ((pow(2, n_i + n_j - 1) - 1))));
14544 
14545         /* adjust for Beta proposal in back move */
14546         dirParm[0] = alphaPi * n_i;
14547         dirParm[1] = alphaPi * n_j;
14548         rateProps[0] = R_i / R;
14549         rateProps[1] = R_j / R;
14550         x  = LnGamma(dirParm[0] + dirParm[1]);
14551         x -= LnGamma(dirParm[0]);
14552         x -= LnGamma(dirParm[1]);
14553         x += (dirParm[0] - 1.0) * log(rateProps[0]);
14554         x += (dirParm[1] - 1.0) * log(rateProps[1]);
14555         (*lnProposalRatio) += x;
14556 
14557         /* Jacobian for the rate proportion */
14558         (*lnProposalRatio) -= log(R);
14559         }
14560     else
14561         {
14562         /* split two rates */
14563         nNewRates = nOldRates + 1;
14564 
14565         /* determine split and merge probs */
14566         if (nNewRates == 6)
14567             prob_merge = 1.0;
14568         else
14569             prob_merge = 0.5;
14570         if (nOldRates == 1)
14571             prob_split = 1.0;
14572         else
14573             prob_split = 0.5;
14574 
14575         /* check group sizes before split */
14576         for (i=0; i<nOldRates; i++)
14577             groupSize[i] = 0;
14578         for (i=0; i<6; i++)
14579             groupSize[oldGrowthFxn[i]]++;
14580         nCompositeRates = 0;
14581         for (i=0; i<nOldRates; i++)
14582             {
14583             if (groupSize[i] > 1)
14584                 nCompositeRates++;
14585             }
14586 
14587         /* randomly select a rate with two or more components to split */
14588         k = (int) (RandomNumber(seed) * nCompositeRates);
14589 
14590         for (i=j=0; i<nOldRates; i++)
14591             {
14592             if (groupSize[i] > 1)
14593                 {
14594                 if (k == j)
14595                     break;
14596                 j++;
14597                 }
14598             }
14599         assert (i < nOldRates && groupSize[i] > 1);
14600         index_i = i;
14601 
14602         /* adjust growth function */
14603         do {
14604             foundFirstI = foundFirstJ = NO;
14605             k = 0;
14606             index_j = -1;
14607             for (i=0; i<6; i++)
14608                 {
14609                 if (oldGrowthFxn[i] == index_i)
14610                     {
14611                     if (foundFirstI == NO)
14612                         {
14613                         newGrowthFxn[i] = index_i;
14614                         foundFirstI = YES;
14615                         }
14616                     else
14617                         {
14618                         if (RandomNumber(seed) < 0.5)
14619                             {
14620                             if (foundFirstJ == NO)
14621                                 {
14622                                 foundFirstJ = YES;
14623                                 index_j = k + 1;    /* one more than previous max */
14624                                 newGrowthFxn[i] = index_j;
14625                                 }
14626                             else
14627                                 {
14628                                 newGrowthFxn[i] = index_j;
14629                                 }
14630                             }
14631                         else
14632                             newGrowthFxn[i] = index_i;
14633                         }
14634                     }
14635                 else if (foundFirstJ == YES && oldGrowthFxn[i] >= index_j)
14636                     newGrowthFxn[i] = oldGrowthFxn[i] + 1;
14637                 else
14638                     newGrowthFxn[i] = oldGrowthFxn[i];
14639                 if (foundFirstJ == NO && oldGrowthFxn[i] > k)
14640                     k = oldGrowthFxn[i];
14641                 }
14642             } while (foundFirstJ == NO);
14643 
14644         /* find group sizes */
14645         n_i = n_j = 0;
14646         for (i=0; i<6; i++)
14647             {
14648             if (newGrowthFxn[i] == index_i)
14649                 n_i++;
14650             else if (newGrowthFxn[i] == index_j)
14651                 n_j++;
14652             }
14653 
14654         /* find old rate */
14655         R = oldRate[index_i];
14656 
14657         /* propose new rates */
14658         dirParm[0] = alphaPi * n_i;
14659         dirParm[1] = alphaPi * n_j;
14660 
14661         DirichletRandomVariable(dirParm, rateProps, 2, seed);
14662         R_i = rateProps[0] * R;
14663         R_j = rateProps[1] * R;
14664 
14665         if (R_i/n_i < RATE_MIN)
14666             {
14667             R_i = RATE_MIN*n_i;
14668             rateProps[0] = R_i/R;
14669             rateProps[1] = 1-rateProps[0];
14670             R_j = rateProps[1] * R;
14671             assert (R_j/n_j < RATE_MIN);
14672             }
14673         else if (R_j/n_j < RATE_MIN)
14674             {
14675             R_j = RATE_MIN*n_j;
14676             rateProps[1] = R_j/R;
14677             rateProps[0] = 1-rateProps[1];
14678             R_i = rateProps[0] * R;
14679             assert (R_i/n_i < RATE_MIN);
14680             }
14681 
14682         /* set the new rates */
14683         for (i=0; i<nNewRates; i++)
14684             {
14685             if (i == index_i)
14686                 newRate[i] = R_i;
14687             else if (i == index_j)
14688                 newRate[i] = R_j;
14689             else if (i > index_j)
14690                 newRate[i] = oldRate[i-1];
14691             else
14692                 newRate[i] = oldRate[i];
14693             }
14694 
14695         /* copy new unique rate values back into the value array */
14696         for (i=0; i<nNewRates; i++)
14697             {
14698             k = 0;
14699             for (j=i; j<6; j++)
14700                 {
14701                 if (newGrowthFxn[j] == i)
14702                     k++;
14703                 }
14704             for (j=i; j<6; j++)
14705                 {
14706                 if (newGrowthFxn[j] == i)
14707                     newValue[j] = newRate[i] / (MrBFlt) k;
14708                 }
14709             }
14710 
14711         /* calculate prior ratio (different in the paper) */
14712         (*lnPriorRatio) = LnGamma((n_i + n_j) * symDir) - LnGamma(n_i * symDir) - LnGamma(n_j * symDir);
14713         (*lnPriorRatio) += (n_i * symDir - 1.0) * log(R_i) + (n_j * symDir - 1.0) * log(R_j) - ((n_i + n_j) * symDir - 1.0) * log(R);;
14714 
14715         /* calculate proposal ratio */
14716         (*lnProposalRatio) = log ((prob_merge / prob_split) * ((2.0 * nCompositeRates) / (nNewRates * (nNewRates - 1))) * ((pow(2, n_i + n_j - 1) - 1)));
14717 
14718         /* adjust for Beta proposal */
14719         x  = LnGamma(dirParm[0] + dirParm[1]);
14720         x -= LnGamma(dirParm[0]);
14721         x -= LnGamma(dirParm[1]);
14722         x += (dirParm[0] - 1.0) * log(rateProps[0]);
14723         x += (dirParm[1] - 1.0) * log(rateProps[1]);
14724         (*lnProposalRatio) -= x;
14725 
14726         /* Jacobian for rate proportion */
14727         (*lnProposalRatio) += log (R);
14728         }
14729 
14730 #if defined (DEBUG_SPLITMERGE)
14731     if (*lnPriorRatio != *lnPriorRatio)
14732         {
14733         printf ("prob_merge=%f prob_split=%f nCompositeRates=%d nOldRates=%d nNewRates=%d\n", prob_merge, prob_split, nCompositeRates, nOldRates, nNewRates);
14734         printf ("merge=%s n_i=%d n_j=%d rateProps[0]=%f R=%f R_i=%f R_j=%f\n", merge == NO ? "NO" : "YES", n_i, n_j, rateProps[0], R, R_i, R_j);
14735         printf ("Old rates={%f,%f,%f,%f,%f,%f}\n", oldValue[0], oldValue[1], oldValue[2], oldValue[3], oldValue[4], oldValue[5]);
14736         printf ("Old growth fxn={%d,%d,%d,%d,%d,%d}\n", oldGrowthFxn[0], oldGrowthFxn[1], oldGrowthFxn[2], oldGrowthFxn[3], oldGrowthFxn[4], oldGrowthFxn[5]);
14737         printf ("New rates={%f,%f,%f,%f,%f,%f}\n", newValue[0], newValue[1], newValue[2], newValue[3], newValue[4], newValue[5]);
14738         printf ("New growth fxn={%d,%d,%d,%d,%d,%d}\n", newGrowthFxn[0], newGrowthFxn[1], newGrowthFxn[2], newGrowthFxn[3], newGrowthFxn[4], newGrowthFxn[5]);
14739         printf ("lnPriorRatio=%f  lnProposalRatio=%f\n", *lnPriorRatio, *lnProposalRatio);
14740         getchar();
14741         }
14742 #endif
14743 
14744     /* Set update flags for all partitions that share this revmat. Note that the conditional
14745        likelihood update flags have been set before we even call this function. */
14746     for (i=0; i<param->nRelParts; i++)
14747         TouchAllTreeNodes(&modelSettings[param->relParts[i]],chain);
14748 
14749     /* Set update flags for cijks for all affected partitions */
14750     for (i=0; i<param->nRelParts; i++)
14751         modelSettings[param->relParts[i]].upDateCijk = YES;
14752 
14753     return (NO_ERROR);
14754 }
14755 
14756 
14757 /*----------------------------------------------------------------
14758 |
14759 |   Move_Revmat_SplitMerge2: Componentwise split or merge move.
14760 |
14761 ----------------------------------------------------------------*/
Move_Revmat_SplitMerge2(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)14762 int Move_Revmat_SplitMerge2 (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
14763 {
14764     int         i, k, n_i, n_j, index_i, index_j, groupIndex_i, groupIndex_j,
14765                 *newGrowthFxn, *oldGrowthFxn;
14766     MrBFlt      R_i, R_j, r_j, alphaPi, *newValue, *oldValue, symDir,
14767                 dirParm[2], rateProps[2], x;
14768     ModelParams *mp;
14769 
14770     /* get model params and settings */
14771     mp = &modelParams[param->relParts[0]];
14772 
14773     /* get the values we need */
14774     oldValue     = GetParamVals(param, chain, state[chain] ^ 1);
14775     newValue     = GetParamVals(param, chain, state[chain]);
14776     oldGrowthFxn = GetParamIntVals(param, chain, state[chain] ^ 1);
14777     newGrowthFxn = GetParamIntVals (param, chain, state[chain]);
14778     symDir       = mp->revMatSymDir;
14779     alphaPi      = mvp[0];      /* tuning parameter */
14780 
14781     /* pick two component rates at random without replacement */
14782     index_i = (int) (RandomNumber(seed) * 6);
14783     index_j = (int) (RandomNumber(seed) * 5);
14784     if (index_j == index_i)
14785         index_j = 5;
14786     groupIndex_i = oldGrowthFxn[index_i];
14787     groupIndex_j = oldGrowthFxn[index_j];
14788 
14789     if (oldGrowthFxn[index_i] != oldGrowthFxn[index_j])
14790         {
14791         /* the rates are different, so merge them */
14792 
14793         /* calculate n_i, n_j, R_i and R_j before merge */
14794         n_i = n_j = 0;
14795         R_i = R_j = 0.0;
14796         for (i=0; i<6; i++)
14797             {
14798             if (oldGrowthFxn[i] == groupIndex_i)
14799                 {
14800                 n_i++;
14801                 R_i += oldValue[i];
14802                 }
14803             if (oldGrowthFxn[i] == groupIndex_j)
14804                 {
14805                 n_j++;
14806                 R_j += oldValue[i];
14807                 }
14808             }
14809 
14810         /* merge component rates by adding j to i */
14811         newGrowthFxn[index_j] = oldGrowthFxn[index_i];
14812 
14813         /* select a new rate for r_j */
14814         if (n_j == 1)
14815             r_j = oldValue[index_j];
14816         else
14817             {
14818             dirParm[0] = alphaPi * 1;
14819             dirParm[1] = alphaPi * (n_j - 1);
14820 
14821             DirichletRandomVariable(dirParm, rateProps, 2, seed);
14822             r_j = rateProps[0] * R_j;
14823 
14824             if (R_j - r_j < RATE_MIN)
14825                 {
14826                 r_j = R_j - RATE_MIN;
14827                 rateProps[0] = r_j/R_j;
14828                 rateProps[1] = 1 - rateProps[0];
14829                 }
14830             }
14831 
14832         /* update new growth function */
14833         UpdateGrowthFxn(newGrowthFxn);
14834 
14835         /* we divide R_i + r_j equally among components of merged group,
14836            and R_j - r_j equally among split group */
14837         for (i=0; i<6; i++)
14838             {
14839             if (oldGrowthFxn[i] == oldGrowthFxn[index_i] || i == index_j)
14840                 newValue[i] = (R_i + r_j) / (MrBFlt)(n_i + 1);
14841             else if (oldGrowthFxn[i] == oldGrowthFxn[index_j])
14842                 newValue[i] = (R_j - r_j) / (MrBFlt)(n_j - 1);
14843             else
14844                 newValue[i] = oldValue[i];
14845             }
14846 
14847         /* calculate prior ratio */
14848         if (n_j > 1)
14849             {
14850             /* no category disappeared */
14851             (*lnPriorRatio) += LnGamma (n_i * symDir) + LnGamma(n_j * symDir);
14852             (*lnPriorRatio) -= LnGamma((n_i +1)* symDir) + LnGamma((n_j-1) * symDir);
14853             (*lnPriorRatio) += ((n_i + 1) * symDir - 1.0) * log(R_i + r_j) + ((n_j - 1) * symDir - 1.0) * log(R_j - r_j);
14854             (*lnPriorRatio) -= (n_i * symDir - 1.0) * log(R_i) + (n_j * symDir - 1.0) * log(R_j);
14855             }
14856         else
14857             {
14858             /* j category disappeared */
14859             (*lnPriorRatio) += LnGamma (n_i * symDir) + LnGamma(n_j * symDir);
14860             (*lnPriorRatio) -= LnGamma((n_i +1)* symDir);
14861             (*lnPriorRatio) += ((n_i + 1) * symDir - 1.0) * log(R_i + r_j);
14862             (*lnPriorRatio) -= (n_i * symDir - 1.0) * log(R_i) + (n_j * symDir - 1.0) * log(R_j);
14863             }
14864 
14865         /* calculate proposal ratio; this is the probability of choosing the right category for rate j when splitting */
14866         k = GetKFromGrowthFxn(newGrowthFxn);
14867         (*lnProposalRatio) = log (1.0 / k);
14868 
14869         /* adjust for Beta proposal in back move */
14870         dirParm[0] = alphaPi * 1;
14871         dirParm[1] = alphaPi * n_i;
14872         rateProps[0] = r_j / (R_i + r_j);
14873         rateProps[1] = 1.0 - rateProps[0];
14874         x  = LnGamma(dirParm[0] + dirParm[1]);
14875         x -= LnGamma(dirParm[0]);
14876         x -= LnGamma(dirParm[1]);
14877         x += (dirParm[0] - 1.0) * log(rateProps[0]);
14878         x += (dirParm[1] - 1.0) * log(rateProps[1]);
14879         (*lnProposalRatio) += x;
14880 
14881         /* adjust for Beta proposal in forward move */
14882         if (n_j > 1)
14883             {
14884             dirParm[0] = alphaPi * 1;
14885             dirParm[1] = alphaPi * n_j;
14886             rateProps[0] = r_j / R_j;
14887             rateProps[1] = 1.0 - rateProps[0];
14888             x  = LnGamma(dirParm[0] + dirParm[1]);
14889             x -= LnGamma(dirParm[0]);
14890             x -= LnGamma(dirParm[1]);
14891             x += (dirParm[0] - 1.0) * log(rateProps[0]);
14892             x += (dirParm[1] - 1.0) * log(rateProps[1]);
14893             (*lnProposalRatio) -= x;
14894             }
14895 
14896         /* Jacobian */
14897         (*lnProposalRatio) -= log (R_i + r_j);
14898         if (n_j > 1)
14899             (*lnProposalRatio) += log (R_j);
14900         }
14901     else
14902         {
14903         /* split component rates because they are the same */
14904 
14905         /* split component rates by selecting new group for j from (0,K), with j starting a new group if index becomes the same */
14906         k = GetKFromGrowthFxn(oldGrowthFxn);
14907         newGrowthFxn[index_j] = (int) (RandomNumber(seed) * k);
14908         if (newGrowthFxn[index_j] == oldGrowthFxn[index_j])
14909             newGrowthFxn[index_j] = k + 1;
14910 
14911         /* update growth function and group indices */
14912         UpdateGrowthFxn(newGrowthFxn);
14913         groupIndex_i = newGrowthFxn[index_i];
14914         groupIndex_j = newGrowthFxn[index_j];
14915 
14916         /* calculate n_i, n_j, R_i and R_j after split */
14917         n_i = n_j = 0;
14918         R_i = R_j = 0.0;
14919         for (i=0; i<6; i++)
14920             {
14921             if (i == index_j)
14922                 {
14923                 R_i += oldValue[i];
14924                 n_i++;
14925                 }
14926             else if (newGrowthFxn[i] == groupIndex_i)
14927                 {
14928                 n_i++;
14929                 R_i += oldValue[i];
14930                 }
14931             else if (newGrowthFxn[i] == groupIndex_j)
14932                 {
14933                 n_j++;
14934                 R_j += oldValue[i];
14935                 }
14936             }
14937 
14938         /* select a new rate for r_j */
14939         dirParm[0] = alphaPi * 1;
14940         dirParm[1] = alphaPi * (n_i - 1);
14941 
14942         DirichletRandomVariable(dirParm, rateProps, 2, seed);
14943         r_j = rateProps[0] * R_i;
14944 
14945         if (R_i-r_j < RATE_MIN)
14946             {
14947             r_j = R_i - RATE_MIN;
14948             rateProps[0] = r_j/R_i;
14949             rateProps[1] = 1 - rateProps[0];
14950             }
14951 
14952         /* update n_i, n_j, R_i and R_j after split */
14953         n_i -= 1;
14954         n_j += 1;
14955         R_i -= r_j;
14956         R_j += r_j;
14957 
14958         /* we divide R_i equally among remaining components of split group,
14959            and R_j equally among new or expanded group */
14960         for (i=0; i<6; i++)
14961             {
14962             if (newGrowthFxn[i] == groupIndex_i)
14963                 newValue[i] = R_i / (MrBFlt)(n_i);
14964             else if (newGrowthFxn[i] == groupIndex_j)
14965                 newValue[i] = R_j / (MrBFlt)(n_j);
14966             else
14967                 newValue[i] = oldValue[i];
14968             }
14969 
14970         /* calculate prior ratio */
14971         if (n_j > 1)
14972             {
14973             /* no new category created by split */
14974             (*lnPriorRatio) += LnGamma((n_i +1)* symDir) + LnGamma((n_j-1) * symDir);
14975             (*lnPriorRatio) -= LnGamma (n_i * symDir) + LnGamma(n_j * symDir);
14976             (*lnPriorRatio) += (n_i * symDir - 1.0) * log(R_i) + (n_j * symDir - 1.0) * log(R_j);
14977             (*lnPriorRatio) -= ((n_i + 1) * symDir - 1.0) * log(R_i + r_j) + ((n_j - 1) * symDir - 1.0) * log(R_j - r_j);
14978             }
14979         else
14980             {
14981             /* new category created by split */
14982             (*lnPriorRatio) += LnGamma((n_i +1)* symDir);
14983             (*lnPriorRatio) -= LnGamma (n_i * symDir) + LnGamma(n_j * symDir);
14984             (*lnPriorRatio) += (n_i * symDir - 1.0) * log(R_i) + (n_j * symDir - 1.0) * log(R_j);
14985             (*lnPriorRatio) -= ((n_i + 1) * symDir - 1.0) * log(R_i + r_j);
14986             }
14987 
14988         /* calculate proposal ratio; this is one over the probability of choosing the right category for rate j when splitting */
14989         k = GetKFromGrowthFxn(oldGrowthFxn);
14990         (*lnProposalRatio) = log (k);
14991 
14992         /* adjust for Beta proposal in back move */
14993         if (n_j > 1)
14994             {
14995             dirParm[0] = alphaPi * 1;
14996             dirParm[1] = alphaPi * (n_j - 1);
14997             rateProps[0] = r_j / R_j;
14998             rateProps[1] = 1.0 - rateProps[0];
14999             x  = LnGamma(dirParm[0] + dirParm[1]);
15000             x -= LnGamma(dirParm[0]);
15001             x -= LnGamma(dirParm[1]);
15002             x += (dirParm[0] - 1.0) * log(rateProps[0]);
15003             x += (dirParm[1] - 1.0) * log(rateProps[1]);
15004             (*lnProposalRatio) += x;
15005             }
15006 
15007         /* adjust for Beta proposal in forward move */
15008         dirParm[0] = alphaPi * 1;
15009         dirParm[1] = alphaPi * n_i;
15010         rateProps[0] = r_j / (R_i + r_j);
15011         rateProps[1] = 1.0 - rateProps[0];
15012         x  = LnGamma(dirParm[0] + dirParm[1]);
15013         x -= LnGamma(dirParm[0]);
15014         x -= LnGamma(dirParm[1]);
15015         x += (dirParm[0] - 1.0) * log(rateProps[0]);
15016         x += (dirParm[1] - 1.0) * log(rateProps[1]);
15017         (*lnProposalRatio) -= x;
15018 
15019         /* Jacobian */
15020         (*lnProposalRatio) += log (R_i + r_j);
15021         if (n_j > 1)
15022             (*lnProposalRatio) -= log (R_j);
15023         }
15024 
15025     /* Set update flags for all partitions that share this revmat. Note that the conditional
15026        likelihood update flags have been set before we even call this function. */
15027     for (i=0; i<param->nRelParts; i++)
15028         TouchAllTreeNodes(&modelSettings[param->relParts[i]],chain);
15029 
15030     /* Set update flags for cijks for all affected partitions */
15031     for (i=0; i<param->nRelParts; i++)
15032         modelSettings[param->relParts[i]].upDateCijk = YES;
15033 
15034     return (NO_ERROR);
15035 }
15036 
15037 
Move_Speciation(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)15038 int Move_Speciation (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
15039 {
15040     /* change speciation rate using sliding window */
15041 
15042     int         isLPriorExp, isValidL, valIndex;
15043     MrBFlt      *valPtr, oldL, newL, minL, maxL, lambdaExp=0.0, *sR, *eR, sF, *fR, oldLnPrior, newLnPrior,
15044                 window, clockRate;
15045     char        *sS;
15046     ModelParams *mp;
15047     ModelInfo   *m;
15048     Tree        *t;
15049 
15050     /* get size of window, centered on current value */
15051     window = mvp[0];
15052 
15053     /* get model params and settings */
15054     mp = &modelParams[param->relParts[0]];
15055     m = &modelSettings[param->relParts[0]];
15056 
15057     /* get minimum and maximum values */
15058     if (param->paramId == SPECRATE_UNI)
15059         {
15060         minL = mp->speciationUni[0];
15061         maxL = mp->speciationUni[1];
15062         isLPriorExp = NO;
15063         }
15064     else
15065         {
15066         minL = 0.000001;
15067         maxL = 1000.0;
15068         lambdaExp = mp->speciationExp;
15069         isLPriorExp = YES;
15070         }
15071 
15072     /* get pointer to value to be changed */
15073     valIndex = (int)(RandomNumber(seed) * param->nValues);
15074     valPtr = GetParamVals(param, chain, state[chain]) + valIndex;
15075 
15076     /* get old value */
15077     oldL = *valPtr;
15078 
15079     /* change value */
15080     if (maxL-minL < window)
15081         window = maxL-minL;
15082     newL = oldL + window * (RandomNumber(seed) - 0.5);
15083 
15084     /* check that new value is valid */
15085     isValidL = NO;
15086     do  {
15087         if (newL < minL)
15088             newL = 2 * minL - newL;
15089         else if (newL > maxL)
15090             newL = 2 * maxL - newL;
15091         else
15092             isValidL = YES;
15093         } while (isValidL == NO);
15094 
15095     /* get proposal ratio */
15096     *lnProposalRatio = 0.0;
15097 
15098     /* calculate prior ratio */
15099     t  = GetTree(modelSettings[param->relParts[0]].brlens,chain,state[chain]);
15100     sR = GetParamVals (param, chain, state[chain]);
15101     eR = GetParamVals (m->extinctionRates, chain, state[chain]);
15102     sF = mp->sampleProb;
15103     sS = mp->sampleStrat;
15104     clockRate = *GetParamVals (m->clockRate, chain, state[chain]);
15105 
15106     if (!strcmp(mp->clockPr,"Birthdeath"))
15107         {
15108         if (LnBirthDeathPriorPr (t, clockRate, &oldLnPrior, *sR, *eR, sS, sF) == ERROR)
15109             {
15110             MrBayesPrint ("%s   Problem calculating prior for birth-death process\n", spacer);
15111             return (ERROR);
15112             }
15113         *valPtr = newL;  // update with new value
15114         if (LnBirthDeathPriorPr (t, clockRate, &newLnPrior, *sR, *eR, sS, sF) == ERROR)
15115             {
15116             MrBayesPrint ("%s   Problem calculating prior for birth-death process\n", spacer);
15117             return (ERROR);
15118             }
15119         }
15120     else if (!strcmp(mp->clockPr,"Fossilization"))
15121         {
15122         fR = GetParamVals (m->fossilizationRates, chain, state[chain]);
15123         if (LnFossilizationPriorPr (t, clockRate, &oldLnPrior, sR, eR, fR, sF, sS) == ERROR)
15124             {
15125             MrBayesPrint ("%s   Problem calculating prior for fossilized birth-death process\n", spacer);
15126             return (ERROR);
15127             }
15128         *valPtr = newL;  // update with new value
15129         // for (i=0; i<param->nValues; i++)  *(GetParamVals(param, chain, state[chain]) + i) = newL;
15130         if (LnFossilizationPriorPr (t, clockRate, &newLnPrior, sR, eR, fR, sF, sS) == ERROR)
15131             {
15132             MrBayesPrint ("%s   Problem calculating prior for fossilized birth-death process\n", spacer);
15133             return (ERROR);
15134             }
15135         }
15136     else {
15137         MrBayesPrint ("%s   Move_Speciation not applicable\n", spacer);
15138         return (ERROR);
15139         }
15140 
15141     if (isLPriorExp == NO)
15142         *lnPriorRatio = newLnPrior - oldLnPrior;
15143     else
15144         *lnPriorRatio = -lambdaExp * (newL - oldL) + (newLnPrior - oldLnPrior);
15145 
15146     return (NO_ERROR);
15147 }
15148 
15149 
Move_Speciation_M(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)15150 int Move_Speciation_M (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
15151 {
15152     /* change speciation rate using multiplier */
15153 
15154     int         isLPriorExp, isValidL, valIndex;
15155     MrBFlt      *valPtr, oldL, newL, minL, maxL, lambdaExp=0.0, *sR, *eR, sF, *fR, oldLnPrior, newLnPrior,
15156                 tuning, clockRate;
15157     char        *sS;
15158     ModelParams *mp;
15159     ModelInfo   *m;
15160     Tree        *t;
15161 
15162     /* get tuning parameter */
15163     tuning = mvp[0];
15164 
15165     /* get model params and settings */
15166     mp = &modelParams[param->relParts[0]];
15167     m = &modelSettings[param->relParts[0]];
15168 
15169     /* get minimum and maximum values */
15170     if (param->paramId == SPECRATE_UNI)
15171         {
15172         minL = mp->speciationUni[0];
15173         maxL = mp->speciationUni[1];
15174         isLPriorExp = NO;
15175         }
15176     else
15177         {
15178         minL = 0.000001;
15179         maxL = 1000.0;
15180         lambdaExp = mp->speciationExp;
15181         isLPriorExp = YES;
15182         }
15183 
15184     /* get pointer to value to be changed */
15185     valIndex = (int)(RandomNumber(seed) * param->nValues);
15186     valPtr = GetParamVals(param, chain, state[chain]) + valIndex;
15187 
15188     /* get old value */
15189     oldL = *valPtr;
15190 
15191     /* change value */
15192     newL = oldL * exp(tuning * (RandomNumber(seed) - 0.5));
15193 
15194     /* check that new value is valid */
15195     isValidL = NO;
15196     do  {
15197         if (newL < minL)
15198             newL = minL * minL / newL;
15199         else if (newL > maxL)
15200             newL = maxL * maxL / newL;
15201         else
15202             isValidL = YES;
15203         } while (isValidL == NO);
15204 
15205     /* get proposal ratio */
15206     *lnProposalRatio = log (newL / oldL);
15207 
15208     /* calculate prior ratio */
15209     t  = GetTree(modelSettings[param->relParts[0]].brlens,chain,state[chain]);
15210     sR = GetParamVals (param, chain, state[chain]);
15211     eR = GetParamVals (m->extinctionRates, chain, state[chain]);
15212     sF = mp->sampleProb;
15213     sS = mp->sampleStrat;
15214     clockRate = *GetParamVals(m->clockRate, chain, state[chain]);
15215 
15216     if (!strcmp(mp->clockPr,"Birthdeath"))
15217         {
15218         if (LnBirthDeathPriorPr (t, clockRate, &oldLnPrior, *sR, *eR, sS, sF) == ERROR)
15219             {
15220             MrBayesPrint ("%s   Problem calculating prior for birth-death process\n", spacer);
15221             return (ERROR);
15222             }
15223         *valPtr = newL;  // update with new value
15224         if (LnBirthDeathPriorPr (t, clockRate, &newLnPrior, *sR, *eR, sS, sF) == ERROR)
15225             {
15226             MrBayesPrint ("%s   Problem calculating prior for birth-death process\n", spacer);
15227             return (ERROR);
15228             }
15229         }
15230     else if (!strcmp(mp->clockPr,"Fossilization"))
15231         {
15232         fR = GetParamVals (m->fossilizationRates, chain, state[chain]);
15233         if (LnFossilizationPriorPr (t, clockRate, &oldLnPrior, sR, eR, fR, sF, sS) == ERROR)
15234             {
15235             MrBayesPrint ("%s   Problem calculating prior for fossilized birth-death process\n", spacer);
15236             return (ERROR);
15237             }
15238         *valPtr = newL;  // update with new value
15239         if (LnFossilizationPriorPr (t, clockRate, &newLnPrior, sR, eR, fR, sF, sS) == ERROR)
15240             {
15241             MrBayesPrint ("%s   Problem calculating prior for fossilized birth-death process\n", spacer);
15242             return (ERROR);
15243             }
15244         }
15245     else {
15246         MrBayesPrint ("%s   Move_Speciation_M not applicable\n", spacer);
15247         return (ERROR);
15248         }
15249 
15250     if (isLPriorExp == NO)
15251         *lnPriorRatio = newLnPrior - oldLnPrior;
15252     else
15253         *lnPriorRatio = -lambdaExp * (newL - oldL) + (newLnPrior - oldLnPrior);
15254 
15255     return (NO_ERROR);
15256 }
15257 
15258 
Move_Statefreqs(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)15259 int Move_Statefreqs (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
15260 {
15261     /* change pi */
15262     int         i, nStates, isValid;
15263     MrBFlt      dirichletParameters[64], *newPi, *oldPi, *priorAlpha, sum, alphaPi, x, y;
15264 
15265     /* get the values we need */
15266     nStates = param->nSubValues;
15267     priorAlpha = GetParamVals(param, chain, state[chain]);
15268     newPi = GetParamSubVals (param, chain, state[chain]);
15269     oldPi = GetParamSubVals (param, chain, state[chain] ^ 1);
15270 
15271     /* tuning parameter */
15272     alphaPi = mvp[0]*nStates;
15273 
15274     /* multiply old values with some large number to get new values close to the old ones */
15275     for (i=0; i<nStates; i++)
15276         dirichletParameters[i] = oldPi[i] * alphaPi;
15277 
15278     do  {
15279         DirichletRandomVariable (dirichletParameters, newPi, nStates, seed);
15280         isValid = YES;
15281         for (i=0; i<nStates; i++)
15282             {
15283             if (newPi[i] < PI_MIN)
15284                 {
15285                 isValid = NO;
15286                 break;
15287                 }
15288             }
15289         } while (isValid == NO);
15290 
15291     /* get proposal ratio */
15292     sum = 0.0;
15293     for (i=0; i<nStates; i++)
15294         sum += newPi[i]*alphaPi;
15295     x = LnGamma(sum);
15296     for (i=0; i<nStates; i++)
15297         x -= LnGamma(newPi[i]*alphaPi);
15298     for (i=0; i<nStates; i++)
15299         x += (newPi[i]*alphaPi-1.0)*log(oldPi[i]);
15300     sum = 0.0;
15301     for (i=0; i<nStates; i++)
15302         sum += oldPi[i]*alphaPi;
15303     y = LnGamma(sum);
15304     for (i=0; i<nStates; i++)
15305         y -= LnGamma(oldPi[i]*alphaPi);
15306     for (i=0; i<nStates; i++)
15307         y += (oldPi[i]*alphaPi-1.0)*log(newPi[i]);
15308     (*lnProposalRatio) = x - y;
15309 
15310     /* get prior ratio */
15311     y = x = 0.0;                    /* the Gamma part of the prior is the same */
15312     for (i=0; i<nStates; i++)
15313         x += (priorAlpha[i]-1.0)*log(newPi[i]);
15314     for (i=0; i<nStates; i++)
15315         y += (priorAlpha[i]-1.0)*log(oldPi[i]);
15316     (*lnPriorRatio) = x - y;
15317 
15318     /* Touch the entire tree */
15319     for (i=0; i<param->nRelParts; i++)
15320         TouchAllTreeNodes(&modelSettings[param->relParts[i]],chain);
15321 
15322     /* Set update flags for cijks for all affected partitions. If this is a simple 4 X 4 model,
15323        we don't take any hit, because we will never go into a general transition probability
15324        calculator. However, for many models we do want to update the cijk flag, as the transition
15325        probability matrices require diagonalizing the rate matrix. */
15326     for (i=0; i<param->nRelParts; i++)
15327         modelSettings[param->relParts[i]].upDateCijk = YES;
15328 
15329     return (NO_ERROR);
15330 }
15331 
15332 
15333 /*----------------------------------------------------------------
15334 |
15335 |   Move_Statefreqs_Slider: Change state frequencies using Slider proposal
15336 |       mechanism.
15337 |       Choose pairs of the parameter values (e.g. pi(A), and pi(G)) at
15338 |       random and denote them piA, and piB. Let oldProp = piA/(piA + piB)
15339 |       and newProp = oldProp + delta(U - 0.5), where U is a uniform random variable
15340 |       on the interval (0, 1] and delta is a tuning parameter. Values
15341 |       that fall outside the boundaries are reflected back in. Then
15342 |       set newPiA = newProp*(piA+piB) and newPiB = (1-newProp)*(piA+piB).
15343 |       The Hastings ratio of this move is 1.0.
15344 |
15345 ----------------------------------------------------------------*/
Move_Statefreqs_Slider(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)15346 int Move_Statefreqs_Slider (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
15347 {
15348     int         i, j, nStates, isValid;
15349     MrBFlt      delta, *newPi, *oldPi, *priorAlpha, x, y, sum, min, max;
15350 
15351     /* get the values we need */
15352     nStates = param->nSubValues;
15353     priorAlpha = GetParamVals(param, chain, state[chain]);
15354     newPi = GetParamSubVals (param, chain, state[chain]);
15355     oldPi = GetParamSubVals (param, chain, state[chain] ^ 1);
15356 
15357     /* get window size */
15358     delta = mvp[0];
15359 
15360     /* choose a pair to change */
15361     i = (int) (RandomNumber(seed) * nStates);
15362     j = (int) (RandomNumber(seed) * (nStates-1));
15363     if (i == j)
15364         j = nStates-1;
15365 
15366     /* find new proportion */
15367     sum = oldPi[i] + oldPi[j];
15368 
15369     /* reflect */
15370     isValid = NO;
15371     min = PI_MIN / sum;
15372     max = 1.0 - min;
15373 
15374     x   = oldPi[i] / sum;
15375     if (delta > max-min) /* we do it to avoid following long while loop in case if delta is high */
15376         {
15377         delta = max-min;
15378         }
15379     y = x + delta * (RandomNumber(seed) - 0.5);
15380 
15381     do {
15382         if (y < min)
15383             y = 2.0 * min - y;
15384         else if (y > max)
15385             y = 2.0 * max - y;
15386         else
15387             isValid = YES;
15388         } while (isValid == NO);
15389 
15390     /* set the new values */
15391     newPi[i] = y * sum;
15392     newPi[j] = sum - newPi[i];
15393 
15394     /* get proposal ratio */
15395     *lnProposalRatio = 0.0;
15396 
15397     /* get prior ratio */
15398     /* (the Gamma part of the prior is the same) */
15399     x = (priorAlpha[i]-1.0)*log(newPi[i]);
15400     x += (priorAlpha[j]-1.0)*log(newPi[j]);
15401     y = (priorAlpha[i]-1.0)*log(oldPi[i]);
15402     y += (priorAlpha[j]-1.0)*log(oldPi[j]);
15403     (*lnPriorRatio) = x - y;
15404 
15405     /* Set update for entire tree */
15406     for (i=0; i<param->nRelParts; i++)
15407         TouchAllTreeNodes(&modelSettings[param->relParts[i]],chain);
15408 
15409     /* Set update flags for cijks for all affected partitions. If this is a simple 4 X 4 model,
15410        we don't take any hit, because we will never go into a general transition probability
15411        calculator. However, for many models we do want to update the cijk flag, as the transition
15412        probability matrices require diagonalizing the rate matrix. */
15413     for (i=0; i<param->nRelParts; i++)
15414         modelSettings[param->relParts[i]].upDateCijk = YES;
15415 
15416     return (NO_ERROR);
15417 }
15418 
15419 
Move_StatefreqsSymDirMultistate(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)15420 int Move_StatefreqsSymDirMultistate (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
15421 {
15422     /* change state freqs of multistate characters */
15423     /* ideally, we would let the likelihood calculator deal with only the affected character
15424        but we do not have the mechanism for doing that in the current version of mrbayes, so
15425        take the hit of updating all chars of the morph partition(s). */
15426     int     i, nStates, charIndex;
15427     MrBFlt  dirichletParameters[10], symDirAlphai, *newPi, *oldPi, sum, alphaPi, x, y;
15428     Model   *mp;
15429 
15430     /* tuning parameters */
15431     alphaPi = mvp[0];
15432 
15433     /* get model paramaters */
15434     mp = &modelParams[param->relParts[0]];
15435 
15436     /* select one character at random */
15437     charIndex = (int) (RandomNumber(seed) * param->nSympi);
15438 
15439     /* get the values we need */
15440     symDirAlphai = *GetParamVals(param, chain, state[chain]);
15441     newPi = GetParamStdStateFreqs (param, chain, state[chain]);
15442     oldPi = GetParamStdStateFreqs (param, chain, state[chain] ^ 1);
15443     newPi += 2 * mp->numBetaCats;
15444     oldPi += 2 * mp->numBetaCats;
15445     for (i=0; i<charIndex; i++)
15446         {
15447         oldPi += param->sympinStates[i];
15448         newPi += param->sympinStates[i];
15449         }
15450     nStates = param->sympinStates[charIndex];
15451 
15452     /* multiply old values with some large number to get new values close to the old ones */
15453     for (i=0; i<nStates; i++)
15454         dirichletParameters[i] = oldPi[i] * alphaPi;
15455 
15456     DirichletRandomVariable (dirichletParameters, newPi, nStates, seed);
15457 
15458     sum = 0.0;
15459     for (i=0; i<nStates; i++)
15460         {
15461         if (newPi[i] < 0.0001)
15462             newPi[i] = 0.0001;
15463         sum += newPi[i];
15464         }
15465     for (i=0; i<nStates; i++)
15466         newPi[i] /= sum;
15467 
15468     /* get proposal ratio */
15469     sum = 0.0;
15470     for (i=0; i<nStates; i++)
15471         sum += newPi[i]*alphaPi;
15472     x = LnGamma(sum);
15473     for (i=0; i<nStates; i++)
15474         x -= LnGamma(newPi[i]*alphaPi);
15475     for (i=0; i<nStates; i++)
15476         x += (newPi[i]*alphaPi-1.0)*log(oldPi[i]);
15477     sum = 0.0;
15478     for (i=0; i<nStates; i++)
15479         sum += oldPi[i]*alphaPi;
15480     y = LnGamma(sum);
15481     for (i=0; i<nStates; i++)
15482         y -= LnGamma(oldPi[i]*alphaPi);
15483     for (i=0; i<nStates; i++)
15484         y += (oldPi[i]*alphaPi-1.0)*log(newPi[i]);
15485     (*lnProposalRatio) = x - y;
15486 
15487     /* get prior ratio */
15488     y = x = 0.0;    /* the Gamma part of the prior is the same */
15489     for (i=0; i<nStates; i++)
15490         x += (symDirAlphai-1.0)*log(newPi[i]);
15491     for (i=0; i<nStates; i++)
15492         y += (symDirAlphai-1.0)*log(oldPi[i]);
15493     (*lnPriorRatio) = x - y;
15494 
15495     for (i=0; i<param->nRelParts; i++)
15496         TouchAllTreeNodes(&modelSettings[param->relParts[i]],chain);
15497 
15498     /* Set update flags for cijks for all affected partitions. Only cijks for the changed character
15499        actually need to be updated but we can't do that in the current version of the program. */
15500     for (i=0; i<param->nRelParts; i++)
15501         modelSettings[param->relParts[i]].upDateCijk = YES;
15502 
15503     return (NO_ERROR);
15504 }
15505 
15506 
Move_SwitchRate(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)15507 int Move_SwitchRate (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
15508 {
15509     /* change switch rate of covarion model using sliding window */
15510 
15511     int         i, isSPriorExp, isValidS, whichRate;
15512     MrBFlt      oldS, newS, window, minS, maxS, sExp=0.0, ran, *value;
15513     ModelParams *mp;
15514 
15515     /* decide which switching rate to change */
15516     if (RandomNumber(seed) < 0.5)
15517         whichRate = 0;
15518     else
15519         whichRate = 1;
15520 
15521     /* get size of window, centered on current switching rates value */
15522     window = mvp[0];
15523 
15524     /* get model params */
15525     mp = &modelParams[param->relParts[0]];
15526 
15527     /* get minimum and maximum values for switching rate */
15528     if (param->paramId == SWITCH_UNI)
15529         {
15530         minS = mp->covswitchUni[0];
15531         maxS = mp->covswitchUni[1];
15532         isSPriorExp = NO;
15533         }
15534     else
15535         {
15536         minS = 0.01;
15537         maxS = KAPPA_MAX;
15538         sExp = mp->covswitchExp;
15539         isSPriorExp = YES;
15540         }
15541 
15542     /* get old value of switching rate */
15543     value = GetParamVals(param, chain, state[chain]);
15544     oldS = value[whichRate];
15545 
15546     /* change value for switching rate */
15547     ran = RandomNumber(seed);
15548     if (maxS-minS < window)
15549         {
15550         window = maxS-minS;
15551         }
15552     newS = oldS + window * (ran - 0.5);
15553 
15554     /* check that new value is valid */
15555     isValidS = NO;
15556     do
15557         {
15558         if (newS < minS)
15559             newS = 2* minS - newS;
15560         else if (newS > maxS)
15561             newS = 2 * maxS - newS;
15562         else
15563             isValidS = YES;
15564         } while (isValidS == NO);
15565 
15566     /* get proposal ratio */
15567     *lnProposalRatio = 0.0;
15568 
15569     /* get prior ratio */
15570     if (isSPriorExp == NO)
15571         *lnPriorRatio = 0.0;
15572     else
15573         *lnPriorRatio = -sExp * (newS - oldS);
15574 
15575     /* copy new switching rate value back */
15576     value[whichRate] = newS;
15577 
15578     /* Set update flags for all partitions that share this switching rate. Note that the conditional
15579        likelihood update flags have been set before we even call this function. */
15580     for (i=0; i<param->nRelParts; i++)
15581         TouchAllTreeNodes(&modelSettings[param->relParts[i]],chain);
15582 
15583     /* Set update flags for cijks for all affected partitions. If this is a simple 4 X 4 model,
15584        we don't take any hit, because we will never go into a general transition probability
15585        calculator. However, for covarion, doublet, and codon models, we do want to update
15586        the cijk flag. */
15587     for (i=0; i<param->nRelParts; i++)
15588         modelSettings[param->relParts[i]].upDateCijk = YES;
15589 
15590     return (NO_ERROR);
15591 }
15592 
15593 
Move_SwitchRate_M(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)15594 int Move_SwitchRate_M (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
15595 {
15596     /* change switch rate of covarion model using multiplier */
15597 
15598     int         i, isSPriorExp, isValidS, whichRate;
15599     MrBFlt      oldS, newS, minS, maxS, sExp=0.0, tuning, ran, factor, *value;
15600     ModelParams *mp;
15601 
15602     /* decide which switching rate to change */
15603     if (RandomNumber(seed) < 0.5)
15604         whichRate = 0;
15605     else
15606         whichRate = 1;
15607 
15608     /* get tuning parameter */
15609     tuning = mvp[0];
15610 
15611     /* get model params */
15612     mp = &modelParams[param->relParts[0]];
15613 
15614     /* get minimum and maximum values for switching rate */
15615     if (param->paramId == SWITCH_UNI)
15616         {
15617         minS = mp->covswitchUni[0];
15618         maxS = mp->covswitchUni[1];
15619         isSPriorExp = NO;
15620         }
15621     else
15622         {
15623         minS = 0.01;
15624         maxS = KAPPA_MAX;
15625         sExp = mp->covswitchExp;
15626         isSPriorExp = YES;
15627         }
15628 
15629     /* get old value of switching rate */
15630     value = GetParamVals(param, chain, state[chain]);
15631     oldS = value[whichRate];
15632 
15633     /* change value for switching rate */
15634     ran = RandomNumber(seed);
15635     factor = exp(tuning * (ran - 0.5));
15636     newS = oldS * factor;
15637 
15638     /* check that new value is valid */
15639     isValidS = NO;
15640     do
15641         {
15642         if (newS < minS)
15643             newS = minS * minS / newS;
15644         else if (newS > maxS)
15645             newS = maxS * maxS / newS;
15646         else
15647             isValidS = YES;
15648         } while (isValidS == NO);
15649 
15650     /* get proposal ratio */
15651     *lnProposalRatio = log (newS / oldS);
15652 
15653     /* get prior ratio */
15654     if (isSPriorExp == NO)
15655         *lnPriorRatio = 0.0;
15656     else
15657         *lnPriorRatio = -sExp * (newS - oldS);
15658 
15659     /* copy new switching rate value back */
15660     value[whichRate] = newS;
15661 
15662     /* Set update flags for all partitions that share this switching rate. Note that the conditional
15663        likelihood update flags have been set before we even call this function. */
15664     for (i=0; i<param->nRelParts; i++)
15665         TouchAllTreeNodes(&modelSettings[param->relParts[i]],chain);
15666 
15667     /* Set update flags for cijks for all affected partitions. If this is a simple 4 X 4 model,
15668        we don't take any hit, because we will never go into a general transition probability
15669        calculator. However, for covarion, doublet, and codon models, we do want to update
15670        the cijk flag. */
15671     for (i=0; i<param->nRelParts; i++)
15672         modelSettings[param->relParts[i]].upDateCijk = YES;
15673 
15674     return (NO_ERROR);
15675 }
15676 
15677 
Move_TK02BranchRate(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)15678 int Move_TK02BranchRate (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
15679 {
15680     /* move one TK02 relaxed clock branch rate using multiplier */
15681 
15682     int         i;
15683     MrBFlt      newRate, oldRate, tuning, minR, maxR, nu, *tk02Rate, *brlens;
15684     TreeNode    *p = NULL;
15685     ModelInfo   *m;
15686     Tree        *t;
15687     TreeNode    *q;
15688 
15689     /* get model settings */
15690     m = &modelSettings[param->relParts[0]];
15691 
15692     /* get the tuning parameter */
15693     tuning = mvp[0];
15694 
15695     /* get the TK02 branch rate and effective branch length data */
15696     tk02Rate = GetParamVals (param, chain, state[chain]);
15697     brlens   = GetParamSubVals (param, chain, state[chain]);
15698 
15699     /* get tree */
15700     t = GetTree (param, chain, state[chain]);
15701 
15702     /* get minimum and maximum rate */
15703     minR = RATE_MIN;
15704     maxR = RATE_MAX;
15705 
15706     /* randomly pick a rate */
15707     do  {
15708         i = (int) (RandomNumber(seed) * (t->nNodes -2));
15709         p = t->allDownPass[i];
15710         }
15711     while (p->length < TIME_MIN);  // not ancestral fossil
15712 
15713     /* find new rate */
15714     oldRate = tk02Rate[p->index];
15715     newRate = oldRate * exp ((0.5 - RandomNumber(seed)) * tuning);
15716 
15717     /* reflect if necessary */
15718     while (newRate < minR || newRate > maxR)
15719         {
15720         if (newRate < minR)
15721             newRate = minR * minR / newRate;
15722         if (newRate > maxR)
15723             newRate = maxR * maxR / newRate;
15724         }
15725 
15726     tk02Rate[p->index] = newRate;
15727 
15728     /* calculate prior ratio */
15729     nu = *GetParamVals (m->tk02var, chain, state[chain]);
15730     (*lnPriorRatio) = LnRatioTK02LogNormal (tk02Rate[p->anc->index], nu*p->length, newRate, oldRate);
15731     if (p->left != NULL)
15732         {
15733         if (p->left->length > 0.0)
15734             {
15735             (*lnPriorRatio) -= LnProbTK02LogNormal (oldRate, nu*p->left->length,  tk02Rate[p->left->index ]);
15736             (*lnPriorRatio) += LnProbTK02LogNormal (newRate, nu*p->left->length,  tk02Rate[p->left->index ]);
15737             }
15738         if (p->right->length > 0.0)
15739             {
15740             (*lnPriorRatio) -= LnProbTK02LogNormal (oldRate, nu*p->right->length, tk02Rate[p->right->index]);
15741             (*lnPriorRatio) += LnProbTK02LogNormal (newRate, nu*p->right->length, tk02Rate[p->right->index]);
15742             }
15743         }
15744 
15745     /* calculate proposal ratio */
15746     (*lnProposalRatio) = log (newRate / oldRate);
15747 
15748     /* update branch evolution lengths */
15749     brlens[p->index] = p->length * (newRate + tk02Rate[p->anc->index]) / 2.0;
15750     if (p->left != NULL)
15751         {
15752         if (p->left->length > 0.0)
15753             {
15754             brlens[p->left->index] = p->left->length  * (tk02Rate[p->left->index] + newRate) / 2.0;
15755             }
15756         if (p->right->length > 0.0)
15757             {
15758             brlens[p->right->index] = p->right->length * (tk02Rate[p->right->index] + newRate) / 2.0;
15759             }
15760         }
15761 
15762     /* set update of ti probs */
15763     p->upDateTi = YES;
15764     if (p->left != NULL)
15765         {
15766         p->left ->upDateTi = YES;
15767         p->right->upDateTi = YES;
15768         }
15769 
15770     /* set update of cond likes down to root */
15771     /* update of crowntree set in UpdateCppEvolLengths */
15772     p->upDateCl = YES;
15773     q = p->anc;
15774     while (q->anc != NULL)
15775         {
15776         q->upDateCl = YES;
15777         q = q->anc;
15778         }
15779 
15780     return (NO_ERROR);
15781 }
15782 
15783 
Move_Tratio_Dir(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)15784 int Move_Tratio_Dir (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
15785 {
15786     /* change tratio using Dirichlet proposal */
15787 
15788     int         i;
15789     MrBFlt      oldK, alphaPi, *alphaDir, oldProp[2], newProp[2], dirParm[2], sum, x, y;
15790     ModelParams *mp;
15791 
15792     /* get model params */
15793     mp = &modelParams[param->relParts[0]];
15794 
15795     /* get so called alphaPi parameter */
15796     alphaPi = mvp[0];
15797 
15798     /* get old value of kappa */
15799     oldK = *GetParamVals(param, chain, state[chain]);
15800 
15801     /* get Dirichlet parameters */
15802     alphaDir = mp->tRatioDir;
15803 
15804     /* calculate old ratesum proportions */
15805     oldProp[0] = oldK / (oldK + 1.0);
15806     oldProp[1] = 1.0 - oldProp[0];
15807 
15808     /* multiply old ratesum props with some large number to get new values close to the old ones */
15809     dirParm[0] = oldProp[0] * alphaPi;
15810     dirParm[1] = oldProp[1] * alphaPi;
15811 
15812     /* get new values */
15813     DirichletRandomVariable (dirParm, newProp, 2, seed);
15814 
15815     if (newProp[0] < DIR_MIN)
15816         {
15817         newProp[0] = DIR_MIN;
15818         newProp[1] = 1.0-DIR_MIN;
15819         }
15820     else if (newProp[1] < DIR_MIN)
15821         {
15822         newProp[1] = DIR_MIN;
15823         newProp[0] = 1.0-DIR_MIN;
15824         }
15825 
15826     /* calculate and copy new kappa value back */
15827     *GetParamVals(param, chain, state[chain]) = newProp[0] / newProp[1];
15828 
15829     /* get proposal ratio */
15830     sum = 0.0;
15831     for (i=0; i<2; i++)
15832         sum += newProp[i]*alphaPi;
15833     x = LnGamma(sum);
15834     for (i=0; i<2; i++)
15835         x -= LnGamma(newProp[i]*alphaPi);
15836     for (i=0; i<2; i++)
15837         x += (newProp[i]*alphaPi-1.0)*log(oldProp[i]);
15838     sum = 0.0;
15839     for (i=0; i<2; i++)
15840         sum += oldProp[i]*alphaPi;
15841     y = LnGamma(sum);
15842     for (i=0; i<2; i++)
15843         y -= LnGamma(oldProp[i]*alphaPi);
15844     for (i=0; i<2; i++)
15845         y += (oldProp[i]*alphaPi-1.0)*log(newProp[i]);
15846     (*lnProposalRatio) = x - y;
15847 
15848     /* get prior ratio */
15849     x = y = 0.0;
15850     for (i=0; i<2; i++)
15851         x += (alphaDir[i]-1.0)*log(newProp[i]);
15852     for (i=0; i<2; i++)
15853         y += (alphaDir[i]-1.0)*log(oldProp[i]);
15854     (*lnPriorRatio) = x - y;
15855 
15856     /* Set update flags for all partitions that share this kappa. Note that the conditional
15857        likelihood update flags have been set before we even call this function. */
15858     for (i=0; i<param->nRelParts; i++)
15859         TouchAllTreeNodes(&modelSettings[param->relParts[i]],chain);
15860 
15861     /* Set update flags for cijks for all affected partitions. If this is a simple 4 X 4 model,
15862        we don't take any hit, because we will never go into a general transition probability
15863        calculator. However, for covarion, doublet, and codon models, we do want to update
15864        the cijk flag. */
15865     for (i=0; i<param->nRelParts; i++)
15866         modelSettings[param->relParts[i]].upDateCijk = YES;
15867 
15868     return (NO_ERROR);
15869 }
15870 
15871 
15872 /* Code added by Jeremy Brown and modified by Maxim Teslenko */
Move_TreeLen(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)15873 int Move_TreeLen (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
15874 {
15875     /* change all branch lengths */
15876 
15877     MrBFlt      begin_tl, treescaler, tuning, maxV, minV, brlensPrExp=0.0;
15878     TreeNode    *p;
15879     ModelParams *mp;
15880     Tree        *t;
15881     int i,branch_counter,  isVPriorExp;
15882 
15883     tuning = mvp[0]; /* Larget & Simon's tuning parameter lambda */
15884 
15885     mp = &modelParams[param->relParts[0]];
15886 
15887     /* max and min brlen */
15888     if (param->paramId == BRLENS_UNI)
15889         {
15890         minV = mp->brlensUni[0];
15891         maxV = mp->brlensUni[1];
15892         isVPriorExp = NO;
15893         }
15894     else if (param->paramId == BRLENS_GamDir)
15895         {
15896         minV = BRLENS_MIN;
15897         maxV = BRLENS_MAX;
15898         isVPriorExp = 2;
15899         }
15900     else if (param->paramId == BRLENS_iGmDir)
15901         {
15902         minV = BRLENS_MIN;
15903         maxV = BRLENS_MAX;
15904         isVPriorExp = 3;
15905         }
15906     else if (param->paramId == BRLENS_twoExp)
15907         {
15908         minV = BRLENS_MIN;
15909         maxV = BRLENS_MAX;
15910         isVPriorExp = 4;
15911         }
15912     else
15913         {
15914         minV = BRLENS_MIN;
15915         maxV = BRLENS_MAX;
15916         brlensPrExp = mp->brlensExp;
15917         isVPriorExp = YES;
15918         }
15919 
15920     /* get tree */
15921     t = GetTree (param, chain, state[chain]);
15922 
15923     assert (t->isRooted == NO);
15924 
15925     /* Dirichlet or twoExp prior */
15926     if (isVPriorExp > 1)
15927         (*lnPriorRatio) = -LogDirPrior(t, mp, isVPriorExp);
15928 
15929     treescaler = exp(tuning * (RandomNumber(seed) - 0.5));
15930 
15931     begin_tl = 0.0;
15932     branch_counter=0;
15933 
15934     for (i=0; i<t->nNodes; i++)
15935         {
15936         p = t->allDownPass[i];
15937         if (p->anc != NULL)
15938             {
15939             if (p->length*treescaler < minV || p->length*treescaler > maxV)
15940                 {
15941                 abortMove = YES;
15942                 return NO_ERROR;
15943                 }
15944             begin_tl += p->length;
15945             branch_counter++;
15946             }
15947         }
15948     assert (branch_counter==t->nNodes-1);
15949 
15950     /* iterate scaling over all branches */
15951     for (i=0; i < t->nNodes; i++)
15952         {
15953         p = t->allDownPass[i];
15954         if (p->anc != NULL)
15955             {
15956             /* set new length */
15957             p->length *= treescaler;
15958 
15959             /* set flags for update of transition probabilities at p */
15960             p->upDateTi = YES;
15961             p->anc->upDateCl = YES;
15962             }
15963         }
15964 
15965     /* calculate proposal ratio */
15966     (*lnProposalRatio) = branch_counter * log(treescaler);
15967 
15968     /* update prior if exponential prior on branch lengths */
15969     if (param->paramId == BRLENS_EXP)
15970         (*lnPriorRatio) = brlensPrExp * (begin_tl* (1 - treescaler));
15971     /* Dirichlet or twoExp prior */
15972     else if (isVPriorExp > 1)
15973         (*lnPriorRatio) += LogDirPrior(t, mp, isVPriorExp);
15974 
15975     return (NO_ERROR);
15976 }
15977 
15978 
15979 /*-----------------------------------------------------------------------------------
15980 |
15981 |   Move_TreeStretch: Shrink or grow a clock tree
15982 |
15983 -------------------------------------------------------------------------------------*/
Move_TreeStretch(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)15984 int Move_TreeStretch (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
15985 {
15986     int         i, j, *nEvents, numChangedNodes;
15987     MrBFlt      minV, maxV, tuning, factor, lambda=0.0, x,
15988                 *brlens=NULL, nu=0.0, igrvar=0.0, *tk02Rate=NULL, *igrRate=NULL;
15989     TreeNode    *p, *q;
15990     ModelParams *mp;
15991     ModelInfo   *m;
15992     Tree        *t, *oldT;
15993     Param       *subParm;
15994     Calibration *calibrationPtr;
15995 
15996     tuning = mvp[0]; /* Larget & Simon tuning parameter lambda */
15997 
15998     (*lnProposalRatio) = (*lnPriorRatio) = 0.0;
15999 
16000     m = &modelSettings[param->relParts[0]];
16001     mp = &modelParams[param->relParts[0]];
16002 
16003     /* get trees */
16004     t = GetTree (param, chain, state[chain]);
16005     oldT = GetTree (param, chain, 1^state[chain]);
16006 
16007     /* min and max branch lengths in relative time and substitution units */
16008     minV = BRLENS_MIN;
16009     maxV = BRLENS_MAX;
16010 
16011     /* determine multiplication factor */
16012     factor = exp(tuning * (RandomNumber(seed) - 0.5));
16013 
16014     /* multiply all changeable ages and node depths by this factor */
16015     numChangedNodes = 0;
16016     for (i=0; i<t->nNodes-1; i++)
16017         {
16018         p = t->allDownPass[i];
16019 
16020         /* skip extant tip and fixed calibration */
16021         if (p->left == NULL && p->isDated == NO)
16022             continue;
16023         if (p->isDated == YES)
16024             calibrationPtr = p->calibration;
16025         else if (p->anc->anc == NULL && (!strcmp(mp->clockPr, "Uniform") ||
16026                                          !strcmp(mp->clockPr, "Birthdeath") ||
16027                                          !strcmp(mp->clockPr, "Fossilization")))
16028             calibrationPtr = &mp->treeAgePr;
16029         else
16030             calibrationPtr = NULL;
16031         if (calibrationPtr != NULL && calibrationPtr->prior == fixed)
16032             continue;
16033 
16034         /* now stretch the node */
16035         if (calibrationPtr != NULL)
16036             {
16037             p->age *= factor;
16038             if (p->age < calibrationPtr->min || p->age > calibrationPtr->max)
16039                 {
16040                 abortMove = YES;
16041                 return (NO_ERROR);
16042                 }
16043             }
16044         p->nodeDepth *= factor;
16045         numChangedNodes++;
16046 
16047         /* deal with ancestral fossils */
16048         if (p->left != NULL)
16049             {
16050             if (p->left->length < TIME_MIN)
16051                 {
16052                 p->left->length = 0.0;
16053                 p->nodeDepth = p->left->nodeDepth;
16054                 if (calibrationPtr != NULL)
16055                     {
16056                     assert (p->left->calibration != NULL);
16057                     p->age = p->left->age;
16058                     if (p->age < calibrationPtr->min || p->age > calibrationPtr->max)
16059                         {
16060                         abortMove = YES;
16061                         return (NO_ERROR);
16062                         }
16063                     }
16064                 numChangedNodes--;
16065                 }
16066             if (p->right->length < TIME_MIN)
16067                 {
16068                 p->right->length = 0.0;
16069                 p->nodeDepth = p->right->nodeDepth;
16070                 if (calibrationPtr != NULL)
16071                     {
16072                     assert (p->right->calibration != NULL);
16073                     p->age = p->right->age;
16074                     if (p->age < calibrationPtr->min || p->age > calibrationPtr->max)
16075                         {
16076                         abortMove = YES;
16077                         return (NO_ERROR);
16078                         }
16079                     }
16080                 numChangedNodes--;
16081                 }
16082             assert (!(p->left->length == 0.0 && p->right->length == 0.0));
16083             }
16084         }
16085 
16086     /* update brls */
16087     for (i=0; i<t->nNodes-1; i++)
16088         {
16089         p = t->allDownPass[i];
16090         if (p->left != NULL)
16091             {
16092             if (p->left->length > 0.0)
16093                 p->left->length = p->nodeDepth - p->left->nodeDepth;
16094             if (p->right->length > 0.0)
16095                 p->right->length = p->nodeDepth - p->right->nodeDepth;
16096             }
16097         }
16098 
16099     /* check that all branch lengths are proper, which need not be the case */
16100     for (i = 0; i < t->nNodes -2; i++)
16101         {
16102         p = t->allDownPass[i];
16103         q = oldT->allDownPass[i];
16104         if (p->length < 0.0 || p->length > maxV || (q->length > minV && p->length < minV) || (q->length < TIME_MIN && p->length > TIME_MIN))
16105             {  /* consider ancestral fossil (brl=0) in fossilized bd tree */
16106             abortMove = YES;
16107             return NO_ERROR;
16108             }
16109         }
16110 
16111     /* calculate proposal ratio */
16112     (*lnProposalRatio) = numChangedNodes * log(factor);
16113 
16114     /* calculate prior ratio */
16115     if (LogClockTreePriorRatio(param, chain, &x) == ERROR)
16116         return ERROR;
16117     (*lnPriorRatio) += x;
16118 
16119     /* adjust proposal and prior ratio for relaxed clock models */
16120     for (i=0; i<param->nSubParams; i++)
16121         {
16122         subParm = param->subParams[i];
16123         if (subParm->paramType == P_CPPEVENTS)
16124             {
16125             nEvents = subParm->nEvents[2*chain+state[chain]];
16126             lambda = *GetParamVals (modelSettings[subParm->relParts[0]].cppRate, chain, state[chain]);
16127             /* proposal ratio */
16128             for (j=0; j<t->nNodes-2; j++)
16129                 {
16130                 p = t->allDownPass[j];
16131                 q = oldT->allDownPass[j];
16132                 (*lnProposalRatio) += nEvents[p->index ] * log (p->length  / q->length);
16133                 }
16134             /* prior ratio */
16135             (*lnPriorRatio) += lambda * (TreeLen(oldT) - TreeLen(t));
16136             /* update effective evolutionary lengths */
16137             if (UpdateCppEvolLengths (subParm, t->root->left, chain) == ERROR)
16138                 {
16139                 abortMove = YES;
16140                 return (NO_ERROR);
16141                 }
16142             }
16143         else if ( subParm->paramType == P_TK02BRANCHRATES ||
16144                  (subParm->paramType == P_MIXEDBRCHRATES && *GetParamIntVals(subParm, chain, state[chain]) == RCL_TK02))
16145             {
16146             if (subParm->paramType == P_TK02BRANCHRATES)
16147                 nu = *GetParamVals (modelSettings[subParm->relParts[0]].tk02var, chain, state[chain]);
16148             else
16149                 nu = *GetParamVals (modelSettings[subParm->relParts[0]].mixedvar, chain, state[chain]);
16150             tk02Rate = GetParamVals (subParm, chain, state[chain]);
16151             brlens = GetParamSubVals (subParm, chain, state[chain]);
16152 
16153             /* prior ratio and update of brlens */
16154             for (j=0; j<t->nNodes-2; j++)
16155                 {
16156                 p = t->allDownPass[j];
16157                 q = oldT->allDownPass[j];
16158                 if (p->length > 0.0)  // not ancestral fossil
16159                     {
16160                     (*lnPriorRatio) -= LnProbTK02LogNormal (tk02Rate[q->anc->index], nu*q->length, tk02Rate[q->index]);
16161                     (*lnPriorRatio) += LnProbTK02LogNormal (tk02Rate[p->anc->index], nu*p->length, tk02Rate[p->index]);
16162                     brlens[p->index] = p->length * (tk02Rate[p->anc->index]+tk02Rate[p->index])/2.0;
16163                     if (brlens[p->index] < RELBRLENS_MIN || brlens[p->index] > RELBRLENS_MAX)
16164                         {
16165                         abortMove = YES;
16166                         return (NO_ERROR);
16167                         }
16168                     }
16169                 }
16170             }
16171         else if ( subParm->paramType == P_IGRBRANCHRATES ||
16172                  (subParm->paramType == P_MIXEDBRCHRATES && *GetParamIntVals(subParm, chain, state[chain]) == RCL_IGR))
16173             {
16174             if (subParm->paramType == P_IGRBRANCHRATES)
16175                 igrvar = *GetParamVals (modelSettings[subParm->relParts[0]].igrvar, chain, state[chain]);
16176             else
16177                 igrvar = *GetParamVals (modelSettings[subParm->relParts[0]].mixedvar, chain, state[chain]);
16178             igrRate = GetParamVals (subParm, chain, state[chain]);
16179             brlens = GetParamSubVals (subParm, chain, state[chain]);
16180 
16181             /* prior ratio and update of igr branch lengths and rates (stretched in the same way as tree) */
16182             for (j=0; j<t->nNodes-2; j++)
16183                 {
16184                 p = t->allDownPass[j];
16185                 q = oldT->allDownPass[j];
16186                 if (p->length > 0.0)  // not ancestral fossil
16187                     {
16188                     (*lnPriorRatio) -= LnProbGamma (q->length/igrvar, q->length/igrvar, igrRate[q->index]);
16189                     (*lnPriorRatio) += LnProbGamma (p->length/igrvar, p->length/igrvar, igrRate[p->index]);
16190                     brlens[p->index] = p->length * igrRate[p->index];
16191                     if (brlens[p->index] < RELBRLENS_MIN || brlens[p->index] > RELBRLENS_MAX)
16192                         {
16193                         abortMove = YES;
16194                         return (NO_ERROR);
16195                         }
16196                     }
16197                 }
16198             }
16199         }
16200 
16201     TouchAllTreeNodes(m, chain);
16202 
16203 #if defined (DEBUG_TREESTRETCH)
16204     printf ("After treestretch:\n");
16205     printf ("Old tree height: %f -- New tree height: %f -- lnPriorRatio = %f -- lnProposalRatio = %f\n",
16206         oldT->root->left->nodeDepth, t->root->left->nodeDepth, (*lnPriorRatio), (*lnProposalRatio));
16207 #endif
16208 
16209     return (NO_ERROR);
16210 }
16211 
16212 
16213 /* Generalized normal move for real random variables */
Move_RealNormal(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)16214 int Move_RealNormal (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
16215 {
16216     int             i;
16217     MrBFlt          oldX, newX, tuning, minX, maxX, u, z;
16218 
16219     /* get tuning parameter */
16220     tuning = mvp[0];
16221 
16222     /* get minimum and maximum values for X */
16223     minX = param->min;
16224     maxX = param->max;
16225 
16226     /* get old value of X */
16227     oldX = *GetParamVals(param, chain, state[chain]);
16228 
16229     /* change value */
16230     u = RandomNumber(seed);
16231     z = PointNormal(u);
16232     newX = oldX + z * tuning;
16233 
16234     /* check that new value is valid */
16235     if (newX < minX || newX > maxX)
16236         {
16237         abortMove = YES;
16238         return (NO_ERROR);
16239         }
16240 
16241     /* get proposal ratio */
16242     (*lnProposalRatio) = 0.0;
16243 
16244     /* get prior ratio */
16245     (*lnPriorRatio) = param->LnPriorRatio(newX, oldX, param->priorParams);
16246 
16247     /* copy new value back */
16248     *GetParamVals(param, chain, state[chain]) = newX;
16249 
16250     /* Set update flags for tree nodes if relevant */
16251     if (param->affectsLikelihood == YES)
16252         {
16253         for (i=0; i<param->nRelParts; i++)
16254             TouchAllTreeNodes(&modelSettings[param->relParts[i]],chain);
16255         }
16256 
16257     return (NO_ERROR);
16258 }
16259 
16260 
16261 /* Generalized slider move for real random variables */
Move_RealSlider(Param * param,int chain,RandLong * seed,MrBFlt * lnPriorRatio,MrBFlt * lnProposalRatio,MrBFlt * mvp)16262 int Move_RealSlider (Param *param, int chain, RandLong *seed, MrBFlt *lnPriorRatio, MrBFlt *lnProposalRatio, MrBFlt *mvp)
16263 {
16264     int             i, isValid;
16265     MrBFlt          oldX, newX, window, minX, maxX, u;
16266 
16267     /* get size of window, centered on current value */
16268     window = mvp[0];
16269 
16270     /* get minimum and maximum values for X */
16271     minX = param->min;
16272     maxX = param->max;
16273 
16274     /* get old value of X */
16275     oldX = *GetParamVals(param, chain, state[chain]);
16276 
16277     /* change value */
16278     u = RandomNumber(seed);
16279     newX = oldX + window * (u - 0.5);
16280 
16281     /* check that new value is valid */
16282     isValid = NO;
16283     do
16284         {
16285         if (newX < minX)
16286             newX = 2* minX - newX;
16287         else if (newX > maxX)
16288             newX = 2 * maxX - newX;
16289         else
16290             isValid = YES;
16291         } while (isValid == NO);
16292 
16293     /* get proposal ratio */
16294     (*lnProposalRatio) = 0.0;
16295 
16296     /* get prior ratio */
16297     (*lnPriorRatio) = param->LnPriorRatio(newX, oldX, param->priorParams);
16298 
16299     /* copy new value back */
16300     *GetParamVals(param, chain, state[chain]) = newX;
16301 
16302     /* Set update flags for tree nodes if relevant */
16303     if (param->affectsLikelihood == YES)
16304         {
16305         for (i=0; i<param->nRelParts; i++)
16306             TouchAllTreeNodes(&modelSettings[param->relParts[i]],chain);
16307         }
16308 
16309     return (NO_ERROR);
16310 }
16311 
16312 
TouchAllTreeNodes(ModelInfo * m,int chain)16313 void TouchAllTreeNodes (ModelInfo *m, int chain)
16314 {
16315     int         i;
16316     Tree        *t;
16317     TreeNode    *p;
16318 
16319     t = GetTree(m->brlens, chain, state[chain]);
16320     for (i=0; i<t->nNodes; i++)
16321         {
16322         p = t->allDownPass[i];
16323         p->upDateCl = YES;
16324         p->upDateTi = YES;
16325         }
16326     m->upDateAll = YES;
16327 }
16328 
16329