tests/testthat/testNestedFacs.r

In dae: Functions Useful in the Design and ANOVA of Experiments

#devtools::test("dae")
context("factor")

cat("#### Test for fac.nested\n")
test_that("fac.nested", {
  skip_on_cran()
  library(dae)
  
  #Set up a data.frame with two factors A & B and use fac.nested to get B
  lay <- data.frame(A = factor(rep(c(1:3), c(3,6,4)), labels = letters[1:3]))
  lay$B <-fac.nested(lay$A)
  testthat::expect_equal(length(levels(lay$B)),6)
  
  #Test for wqhen NAs are present
  A <- factor(rep(c(1:3), c(3,6,4)), labels = letters[1:3])
  A[c(4,9)] <- NA
  A <- c(A, NA)
  B <-fac.nested(A)
  testthat::expect_equal(length(levels(B)),4)
  testthat::expect_true(all(is.na(B[c(4,9,14)])))
  
  #Test when the number of levels of the nesting.fac is large (33478)
  data("TagDay")
  Watering <- fac.nested(TagDay, nested.labs = c("","a"))
  testthat::expect_equal(length(levels(Watering)),2)
  testthat::expect_true(all(table(Watering) == c(33478, 523)))
  
})
cat("#### Test for fac.multinested\n")
test_that("Multiple nesting", {
  skip_on_cran()
  library(dae)

  #Set up a data.frame with two factors A & B and use fac.nested to get B
  lay <- data.frame(A = factor(rep(c(1:3), c(3,6,4)), labels = letters[1:3]))
  lay$B <-fac.nested(lay$A)
  testthat::expect_equal(length(levels(lay$B)),6)
  
  #Add factors for B within each level of A
  lay2 <- cbind(lay, fac.multinested(lay$A))
  testthat::expect_true(all(letters[1:3] %in% names(lay2)))
  testthat::expect_equal(length(levels(lay2$b)),7)
  testthat::expect_equal(levels(lay2$b)[1],"rest")
  testthat::expect_true(all(lay2$a[1:4] == c("1", "2", "3", "rest")))
  canon2 <- designAnatomy(list(~A/(a+b+c)), data = lay2)
  summ <- summary(canon2)
  testthat::expect_true(all(c("A", "a[A]", "b[A]", "c[A]") == summ$decomp$Source))
  testthat::expect_true(all(c(2,2,5,3) == summ$decomp$df))
  
  #Add factors for B within each level of A, but with levels and outlabel given
  lay2 <- cbind(lay, fac.multinested(lay$A, nested.levs = seq(10,60,10), outlabel = "other"))
  testthat::expect_true(all(letters[1:3] %in% names(lay2)))
  testthat::expect_equal(length(levels(lay2$b)),7)
  testthat::expect_true(all(lay2$a[1:4] == c("10", "20", "30", "other")))
  canon2 <- designAnatomy(list(~A/(a+b+c)), data = lay2)
  summ <- summary(canon2)
  testthat::expect_true(all(c("A", "a[A]", "b[A]", "c[A]") == summ$decomp$Source))
  testthat::expect_true(all(c(2,2,5,3) == summ$decomp$df))
  
  #Set a value of A to missing
  lay2 <- lay
  lay2$A[7] <- NA
  lay2 <- cbind(lay2, fac.multinested(lay2$A, outlabel = "0"))
  testthat::expect_true(all(letters[1:3] %in% names(lay2)))
  testthat::expect_equal(length(levels(lay2$b)),6)
  testthat::expect_equal(levels(lay2$b)[1],"0")
  
  #Replicate the combinations of A and B three times and index them with the factor sample
  lay3 <- rbind(lay,lay,lay)
  lay3$sample <- with(lay3, fac.nested(fac.combine(list(A,B))))
  
  #Add factors for B within each level of A
  lay4 <- cbind(lay3, fac.multinested(nesting.fac = lay$A, nested.fac = lay$B))
  testthat::expect_true(all(letters[1:3] %in% names(lay4)))
  testthat::expect_equal(length(levels(lay4$b)),7)
  testthat::expect_equal(levels(lay4$b)[1],"rest")
  canon4 <- designAnatomy(list(~(A/(a+b+c))/sample), data = lay4)
  summ <- summary(canon4)
  testthat::expect_true(all(c("A", "a[A]", "b[A]", "c[A]", "a#b#c#sample[A]") == summ$decomp$Source))
  testthat::expect_true(all(c(2,2,5,3,26) == summ$decomp$df))
  
  #Add factors for sample within each combination of A and B
  lay5 <- with(lay4, cbind(lay4, 
                           fac.multinested(nesting.fac = a, fac.prefix = "a"),
                           fac.multinested(nesting.fac = b, fac.prefix = "b"),
                           fac.multinested(nesting.fac = c, fac.prefix = "c")))
  testthat::expect_equal(ncol(lay5),19)
  testthat::expect_true(all(unlist(lapply(lay5[paste0("b", 1:6)], 
                                          function(fac) length(levels(fac)))) == rep(4, 6)))
  testthat::expect_equal(levels(lay5$b)[1],"rest")
  testthat::expect_equal(levels(lay5$b1)[1],"rest")
  canon5 <- designAnatomy(list(~A/(a/(a1+a2+a3)+b/(b1+b2+b3+b4+b5+b6)+c/(c1+c2+c3))), data = lay5)
  summ <- summary(canon5)
  testthat::expect_true(all(rep(c(2,5,2,3,2), c(5,1,6,1,3)) == summ$decomp$` df`))
  
  #Add factors for sample within each level of A
  lay6 <- cbind(lay4, 
                fac.multinested(nesting.fac = lay4$A, nested.fac = lay$sample, fac.prefix = "samp"))
  testthat::expect_true(all(c(letters[1:3], paste0("samp",letters[1:3])) %in% names(lay6)))
  testthat::expect_equal(length(levels(lay6$b)),7)
  testthat::expect_equal(length(levels(lay6$sampb)),19)
  testthat::expect_equal(levels(lay6$b)[1],"rest")
  testthat::expect_equal(levels(lay6$sampb)[1],"rest")
  canon6 <- designAnatomy(list(~A/(a/sampa+b/sampb+c/sampc)), data = lay6)
  summ <- summary(canon6)
  testthat::expect_true(all(c("A", "a[A]", "sampa[A:a]", "b[A]", "sampb[A:b]", "c[A]", "sampc[A:c]") == 
                              summ$decomp$Source))
  testthat::expect_true(all(c(2,2,6,5,12,3,8) == summ$decomp$df))
})