Nothing
context("SumStat SFS")
test_that("calculation of the SFS is correct", {
seg.sites <- list(create_segsites(matrix(c(1, 0, 0, 0,
1, 1, 0, 1,
0, 0, 1, 1,
1, 1, 0, 1), 4, 4, byrow = TRUE),
c(0.1, 0.2, 0.5, 0.7)))
model <- coal_model(4, 1)
stat_sfs_all <- sumstat_sfs(population = "all")
stat_sfs_1 <- sumstat_sfs(population = 1)
stat_sfs_2 <- sumstat_sfs(population = 2)
expect_equal(stat_sfs_1$calculate(seg.sites, NULL, NULL, model), c(1, 1, 2))
expect_equal(stat_sfs_all$calculate(seg.sites, NULL, NULL, model), c(1, 1, 2))
model <- coal_model(c(2, 2), 1)
expect_equal(stat_sfs_all$calculate(seg.sites, NULL, NULL, model), c(1, 1, 2))
expect_equal(stat_sfs_1$calculate(seg.sites, NULL, NULL, model), 2)
expect_equal(stat_sfs_2$calculate(seg.sites, NULL, NULL, model), 3)
seg.sites[[2]] <- create_segsites(matrix(c(1, 1, 1,
1, 1, 1,
1, 1, 1,
1, 1, 1), 4, 3),
c(0.1, 0.5, 0.7))
expect_equal(stat_sfs_all$calculate(seg.sites, NULL, NULL, model), c(1, 1, 2))
expect_equal(stat_sfs_1$calculate(seg.sites, NULL, NULL, model), c(2))
expect_equal(stat_sfs_2$calculate(seg.sites, NULL, NULL, model), c(3))
seg.sites[[3]] <- create_empty_segsites(4)
expect_equal(stat_sfs_all$calculate(seg.sites, NULL, NULL, model), c(1, 1, 2))
expect_equal(stat_sfs_1$calculate(seg.sites, NULL, NULL, model), 2)
expect_equal(stat_sfs_2$calculate(seg.sites, NULL, NULL, model), 3)
})
test_that("calculation of sfs works with trios", {
ss <- matrix(c(1, 0, 0, 0,
1, 1, 0, 1,
1, 0, 0, 1,
1, 0, 0, 1), 4, 4, byrow = TRUE)
seg.sites <- list(create_segsites(cbind(ss, ss, ss),
rep(c(0.1, 0.2, 0.5, 0.7), 3),
rep(c(-1, 0, 1), each = 4)))
model <- coal_model(4, 1)
stat_sfs_all <- sumstat_sfs(population = "all")
expect_equal(stat_sfs_all$calculate(seg.sites, NULL, NULL, model), c(1, 0, 1))
})
test_that("SFS is calculate with an outgroup present", {
model <- coal_model(c(2, 1, 1), 1) + feat_outgroup(3)
stat <- sumstat_sfs("sfs", "all")
seg_sites <- list(create_segsites(matrix(c(1, 0, 0, 0,
1, 1, 0, 1,
1, 0, 0, 1), 3, 4, byrow = TRUE),
1:4 / 4))
expect_equal(stat$calculate(seg_sites, NULL, NULL, model), c(1, 1))
stat <- sumstat_sfs("jsfs", 3)
expect_error(stat$calculate(seg_sites, NULL, NULL, model))
model <- coal_model(c(2, 1, 1), 1) + feat_outgroup(2)
expect_equal(sumstat_sfs("jsfs", 1)$calculate(seg_sites, NULL, NULL, model),
2)
expect_equal(sumstat_sfs("jsfs", 3)$calculate(seg_sites, NULL, NULL, model),
numeric(0))
})
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.