test-add_ranef.R
In faux: Simulation for Factorial Designs

test_that("x", {
  data <- expand.grid(
    rater = 1:3,
    stimulus = 1:2,
    obs = 1:4
  )
  
  datar <- data %>%
    add_ranef("rater", r_i = 1) %>%
    add_ranef("stimulus", s_i = 10) %>%
    add_ranef(c("rater", "stimulus"), rs_i = 100)
  
  r <- datar$r_i
  s <- datar$s_i
  rs <- datar$rs_i
  
  expect_equal(rep(r[1:3], 8), r)
  expect_equal(rep(s[c(1, 4)], each = 3, times = 4), s)
  expect_equal(rep(rs[1:6], 4), rs)
})

test_that("x and y", {
  set.seed(1)
  
  nrater <- 5000
  x_sd <- sample(1:10, 1)
  y_sd <- sample(1:10, 1)
  r_xy <- 0.5
  
  data <- expand.grid(
    rater = 1:nrater,
    stimulus = 1:2
  )
  
  datar <- add_ranef(data, "rater", x = x_sd, y = y_sd, .cors = r_xy)
  x <- datar$x[1:nrater]
  y <- datar$y[1:nrater]
  
  expect_equal(x, datar$x[(nrater+1):(2*nrater)])
  
  expect_true(mean(x) %>% abs() < .1)
  expect_true(mean(y) %>% abs() < .1)
  expect_equal(sd(x), x_sd, tol = 0.05)
  expect_equal(sd(y), y_sd, tol = 0.05)
  expect_equal(cor(x, y), r_xy, tol = .05)
})

# add_random ----
test_that("add_random", {
  # start a data frame
  data1 <- add_random(school = 3)
  expect_equal(data1$school, paste0("school", 1:3))
  # nest classes in schools (2 classes per school)
  data2 <- add_random(data1, class = 2, .nested_in = "school")
  expect_equal(data2$class, paste0("class", 1:6))
  expect_equal(data2$school, rep(data1$school, each = 2))
  # nest students in each class (different n per class)
  n <- c(20, 24, 23, 21, 25, 24)
  data3 <- add_random(data2, student = n, .nested_in = "class")
  expect_equal(nrow(data3), sum(n))
  # cross each student with 10 questions
  data4 <- add_random(data3, question = 10)
  expect_equal(nrow(data4), sum(n)*10)
  expect_equal(data4$student, rep(data3$student, each = 10))
  
  # add crossed random factor to existing dataset
  data5 <- sim_design(within = 2, n = 3, long = TRUE, plot = FALSE)
  data6 <- add_random(data5, Q = 2)
  expect_equal(data6$Q, rep(c("Q1", "Q2"), 6))
  
  # compare nesting in 2 different factors
  data <- add_random(A = 2., B = 2)
  nested_in_A <- add_random(data, C = 2, .nested_in = "A")
  nested_in_B <- add_random(data, C = 2, .nested_in = "B")
  expect_false(all(nested_in_A$C == nested_in_B$C))
})

## ids ----
test_that("add_random ids", {
  # crossed random factors
  ids <- c("A", "B", "C")
  data1 <- add_random(school = ids)
  expect_equal(data1$school, ids)
  
  data1b <- add_random(school = ids, class = 3)
  check <- dplyr::tibble(
    school = rep(ids, each = 3),
    class = rep(paste0("class", 1:3), 3)
  )
  expect_equal(data1b, check)
  
  # nested random factors
  data2 <- add_random(data1, class = 2, .nested_in = "school")
  expect_equal(data2$class, paste0("class", 1:6))
  
  data2 <- add_random(data1, class = c(2, 3, 4), .nested_in = "school")
  expect_equal(data2$class, paste0("class", 1:9))
  
  data3 <- add_random(data1, 
                      class = list(
                        LETTERS[1:2],
                        LETTERS[3:5],
                        LETTERS[6:9]
                      ), 
                      .nested_in = "school")
  expect_equal(data3$class, LETTERS[1:9])
})

