#context("dispRity.utilities")
## utilities internals
test_that("utilities internal: extract.disparity.values", {
data(disparity)
data <- disparity
test_con <- extract.disparity.values(1, data, rarefaction = FALSE, concatenate = TRUE)
## extract list of 100 (bs) numeric elements
expect_is(test_con, "list")
expect_is(test_con[[1]], "numeric")
expect_equal(length(test_con[[1]]), data$call$bootstrap[[1]])
test_uncon <- extract.disparity.values(1, data, rarefaction = FALSE, concatenate = FALSE)
## extract list of 100 (bs) numeric elements
expect_is(test_uncon, "list")
expect_is(test_uncon[[1]], "numeric")
expect_equal(length(test_uncon[[1]]), 1)
expect_equal(length(test_uncon), data$call$bootstrap[[1]])
})
test_that("utilities internal: clean.list", {
dummy_list <- list("a" = NULL, "b" = 1, "c" = list(NULL, 1))
test <- clean.list(dummy_list)
expect_is(test, "list")
expect_equal(length(test), length(dummy_list)-1)
})
test_that("utilities internal: recursive.sort", {
expect_equal(recursive.sort(LETTERS[1:5], 5:1), rev(LETTERS[1:5]))
})
test_that("utilities internal: merge.two.subsets", {
data(disparity)
data <- disparity
## Merging two first subsets
test <- merge.two.subsets(1,2, data)
expect_is(test, "dispRity")
expect_equal(length(test), 5)
expect_is(test$subsets, "list")
expect_equal(length(test$subsets),length(data$subsets)-1)
expect_equal(names(test$subsets)[1], paste(names(data$subsets)[1:2], collapse = "-"))
})
test_that("utilities internal: check.subsets", {
data(disparity)
data <- disparity
## Testing if subsets work
expect_error(
check.subsets(1:20, data)
)
expect_error(
check.subsets(8, data)
)
expect_error(
check.subsets(c(1,2,8), data)
)
expect_error(
check.subsets(c("8", "0"), data)
)
expect_error(
check.subsets(matrix(NA), data)
)
## Between.groups check.subsets
data(BeckLee_mat50)
data(BeckLee_tree)
group <- crown.stem(BeckLee_tree, inc.nodes = FALSE)
group$all <- rownames(BeckLee_mat50)
## Get the disparity between groups
disparity <- dispRity(boot.matrix(custom.subsets(BeckLee_mat50, group = group)), metric = group.dist, between.groups = TRUE)
expect_null(check.subsets(names(disparity$subsets), disparity))
expect_null(check.subsets(c("all", "crown"), disparity))
expect_null(check.subsets(c(1,2), disparity))
expect_null(check.subsets(c("all:crown"), disparity))
expect_null(check.subsets(c("crown:all"), disparity))
error <- capture_error(check.subsets(c(1,2,3,4), disparity))
expect_equal(error[[1]], "Subset 4 not found.")
error <- capture_error(check.subsets(c("ally", "crown"), disparity))
expect_equal(error[[1]], "Subset ally not found.")
})
## make.dispRity
test_that("make.matrix", {
test1 <- make.dispRity()
expect_is(
test1
,"dispRity")
expect_is(
test1$matrix
,"list")
expect_equal(
test1$matrix[[1]]
,NULL)
expect_is(
test1$call
,"list")
expect_is(
test1$subsets
,"list")
expect_is(
test1$tree
,"list")
expect_equal(
test1$tree[[1]]
,NULL)
data_test <- matrix(rnorm(12), ncol = 3)
test2 <- make.dispRity(data = data_test)
expect_is(
test2
,"dispRity")
expect_is(
test2$matrix
,"list")
expect_is(
test2$matrix[[1]]
,"matrix")
expect_is(
test2$call
,"list")
expect_is(
test2$subsets
,"list")
expect_equal(
length(unlist(test2))
, 12)
expect_is(
test1$tree
,"list")
expect_equal(
test1$tree[[1]]
,NULL)
test3 <- make.dispRity(data = list(data_test))
expect_is(
test3
,"dispRity")
expect_is(
test3$matrix
,"list")
expect_is(
test3$matrix[[1]]
,"matrix")
expect_is(
test3$call
,"list")
expect_is(
test3$subsets
,"list")
expect_equal(
length(unlist(test3))
, 12)
test4 <- make.dispRity(data = list(data_test, data_test))
expect_equal(
length(unlist(test4))
, 24)
test5 <- make.dispRity(data = data_test, tree = rtree(5))
expect_is(
test5$tree
,"multiPhylo")
expect_is(
test5$tree[[1]]
,"phylo")
test6 <- make.dispRity(data = data_test, tree = rmtree(5, 5))
expect_is(
test6$tree
,"multiPhylo")
expect_is(
test6$tree[[1]]
,"phylo")
})
## fill.dispRity
test_that("fill.dispRity", {
expect_error(
fill.dispRity(make.dispRity())
)
expect_warning(test <- fill.dispRity(make.dispRity(data = matrix(rnorm(12), ncol = 3))))
## Warn is added dimnames
expect_is(
test
,"dispRity")
expect_is(
test$matrix
,"list")
expect_is(
test$matrix[[1]]
,"matrix")
expect_is(
test$call
,"list")
expect_is(
test$subsets
,"list")
expect_equal(
length(unlist(test$matrix[[1]]))
, 12)
expect_equal(
test$call$dimensions
, 1:ncol(test$matrix[[1]]))
expect_equal(
as.vector(test$subsets[[1]]$elements)
, 1:nrow(test$matrix[[1]]))
test <- make.dispRity(data = matrix(rnorm(12), ncol = 3))
test$subsets <- c(list(), list())
expect_warning(test <- fill.dispRity(test))
expect_equal(
as.vector(test$subsets[[1]]$elements)
, 1:nrow(test$matrix[[1]]))
## Filling trees
## One tree one data
tree <- makeNodeLabel(rtree(5))
data <- matrix(0, nrow = 9, ncol = 2, dimnames = list(c(paste0("t", 1:5), paste0("Node", 1:4))))
test <- fill.dispRity(make.dispRity(data = data, tree = tree))
## Basic works
expect_is(test, "dispRity")
expect_is(test$tree, "multiPhylo")
expect_is(test$tree[[1]], "phylo")
expect_equal(length(test$tree), 1)
expect_equal(length(test$matrix), 1)
## Multiple tree one data
tree <- makeNodeLabel(rtree(5))
tree <- list(tree, tree)
class(tree) <- "multiPhylo"
data <- matrix(0, nrow = 9, ncol = 2, dimnames = list(c(paste0("t", 1:5), paste0("Node", 1:4))))
test <- fill.dispRity(make.dispRity(data = data, tree = tree))
## multiple trees works
expect_is(test, "dispRity")
expect_is(test$tree, "multiPhylo")
expect_is(test$tree[[1]], "phylo")
expect_equal(length(test$tree), 2)
expect_equal(length(test$matrix), 1)
## One tree multiple data
tree <- makeNodeLabel(rtree(5))
data <- matrix(0, nrow = 9, ncol = 2, dimnames = list(c(paste0("t", 1:5), paste0("Node", 1:4))))
test <- fill.dispRity(make.dispRity(data = list(data, data), tree = tree))
## One tree multiple data works
expect_is(test, "dispRity")
expect_is(test$tree, "multiPhylo")
expect_is(test$tree[[1]], "phylo")
expect_equal(length(test$tree), 1)
expect_equal(length(test$matrix), 2)
## multiple tree multiple data
tree <- makeNodeLabel(rtree(5))
tree <- list(tree, tree)
class(tree) <- "multiPhylo"
data <- matrix(0, nrow = 9, ncol = 2, dimnames = list(c(paste0("t", 1:5), paste0("Node", 1:4))))
## multiple tree multiple data works
test <- fill.dispRity(tree = tree, data = make.dispRity(data = list(data, data)))
expect_is(test, "dispRity")
expect_is(test$tree, "multiPhylo")
expect_is(test$tree[[1]], "phylo")
expect_equal(length(test$tree), 2)
expect_equal(length(test$matrix), 2)
## Also works with just tips
my_tree <- rtree(6)
my_data <- matrix(0, ncol = 2, nrow = 6, dimnames = list(c(my_tree$tip.label)))
test <- fill.dispRity(tree = my_tree, data = make.dispRity(my_data))
expect_is(test, "dispRity")
expect_is(test$tree, "multiPhylo")
expect_is(test$tree[[1]], "phylo")
expect_equal(length(test$tree), 1)
expect_equal(length(test$matrix), 1)
})
## get.matrix
test_that("get.matrix", {
## Load the Beck & Lee 2014 data
data(BeckLee_mat50)
## Calculating the disparity from a customised subsets
## Generating the subsets
groups <- as.data.frame(matrix(data = c(rep(1, nrow(BeckLee_mat50)/2), rep(2, nrow(BeckLee_mat50)/2)), nrow = nrow(BeckLee_mat50), ncol = 1, dimnames = list(rownames(BeckLee_mat50))))
customised_subsets <- custom.subsets(BeckLee_mat50, groups)
## Bootstrapping and rarefying the data
set.seed(1)
dispRity_data <- boot.matrix(customised_subsets, bootstraps = 100,rarefaction = c(15, 10))
expect_error(
get.matrix(matrix(rnorm(12), ncol = 3))
)
expect_true(
all(get.matrix(dispRity_data) == BeckLee_mat50)
)
expect_equal(
dim(get.matrix(dispRity_data, subsets = 2))
, c(25, 48))
expect_equal(
rownames(get.matrix(dispRity_data, subsets = 2))
, c("Rhombomylus","Gomphos","Mimotona","Soricidae","Solenodon","Eoryctes","Potamogalinae","Rhynchocyon","Procavia","Moeritherium","Dasypodidae","Bradypus","Myrmecophagidae","Dilambdogale","Widanelfarasia","Todralestes","unnamed_zalambdalestid","unnamed_cimolestid","Oxyclaenus","Protictis","Icaronycteris","Patriomanis","Cynocephalus","Pezosiren","Trichechus"))
expect_equal(
dim(get.matrix(dispRity_data, subsets = 2, rarefaction = 2, bootstrap = 52))
, c(15, 48))
expect_equal(
rownames(get.matrix(dispRity_data, subsets = 2, rarefaction = 2, bootstrap = 52))
, c("Eoryctes", "Rhynchocyon", "Pezosiren", "Potamogalinae", "Soricidae", "Myrmecophagidae", "Protictis", "Protictis", "unnamed_cimolestid", "Bradypus", "Mimotona", "Todralestes", "Moeritherium", "Dasypodidae", "Bradypus"))
})
## get.subsets
test_that("get.subsets", {
data(BeckLee_mat99)
data(BeckLee_tree)
subsets_full <- chrono.subsets(BeckLee_mat99, BeckLee_tree, method = "continuous",time = 5, model = "acctran")
bootstrapped_data <- boot.matrix(subsets_full, bootstraps = 10, rarefaction = c(3, 5))
disparity_data <- dispRity(bootstrapped_data, variances)
expect_error(
get.subsets(disparity_data)
)
expect_error(
get.subsets(disparity_data, matrix(1))
)
expect_error(
get.subsets(disparity_data, "blabalbal")
)
expect_error(
get.subsets(disparity_data, 1:10)
)
expect_error(
get.subsets(disparity_data, 6)
)
test <- get.subsets(subsets_full, subsets = c(1,2))
expect_is(
test
,"dispRity")
expect_equal(
length(test)
,3)
expect_equal(
length(test$subsets)
,2)
expect_equal(
names(test$subsets)
,names(subsets_full$subsets)[1:2])
test <- get.subsets(bootstrapped_data, subsets = "66.76")
expect_is(
test
,"dispRity")
expect_equal(
length(test)
,3)
expect_equal(
length(test$subsets)
,1)
expect_equal(
test$call$bootstrap[[1]]
,10)
test <- get.subsets(disparity_data, subsets = c(1:3))
expect_is(
test
,"dispRity")
expect_equal(
length(test)
,4)
expect_equal(
length(test$subsets)
,3)
expect_equal(
length(test$disparity)
,3)
expect_equal(
as.character(test$call$disparity$metric[[1]])
,"variances")
})
## get.disparity
test_that("get.disparity", {
data(BeckLee_mat99) ; data(BeckLee_tree)
subsets_full <- chrono.subsets(BeckLee_mat99, BeckLee_tree, method = "continuous",time = 5, model = "acctran")
bootstrapped_data <- boot.matrix(subsets_full, bootstraps = 10, rarefaction = c(3, 5))
data <- dispRity(bootstrapped_data, c(sum,variances))
expect_error(
get.disparity(subsets_full)
)
expect_error(
get.disparity(data, 1, rarefaction = 4, observed = FALSE)
)
expect_warning(
test1 <- get.disparity(data, 1, rarefaction = 3, observed = TRUE)
)
expect_equal(test1,
get.disparity(data, 1, observed = TRUE)
)
test <- get.disparity(data)
expect_is(
test
,"list")
expect_equal(
length(test)
,length(data$subsets))
expect_equal(
names(test)
,names(data$subsets))
expect_equal(
round(test[[5]], digit = 5)
,4.09234)
test <- get.disparity(data, observed = FALSE)
expect_is(
test
,"list")
expect_equal(
length(test)
,length(data$subsets))
expect_equal(
names(test)
,names(data$subsets))
expect_equal(
length(test[[5]][[1]])
,data$call$bootstrap[[1]])
test <- get.disparity(data, observed = FALSE, rarefaction = 5)
expect_is(
test
,"list")
expect_equal(
length(test)
,length(data$subsets))
expect_equal(
names(test)
,names(data$subsets))
expect_null(
test[[1]])
test <- get.disparity(data, observed = FALSE, subsets = c(1,5))
expect_is(
test
,"list")
expect_equal(
length(test)
,2)
expect_equal(
names(test)
,names(data$subsets)[c(1,5)])
## Test whithout disparity but with distribution
data <- dispRity(BeckLee_mat99, metric = centroids)
expect_error(get.disparity(data, observed = FALSE))
test <- get.disparity(data, observed = TRUE)
expect_is(test, "list")
expect_equal(length(test[[1]]), nrow(BeckLee_mat99))
})
## scale.dispRity
test_that("scale.dispRity", {
data(BeckLee_mat50)
groups <- as.data.frame(matrix(data = c(rep(1, nrow(BeckLee_mat50)/2), rep(2, nrow(BeckLee_mat50)/2)), nrow = nrow(BeckLee_mat50), ncol = 1, dimnames = list(rownames(BeckLee_mat50))))
customised_subsets <- custom.subsets(BeckLee_mat50, groups)
bootstrapped_data <- boot.matrix(customised_subsets, bootstraps = 7, rarefaction = c(10, 25))
data <- dispRity(bootstrapped_data, metric = c(sum, centroids))
expect_error(
scale.dispRity(bootstrapped_data)
)
expect_error(
scale.dispRity(data, scale = "yes")
)
expect_error(
scale.dispRity(data, center = "yes")
)
expect_error(
scale.dispRity(data, center = c(1,2))
)
expect_is(
scale.dispRity(data, scale = TRUE)
,"dispRity")
expect_is(
scale.dispRity(data, scale = FALSE)
,"dispRity")
expect_is(
scale.dispRity(data, scale = TRUE, center = TRUE)
,"dispRity")
base <- summary(data)
scaled_down <- summary(scale.dispRity(data, scale = TRUE))
scaled_up <- summary(scale.dispRity(data, scale = 0.1))
expect_lt(
scaled_down[1,3]
,base[1,3])
expect_gt(
scaled_up[1,3]
,base[1,3])
})
## sort.dispRity
test_that("sort.dispRity", {
data(BeckLee_mat99) ; data(BeckLee_tree)
subsets <- chrono.subsets(data = BeckLee_mat99, tree = BeckLee_tree, method = "continuous", time = 5, model = "acctran")
data <- dispRity(subsets, metric = mean)
expect_error(
sort.dispRity("yes")
)
expect_error(
sort.dispRity(data, sort = c(6,5,1,2,3))
)
sorted <- sort(data, decreasing = TRUE)
expect_true(
all(summary(sorted) == summary(data)[5:1,])
)
sorted <- sort(data, decreasing = FALSE)
expect_true(
all(summary(sorted) == summary(data)[1:5,])
)
sorted <- sort(data, sort = c(1,3,4,5,2))
expect_true(
all(summary(sorted) == summary(data)[c(1,3,4,5,2),])
)
data2 <- dispRity(BeckLee_mat99, metric = mean)
expect_error(sort(data2))
})
## combine.subsets
test_that("combine.subsets", {
data(disparity)
data_test1 <- disparity
expect_warning(data_test2 <- custom.subsets(matrix(rnorm(120), 40), group = list("a" = c(1:5), "b" = c(6:10), "c" = c(11:20), "d" = c(21:24), "e" = c(25:30), "f" = c(31:40))))
tests <- list()
expected_names <- list(c("70", "60", "90-80-50", "40", "30"),
c("70", "60", "80-90-50", "40", "30"),
c("90-80", "70", "60", "30-50-40"),
c("b-a-c", "d", "e", "f"),
c("b-a-c", "d", "e", "f"),
c("a-b", "c", "d-e", "f"))
expected_elements <- list(c(23, 21, 49, 15, 10),
c(23, 21, 49, 15, 10),
c(34, 23, 21, 23),
c(20, 4, 6, 10),
c(20, 4, 6, 10),
c(10, 10, 11, 10))
## Errors
expect_error(
combine.subsets("data_test1", c(1,2))
)
expect_error(
combine.subsets(matrix(100,10), c(1,2))
)
expect_error(
combine.subsets(data_test2, "c(1,2)")
)
expect_error(
combine.subsets(data_test2, c(13,14))
)
expect_error(
combine.subsets(data_test2, c("a", "x"))
)
expect_warning(
bs <- combine.subsets(boot.matrix(data_test2), c(1,2))
)
expect_error(
combine.subsets(data_test2, (nrow(data_test2$matrix)+1))
)
expect_error(
combine.subsets(data_test2, "a")
)
expect_error(
combine.subsets(data_test2, c(1,2,3,4,5,6,7))
)
dummy_data1 <- dummy_data2 <- data_test1
dummy_data1$call$bootstrap <- NULL
test1 <- capture_warnings(garbage <- combine.subsets(dummy_data1, c(1,2)))
expect_equal(test1, "dummy_data1 contained disparity data that has been discarded in the output.")
## Warnings
expect_warning(
tests[[1]] <- combine.subsets(data_test1, c(2,1,5))
)
expect_warning(
tests[[2]] <- combine.subsets(data_test1, c("90", "80", "50"))
)
expect_warning(
tests[[3]] <- combine.subsets(data_test1, 20)
)
## Working fine!
tests[[4]] <- combine.subsets(data_test2, c(1,2,3))
tests[[5]] <- combine.subsets(data_test2, c("a", "b", "c"))
tests[[6]] <- combine.subsets(data_test2, 10)
for(test in 1:length(tests)) {
## Class
expect_is(tests[[test]]
, "dispRity")
## Number of subsets
expect_equal(
names(tests[[test]]$subsets)
,expected_names[[test]])
## Number of elements per subsets
expect_equal(
as.vector(unlist(lapply(tests[[test]]$subsets, lapply, length)))
,expected_elements[[test]])
}
error <- capture_error(expect_warning(combine.subsets(data_test1, c(1,1))))
expect_equal(error[[1]], "subsets argument must not contain duplicates.")
})
## size.subsets
test_that("size.subsets works", {
data(disparity)
expect_equal(
size.subsets(disparity)
, c("90"=18, "80"=22, "70"=23, "60"=21, "50"=18, "40"=15, "30"=10))
})
## extinction.subsets
test_that("extinction.subsets works", {
data(disparity)
data(BeckLee_mat99)
data(BeckLee_tree)
## Errors
data <- dispRity(BeckLee_mat50, metric = mean)
expect_error(extinction.subsets(data, 66))
## detect.bin.age (internal)
data <- chrono.subsets(BeckLee_mat99, BeckLee_tree, method = "discrete", time = c(100, 66, 40), inc.nodes = TRUE)
expect_equal(detect.bin.age(data, 66, greater = TRUE), c("100 - 66" = TRUE, "66 - 40" = FALSE))
expect_equal(detect.bin.age(data, 66, greater = FALSE), c("100 - 66" = FALSE, "66 - 40" = TRUE))
expect_equal(detect.bin.age(data, 60, greater = TRUE), c("100 - 66" = TRUE, "66 - 40" = FALSE))
## Sanitising
expect_error(extinction.subsets("disparity", 66, names = TRUE, as.list = TRUE))
expect_error(extinction.subsets(disparity, c(1,2), names = TRUE, as.list = TRUE))
expect_error(extinction.subsets(disparity, 66, names = "TRUE", as.list = TRUE))
expect_error(extinction.subsets(disparity, 66, names = TRUE, as.list = "TRUE"))
expect_error(extinction.subsets(disparity, 91, names = TRUE, as.list = TRUE))
expect_error(extinction.subsets(disparity, 66, names = TRUE, as.list = TRUE, lag = 0))
## Normal behaviour
expect_equal(extinction.subsets(disparity, 66, names = TRUE, as.list = TRUE), list("60" = c("70", "60")))
expect_equal(extinction.subsets(disparity, 66, lag = 4), c(3:7))
expect_warning(expect_equal(extinction.subsets(disparity, 66, lag = 12), c(3:7)))
expect_equal(extinction.subsets(chrono.subsets(BeckLee_mat99, tree = BeckLee_tree, method = "discrete", time = 6, inc.nodes = TRUE), 111.2592), c(1,2))
expect_equal(extinction.subsets(chrono.subsets(BeckLee_mat99, tree = BeckLee_tree, method = "discrete", time = 6, inc.nodes = TRUE), 111), c(1,2))
})
test_that("n.subset works", {
data(disparity)
expect_equal(n.subsets(disparity), 7)
})
test_that("tree utilities works", {
data(BeckLee_mat99)
disparity <- dispRity(BeckLee_mat99, metric = mean)
data(BeckLee_tree)
expect_null(disparity$tree[[1]])
disparitree <- add.tree(tree = BeckLee_tree, data = disparity)
expect_is(disparitree$tree, "multiPhylo")
disparitree <- add.tree(tree = BeckLee_tree, data = disparity)
expect_is(disparitree$tree, "multiPhylo")
disparitree2 <- add.tree(tree = c(BeckLee_tree, BeckLee_tree, BeckLee_tree), data = disparity)
expect_is(disparitree2$tree, "multiPhylo")
tree <- get.tree(disparitree)
expect_is(tree, "phylo")
tree <- get.tree(disparitree2)
expect_is(tree, "multiPhylo")
expect_null(remove.tree(disparitree)$tree[[1]])
expect_null(remove.tree(disparitree2)$tree[[1]])
## Remove and replace trees
disparity <- dispRity(BeckLee_mat99, metric = mean)
expect_null(disparity$tree[[1]])
disparitree <- add.tree(tree = BeckLee_tree, data = disparity)
expect_equal(length(disparitree$tree), 1)
disparitree <- add.tree(tree = BeckLee_tree, data = disparitree)
expect_equal(length(disparitree$tree), 2)
disparitree <- add.tree(tree = BeckLee_tree, data = disparitree, replace = TRUE)
expect_equal(length(disparitree$tree), 1)
})
test_that("name.subsets(dispRity)", {
data(disparity)
expect_equal(name.subsets(disparity), names(disparity$subsets))
expect_warning(test <- dispRity(matrix(rnorm(25), 5, 5), metric = mean))
expect_null(name.subsets(test))
})
test_that("get.tree with subsets", {
## Testing detect edges and get new tree
set.seed(1)
simple_tree <- rtree(5)
simple_tree$edge.length <- rep(1, Nedge(simple_tree))
simple_tree$root.time <- 4
simple_tree$node.label <- letters[1:4]
plot(simple_tree, show.tip.label = FALSE); axisPhylo()
nodelabels()
nodelabels(simple_tree$node.label, adj = -1, col = "blue")
edgelabels()
tiplabels()
tiplabels(simple_tree$tip.label, adj = -1, col = "blue")
abline(v = c(0, 1, 2, 3, 3.8), col = "grey", lty = 2)
# dev.new()
tree <- simple_tree
## Detect edges
expect_equal(sort(detect.edges(tree, c(5, 3, 2, 8), to.root = FALSE)), sort(c(6, 5, 4, 3, 8)))
expect_equal(sort(detect.edges(tree, c(5, 3, 2, 8), to.root = TRUE)), sort(c(6, 5, 4, 3, 8, 2)))
expect_equal(sort(detect.edges(tree, c(9, 6, 1), to.root = FALSE)), sort(c(5,3,2,1)))
expect_equal(sort(detect.edges(tree, c(9, 6, 1), to.root = TRUE)), sort(c(5,3,2,1)))
## Get new tree
test <- get.new.tree(tree = tree, elements = c(5, 3, 2, 8), to.root = TRUE)
expect_is(test, "phylo")
expect_equal(Ntip(test), 3)
expect_equal(Nnode(test), 4)
expect_equal(test$tip.label, c("t1", "t3", "t5"))
expect_equal(test$node.label, c("a", "b", "c", "d"))
# plot(test) ; nodelabels(test$node.label)
test <- get.new.tree(tree = tree, elements = c(5, 3, 2, 8), to.root = FALSE)
expect_is(test, "phylo")
expect_equal(Ntip(test), 3)
expect_equal(Nnode(test), 3)
expect_equal(test$tip.label, c("t1", "t3", "t5"))
expect_equal(test$node.label, c("b", "c", "d"))
# plot(test) ; nodelabels(test$node.label)
test <- get.new.tree(tree = tree, elements = c(5, 9, 2, 8), to.root = FALSE)
expect_is(test, "phylo")
expect_equal(Ntip(test), 3)
expect_equal(Nnode(test), 2)
expect_equal(test$tip.label, c("t1", "d", "t5"))
expect_equal(test$node.label, c("b", "c"))
# plot(test) ; nodelabels(test$node.label)
test <- get.new.tree(tree = tree, elements = c(9, 6, 1), to.root = FALSE)
expect_is(test, "phylo")
expect_equal(Ntip(test), 2)
expect_equal(Nnode(test), 3)
expect_equal(test$tip.label, c("t2", "d"))
expect_equal(test$node.label, c("a", "b", "c"))
test <- get.new.tree(tree = tree, elements = c(9, 6, 1), to.root = TRUE)
expect_is(test, "phylo")
expect_equal(Ntip(test), 2)
expect_equal(Nnode(test), 3)
expect_equal(test$tip.label, c("t2", "d"))
expect_equal(test$node.label, c("a", "b", "c"))
test <- get.new.tree(tree = tree, elements = c(4,3), to.root = FALSE)
expect_is(test, "phylo")
expect_equal(Ntip(test), 2)
expect_equal(Nnode(test), 1)
expect_equal(test$tip.label, c("t3", "t4"))
expect_equal(test$node.label, c("d"))
test <- get.new.tree(tree = tree, elements = c(4,3), to.root = TRUE)
expect_is(test, "phylo")
expect_equal(Ntip(test), 2)
expect_equal(Nnode(test), 4)
expect_equal(test$tip.label, c("t3", "t4"))
expect_equal(test$node.label, c("a", "b", "c", "d"))
## Big test
set.seed(2)
big_tree <- rtree(20)
big_tree$node.label <- letters[1:19]
big_tree$edge.length <- rep(1, Nedge(big_tree))
big_tree$root.time <- max(tree.age(big_tree)$ages)
plot(big_tree, show.tip.label = FALSE); axisPhylo()
nodelabels(cex = 0.8)
nodelabels(big_tree$node.label, adj = -3, col = "blue", cex = 0.8)
edgelabels(cex = 0.8)
tiplabels(cex = 0.8)
tiplabels(big_tree$tip.label, adj = -2, col = "blue", cex = 0.8)
test <- get.new.tree(tree = big_tree, elements = c(6, 32, 28, 15, 35), to.root = FALSE)
expect_is(test, "phylo")
expect_equal(Ntip(test), 4)
expect_equal(Nnode(test), 10)
expect_equal(test$tip.label, c("t6", "l", "o", "t12"))
expect_equal(test$node.label, c("b", "c", "d", "e", "f", "h", "i", "j", "m", "n"))
set.seed(1) ; elements <- sample(1:39, 10)
test <- get.new.tree(tree = big_tree, elements = elements, to.root = FALSE)
expect_is(test, "phylo")
expect_equal(Ntip(test), 5)
expect_equal(Nnode(test), 16)
expect_equal(test$tip.label, c("t16", "t7", "t15", "t5", "t17"))
expect_equal(test$node.label, c("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "l", "m", "n", "o", "p", "q"))
## Basic subsets, return the tree per subsets
set.seed(1)
simple_tree <- rtree(10)
simple_tree$edge.length <- rep(1, Nedge(simple_tree))
simple_tree$node.label <- letters[1:9]
matrix_dumb <- matrix(1, ncol = 1, nrow = 19, dimnames = list(c(simple_tree$tip.label, simple_tree$node.label)))
plot(simple_tree)
nodelabels(simple_tree$node.label)
## Groups
groups <- list("clade1" = c("t3", "t2", "t7"),
"clade2" = c("c", "f", "t4"),
"clade3" = c("t10", "a", "t7"),
"clade4" = simple_tree$tip.label)
data <- custom.subsets(data = matrix_dumb, tree = simple_tree, group = groups)
## Just get trees
test_norm <- get.tree(data)
expect_is(test_norm, "phylo")
expect_equal(test_norm$tip.label, simple_tree$tip.label)
## Get subsets
test <- get.tree(data, subsets = TRUE)
expect_is(test, "list")
expect_equal(length(test), 4)
expect_equal(test$clade1$elements$tip.label, c("t7", "t2", "t3"))
expect_equal(test$clade2$elements$tip.label, c("c", "f", "t4"))
expect_equal(test$clade3$elements$tip.label, c("t7", "t10"))
expect_equal(test$clade4$elements$tip.label, simple_tree$tip.label)
## Get subsets
test <- get.tree(data, subsets = c(1,2))
expect_is(test, "list")
expect_equal(length(test), 2)
expect_equal(names(test), c("clade1", "clade2"))
## Groups and bootstraps
data <- boot.matrix(data, 3)
test <- get.tree(data, subsets = TRUE)
expect_is(test, "list")
expect_equal(length(test), 4)
expect_equal(test$clade1$elements$tip.label, c("t7", "t2", "t3"))
expect_equal(test$clade2$elements$tip.label, c("c", "f", "t4"))
expect_equal(test$clade3$elements$tip.label, c("t7", "t10"))
expect_equal(test$clade4$elements$tip.label, simple_tree$tip.label)
## Testing slide.node.root
set.seed(1)
simple_tree <- rtree(5)
simple_tree$edge.length <- rep(1, Nedge(simple_tree))
simple_tree$root.time <- 4
simple_tree$node.label <- letters[1:4]
tree <- simple_tree
bin_age <- c(2, 1)
test <- slide.node.root(bin_age, tree)
expect_is(test, "phylo")
expect_equal(Ntip(test), 4)
expect_equal(test$edge.length[c(1,6)], c(0,0))
## Testing the pipeline for discrete bins
tree <- simple_tree
tree$edge.length[8] <- 1.5
matrix_dumb <- matrix(1, ncol = 1, nrow = 9, dimnames = list(c(simple_tree$tip.label, simple_tree$node.label)))
time = c(0.5, 1, 2, 3, 3.5)
data_bins <- chrono.subsets(matrix_dumb, tree = simple_tree, method = "discrete", time = time, inc.nodes = TRUE)
## Getting the trees from data bin
test <- get.tree(data_bins, subsets = FALSE)
expect_is(test, "phylo")
test <- get.tree(data_bins, subsets = TRUE, to.root = FALSE)
expect_is(test, "list")
expect_equal(length(test), 4)
expect_is(test[[2]], "phylo")
expect_equal(test[[2]]$edge.length, c(0,0,1,1))
test <- get.tree(data_bins, subsets = TRUE, to.root = TRUE)
expect_is(test, "list")
expect_equal(length(test), 4)
expect_is(test[[2]], "phylo")
expect_equal(test[[2]]$edge.length, c(1,1,1,1))
## Working on a multiPhylo
multi_tree <- list(simple_tree, simple_tree)
class(multi_tree) <- "multiPhylo"
data_bins <- chrono.subsets(matrix_dumb, tree = multi_tree, method = "discrete", time = time, inc.nodes = TRUE)
test <- get.tree(data_bins, subsets = FALSE)
expect_is(test, "multiPhylo")
test <- get.tree(data_bins, subsets = TRUE, to.root = FALSE)
expect_is(test, "list")
expect_equal(length(test), 4)
expect_is(test[[2]], "multiPhylo")
## Working on slices
data_slices <- chrono.subsets(matrix_dumb, tree = simple_tree, method = "continuous", model = "acctran", time = time, inc.nodes = TRUE)
test <- get.tree(data_slices, subsets = TRUE, to.root = TRUE)
expect_is(test, "list")
expect_equal(length(test), 5)
expect_is(test[[2]], "phylo")
expect_equal(test[[2]]$edge.length, c(1,1))
test <- get.tree(data_slices, subsets = TRUE, to.root = FALSE)
expect_is(test, "list")
expect_equal(length(test), 5)
expect_is(test[[2]], "phylo")
expect_equal(test[[2]]$edge.length, c(1,1))
## Working on multiPhylo
data_slices <- chrono.subsets(matrix_dumb, tree = multi_tree, method = "continuous", model = "equal.split", time = time, inc.nodes = TRUE)
test <- get.tree(data_slices, subsets = FALSE)
expect_is(test, "multiPhylo")
test <- get.tree(data_slices, subsets = TRUE, to.root = FALSE)
expect_is(test, "list")
expect_equal(length(test), 5)
expect_is(test[[2]], "multiPhylo")
})
test_that("remove.dispRity works", {
## Testing the mini chains pipeline
load("covar_model_list.rda")
load("covar_char_data.rda")
load("covar_tree_data.rda")
data(disparity)
with_covar <- MCMCglmm.subsets(data = covar_char_data, posteriors = covar_model_list[[1]])
## Wrong remove
error <- capture_error(remove.dispRity(disparity, what = "data"))
expect_equal(error[[1]], "The what argument must be one of the following: subsets, bootstraps, covar, tree, disparity.")
## Remove the subsets
expect_false(is.null(disparity$subsets))
test <- remove.dispRity(disparity, what = "subsets")
expect_true(is.null(test$subsets))
expect_null(test$call$subsets)
expect_null(test$call$bootstrap)
expect_null(test$disparity)
expect_null(test$call$disparity)
## Remove the bootstraps
expect_false(is.null(disparity$call$bootstrap))
expect_equal(length(disparity$subsets[[1]]), 5)
expect_equal(length(disparity$disparity[[1]]), 5)
test <- remove.dispRity(disparity, what = "bootstraps")
expect_equal(length(test$subsets[[1]]), 1)
expect_equal(length(test$disparity[[1]]), 1)
expect_null(test$call$bootstrap)
## Remove the covar
expect_false(is.null(with_covar$covar))
test <- remove.dispRity(with_covar, what = "covar")
expect_true(is.null(test$subsets))
expect_null(test$call$subsets)
expect_true(is.null(test$covar))
expect_null(test$call$bootstrap)
## Remove the tree
expect_false(is.null(disparity$tree[[1]]))
test <- remove.dispRity(disparity, what = "tree")
expect_true(is.null(test$tree[[1]]))
## Remove the disparity
expect_false(is.null(disparity$disparity))
test <- remove.dispRity(disparity, what = "disparity")
expect_true(is.null(test$disparity))
expect_null(test$call$disparity)
## Remove everything
test <- remove.dispRity(disparity, what = c("subsets", "bootstraps", "covar", "tree", "disparity"))
expect_equal(names(test), c("matrix", "tree", "call"))
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.