tests/testthat/test-fit-bd.r

In RPANDA: Phylogenetic ANalyses of DiversificAtion

# Load data and get tot_time
data(Cetacea)
tot_time<-max(node.age(Cetacea)$ages)
options(digits=17)

# # Parameters for validation
# precision_lh <- 3e-3
# precision_aicc <- 2e-1
# precision_param <- 5e-2

context("B constant")
# B constant
f.lamb <-function(t,y){y[1]}
f.mu<-function(t,y){0}
lamb_par <- c(0.09)
mu_par <- c()
res <- fit_bd(Cetacea,tot_time,f.lamb,f.mu,lamb_par,mu_par,f=87/89, cst.lamb=TRUE,fix.mu=TRUE, cond="stem", dt=1e-3)

test_that("B constant",{
  # Reference values
  reference_lh <- -279.0280
  reference_aicc <- 560.1031
  reference_lamb <- 0.107
  # Parameters for validation
  precision_lh <- 3e-3
  precision_aicc <- 2e-1
  precision_param <- 5e-2
  expect_that( abs(res$LH - reference_lh)  , is_less_than(precision_lh) )
  expect_that( abs(res$aicc - reference_aicc)  , is_less_than(precision_aicc) )
  expect_that( abs(res$lamb_par - reference_lamb)  , is_less_than(precision_param) )
})

# BD constant
context("B & D constant")
f.lamb <-function(t,y){y[1]}
f.mu<-function(t,y){y[1]}
lamb_par <- c(0.09)
mu_par <- c(0.3)
res <- fit_bd(Cetacea,tot_time,f.lamb,f.mu,lamb_par,mu_par,f=87/89,cst.lamb=TRUE,cst.mu=TRUE, cond="stem", dt=1e-3)

test_that("BD constant",{
  # Reference values
  reference_lh <- -279.0280
  reference_aicc <- 562.1989
  reference_lamb <- 0.107
  reference_mu <- -1.0e-7
  # Parameters for validation
  precision_lh <- 3e-3
  precision_aicc <- 2e-1
  precision_param <- 5e-2
  expect_that( abs(res$LH - reference_lh)  , is_less_than(precision_lh) )
  expect_that( abs(res$aicc - reference_aicc)  , is_less_than(precision_aicc) )
  expect_that( abs(res$lamb_par - reference_lamb)  , is_less_than(precision_param) )
})


# 3) B variable E
context("B exponential")
f.lamb <-function(t,y){y[1] * exp(y[2] * t)}
f.mu<-function(t,y){0}
lamb_par<-c(0.05, 0.01)
mu_par<-c()
res <- fit_bd(Cetacea,tot_time,f.lamb,f.mu,lamb_par,mu_par,f=87/89, expo.lamb=TRUE, fix.mu=TRUE, cond="stem", dt=1e-3)

test_that("B variable exponential",{
  # Reference values
  reference_lh <- -278.9887
  reference_aicc <- 562.0485
  reference_lamb <- c(0.103,0.004)
  # Parameters for validation
  precision_lh <- 3e-3
  precision_aicc <- 2e-1
  precision_param <- 5e-2
  expect_that( abs(res$LH - reference_lh)  , is_less_than(precision_lh) )
  expect_that( abs(res$aicc - reference_aicc)  , is_less_than(precision_aicc) )
  expect_that( abs(res$lamb_par[1] - reference_lamb[1])  , is_less_than(precision_param) )
  expect_that( abs(res$lamb_par[2] - reference_lamb[2])  , is_less_than(precision_param) )
})

# 4) B variable L
context("B linear")
f.lamb <-function(t,y){y[1] + y[2] * t}
f.mu<-function(t,y){0}
lamb_par<-c(0.05, 0.01)
mu_par<-c()
res <- fit_bd(Cetacea,tot_time,f.lamb,f.mu,lamb_par,mu_par,f=87/89, fix.mu=TRUE, cond="stem", dt=1e-3)

test_that("B variable linear",{
  # Reference values
  reference_lh <- -278.9896
  reference_aicc <- 562.0502
  reference_lamb <- c(0.104,0.0004)
  # Parameters for validation
  precision_lh <- 3e-3
  precision_aicc <- 2e-1
  precision_param <- 5e-2
  expect_that( abs(res$LH - reference_lh)  , is_less_than(precision_lh) )
  expect_that( abs(res$aicc - reference_aicc)  , is_less_than(precision_aicc) )
  expect_that( abs(res$lamb_par[1] - reference_lamb[1])  , is_less_than(precision_param) )
  expect_that( abs(res$lamb_par[2] - reference_lamb[2])  , is_less_than(precision_param) )
})


