Illustrating the coalescent
options(tidyverse.quiet = TRUE)
library(tidyverse)
library(phyclust)
Loading required package: ape
Attaching package: ‘ape’
The following object is masked from ‘package:dplyr’:
where
Attaching package: ‘phyclust’
The following object is masked from ‘package:lubridate’:
ms
library(ape)
n_sample <- 100
ms_out <- ms(nsam = 2*n_sample, opts = "-T")
ms_tree <- read.tree(text = ms_out)
plot(ms_tree, show.tip.label = FALSE)

Comparing the efficiency of coalescent simulation with direct
simulation
Here’s a simple comparison of simulating drift directly and
simulating it with the coalescent. I’ve set \(N_e\) to 100 and \(n_sample\) to 25.
## These are the parameters you can play with
##
n_e <- 1000
n_sample <- 25
## There's no easy way to tell when the forward simulation has run long enough
## to reach stationarity. I just fix the number of iterations to the expected
## fixation time and hope that that's close enough
##
n_gen <- 4*n_e
## The number of times to repeat each simulation
##
n_reps <- 10000
## This is the forward simulation.
##
start_time <- Sys.time()
for (rep in 1:n_reps) {
p <- numeric(n_gen)
p[1] <- 0.5
for (i in 2:n_gen) {
k <- rbinom(1, 2*n_e, p[i-1])
p[i] <- k/(2*n_e)
}
sample <- rbinom(1, 2*n_sample, p[n_gen])
}
end_time <- Sys.time()
cat("Elapsed time for forward simulation: ", round(end_time - start_time, 2))
Elapsed time for forward simulation: 1.72
## Here's the coalescent simulation.
##
start_time <- Sys.time()
for (rep in 1:n_reps) {
ms_out <- ms(nsam = 2*n_sample, opts = "-T")
}
end_time <- Sys.time()
cat("\nElapsed time for coalescent simulation: ", round(end_time - start_time, 2))
Elapsed time for coalescent simulation: 5.64
The coalescent with migration
As you’ve seen in lab this week, ms()
also allows you to
simulate the coalescent with migration. What you didn’t see was the
actual call to ms()
that does it. Here’s an example with
Wright’s island model: 5 islands with a sample size of 25 from each
island and \(N_em = 0.1\).
ms_out <- ms(nsam = 125, # The total number of alleles in the sample
nreps = 1, # The number of coalescent samples to produce
opts = "-T -I 5 25 25 25 25 25 0.1",
# -T produce a tree with coalescent times
# -I migration follows Wright's island model
# 5 populations
# 25 the number of samples from each population
# 0.1 Ne*m
)
ms_tree <- read.tree(text = ms_out)
plot(ms_tree, show.tip.label = FALSE)
LS0tCnRpdGxlOiAiUiBOb3RlYm9vayIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQoKIyMgSWxsdXN0cmF0aW5nIHRoZSBjb2FsZXNjZW50CgpgYGB7cn0Kb3B0aW9ucyh0aWR5dmVyc2UucXVpZXQgPSBUUlVFKQpsaWJyYXJ5KHRpZHl2ZXJzZSkKbGlicmFyeShwaHljbHVzdCkKbGlicmFyeShhcGUpCgpuX3NhbXBsZSA8LSAxMDAKbXNfb3V0IDwtIG1zKG5zYW0gPSAyKm5fc2FtcGxlLCBvcHRzID0gIi1UIikKbXNfdHJlZSA8LSByZWFkLnRyZWUodGV4dCA9IG1zX291dCkKcGxvdChtc190cmVlLCBzaG93LnRpcC5sYWJlbCA9IEZBTFNFKQpgYGAKCiMjIENvbXBhcmluZyB0aGUgZWZmaWNpZW5jeSBvZiBjb2FsZXNjZW50IHNpbXVsYXRpb24gd2l0aCBkaXJlY3Qgc2ltdWxhdGlvbgoKSGVyZSdzIGEgc2ltcGxlIGNvbXBhcmlzb24gb2Ygc2ltdWxhdGluZyBkcmlmdCBkaXJlY3RseSBhbmQgc2ltdWxhdGluZyBpdCB3aXRoIHRoZSBjb2FsZXNjZW50LiBJJ3ZlIHNldCAkTl9lJCB0byAxMDAgYW5kICRuX3NhbXBsZSQgdG8gMjUuCgpgYGB7cn0KIyMgVGhlc2UgYXJlIHRoZSBwYXJhbWV0ZXJzIHlvdSBjYW4gcGxheSB3aXRoCiMjCm5fZSA8LSAxMDAwCm5fc2FtcGxlIDwtIDI1CgojIyBUaGVyZSdzIG5vIGVhc3kgd2F5IHRvIHRlbGwgd2hlbiB0aGUgZm9yd2FyZCBzaW11bGF0aW9uIGhhcyBydW4gbG9uZyBlbm91Z2ggCiMjIHRvIHJlYWNoIHN0YXRpb25hcml0eS4gSSBqdXN0IGZpeCB0aGUgbnVtYmVyIG9mIGl0ZXJhdGlvbnMgdG8gdGhlIGV4cGVjdGVkCiMjIGZpeGF0aW9uIHRpbWUgYW5kIGhvcGUgdGhhdCB0aGF0J3MgY2xvc2UgZW5vdWdoCiMjCm5fZ2VuIDwtIDQqbl9lCgojIyBUaGUgbnVtYmVyIG9mIHRpbWVzIHRvIHJlcGVhdCBlYWNoIHNpbXVsYXRpb24KIyMKbl9yZXBzIDwtIDEwMDAwCgojIyBUaGlzIGlzIHRoZSBmb3J3YXJkIHNpbXVsYXRpb24uCiMjCnN0YXJ0X3RpbWUgPC0gU3lzLnRpbWUoKQpmb3IgKHJlcCBpbiAxOm5fcmVwcykgewogIHAgPC0gbnVtZXJpYyhuX2dlbikKICBwWzFdIDwtIDAuNQogIGZvciAoaSBpbiAyOm5fZ2VuKSB7CiAgICBrIDwtIHJiaW5vbSgxLCAyKm5fZSwgcFtpLTFdKQogICAgcFtpXSA8LSBrLygyKm5fZSkKICB9CiAgc2FtcGxlIDwtIHJiaW5vbSgxLCAyKm5fc2FtcGxlLCBwW25fZ2VuXSkKfQplbmRfdGltZSA8LSBTeXMudGltZSgpCmNhdCgiRWxhcHNlZCB0aW1lIGZvciBmb3J3YXJkIHNpbXVsYXRpb246ICAgICAgICIsIHJvdW5kKGVuZF90aW1lIC0gc3RhcnRfdGltZSwgMikpCgojIyBIZXJlJ3MgdGhlIGNvYWxlc2NlbnQgc2ltdWxhdGlvbi4KIyMKc3RhcnRfdGltZSA8LSBTeXMudGltZSgpCmZvciAocmVwIGluIDE6bl9yZXBzKSB7CiAgbXNfb3V0IDwtIG1zKG5zYW0gPSAyKm5fc2FtcGxlLCBvcHRzID0gIi1UIikKfQplbmRfdGltZSA8LSBTeXMudGltZSgpCmNhdCgiXG5FbGFwc2VkIHRpbWUgZm9yIGNvYWxlc2NlbnQgc2ltdWxhdGlvbjogIiwgcm91bmQoZW5kX3RpbWUgLSBzdGFydF90aW1lLCAyKSkKYGBgCgojIyBUaGUgY29hbGVzY2VudCB3aXRoIG1pZ3JhdGlvbgoKQXMgeW91J3ZlIHNlZW4gaW4gbGFiIHRoaXMgd2VlaywgYG1zKClgIGFsc28gYWxsb3dzIHlvdSB0byBzaW11bGF0ZSB0aGUgY29hbGVzY2VudCB3aXRoIG1pZ3JhdGlvbi4gV2hhdCB5b3UgZGlkbid0IHNlZSB3YXMgdGhlIGFjdHVhbCBjYWxsIHRvIGBtcygpYCB0aGF0IGRvZXMgaXQuIEhlcmUncyBhbiBleGFtcGxlIHdpdGggV3JpZ2h0J3MgaXNsYW5kIG1vZGVsOiA1IGlzbGFuZHMgd2l0aCBhIHNhbXBsZSBzaXplIG9mIDI1IGZyb20gZWFjaCBpc2xhbmQgYW5kICROX2VtID0gMC4xJC4KCmBgYHtyfQptc19vdXQgPC0gbXMobnNhbSA9IDEyNSwgIyBUaGUgdG90YWwgbnVtYmVyIG9mIGFsbGVsZXMgaW4gdGhlIHNhbXBsZQogICAgICAgICAgICAgbnJlcHMgPSAxLCAgIyBUaGUgbnVtYmVyIG9mIGNvYWxlc2NlbnQgc2FtcGxlcyB0byBwcm9kdWNlCiAgICAgICAgICAgICBvcHRzID0gIi1UIC1JIDUgMjUgMjUgMjUgMjUgMjUgMC4xIiwKICAgICAgICAgICAgICAgICAgICAgICAgICMgLVQgcHJvZHVjZSBhIHRyZWUgd2l0aCBjb2FsZXNjZW50IHRpbWVzCiAgICAgICAgICAgICAgICAgICAgICAgICAjIC1JIG1pZ3JhdGlvbiBmb2xsb3dzIFdyaWdodCdzIGlzbGFuZCBtb2RlbAogICAgICAgICAgICAgICAgICAgICAgICAgIyA1IHBvcHVsYXRpb25zCiAgICAgICAgICAgICAgICAgICAgICAgICAjIDI1IHRoZSBudW1iZXIgb2Ygc2FtcGxlcyBmcm9tIGVhY2ggcG9wdWxhdGlvbgogICAgICAgICAgICAgICAgICAgICAgICAgIyAwLjEgTmUqbQogICAgICAgICAgICApCm1zX3RyZWUgPC0gcmVhZC50cmVlKHRleHQgPSBtc19vdXQpCnBsb3QobXNfdHJlZSwgc2hvdy50aXAubGFiZWwgPSBGQUxTRSkKYGBgCg==