tests/testthat/test-snpclone.R

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

context("snpclone coercion tests")

set.seed(999)
dat            <- matrix(sample(c(0:2), 50*64, replace = TRUE), 50, 64)
dat[sample(length(dat), 10)] <- NA
dat2           <- rbind(dat, tail(dat, 10))
rownames(dat2) <- paste("sample", seq(60))
colnames(dat2) <- paste("SNP", seq(64))
gl             <- new("genlight", dat2, parallel = FALSE, n.cores = 1L)
sc             <- as.snpclone(gl, parallel = FALSE, n.cores = 1L)
# mlg.filter(sc, threads = 1L) <- 0.25


test_that("subsetting a snpclone object retains the MLG definitions", {
  idn <- mlg.id(sc)[[2]]
  idl <- indNames(sc) %in% idn
  idi <- which(idl)
  expect_equal(mll(sc[idn]), mll(sc[idl]))
  expect_equal(mll(sc[idi]), mll(sc[idl]))
})

test_that("snpclone can be subset with and without MLG-class MLGs", {
  skip_on_cran()
  scm <- sc
  scm@mlg <- sc@mlg[]
  # normal subsetting is no problem
  expect_identical(sc[1:10]@mlg[], scm[1:10]@mlg[])
  # subsetting with reset is also good
  expect_identical(sc[1:10, mlg.reset = TRUE]@mlg[], scm[1:10, mlg.reset = TRUE]@mlg[])
  # re-setting the MLG class also works exactly the same way. 
  mll(scm) <- "original"
  expect_identical(sc@mlg, scm@mlg)
})

test_that("mlg.vector returns the same value for genlight and snpclone", {
  skip_on_cran()
  expect_equal(mlg.vector(gl), mlg.vector(sc))
})

test_that("snpclone objects can be initialized with unique mlgs", {
  skip_on_cran()
  scu <- as.snpclone(gl, parallel = FALSE, n.cores = 1L, mlg = seq_len(nInd(gl)))
  expect_identical(indNames(scu), indNames(sc))
  expect_identical(locNames(scu), locNames(sc))
  expect_identical(mll(scu), seq_len(nInd(gl)))
  expect_identical(mll(scu[mlg.reset = TRUE]), mll(sc))
})
# TODO: test for handling of missing data (should be considered new genotype)
test_that("a single instance of missing data won't induce a new genotype", {
  skip_on_cran()
  datm        <- dat2
  datm[60, 1] <- NA
  scm         <- as.snpclone(new("genlight", datm, parallel = FALSE, n.cores = 1L),
                             parallel = FALSE, n.cores = 1L)
  expect_equal(nmll(scm), 50L)
})

test_that("mlg.filter will reduce the number of multilocus lineages", {
  skip_on_cran()
  mlg.filter(sc) <- 0.4
  expect_lt(nmll(sc), nmll(sc, "original"))
})

test_that("mlg.filter<- can't be used for genlight objects", {
  skip_on_cran()
  expect_warning(mlg.filter(gl) <- 0.5, "mlg.filter<- only has an effect on snpclone objects.")
})