# 5) B variable E, D constant
context("B exponential, D constant")
f.lamb <-function(t,y){y[1] * exp(y[2] * t)}
mu_par <- c(0.5)
f.mu<-function(t,y){y[1]}
lamb_par<-c(0.05, 0.01)
mu_par<-c(0.1)
res <- fit_bd(Cetacea,tot_time,f.lamb,f.mu,lamb_par,mu_par,f=87/89, expo.lamb=TRUE, cst.mu=TRUE, cond="stem", dt=1e-3)

test_that("B variable exponential, D constant",{
  # Reference values
  reference_lh <- -278.9887
  reference_aicc <- 564.1204
  reference_lamb <- c(0.104,0.004)
  reference_mu <- -1.0e-6
  # Parameters for validation
  precision_lh <- 3e-3
  precision_aicc <- 2e-1
  precision_param <- 5e-2
  expect_that( abs(res$LH - reference_lh)  , is_less_than(precision_lh) )
  expect_that( abs(res$aicc - reference_aicc)  , is_less_than(precision_aicc) )
  expect_that( abs(res$lamb_par[1] - reference_lamb[1])  , is_less_than(precision_param) )
  expect_that( abs(res$lamb_par[2] - reference_lamb[2])  , is_less_than(precision_param) )
})


# 6) B variable L, D constant
context("B linear, D constant")
f.lamb <-function(t,y){y[1] + y[2] * t}
f.mu<-function(t,y){y[1]}
lamb_par<-c(0.05, 0.01)
mu_par <- c(0.5)
res <- fit_bd(Cetacea,tot_time,f.lamb,f.mu,lamb_par,mu_par,f=87/89, cst.mu= TRUE, cond="stem", dt=1e-3)

test_that("B variable linear, D constant",{
  # Reference values
  reference_lh <- -278.9896
  reference_aicc <- 564.1221
  reference_lamb <- c(0.104,0.0004)
  reference_mu <- 2.5e-7
  # Parameters for validation
  precision_lh <- 3e-3
  precision_aicc <- 2e-1
  precision_param <- 5e-2
  expect_that( abs(res$LH - reference_lh)  , is_less_than(precision_lh) )
  expect_that( abs(res$aicc - reference_aicc)  , is_less_than(precision_aicc) )
  expect_that( abs(res$lamb_par[1] - reference_lamb[1])  , is_less_than(precision_param) )
  expect_that( abs(res$lamb_par[2] - reference_lamb[2])  , is_less_than(precision_param) )
})


# 7) B constant, D variable E
context("B constant, D exponential")
f.lamb<-function(t,y){y[1]}
f.mu <-function(t,y){y[1] * exp(y[2] * t)}
lamb_par <- c(0.05)
mu_par <-c(0.005, 0.01)
res <- fit_bd(Cetacea,tot_time,f.lamb,f.mu,lamb_par,mu_par,f=87/89, cst.lamb=TRUE, expo.mu=TRUE, cond="stem", dt=1e-3)

test_that("B constant, D exponential",{
  # Reference values
  reference_lh <- -279.0280
  reference_aicc <- 564.1989
  reference_lamb <- 0.107
  reference_mu <- c(-9.637e-09, -0.0111)
  # Parameters for validation
  precision_lh <- 3e-3
  precision_aicc <- 2e-1
  precision_param <- 5e-2
  expect_that( abs(res$LH - reference_lh)  , is_less_than(precision_lh) )
  expect_that( abs(res$aicc - reference_aicc)  , is_less_than(precision_aicc) )
  expect_that( abs(res$lamb_par - reference_lamb)  , is_less_than(precision_param) )
})


# 8) B constant, D variable L
context("B constant, D linear")
f.lamb<-function(t,y){y[1]}
f.mu <-function(t,y){y[1] + y[2] * t}
lamb_par <- c(0.05)
mu_par <-c(0.005, 0.001)
res <- fit_bd(Cetacea,tot_time,f.lamb,f.mu,lamb_par,mu_par,f=87/89, cst.lamb=TRUE, cond="stem", dt=1e-3)

test_that("B constant, D linear",{
  # Reference values
  reference_lh <- -279.0280
  reference_aicc <- 564.1989
  reference_lamb <- 0.107
  reference_mu <- c(-1.0e-07, 3.2e-08)
  # Parameters for validation
  precision_lh <- 3e-3
  precision_aicc <- 2e-1
  precision_param <- 5e-2
  expect_that( abs(res$LH - reference_lh)  , is_less_than(precision_lh) )
  expect_that( abs(res$aicc - reference_aicc)  , is_less_than(precision_aicc) )
  expect_that( abs(res$lamb_par - reference_lamb)  , is_less_than(precision_param) )
})