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