###
# first, it's good to check that it can work with constant rates
# initial number of species
n0 <- 1
# maximum simulation time
tMax <- 40
# speciation
lambda <- 0.1
# extinction
mu <- 0.03
# set seed
set.seed(1)
# run the simulation, making sure we have more than one species in the end
sim <- bd.sim.traits(n0, lambda, mu, tMax, nFinal = c(2, Inf))
# we can plot the phylogeny to take a look
if (requireNamespace("ape", quietly = TRUE)) {
phy <- make.phylo(sim$SIM)
ape::plot.phylo(phy)
}
###
# now let's actually make it trait-dependent, a simple BiSSE model
# initial number of species
n0 <- 1
# maximum simulation time
tMax <- 40
# speciation, higher for state 1
lambda <- c(0.1, 0.2)
# extinction, trait-independent
mu <- 0.03
# number of traits and states (1 binary trait)
nTraits <- 1
nStates <- 2
# initial value of the trait
X0 <- 0
# transition matrix, with symmetrical transition rates
Q <- list(matrix(c(0, 0.1,
0.1, 0), ncol = 2, nrow = 2))
# set seed
set.seed(1)
# run the simulation
sim <- bd.sim.traits(n0, lambda, mu, tMax, nTraits = nTraits,
nStates = nStates, X0 = X0, Q = Q, nFinal = c(2, Inf))
# get trait values for all tips
traits <- unlist(lapply(sim$TRAITS, function(x) tail(x[[1]]$value, 1)))
# we can plot the phylogeny to take a look
if (requireNamespace("ape", quietly = TRUE)) {
phy <- make.phylo(sim$SIM)
# color 0 valued tips red and 1 valued tips blue
ape::plot.phylo(phy, tip.color = c("red", "blue")[traits + 1])
}
###
# extinction can be trait-dependent too, of course
# initial number of species
n0 <- 1
# number of species at the end of the simulation
N <- 20
# speciation, higher for state 1
lambda <- c(0.1, 0.2)
# extinction, highe for state 0
mu <- c(0.06, 0.03)
# number of traits and states (1 binary trait)
nTraits <- 1
nStates <- 2
# initial value of the trait
X0 <- 0
# transition matrix, with symmetrical transition rates
Q <- list(matrix(c(0, 0.1,
0.1, 0), ncol = 2, nrow = 2))
# set seed
set.seed(1)
# run the simulation
sim <- bd.sim.traits(n0, lambda, mu, N = N, nTraits = nTraits,
nStates = nStates, X0 = X0, Q = Q, nFinal = c(2, Inf))
# get trait values for all tips
traits <- unlist(lapply(sim$TRAITS, function(x) tail(x[[1]]$value, 1)))
# we can plot the phylogeny to take a look
if (requireNamespace("ape", quietly = TRUE)) {
phy <- make.phylo(sim$SIM)
# color 0 valued tips red and 1 valued tips blue
ape::plot.phylo(phy, tip.color = c("red", "blue")[traits + 1])
}
###
# we can complicate the model further by making transition rates asymmetric
# initial number of species
n0 <- 1
# maximum simulation time
tMax <- 20
# speciation, higher for state 1
lambda <- c(0.1, 0.2)
# extinction, lower for state 1
mu <- c(0.03, 0.01)
# number of traits and states (1 binary trait)
nTraits <- 1
nStates <- 2
# initial value of the trait
X0 <- 0
# transition matrix, with q01 higher than q10
Q <- list(matrix(c(0, 0.1,
0.25, 0), ncol = 2, nrow = 2))
# set seed
set.seed(1)
# run the simulation
sim <- bd.sim.traits(n0, lambda, mu, tMax, nTraits = nTraits,
nStates = nStates, X0 = X0, Q = Q, nFinal = c(2, Inf))
# get trait values for all tips
traits <- unlist(lapply(sim$TRAITS, function(x) tail(x[[1]]$value, 1)))
# we can plot the phylogeny to take a look
if (requireNamespace("ape", quietly = TRUE)) {
phy <- make.phylo(sim$SIM)
# color 0 valued tips red and 1 valued tips blue
ape::plot.phylo(phy, tip.color = c("red", "blue")[traits + 1])
}
###
# MuSSE is BiSSE but with higher numbers of states
# initial number of species
n0 <- 1
# number of species at the end of the simulation
N <- 20
# speciation, higher for state 1, highest for state 2
lambda <- c(0.1, 0.2, 0.3)
# extinction, higher for state 2
mu <- c(0.03, 0.03, 0.06)
# number of traits and states (1 trinary trait)
nTraits <- 1
nStates <- 3
# initial value of the trait
X0 <- 0
# transition matrix, with symmetrical, fully reversible transition rates
Q <- list(matrix(c(0, 0.1, 0.1,
0.1, 0, 0.1,
0.1, 0.1, 0), ncol = 3, nrow = 3))
# set seed
set.seed(1)
# run the simulation
sim <- bd.sim.traits(n0, lambda, mu, N = N, nTraits = nTraits,
nStates = nStates, X0 = X0, Q = Q, nFinal = c(2, Inf))
# get trait values for all tips
traits <- unlist(lapply(sim$TRAITS, function(x) tail(x[[1]]$value, 1)))
# we can plot the phylogeny to take a look
if (requireNamespace("ape", quietly = TRUE)) {
phy <- make.phylo(sim$SIM)
# 0 tips = red, 1 tips = blue, 2 tips = green
ape::plot.phylo(phy, tip.color = c("red", "blue", "green")[traits + 1])
}
###
# HiSSE is like BiSSE, but with the possibility of hidden traits
# here we have 4 states, representing two states for the observed trait
# (0 and 1) and two for the hidden trait (A and B), i.e. 0A, 1A, 0B, 1B
# initial number of species
n0 <- 1
# maximum simulation time
tMax <- 20
# speciation, higher for state 1A, highest for 1B
lambda <- c(0.1, 0.2, 0.1, 0.3)
# extinction, lowest for 0B
mu <- c(0.03, 0.03, 0.01, 0.03)
# number of traits and states (1 binary observed trait,
# 1 binary hidden trait)
nTraits <- 1
nStates <- 2
nHidden <- 2
# initial value of the trait
X0 <- 0
# transition matrix, with symmetrical transition rates. Only one transition
# is allowed at a time, i.e. 0A can go to 0B and 1A,
# but not to 1B, and similarly for others
Q <- list(matrix(c(0, 0.1, 0.1, 0,
0.1, 0, 0, 0.1,
0.1, 0, 0, 0.1,
0, 0.1, 0.1, 0), ncol = 4, nrow = 4))
# set seed
set.seed(1)
# run the simulation
sim <- bd.sim.traits(n0, lambda, mu, tMax, nTraits = nTraits,
nStates = nStates, nHidden = nHidden,
X0 = X0, Q = Q, nFinal = c(2, Inf))
# get trait values for all tips
traits <- unlist(lapply(sim$TRAITS, function(x) tail(x[[1]]$value, 1)))
# we can plot the phylogeny to take a look
if (requireNamespace("ape", quietly = TRUE)) {
phy <- make.phylo(sim$SIM)
# color 0 valued tips red and 1 valued tips blue
ape::plot.phylo(phy, tip.color = c("red", "blue")[traits + 1])
}
###
# we can also increase the number of traits, e.g. to have a neutral trait
# evolving with the real one to compare the estimates of the model for each
# initial number of species
n0 <- 1
# maximum simulation time
tMax <- 20
# speciation, higher for state 1
lambda <- c(0.1, 0.2)
# extinction, lowest for state 0
mu <- c(0.01, 0.03)
# number of traits and states (2 binary traits)
nTraits <- 2
nStates <- 2
# initial value of both traits
X0 <- 0
# transition matrix, with symmetrical transition rates for trait 1,
# and asymmetrical (and higher) for trait 2
Q <- list(matrix(c(0, 0.1,
0.1, 0), ncol = 2, nrow = 2),
matrix(c(0, 1,
0.5, 0), ncol = 2, nrow = 2))
# set seed
set.seed(1)
# run the simulation
sim <- bd.sim.traits(n0, lambda, mu, tMax, nTraits = nTraits,
nStates = nStates, X0 = X0, Q = Q, nFinal = c(2, Inf))
# get trait values for all tips
traits1 <- unlist(lapply(sim$TRAITS, function(x) tail(x[[1]]$value, 1)))
traits2 <- unlist(lapply(sim$TRAITS, function(x) tail(x[[2]]$value, 1)))
# make index for coloring tips
index <- ifelse(!(traits1 | traits2), "red",
ifelse(traits1 & !traits2, "purple",
ifelse(!traits1 & traits2, "magenta", "blue")))
# 00 = red, 10 = purple, 01 = magenta, 11 = blue
# we can plot the phylogeny to take a look
if (requireNamespace("ape", quietly = TRUE)) {
phy <- make.phylo(sim$SIM)
# color 0 valued tips red and 1 valued tips blue
ape::plot.phylo(phy, tip.color = index)
}
###
# we can then do the same thing, but with the
# second trait controlling extinction
# initial number of species
n0 <- 1
# maximum simulation time
tMax <- 20
# speciation, higher for state 10 and 11
lambda <- c(0.1, 0.2)
# extinction, lowest for state 00 and 01
mu <- c(0.01, 0.03)
# number of traits and states (2 binary traits)
nTraits <- 2
nStates <- 2
nFocus <- c(1, 2)
# initial value of both traits
X0 <- 0
# transition matrix, with symmetrical transition rates for trait 1,
# and asymmetrical (and higher) for trait 2
Q <- list(matrix(c(0, 0.1,
0.1, 0), ncol = 2, nrow = 2),
matrix(c(0, 1,
0.5, 0), ncol = 2, nrow = 2))
# set seed
set.seed(1)
# run the simulation
sim <- bd.sim.traits(n0, lambda, mu, tMax, nTraits = nTraits,
nStates = nStates, nFocus = nFocus,
X0 = X0, Q = Q, nFinal = c(2, Inf))
# get trait values for all tips
traits1 <- unlist(lapply(sim$TRAITS, function(x) tail(x[[1]]$value, 1)))
traits2 <- unlist(lapply(sim$TRAITS, function(x) tail(x[[2]]$value, 1)))
# make index for coloring tips
index <- ifelse(!(traits1 | traits2), "red",
ifelse(traits1 & !traits2, "purple",
ifelse(!traits1 & traits2, "magenta", "blue")))
# 00 = red, 10 = purple, 01 = magenta, 11 = blue
# we can plot the phylogeny to take a look
if (requireNamespace("ape", quietly = TRUE)) {
phy <- make.phylo(sim$SIM)
# color 0 valued tips red and 1 valued tips blue
ape::plot.phylo(phy, tip.color = index)
}
###
# as a final level of complexity, let us change the X0
# and number of states of the trait controlling extinction
# initial number of species
n0 <- 1
# maximum simulation time
tMax <- 20
# speciation, higher for state 10 and 11
lambda <- c(0.1, 0.2)
# extinction, lowest for state 00, 01, and 02
mu <- c(0.01, 0.03, 0.03)
# number of traits and states (2 binary traits)
nTraits <- 2
nStates <- c(2, 3)
nFocus <- c(1, 2)
# initial value of both traits
X0 <- c(0, 2)
# transition matrix, with symmetrical transition rates for trait 1,
# and asymmetrical, directed, and higher rates for trait 2
Q <- list(matrix(c(0, 0.1,
0.1, 0), ncol = 2, nrow = 2),
matrix(c(0, 1, 0,
0.5, 0, 0.75,
0, 1, 0), ncol = 3, nrow = 3))
# set seed
set.seed(1)
# run the simulation
sim <- bd.sim.traits(n0, lambda, mu, tMax, nTraits = nTraits,
nStates = nStates, nFocus = nFocus,
X0 = X0, Q = Q, nFinal = c(2, Inf))
# get trait values for all tips
traits1 <- unlist(lapply(sim$TRAITS, function(x) tail(x[[1]]$value, 1)))
traits2 <- unlist(lapply(sim$TRAITS, function(x) tail(x[[2]]$value, 1)))
# make index for coloring tips
index <- ifelse(!(traits1 | (traits2 != 0)), "red",
ifelse(traits1 & (traits2 == 0), "purple",
ifelse(!traits1 & (traits2 == 1), "magenta",
ifelse(traits1 & (traits2 == 1), "blue",
ifelse(!traits1 & (traits2 == 2),
"orange", "green")))))
# 00 = red, 10 = purple, 01 = magenta, 11 = blue, 02 = orange, 12 = green
# we can plot the phylogeny to take a look
if (requireNamespace("ape", quietly = TRUE)) {
phy <- make.phylo(sim$SIM)
# color 0 valued tips red and 1 valued tips blue
ape::plot.phylo(phy, tip.color = index)
}
# one could further complicate the model by adding hidden states
# to each trait, each with its own number etc, but these examples
# include all the tools necessary to make these or further extensions
Run the code above in your browser using DataLab