Skip to content

Commit

Permalink
Changed subsample -> subset [COMPILED]
Browse files Browse the repository at this point in the history
  • Loading branch information
@TGuillerme
TGuillerme committed Nov 15, 2017
1 parent 7feffe0 commit 480223a
Show file tree
Hide file tree
Showing 13 changed files with 375 additions and 375 deletions.
42 changes: 21 additions & 21 deletions tests/testthat/dev-test-sequential.test.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,48 +4,48 @@ context("sequential.test")
data(BeckLee_mat50)
groups <- as.data.frame(matrix(data = c(rep(1, 12), rep(2, 13), rep(3, 25)),
dimnames = list(rownames(BeckLee_mat50))), ncol = 1)
sum_of_variances <- dispRity(boot.matrix(custom.subsetss(BeckLee_mat50, groups), bootstraps = 100), metric = c(sum, variances))
subsetss <- extract.dispRity(sum_of_variances, observed = FALSE, keep.structure = TRUE)
seq_subsetss <- list(c(1,2), c(2,3))
sum_of_variances <- dispRity(boot.matrix(custom.subsets(BeckLee_mat50, groups), bootstraps = 100), metric = c(sum, variances))
subsets <- extract.dispRity(sum_of_variances, observed = FALSE, keep.structure = TRUE)
seq_subsets <- list(c(1,2), c(2,3))

