# NOT RUN {
# Generate a random tree with exponentially varying lambda & mu
Ntips = 10000
rho = 0.5 # sampling fraction
time_grid = seq(from=0, to=100, by=0.01)
lambdas = 2*exp(0.1*time_grid)
mus = 1.5*exp(0.09*time_grid)
sim = generate_random_tree( parameters = list(rarefaction=rho),
max_tips = Ntips/rho,
coalescent = TRUE,
added_rates_times = time_grid,
added_birth_rates_pc = lambdas,
added_death_rates_pc = mus)
tree = sim$tree
root_age = castor::get_tree_span(tree)$max_distance
cat(sprintf("Tree has %d tips, spans %g Myr\n",length(tree$tip.label),root_age))
# Fit PSR on grid
oldest_age=root_age/2 # only consider recent times when fitting
Ngrid = 10
age_grid = seq(from=0,to=oldest_age,length.out=Ngrid)
fit = fit_hbd_psr_on_grid(tree,
oldest_age = oldest_age,
age_grid = age_grid,
min_PSR = 0,
max_PSR = +100,
condition = "crown",
Ntrials = 10, # perform 10 fitting trials
Nthreads = 10, # use two CPUs
max_model_runtime = 1) # limit model evaluation to 1 second
if(!fit$success){
cat(sprintf("ERROR: Fitting failed: %s\n",fit$error))
}else{
cat(sprintf("Fitting succeeded:\nLoglikelihood=%g\n",fit$loglikelihood))
# plot fitted PSR
plot( x = fit$age_grid,
y = fit$fitted_PSR,
main = 'Fitted PSR',
xlab = 'age',
ylab = 'PSR',
type = 'b',
xlim = c(root_age,0))
# plot deterministic LTT of fitted model
plot( x = fit$age_grid,
y = fit$fitted_LTT,
main = 'Fitted dLTT',
xlab = 'age',
ylab = 'lineages',
type = 'b',
log = 'y',
xlim = c(root_age,0))
# get fitted PSR as a function of age
PSR_fun = approxfun(x=fit$age_grid, y=fit$fitted_PSR)
}
# }
Run the code above in your browser using DataLab