tests/testthat/test-sampling.R

In grunwaldlab/poppr: Genetic Analysis of Populations with Mixed Reproduction

context("Random Sample Tests")

data("nancycats", package = "adegenet")
data("Pinf", package = "poppr")

test_that("all shuffling methods work with missing data", {
	skip_on_cran()
	nan1   <- popsub(nancycats, 1)
	inftab <- info_table(nan1)

	expect_error(s1 <- shufflepop(nan1, method = 1), NA)
	expect_error(s2 <- shufflepop(nan1, method = 2), NA)
	expect_error(s3 <- shufflepop(nan1, method = 3), NA)
	expect_error(s4 <- shufflepop(nan1, method = 4), NA)

	expect_that(info_table(s1), is_equivalent_to(inftab))
	expect_null(suppressMessages(info_table(s2)))
	expect_null(suppressMessages(info_table(s3)))
	expect_that(info_table(s4), is_equivalent_to(inftab))
})

test_that("shuffling methods behave as expected with polyploids", {
	skip_on_cran()
	pr <- recode_polyploids(Pinf, newploidy = TRUE)

	expect_error(s1 <- shufflepop(pr, method = 1), NA)
	expect_error(s2 <- shufflepop(pr, method = 2), NA)
	expect_error(s3 <- shufflepop(pr, method = 3), NA)
	expect_error(s4 <- shufflepop(pr, method = 4), NA)

	s2rows <- rowSums(tab(s2), na.rm = TRUE)
	s3rows <- rowSums(tab(s3), na.rm = TRUE)
	expect_identical(rowSums(tab(s1)), rowSums(tab(pr)))
	expect_true(all(s2rows == sample(s2rows, 1)))
	expect_true(all(s3rows == sample(s3rows, 1)))
	expect_false(identical(rowSums(tab(s4)), rowSums(tab(pr))))

})

test_that("shuffling methods work for PA data", {
	skip_on_cran()
	data("Aeut", package = "poppr")
	expect_is(shufflepop(Aeut, method = 1), "genind")
	expect_is(shufflepop(Aeut, method = 2), "genind")
	expect_is(shufflepop(Aeut, method = 3), "genind")
	expect_is(shufflepop(Aeut, method = 4), "genind")
	expect_error(shufflepop(Aeut, method = 5), "Method 5 is not defined")

	A10 <- Aeut[sample(nInd(Aeut), 10)]
	expect_is(poppr(A10, sample = 9, method = 1, quiet = TRUE, hist = FALSE, sublist = "Total"), "popprtable")
	expect_is(poppr(A10, sample = 9, method = 2, quiet = TRUE, hist = FALSE, sublist = "Total"), "popprtable")
	expect_is(poppr(A10, sample = 9, method = 3, quiet = TRUE, hist = FALSE, sublist = "Total"), "popprtable")
	expect_is(poppr(A10, sample = 9, method = 4, quiet = TRUE, sublist = "Total"), "popprtable")

})