test_that("set.pair.subsetss internal", {
test_that("set.pair.subsets internal", {
set.seed(1)
subsetss_pair <- list(replicate(3,rnorm(10), simplify = FALSE), replicate(3,rnorm(10, 100), simplify = FALSE))
subsets_pair <- list(replicate(3,rnorm(10), simplify = FALSE), replicate(3,rnorm(10, 100), simplify = FALSE))
#Errors
expect_error(
set.pair.subsetss("a", NULL)
set.pair.subsets("a", NULL)
)
expect_error(
set.pair.subsetss(list(), NULL)
set.pair.subsets(list(), NULL)
)

#Normal results
expect_is(
set.pair.subsetss(subsetss_pair, intercept = NULL)
set.pair.subsets(subsets_pair, intercept = NULL)
,"list")
expect_equal(
unique(unlist(lapply(set.pair.subsetss(subsetss_pair, intercept = NULL), class)))
unique(unlist(lapply(set.pair.subsets(subsets_pair, intercept = NULL), class)))
,"data.frame")
expect_equal(
unique(unlist(lapply(set.pair.subsetss(subsetss_pair, intercept = NULL), dim)))
unique(unlist(lapply(set.pair.subsets(subsets_pair, intercept = NULL), dim)))
,c(20, 2))
expect_equal(
unique(unlist(lapply(set.pair.subsetss(subsetss_pair, intercept = "a"), dim)))
unique(unlist(lapply(set.pair.subsets(subsets_pair, intercept = "a"), dim)))
,c(20, 3))
expect_lt(
max(set.pair.subsetss(subsetss_pair, intercept = NULL)[[1]][[1]][1:10])
max(set.pair.subsets(subsets_pair, intercept = NULL)[[1]][[1]][1:10])
,50)
expect_gt(
min(set.pair.subsetss(subsetss_pair, intercept = NULL)[[1]][[1]][11:20])
min(set.pair.subsets(subsets_pair, intercept = NULL)[[1]][[1]][11:20])
,50)
expect_equal(
unique(set.pair.subsetss(subsetss_pair, intercept = NULL)[[1]][[2]][1:10])
unique(set.pair.subsets(subsets_pair, intercept = NULL)[[1]][[2]][1:10])
,0)
expect_equal(
unique(set.pair.subsetss(subsetss_pair, intercept = NULL)[[1]][[2]][11:20])
unique(set.pair.subsets(subsets_pair, intercept = NULL)[[1]][[2]][11:20])
,1)
expect_false(
set.pair.subsetss(subsetss_pair, intercept = NULL)[[1]][[1]][1] == set.pair.subsetss(subsetss_pair, intercept = NULL)[[2]][[1]][1]
set.pair.subsets(subsets_pair, intercept = NULL)[[1]][[1]][1] == set.pair.subsets(subsets_pair, intercept = NULL)[[2]][[1]][1]
)
})

Expand Down Expand Up @@ -99,14 +99,14 @@ test_that("create.model works", {
create.model(matrix(2,2), family = gaussian)
)
expect_error(
create.model(set.pair.subsetss(subsetss[seq_subsetss[[1]]]), family = "whatever")
create.model(set.pair.subsets(subsets[seq_subsets[[1]]]), family = "whatever")
)
#Normal results
expect_is(
create.model(set.pair.subsetss(subsetss[seq_subsetss[[1]]])[[1]], family = gaussian)
create.model(set.pair.subsets(subsets[seq_subsets[[1]]])[[1]], family = gaussian)
, c("glm","lm"))
expect_equal(
length(create.model(set.pair.subsetss(subsetss[seq_subsetss[[1]]])[[1]], family = gaussian))
length(create.model(set.pair.subsets(subsets[seq_subsets[[1]]])[[1]], family = gaussian))
, 30)
})

Expand All @@ -118,10 +118,10 @@ test_that("sequential.test works", {
)
)
expect_error(
sequential.test(subsetss, family = c(1, 2))
sequential.test(subsets, family = c(1, 2))
)
#results
test <- sequential.test(subsetss, family = gaussian)
test <- sequential.test(subsets, family = gaussian)
expect_is(
test
, c("dispRity", "seq.test"))
Expand Down
76 changes: 38 additions & 38 deletions tests/testthat/test-boot.matrix.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -29,21 +29,21 @@ test_that("internal: bootstrap methods", {
## Internal functions tests
test_that("internal: bootstrap replicates", {
data(disparity)
subsetss <- disparity$subsetss[[1]]
subsets <- disparity$subsets[[1]]

## Select rarefactions
expect_equal(
select.rarefaction(subsetss, 8)
select.rarefaction(subsets, 8)
,list(18, 8))
expect_equal(
select.rarefaction(subsetss, c(3,5))
select.rarefaction(subsets, c(3,5))
,list(18, 3, 5))

## One bootstrap replicate
set.seed(1)
test_silent <- replicate.bootstraps.silent(6, 5, subsetss, boot.full)
test_silent <- replicate.bootstraps.silent(6, 5, subsets, boot.full)
set.seed(1)
expect_message(test_verbose <- replicate.bootstraps.verbose(6, 5, subsetss, boot.full))
expect_message(test_verbose <- replicate.bootstraps.verbose(6, 5, subsets, boot.full))

## Both are the same!
expect_is(test_silent, "matrix")
Expand All @@ -53,7 +53,7 @@ test_that("internal: bootstrap replicates", {
expect_true(all(as.vector(test_silent) == as.vector(test_verbose)))

## Bootstrap replicates wrapper
test_boot <- bootstrap.wrapper(subsetss, bootstraps = 6, rarefaction = c(3,5), boot.type.fun = boot.full, verbose = FALSE)
test_boot <- bootstrap.wrapper(subsets, bootstraps = 6, rarefaction = c(3,5), boot.type.fun = boot.full, verbose = FALSE)
expect_is(test_boot, "list")
expect_equal(length(test_boot), 3)
expect_equal(unlist(lapply(test_boot, dim)), c(18, 6, 3, 6, 5, 6))
Expand Down Expand Up @@ -114,19 +114,19 @@ test_that("No bootstraps", {
length(test)
, 3)
expect_equal(
as.vector(test$subsetss[[1]][[1]])
as.vector(test$subsets[[1]][[1]])
, seq(1:nrow(test$matrix)))
expect_equal(
test$call$dimensions
, ncol(test$matrix))
expect_equal(
length(test$subsetss[[1]])
length(test$subsets[[1]])
,1)
expect_equal(
length(test$subsetss)
length(test$subsets)
,1)
expect_is(
test$subsetss[[1]][[1]]
test$subsets[[1]][[1]]
,"matrix")
})

Expand Down Expand Up @@ -155,13 +155,13 @@ test_that("5 bootstraps", {
test$call$dimensions
, ncol(test$matrix))
expect_equal(
dim(test$subsetss[[1]][[1]])
dim(test$subsets[[1]][[1]])
,c(50,1))
expect_equal(
dim(test$subsetss[[1]][[2]])
dim(test$subsets[[1]][[2]])
,c(50,5))
expect_equal(
length(test$subsetss[[1]])
length(test$subsets[[1]])
,2)
})

Expand All @@ -178,22 +178,22 @@ test_that("5 bootstraps, rarefaction = 5", {
test$call$dimensions
, ncol(test$matrix))
expect_equal(
dim(test$subsetss[[1]][[2]])
dim(test$subsets[[1]][[2]])
,c(50,5))
expect_equal(
dim(test$subsetss[[1]][[3]])
dim(test$subsets[[1]][[3]])
,c(5,5))
})

## Bootstraps = 5 + Rarefaction = TRUE
test_that("5 bootstraps, rarefaction = TRUE", {
test <- boot.matrix(data, bootstraps = 5, rarefaction = TRUE)
expect_equal(
length(test$subsetss[[1]])
length(test$subsets[[1]])
, 49)
for(rare in 2:49) {
expect_equal(
dim(test$subsetss[[1]][[rare]])
dim(test$subsets[[1]][[rare]])
,c(50-(rare-2),5))
}
})
Expand All @@ -213,11 +213,11 @@ test_that("5 bootstraps, rarefaction = 5,6, boot type", {
})


## Bootstraps = 5 + Rarefaction = c(5,6) + subsetss
test_that("5 bootstraps, rarefaction = 5,6, subsetss", {
## Bootstraps = 5 + Rarefaction = c(5,6) + subsets
test_that("5 bootstraps, rarefaction = 5,6, subsets", {
ordinated_matrix <- matrix(data = rnorm(90), nrow = 10, ncol = 9, dimnames = list(letters[1:10]))
groups <- as.data.frame(matrix(data = c(rep(1,5), rep(2,5)), nrow = 10, ncol = 1, dimnames = list(letters[1:10])))
matrix_list <- custom.subsetss(ordinated_matrix, groups)
matrix_list <- custom.subsets(ordinated_matrix, groups)
test <- boot.matrix(matrix_list, bootstraps = 2, rarefaction = c(4,3))
expect_is(
test
Expand All @@ -229,17 +229,17 @@ test_that("5 bootstraps, rarefaction = 5,6, subsetss", {
test$call$dimensions
, ncol(test$matrix))
expect_equal(
length(test$subsetss)
length(test$subsets)
,2)
expect_equal(
length(test$subsetss[[1]])
length(test$subsets[[1]])
,4)
expect_equal(
length(test$subsetss[[2]])
length(test$subsets[[2]])
,4)
expect_equal(
dim(test$subsetss[[2]][[2]])
,c(nrow(test$subsetss[[2]]$elements), 2))
dim(test$subsets[[2]][[2]])
,c(nrow(test$subsets[[2]]$elements), 2))
})


Expand All @@ -252,31 +252,31 @@ test_that("verbose bootstrap works", {
})


## Bootstrap works with empty or small (<3 subsetss)
test_that("Boot.matrix works with small, empty/subsetss", {
## Bootstrap works with empty or small (<3 subsets)
test_that("Boot.matrix works with small, empty/subsets", {

tree <- test_data$tree_data
data <- test_data$ord_data_tips_nodes
FADLAD <- test_data$FADLAD_data

silent <- capture_warnings(data <- time.subsetss(data, tree, model = "deltran", method = "continuous", time = c(140, 138, 130, 120, 100)))
silent <- capture_warnings(data <- time.subsets(data, tree, model = "deltran", method = "continuous", time = c(140, 138, 130, 120, 100)))

warnings <- capture_warnings(test <- boot.matrix(data))
expect_equal(warnings, "The following subsetss have less than 3 elements: 140, 138, 130.\nThis might effect the bootstrap/rarefaction output.")
expect_equal(warnings, "The following subsets have less than 3 elements: 140, 138, 130.\nThis might effect the bootstrap/rarefaction output.")

expect_equal(test$subsetss[[1]][[2]], matrix(rep(NA, 100), nrow = 1))
expect_equal(test$subsetss[[2]][[2]], matrix(rep(51, 100), nrow = 1))
expect_equal(test$subsets[[1]][[2]], matrix(rep(NA, 100), nrow = 1))
expect_equal(test$subsets[[2]][[2]], matrix(rep(51, 100), nrow = 1))
})


test_that("boot.matrix deals with probabilities subsetss", {
test_that("boot.matrix deals with probabilities subsets", {
data(BeckLee_mat99)
data(BeckLee_ages)
data(BeckLee_tree)


data1 <- time.subsetss(BeckLee_mat99, BeckLee_tree, method = "continuous", time = c(100, 60), model = "gradual", inc.nodes = TRUE, BeckLee_ages, verbose = FALSE, t0 = FALSE)
data2 <- time.subsetss(BeckLee_mat99, BeckLee_tree, method = "continuous", time = c(100, 60), model = "proximity", inc.nodes = TRUE, BeckLee_ages, verbose = FALSE, t0 = FALSE)
data1 <- time.subsets(BeckLee_mat99, BeckLee_tree, method = "continuous", time = c(100, 60), model = "gradual", inc.nodes = TRUE, BeckLee_ages, verbose = FALSE, t0 = FALSE)
data2 <- time.subsets(BeckLee_mat99, BeckLee_tree, method = "continuous", time = c(100, 60), model = "proximity", inc.nodes = TRUE, BeckLee_ages, verbose = FALSE, t0 = FALSE)

set.seed(1)
test1 <- boot.matrix(data1, bootstraps = 10)
Expand All @@ -288,14 +288,14 @@ test_that("boot.matrix deals with probabilities subsetss", {
for(sub in 1:2) {
## Difference
expect_true(
!all(test1$subsetss[[sub]][[2]] == test2$subsetss[[sub]][[2]])
!all(test1$subsets[[sub]][[2]] == test2$subsets[[sub]][[2]])
)
## Control
expect_false(
!all(test3$subsetss[[sub]][[2]] == test2$subsetss[[sub]][[2]])
!all(test3$subsets[[sub]][[2]] == test2$subsets[[sub]][[2]])
)
## More sampled
expect_gt(length(unique(as.vector(test1$subsetss[[sub]][[2]])))
,length(unique(as.vector(test2$subsetss[[sub]][[2]]))))
expect_gt(length(unique(as.vector(test1$subsets[[sub]][[2]])))
,length(unique(as.vector(test2$subsets[[sub]][[2]]))))
}
})

0 comments on commit 480223a

Please sign in to comment.