Nothing
context("SumStat Class")
test_that("Sumstat initialization works", {
ss1 <- sumstat_class$new("1", I)
expect_true(is.sum_stat(ss1))
expect_error(ss1$calculate(NULL, NULL, NULL, NULL))
ss1 <- sumstat_class$new("1", I)
expect_true(is.sum_stat(ss1))
expect_false(is.sum_stat(1:3))
})
test_that("getting the name works", {
ss1 <- sumstat_class$new("test", identity)
expect_equal(ss1$get_name(), "test")
})
test_that("transformations works", {
expect_equal(sumstat_class$new("sum", function(x) 1)$transform(1:10), 1)
expect_equal(sumstat_class$new("sum", sum)$transform(1:3), 6)
expect_error(sumstat_class$new("sum", 1))
})
test_that("Adding Sumstats to a model works", {
model <- coal_model(5:6, 10) + sumstat_class$new("1", I)
expect_equal(get_summary_statistics(model)[[1]]$get_name(), "1")
expect_error(model + sumstat_class$new("1"))
model <- model + sumstat_class$new("2", I)
expect_equal(names(get_summary_statistics(model)), c("1", "2"))
})
test_that("Calculation of sumstats works", {
stat_sum_class <- R6::R6Class("Stat_Sum", inherit = sumstat_class,
public = list(calculate = function(seg_sites, ...) {
sapply(seg_sites, sum)
})
)
model <- coal_model(5:6, 10) + stat_sum_class$new("sum", identity)
expect_equal(calc_sumstats(model, list(1:3, 1:5, 7)),
list(sum = c(6, 15, 7)))
expect_equal(calc_sumstats(model, list(1:3, 1:5, 7), blub = "test"),
list(sum = c(6, 15, 7), blub = "test"))
expect_equal(calc_sumstats(model, list(1:3, 1:5, 7), bla = 1:5),
list(sum = c(6, 15, 7), bla = 1:5))
})
test_that("Calculation of sumstats from simresults works", {
stat_sum_class <- R6::R6Class("Stat_Sum", inherit = sumstat_class,
public = list(calculate = function(seg_sites, ...) {
sapply(seg_sites, sum)
})
)
model <- coal_model(5:6, 10) + stat_sum_class$new("sum", identity) +
stat_sum_class$new("sum2", identity)
stats <- calc_sumstats_from_sim(list(1:3, 1:5, 7), NULL, "", model, 1:2,
1:3, list(get_simulator("scrm")))
expect_equal(stats$sum, c(6, 15, 7))
expect_equal(stats$sum2, c(6, 15, 7))
expect_equal(stats$cmds, 1:3)
expect_equal(stats$pars, 1:2)
})
test_that("Calculation of sumstats respects transformations", {
stat_sum_class <- R6::R6Class("Stat_Sum", inherit = sumstat_class,
public = list(calculate = function(seg_sites, ...) {
sapply(seg_sites, sum)
})
)
model <- coal_model(5:6, 10) + stat_sum_class$new("sum", sum)
expect_equal(calc_sumstats(model, list(1:3, 1:5, 7)), list(sum = 28))
model <- model + stat_sum_class$new("sum2", function(x) 1:15)
expect_equal(calc_sumstats(model, list(1:3, 1:5, 7)),
list(sum = 28, sum2 = 1:15))
})
test_that("summary statistics can be calculated from real data", {
segsites_list <- list(create_test_segsites(),
create_test_segsites(),
create_test_segsites())
model <- coal_model(3, 3, 100) + feat_mutation(5) + sumstat_sfs()
expect_equal(calc_sumstats_from_data(model, segsites_list),
list(sfs = c(6, 9)))
# Test that an error is thrown for missing data
segsites_list[[2]] <- NA
expect_error(calc_sumstats_from_data(model, segsites_list))
segsites_list[[2]] <- create_test_segsites()
expect_error(calc_sumstats_from_data(coal_model(3, 5), segsites_list))
# Test import with trios
model <- coal_model(c(2, 1)) + locus_trio(number = 2) + coala::sumstat_sfs()
stats <- calc_sumstats_from_data(model, segsites_list, trios = list(1:3, 1:3))
expect_equal(stats, list(sfs = c(4, 6)))
model <- coal_model(3) + locus_trio() + locus_single(5) + coala::sumstat_sfs()
stats <- calc_sumstats_from_data(model, segsites_list, trios = list(1:3, 2))
expect_equal(stats, list(sfs = c(4, 6)))
expect_error(calc_sumstats_from_data(model, tree_list = list("12345")))
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.