# 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)
tree = 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
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))
# Define a parametric HBD model, with exponentially varying lambda & mu
# Assume that the sampling fraction is known
# The model thus has 4 parameters: lambda0, mu0, alpha, beta
lambda_function = function(ages,params){
return(params['lambda0']*exp(-params['alpha']*ages));
}
mu_function = function(ages,params){
return(params['mu0']*exp(-params['beta']*ages));
}
rho_function = function(params){
return(rho) # rho does not depend on any of the parameters
}
# Define an age grid on which lambda_function & mu_function shall be evaluated
# Should be sufficiently fine to capture the variation in lambda & mu
age_grid = seq(from=0,to=100,by=0.01)
# Perform fitting
# Lets suppose extinction rates are already known
cat(sprintf("Fitting model to tree..\n"))
fit = fit_hbd_model_parametric( tree,
param_values = c(lambda0=NA, mu0=3, alpha=NA, beta=-0.09),
param_guess = c(1,1,0,0),
param_min = c(0,0,-1,-1),
param_max = c(10,10,1,1),
param_scale = 1, # all params are in the order of 1
lambda = lambda_function,
mu = mu_function,
rho0 = rho_function,
age_grid = age_grid,
Ntrials = 10, # perform 10 fitting trials
Nthreads = 2, # use 2 CPUs
max_model_runtime = 1, # limit model evaluation to 1 second
fit_control = list(rel.tol=1e-6))
if(!fit$success){
cat(sprintf("ERROR: Fitting failed: %s\n",fit$error))
}else{
cat(sprintf("Fitting succeeded:\nLoglikelihood=%g\n",fit$loglikelihood))
print(fit)
}
# }
Run the code above in your browser using DataLab