tests/testthat/test-winia.R

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

context("win.ia tests")
set.seed(999)
chrom_pos <- vapply(1:10, function(i) sort(sample(1e3, 100)), integer(100)) %>%
  as.vector()
chromo    <- rep(1:10, each = 100)
set.seed(999)
x <- glSim(n.ind = 10, n.snp.nonstruc = 5e2, n.snp.struc = 5e2, ploidy = 2, 
           parallel = FALSE)


test_that("win.ia will throw an error if duplicate positions are found", {
  options(poppr.debug = TRUE)
  on.exit(options(poppr.debug = FALSE))
  x.naive     <- win.ia(x, name_window = TRUE)
  expect_equal(length(x.naive), 10L)
  expect_named(x.naive, as.character(100 * (1:10)))
  expect_null(names(win.ia(x, quiet = TRUE, name_window = FALSE)))
  position(x) <- chrom_pos
  expect_error(win.ia(x), "chromosome")
  
})  

test_that("win.ia will throw a warning if chromosome_buffer is specified", {
  expect_warning(x.naive <- win.ia(x, quiet = TRUE, chromosome_buffer = FALSE), "deprecated")
})

test_that("win.ia will use chromosome structure", {
  skip_on_cran()
  position(x)   <- chrom_pos
  chromosome(x) <- chromo
  x.chrom.bt    <- win.ia(x, quiet = TRUE)
  expect_equal(length(x.chrom.bt), 100L)
  winnames <- paste(rep(1:10, each = 10), rep(100*(1:10), 10), sep = ".")
  expect_equal(names(x.chrom.bt), winnames)
})
  
test_that("win.ia will always start at the beginning of the chromosome", {
  skip_on_cran()
  position(x)   <- chrom_pos
  chromosome(x) <- chromo
  x.chrom.bf    <- win.ia(x, window = 300L, quiet = TRUE)
  x.by.chrom    <- lapply(levels(chromosome(x)), function(i) win.ia(x[, chromosome(x) == i], window = 300L, quiet = TRUE))
  # There should be 4 windows per chromosome.
  expect_equal(length(x.chrom.bf), 40L)
  # Using the function with and without chromosome structure should not matter.
  expect_equal(x.chrom.bf, unlist(x.by.chrom, use.names = FALSE), check.attributes = FALSE)
  
})