test-derivedFactor.R
In mosaic: Project MOSAIC Statistics and Mathematics Teaching Utilities

# context("derivedFactor()")

testthat::test_that("derivedFactor Works", {
  Kf <- mutate(KidsFeet, biggerfoot2 = derivedFactor(
                     dom = biggerfoot == domhand,
                     nondom = biggerfoot != domhand)
                     )
  # Method 1: explicitly define all levels
  modHELP <- mutate(HELPrct, drink_status = derivedFactor(
    abstinent = i1 == 0,
    moderate = (i1>0 & i1<=1 & i2<=3 & sex=='female') |
      (i1>0 & i1<=2 & i2<=4 & sex=='male'),
    highrisk = ((i1>1 | i2>3) & sex=='female') |
      ((i1>2 | i2>4) & sex=='male'),
    .ordered = TRUE)
  )
  
  # Method 2: Use .default for last level
  modHELP2 <- mutate(HELPrct, drink_status = derivedFactor(
    abstinent = i1 == 0,
    moderate = (i1<=1 & i2<=3 & sex=='female') |
      (i1<=2 & i2<=4 & sex=='male'),
    .ordered = TRUE,
    .method = "first",
    .default = "highrisk")
  )
  
  # Method 3: use TRUE to catch any fall through slots
  modHELP3 <- mutate(HELPrct, drink_status = derivedFactor(
    abstinent = i1 == 0,
    moderate = (i1<=1 & i2<=3 & sex=='female') |
      (i1<=2 & i2<=4 & sex=='male'),
    highrisk=TRUE,
    .ordered = TRUE,
    .method = "first"
  )
  )
  regressionTest <- structure(list(name = structure(c(10L, 24L, 36L, 20L, 23L, 34L, 13L, 4L, 14L, 
                                                      8L, 29L, 33L, 5L, 6L, 21L, 22L, 7L, 28L, 26L, 
                                                      19L, 3L, 20L, 25L, 15L, 31L, 16L, 1L, 10L, 30L, 
                                                      11L, 9L, 4L, 27L, 12L, 32L, 17L, 35L, 18L, 2L), 
                                                    .Label = c("Abby", "Alisha", "Andy", "Caitlin", "Cal", 
                                                               "Cam", "Caroline", "Damon", "Danielle", "David",
                                                               "Dwayne", "Dylan", "Edward", "Eleanor", "Erica", "Glen", "Hannah",
                                                               "Hayley", "Heather", "Josh", "Julie", "Kate", "Lang", "Lars",
                                                               "Laura", "Lee", "Leigh", "Maggie", "Mark", "Mike", "Peggy", "Peter", 
                                                               "Ray", "Scotty", "Teshanna", "Zach"), class = "factor"), 
                                   birthmonth = c(5L,  10L, 12L, 1L, 2L, 3L, 2L, 6L, 5L, 9L, 9L, 3L, 8L, 3L, 11L, 4L,  12L, 3L, 6L, 
                                                  3L, 6L, 7L, 9L, 9L, 10L, 7L, 2L, 12L, 11L, 8L, 6L, 7L, 3L, 4L, 4L, 3L, 3L, 1L, 9L), 
                                   birthyear = c(88L, 87L, 87L, 88L, 88L, 88L, 88L, 88L, 88L, 88L, 87L, 88L, 87L, 88L, 87L, 88L, 87L, 
                                                 88L, 88L, 88L, 88L, 88L, 88L, 88L, 88L, 88L, 88L, 87L, 88L, 88L, 88L, 88L, 88L, 88L, 
                                                 88L, 88L, 88L, 88L, 88L), 
                                   length = c(24.4,  25.4, 24.5, 25.2, 25.1, 25.7, 26.1, 23, 23.6, 22.9, 27.5, 24.8,  26.1, 27, 26, 
                                              23.7, 24, 24.7, 26.7, 25.5, 24, 24.4, 24, 24.5,   24.2, 27.1, 26.1, 25.5, 24.2, 23.9, 
                                              24, 22.5, 24.5, 23.6, 24.7,   22.9, 26, 21.6, 24.6), 
                                   width = c(8.4, 8.8, 9.7, 9.8, 8.9, 9.7,  9.6, 8.8, 9.3, 8.8, 9.8, 8.9, 9.1, 9.8, 9.3, 7.9, 8.7, 8.8, 
                                             9,  9.5, 9.2, 8.6, 8.3, 9, 8.1, 9.4, 9.5, 9.5, 8.9, 9.3, 9.3, 8.6, 8.6, 9, 8.6, 8.5, 9, 7.9, 8.8), 
                                   sex = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 
                                                     1L, 2L, 2L, 2L, 1L, 2L, 1L, 1L, 1L, 2L, 2L, 2L, 1L, 1L,  2L, 2L, 2L, 2L), 
                                                   .Label = c("B", "G"), 
                                                   class = "factor"), 
                                   biggerfoot = structure(c(1L,    1L, 2L, 1L, 1L, 2L, 1L, 1L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 2L, 2L,2L, 
                                                            1L, 2L, 2L, 1L, 2L, 1L, 1L, 1L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 2L, 1L, 1L, 2L, 1L), 
                                                          .Label = c("L", "R"), 
                                                          class = "factor"), 
                                   domhand = structure(c(2L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
                                                         1L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 2L, 1L, 2L, 2L, 2L, 1L, 2L, 
                                                         2L, 2L, 2L, 2L, 2L, 1L, 2L, 2L, 2L, 1L, 1L, 2L, 2L, 2L, 2L), 
                                                       .Label = c("L", "R"), class = "factor"), 
                                   biggerfoot2 = structure(c(2L, 1L, 1L, 2L, 2L, 1L, 2L, 2L, 1L, 2L, 1L, 2L, 2L, 2L, 2L, 1L,
                                                             2L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 2L, 2L, 2L, 1L, 
                                                             2L, 2L, 2L, 2L, 2L, 1L, 2L), .Label = c("dom", "nondom"), 
                                                           class = "factor")), 
                              class = "data.frame", 
                              row.names = c(NA, -39L))
  
  
  testcase1 <- structure(c(2L, 11L, 20L, 6L), 
                         .Dim = c(2L, 2L), 
                         .Dimnames = list(biggerfoot = c("L", "R"), 
                                          biggerfoot2 = c("dom", "nondom")), 
                         class = "table")
  testcase2 <- structure(c(2L, 6L, 20L, 11L), 
                         .Dim = c(2L, 2L), 
                         .Dimnames = list(biggerfoot = c("L", "R"), 
                                          domhand = c("L", "R")), 
                         class = "table")
  
  testcase3 <- structure(c(abstinent = 68L, 
                           moderate = 28L, 
                           highrisk = 357L), 
                         .Dim = 3L, 
                         .Dimnames = list(drink_status = c("abstinent", "moderate", "highrisk")), 
                         class = "table")
  
  testcase4 <- structure(c(abstinent = 68L, moderate = 28L, highrisk = 357L), .Dim = 3L, .Dimnames = list(
    drink_status = c("abstinent", "moderate", "highrisk")), class = "table")
  
  testcase5 <- structure(c(abstinent = 68L, moderate = 28L, highrisk = 357L), .Dim = 3L, .Dimnames = list(
    drink_status = c("abstinent", "moderate", "highrisk")), class = "table")
  
  expect_equal(ignore_attr = TRUE, regressionTest, Kf)
  expect_equal(ignore_attr = TRUE, testcase1, tally( ~ biggerfoot + biggerfoot2, data = Kf) )
  expect_equal(ignore_attr = TRUE, testcase2, tally( ~ biggerfoot + domhand, data = Kf) )
  expect_equal(ignore_attr = TRUE, testcase3, tally( ~ drink_status, data = modHELP) )
  expect_equal(ignore_attr = TRUE, testcase4, tally( ~ drink_status, data = modHELP2) )
  expect_equal(ignore_attr = TRUE, testcase5, tally( ~ drink_status, data = modHELP3) )
})