# add_between ----
test_that("add_between", {
  base <- add_random(subj = 4, item = 2)
  
  data <- add_between(base, "subj", cond = c("A", "B"))
  cond <- rep(LETTERS[1:2], each = 2, times = 2) %>% factor()
  expect_equal(data$cond, cond)
  
  data <- add_between(base, "item", cond = c("A", "B"))
  cond <- rep(LETTERS[1:2], 4) %>% factor()
  expect_equal(data$cond, cond)
  
  # 2b2b
  data <- add_between(base, "subj", 
                      cond = c("A", "B"),
                      time = c("morning", "evening"))
  cond <- rep(LETTERS[1:2], each = 4) %>% factor()
  time <- rep(c("morning", "evening"), each = 2, times = 2) %>% 
    factor(levels = c("morning", "evening"))
  expect_equal(data$cond, cond)
  expect_equal(data$time, time)
  
  # shuffle
  set.seed(100)
  base <- add_random(subj = 100, item = 2)
  data <- add_between(base, "subj", time = c("morning", "evening"))
  data_shuffle <- add_between(base, "subj", time = c("morning", "evening"), 
                      .shuffle = TRUE)
  time <- rep(c("morning", "evening"), each = 2, times = 50) %>% 
    factor(levels = c("morning", "evening"))
  expect_equal(data$time, time)
  expect_false(all(data_shuffle$time == time))
  expect_equal(sum(data_shuffle$time == "morning"), 100)
  
  # prob proportion
  set.seed(100)
  mean_prob <- replicate(100, {
    data_prob <- add_between(base, "subj", time = c("morning", "evening"), 
                                .prob = c(.4, .6))
    mean(data_prob$time == "morning")
  }) %>% mean()
  expect_equal(mean_prob, .4, tol = .005)
  
  # exact prob
  for (n in c(0, 10, 20, 30, 100)) {
    data_prob <- add_between(base, "subj", time = c("morning", "evening"), 
                             .prob = c(n, 100-n))
    expect_equal(sum(data_prob$time == "morning"), n*2)
  }
  
  # multiple prob
  prob <- c(10, 20, 30, 40)
  data_prob2 <- add_between(base, "subj", 
                           cond = c("A", "B"),
                           time = c("morning", "evening"),
                           .prob = prob)
  n <- dplyr::count(data_prob2, cond, time)$n
  expect_equal(n, prob*2)
  
  expect_warning({data_prob3 <- 
    add_between(base, "subj", 
                cond = c("A", "B"),
                time = c("morning", "evening"),
                .prob = list(cond = c(10, 90),
                            time = c(90, 10)))})
  cond <- rep(c("A", "B"), c(10*2, 90*2)) %>% factor()
  time <- rep(c("morning", "evening"), c(90*2, 10*2)) %>% 
    factor(c("morning", "evening"))
  expect_equal(data_prob3$cond, cond)
  expect_equal(data_prob3$time, time)
  
  # independent joint probabilities
  set.seed(100)
  means <- replicate(100, {
    data_prob4 <- add_between(base, "subj", 
                            cond = c("A", "B"),
                            time = c("morning", "evening"),
                            .prob = list(cond = c(.3, .7),
                                         time = c(.3, .7)))
    list(
      cond = mean(data_prob4$cond == "A"),
      time = mean(data_prob4$time == "morning"),
      joint = mean(data_prob4$cond == "A" & 
                     data_prob4$time == "morning")
    )
  })
  cond <- means["cond", ] %>% unlist() %>% mean()
  time <- means["time", ] %>% unlist() %>% mean()
  joint <- means["joint", ] %>% unlist() %>% mean()
  expect_equal(cond, .3, tol = 0.01)
  expect_equal(time, .3, tol = 0.01)
  expect_equal(joint, .3*.3, tol = 0.01)
  
  ## numeric levels
  base <- add_random(subj = 6)
  x <- add_between(base, "subj", time = 3:5, letter = c("A", "B"))
  
  expect_true(is.numeric(x$time))
  expect_equal(x$time, c(3, 3, 4, 4, 5, 5))
  expect_true(is.factor(x$letter))
  expect_equal(levels(x$letter), c("A", "B"))
})

# add_within ----
test_that("add_within", {
  base <- add_random(subj = 4, item = 2)
  
  data <- add_within(base, "subj", cond = c("A", "B"))
  cond <- rep(LETTERS[1:2], 4*2) %>% factor()
  expect_equal(data$cond, cond)
  
  data <- add_within(base, "item", cond = c("A", "B"))
  cond <- rep(LETTERS[1:2], 4*2) %>% factor()
  expect_equal(data$cond, cond)
  
  # 2b2b
  data <- add_within(base, "subj", 
                      cond = c("A", "B"),
                      time = c("morning", "evening"))
  cond <- rep(LETTERS[1:2], each = 2, times = 8) %>% factor()
  time <- rep(c("morning", "evening"), 16) %>% 
    factor(levels = c("morning", "evening"))
  expect_equal(data$cond, cond)
  expect_equal(data$time, time)
  
  ## numeric levels
  base <- add_random(subj = 2)
  x <- add_within(base, "subj", time = 3:4, letter = c("A", "B"))
  
  expect_true(is.numeric(x$time))
  expect_equal(x$time, c(3, 3, 4, 4, 3, 3, 4, 4))
  expect_true(is.factor(x$letter))
  expect_equal(levels(x$letter), c("A", "B"))
})