tests/testthat/test-outliers.R

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

context("outliers")

modelLm <- fitTD(testTD, design = "rowcol", traits = paste0("t", 1:4),
                 engine = "lme4")

test_that("checks in outliersSTA function properly", {
  expect_error(outlierSTA(), "STA should be a valid object of class STA")
  expect_error(outlierSTA(modelLm, trials = "E2"),
               "trials has to be a character vector defining trials in modelLm")
  expect_error(outlierSTA(modelLm, traits = 1) ,
               "traits should be NULL or a character vector")
  expect_warning(outlierSTA(modelLm, traits = "t5"),
                 "The following traits are not modeled for E1: t5")
  expect_error(outlierSTA(modelLm, traits = "t1", rLimit = -1),
               "rLimit should be NULL or a single numerical value greater than 0")
  expect_error(outlierSTA(modelLm, traits = "t1", commonFactors = "comFac"),
               "commonFactors has to be a character vector defining columns")
  modelLm$E1$mRand <- NULL
  expect_warning(outlierSTA(modelLm, traits = "t1", what = "random"),
                 "Model with genotype random not available for trial E1")
})

test_that("outliersSTA functions properly", {
  out1 <- outlierSTA(modelLm, trials = "E1", traits = "t1", verbose = FALSE)
  expect_is(out1, "list")
  expect_length(out1, 2)
  expect_is(out1$indicator, "list")
  expect_null(out1$indicator[["E1"]][["t1"]])
  expect_null(out1$outliers)
})

test_that("outliersSTA functions properly for multiple traits", {
  out14 <- outlierSTA(modelLm, trials = "E1", traits = paste0("t", 1:4),
                      verbose = FALSE)
  expect_is(out14, "list")
  expect_length(out14, 2)
  expect_is(out14$indicator, "list")
  expect_named(out14$indicator, "E1")
  expect_named(out14$indicator[["E1"]], paste0("t", 1:4))
  expect_null(out14$outliers)
})

test_that("option what functions properly", {
  out1 <- outlierSTA(modelLm, trials = "E1", traits = "t1", what = "random",
                     verbose = FALSE)
  expect_is(out1, "list")
  expect_length(out1, 2)
  expect_is(out1$indicator, "list")
  expect_null(out1$indicator[["E1"]][["t1"]])
  expect_null(out1$outliers)
})

test_that("option rLimit funtions properly", {
  out1 <- outlierSTA(modelLm, trials = "E1", traits = "t1", rLimit = 1,
                     verbose = FALSE)
  expect_length(out1$indicator[["E1"]][["t1"]], 6)
  expect_equal(nrow(out1$outliers), 6)
  expect_equal(out1$outliers$res,
               c(1.13191821629099, -1.27945389572384, -1.13191821629098,
                 1.27945389572384, -1.23458129246234, 1.23458129246234))
})

test_that("option rLimit funtions properly for multiple traits", {
  out14 <- outlierSTA(modelLm, trials = "E1", traits = paste0("t", 1:4),
                      rLimit = 1, verbose = FALSE)
  expect_equivalent(sapply(X = out14$indicator[["E1"]], FUN = length),
                    c(6, 10, 0, 2))
  expect_equal(nrow(out14$outliers), 18)
})

test_that("option commonFactors functions properly", {
  out1 <- outlierSTA(modelLm, trials = "E1", traits = "t1", rLimit = 1,
                     commonFactors = "subBlock", verbose = FALSE)
  expect_length(out1$indicator[["E1"]][["t1"]], 6)
  expect_equal(nrow(out1$outliers), 18)
  expect_equal(sum(out1$outliers$outlier), 6)
})

test_that("option verbose functions properly", {
  printOut1 <- capture.output(out1 <- outlierSTA(modelLm, trials = "E1",
                                                 traits = "t1", verbose = TRUE))
  printOut2 <- capture.output(out2 <- outlierSTA(modelLm, trials = "E1",
                                                 traits = "t1", what = "random",
                                                 rLimit = 1, verbose = TRUE))
  expect_equal(printOut1, "No large standardized residuals.")
  expect_true("Large standardized residuals." %in% printOut2)
  expect_true(any(grepl(pattern = "1.082710", x = printOut2)))
})