tests/testthat/test-checkStratification.R

In SOAs: Creation of Stratum Orthogonal Arrays

set.seed(123)
oa1 <- lhs::createBusht(3, 4, 3)
oa2 <- DoE.base:::L9.3.4-1
set.seed(12345)
oa3 <- lhs::createBose(8, ncol=3)
oa4 <- lhs::createBose(4, ncol=3)

nullcase <- matrix(0:7, nrow=8, ncol=4)
nullcase4 <- matrix(0:3, nrow=4, ncol=4)
## Shi and Tang strength 3+ construction in 7 8-level factors for 32 runs
st1 <- SOAs_8level(32, optimize=FALSE)

test_that("soacheck2D", {
  expect_false(soacheck2D(nullcase, s=2))
  capture_output(expect_false(soacheck2D(nullcase, s=2, verbose = TRUE)))
  expect_false(soacheck2D(nullcase, s=2, t=2))
  capture_output(expect_snapshot_output(soacheck2D(nullcase, s=2, t=2, verbose = TRUE)))
  expect_true(soacheck2D(st1, s=2, el=3, t=4))
  expect_true(soacheck2D(st1, s=2, el=3, t=3))

  # test when el = 2 and t = 4
  expect_message(expect_true(soacheck2D(oa4, s=2, el=2, t=4)))
  # test when el = 2 and t = 3
  expect_true(soacheck2D(oa4, s=2, el=2, t=3))
  # test when min(OA) == 1
  expect_true(soacheck2D(oa3 + 1, s=2, el=3, t=4))
  #
  expect_false(soacheck2D(nullcase, s=2, el=3, t=4))
  # test verbose output
  capture_output(expect_snapshot_output(expect_true(soacheck2D(st1, s=2, el=3, t=4, verbose=TRUE))))
  capture_output(expect_snapshot_output(expect_false(soacheck2D(nullcase, s=2, el=3, t=4, verbose=TRUE))))
  capture_output(expect_false(soacheck2D(nullcase, s=2, el=3, t=3, verbose=TRUE)))
  capture_output(expect_false(soacheck2D(nullcase4, s=2, el=2, t=3, verbose=TRUE)))

})

test_that("soacheck3D", {
  expect_false(soacheck3D(nullcase, s=2))
  capture_output(expect_false(soacheck3D(nullcase, s=2, verbose = TRUE)))
  expect_false(soacheck3D(nullcase, s=2, t=4))
  capture_output(expect_false(soacheck3D(nullcase, s=2, t=4, verbose = TRUE)))
  expect_true(soacheck3D(st1, s=2, el=3, t=4))
  expect_true(soacheck3D(st1, s=2, el=3, t=3))

  ## t=4, FALSE
  capture_output(expect_snapshot_output(expect_false(soacheck3D(oa3 + 1,
                                s=2, el=3, t=4, verbose = TRUE))))
  expect_false(soacheck3D(oa3 + 1, s=2, el=3, t=4))
  # test verbose output
  expect_true(soacheck3D(st1, s=2, el=3, t=4))
  # test error when min(OA) == 2 (not permitted)
  expect_error(soacheck2D(oa3 + 2, s=2, el=3, t=4))
  expect_error(soacheck3D(oa3 + 2, s=2, el=3, t=4))
  # test error when t is wrong
  expect_error(soacheck2D(oa3, s=2, el=3, t=5))

})


test_that("Spattern", {
  ## n not a power of s
  expect_error(Spattern(nullcase, s=4))

  ## mixed level D
  expect_error(Spattern(cbind(nullcase, rbind(nullcase4, nullcase4)), s=2))

  ## calculations correct ?
  temp <- Spattern(nullcase, s=2, maxdim=NULL, maxwt=NULL)
  attributes(temp) <- NULL
  expect_equal(temp, c(0, 6, 0, 13, 24, 36, 48, 128, 96, 96, 0, 64))

  ## with maxdim and maxwt specified larger than possible
  ##    is silently corrected
  temp <- Spattern(nullcase, s=2, maxdim=5, maxwt=20)
  attributes(temp) <- NULL
  expect_equal(temp, c(0, 6, 0, 13, 24, 36, 48, 128, 96, 96, 0, 64))

  ## same for data frame D
  temp <- Spattern(as.data.frame(nullcase), s=2, maxdim=NULL, maxwt=NULL)
  attributes(temp) <- NULL
  expect_equal(temp, c(0, 6, 0, 13, 24, 36, 48, 128, 96, 96, 0, 64))

  ## same for array starting with 1
  temp <- Spattern(nullcase+1, s=2, maxdim=NULL, maxwt=NULL)
  attributes(temp) <- NULL
  expect_equal(temp, c(0, 6, 0, 13, 24, 36, 48, 128, 96, 96, 0, 64))

  temp <- Spattern(nullcase, s=2, maxwt=NULL)
  ## unchanged, because the default maxdim 4 equals m
  attributes(temp) <- NULL
  expect_equal(temp, c(0, 6, 0, 13, 24, 36, 48, 128, 96, 96, 0, 64))

  temp <- Spattern(nullcase, s=2, maxdim=3, maxwt=NULL)
  ## reduced, missing the last three and earlier ones are reduced
  attributes(temp) <- NULL
  expect_equal(temp, c(0, 6, 0, 12, 24, 24, 48, 96, 0))

  temp <- Spattern(nullcase, s=2)
  attributes(temp) <- NULL
  expect_equal(temp, c(0, 6, 0, 13))

  temp <- Spattern(nullcase, s=2, maxdim=3)
  attributes(temp) <- NULL
  expect_equal(temp, c(0, 6, 0, 12))

  D1 <- cbind(c(18, 19, 11, 16, 20, 14,  4, 12, 10, 22,  2, 15,  1,  3, 23,  0,  8,  7,  9,  6, 24, 21, 13, 17,  5),
              c(16,  9,  1, 20, 22,  7, 17, 12, 15, 14, 21, 11,  5, 10,  3, 13, 23,  8,  4, 19, 18,  6, 24,  0,  2),
              c(14,  0,  2,  3, 12, 10,  1,  7, 24,  5, 22, 21,  4, 11,  8, 15,  6, 18, 13,  9, 19, 23, 17, 16, 20))

  ## s=5
  temp <- Spattern(D1, s=5, maxwt=NULL)
  attributes(temp) <- NULL
  expect_equal(temp[1:3], c(0, 0.64, 26.08))  ## Example 4 Tian and Xu
  expect_equal(sum(temp), (5^(3*2)/25)-1)     ## Theorem 4 Tian and Xu

  ## s = number of levels: works but uses the GWLP
  capture_output(expect_snapshot(Spattern(nullcase, s=8)))
  capture_output(expect_snapshot(Spattern(nullcase, s=8, maxdim=3, maxwt=3)))

  capture_output(expect_snapshot_output(Spattern(st1, s=2, maxdim=4, maxwt=4)))
  capture_output(expect_snapshot_output(dim_wt_tab(Spattern(st1, s=2))))
  capture_output(expect_snapshot_output(Spattern(nullcase4, s=2, maxwt=NULL)))
  capture_output(expect_snapshot_output(Spattern(nullcase4, s=2, maxdim=NULL)))
  capture_output(expect_snapshot_output(Spattern(nullcase4, s=2, maxdim=NULL, maxwt=NULL)))

})