tests/testthat/testInit.R

In cauphy: Trait Evolution on Phylogenies Using the Cauchy Process

test_that("testMoments", {
  
  set.seed(128910)
  
  ## Parameters
  mu <- 0
  disp <- 1
  lambda <- 1
  
  ## tree with three tips
  tree <- read.tree(text = "((A:1,B:0.5):0.3, C:1);")
  
  ## Trait simulation
  trait <- rTraitCauchy(100000, tree, "cauchy", parameters = list(root.value = mu, disp = disp, lambda = lambda))
  
  ## tips
  expect_equal(mad(trait[1, ], constant = 1), vcv(tree)[1, 1], tolerance = 1e-2)
  expect_equal(mad(trait[2, ], constant = 1), vcv(tree)[2, 2], tolerance = 1e-2)
  expect_equal(mad(trait[3, ], constant = 1), vcv(tree)[3, 3], tolerance = 1e-2)
  
  ## Linear combinations
  expect_equal(mad(0.5 * trait[1, ] + 0.5 * trait[2, ], constant = 1),
               0.5 * vcv(tree)[1, 1] + 0.5 * vcv(tree)[2, 2],
               tolerance = 1e-2)
  expect_equal(mad(0.5 * trait[1, ] + 0.5 * trait[3, ], constant = 1),
               0.5 * vcv(tree)[1, 1] + 0.5 * vcv(tree)[3, 3],
               tolerance = 1e-2)
  expect_equal(mad(0.5 * trait[2, ] + 0.5 * trait[3, ], constant = 1),
               0.5 * vcv(tree)[2, 2] + 0.5 * vcv(tree)[3, 3],
               tolerance = 1e-2)
  
  a <- 0.4
  b <- -a
  expect_equal(mad(a * trait[1, ] + b * trait[2, ], constant = 1),
               (abs(a + b) - abs(a) - abs(b)) * vcv(tree)[1, 2] + abs(a) * vcv(tree)[1, 1] + abs(b) * vcv(tree)[2, 2],
               tolerance = 1e-2)
  
  ## With lambda
  lambda <- 0.7
  trait <- rTraitCauchy(100000, tree, "lambda", parameters = list(root.value = mu, disp = disp, lambda = lambda))
  expect_equal(median((abs(trait[1, ] - trait[2, ]) - vcv(tree)[1, 1] - vcv(tree)[2, 2]) / (- 2 * vcv(tree)[1, 2])),
               lambda, tolerance = 1e-1)
})

test_that("testEstimLambda", {
  
  set.seed(128910)
  
  ## Parameters
  mu <- 0
  disp <- 0.5
  lambda <- 0.7
  
  ## tree with three tips
  tree <- rphylo(50, 0.1, 0.02, fossils = TRUE)
  
  ## Trait simulation
  trait <- rTraitCauchy(1000, tree, "lambda", parameters = list(root.value = mu, disp = disp, lambda = lambda))
  
  ## disp
  estim_disp <- function(trait) {
    norm_trait <- (trait - median(trait)) / diag(ape::vcv(tree))
    return(mad(norm_trait, constant = 1))
  }
  
  all_disp <- apply(trait, 2, function(y) initDispersionParameter(tree, y, center = median(y), method.init.disp = "MAD"))
  expect_equal(mean(all_disp), disp, tolerance = 1e-1)
  
  ## lambda
  all_lambda_true_disp <- sapply(1:ncol(trait), function(i) initLambdaParameter(tree, trait[, i], disp))
  expect_equal(mean(all_lambda_true_disp), lambda, tolerance = 1e-1)
  
})