tests/testthat/test-extract.R

In statgenSTA: Single Trial Analysis (STA) of Field Trials

context("extractSTA general options")

modelLm <- fitTD(testTD, design = "rcbd", traits = "t1", engine = "lme4")
test_that("checks in extractSTA function properly", {
  expect_error(extractSTA(1), "STA has to be an object of class STA")
  expect_error(extractSTA(modelLm, traits = 1),
               "traits should be NULL or a character vector")
  expect_error(extractSTA(modelLm, keep = 1),
               "keep should be NULL or a character vector")
  expect_error(extractSTA(modelLm, traits = "t5"),
               "The following traits are not modeled for E1: t5")
  expect_error(extractSTA(modelLm, keep = "myKp"),
               "All keep should be columns in E1")
})

test_that("option keep functions properly", {
  expect_named(extractSTA(modelLm, what = "BLUEs", keep = "trial"),
               c("genotype", "trial", "t1"))
  expect_named(extractSTA(modelLm, what = "fitted", keep = "repId"),
               c("genotype", "trial", "repId", "t1"))
  ## Columns that have duplicate values should be dropped with a warning.
  expect_warning(ext <- extractSTA(modelLm, what = "BLUEs", keep = "checkId"),
                 "Duplicate values for")
  expect_named(ext, c("genotype", "trial", "t1"))
  expect_warning(ext2 <- extractSTA(modelLm, what = "BLUEs",
                                    keep = c("trial", "checkId")),
                 "Duplicate values for")
  expect_named(ext2, c("genotype", "trial", "t1"))
})

test_that("option restoreColNames functions properly", {
  ## Restoring original colnames should work with and without keeping columns.
  expect_named(extractSTA(modelLm, what = "BLUEs", restoreColNames = TRUE),
               c("seed", "field", "t1"))
  expect_named(extractSTA(modelLm, what = "BLUEs", keep = "trial",
                          restoreColNames = TRUE),
               c("seed", "field", "t1"))
  ## Duplicate mappings are a potential problem.
  expect_named(extractSTA(modelLm, what = "fitted",
                          keep = c("rowCoord", "rowId"),
                          restoreColNames = TRUE),
               c("seed", "field", "rep", "Y", "t1"))
})

test_that("function createBaseData functions properly for bdPred = FALSE", {
  testDF <- testTD[["E1"]]
  ## Setting no extra options should just copy column predicted.
  expect_equal(createBaseData(testDF, predicted = "genotype")$baseData$genotype,
               testDF$genotype)
  ## Keep should copy those columns as well.
  expect_equal(createBaseData(testDF, predicted = "genotype",
                              keep = c("family", "trial"))$baseData,
               testDF[, c("genotype", "family", "trial")])
  ## useRepId = TRUE should copy repId as well.
  expect_equal(createBaseData(testDF, predicted = "genotype",
                              useRepId = TRUE)$baseData,
               testDF[, c("genotype", "repId")])
})

test_that("function createBaseData functions properly for bdPred = TRUE", {
  testDF <- testTD[["E1"]]
  ## Setting no extra options should copy unique values in predicted.
  expect_equal(createBaseData(testDF, predicted = "genotype",
                              bdPred = TRUE)$baseDataPred$genotype,
               unique(testDF$genotype))
  ## Keep should copy those columns as well.
  ## A warning should be issued for columns that contain duplicate values.
  expect_warning(testBD <- createBaseData(testDF, predicted = "genotype",
                                          keep = c("family", "trial"),
                                          bdPred = TRUE)$baseDataPred,
                 'Duplicate values for "family"')
  expect_named(testBD, c("genotype", "trial"))
})

test_that("function restoreColNames functions properly", {
  testDF <- testTD[["E1"]]
  testRen <- attr(x = testDF, which = "renamedCols")
  ## Running with restore = FALSE should do nothing.
  expect_equal(testDF, restoreColNames(testDF))
  ## Restoring a single column.
  expect_named(restoreColNames(testDF, renamedCols = testRen[1, ],
                               restore = TRUE),
               c("seed", "family", "trial", "repId", "checkId", "colId",
                 "rowId", "subBlock", "t1", "t2", "t3", "t4", "rowCoord",
                 "colCoord"))
  ## Restoring multiple non-adjacent columns.
  expect_named(restoreColNames(testDF, renamedCols = testRen[c(1, 3), ],
                               restore = TRUE),
               c("seed", "family", "trial", "rep", "checkId", "colId",
                 "rowId", "subBlock", "t1", "t2", "t3", "t4", "rowCoord",
                 "colCoord"))
  ## Set of columns with the same original column.
  expect_named(restoreColNames(testDF, renamedCols = testRen[c(5, 7), ],
                               restore = TRUE),
               c("genotype", "family", "trial", "repId", "checkId", "colId",
                 "Y", "subBlock", "t1", "t2", "t3", "t4", "colCoord"))
  ## Attributes should be kept.
  expect_named(attributes(restoreColNames(testDF, renamedCols = testRen,
                                          restore = TRUE)),
               c("names", "row.names", "trLocation", "renamedCols", "class"))
})