tests/testthat/test-update.R

In Avi-Kenny/SimEngine: A Modular Framework for Statistical Simulations in R

### set up sim ###
sim <- new_sim()

create_rct_data <- function (num_patients, ate) {
  df <- data.frame(
    "patient_id" = integer(),
    "group" = character(),
    "outcome" = double(),
    stringsAsFactors = FALSE
  )
  for (i in 1:num_patients) {
    group <- ifelse(sample(c(0,1), size=1)==1, "treatment", "control")
    treatment_effect <- ifelse(group=="treatment", ate, 0)
    outcome <- rnorm(n=1, mean=130, sd=5) + treatment_effect
    df[i,] <- list(i, group, outcome)
  }
  return (df)
}

estimator_1 <- function(df) {
  n <- nrow(df)
  true_prob <- 0.5
  sum_t <- sum(df$outcome * (df$group=="treatment"))
  sum_c <- sum(df$outcome * (df$group=="control"))
  return ( sum_t/(n*true_prob) - sum_c/(n*(1-true_prob)) )
}
estimator_2 <- function(df) {
  n <- nrow(df)
  est_prob <- sum(df$group=="treatment") / n
  sum_t <- sum(df$outcome * (df$group=="treatment"))
  sum_c <- sum(df$outcome * (df$group=="control"))
  return ( sum_t/(n*est_prob) - sum_c/(n*(1-est_prob)) )
}

sim %<>% set_levels(
  estimator = c("estimator_1"),
  num_patients = c(50, 100),
  ate = c(-7)
)

sim %<>% set_script(
  function() {
    df <- create_rct_data(L$num_patients, L$ate)
    estimate <- do.call(L$estimator, list(df))
    return (list("estimate"=estimate))
  }
)

sim %<>% set_config(num_sim=5)

sim %<>% run()
prev_ncol <- length(sim$results)
prev_nrow <- nrow(sim$results)
prev_row1 <- sim$results[1,]

### update_sim handles errors ###
test_that("Invalid options throw errors", {
  expect_error(update_sim(sim, keep_errors = "a"), "`keep_errors` must be of type 'logical'")
})

# change levels
sim %<>% set_levels(
  estimator = c("estimator_1", "estimator_2"),
  num_patients = c(50, 75, 100),
  ate = c(-7)
)

### update_sim adds levels ###
sim %<>% update_sim()
test_that("update_sim() can add new levels", {
  expect_type(sim$results, "list")
  expect_equal(length(sim$results), prev_ncol)
  expect_equal(nrow(sim$results), prev_nrow + 20)
  expect_equal(sim$results[1,], prev_row1)
})

# back to old levels, add reps
sim %<>% set_levels(
  estimator = c("estimator_1"),
  num_patients = c(50, 100),
  ate = c(-7)
)
sim %<>% set_config(num_sim=10)

### update_sim adds reps ###
sim %<>% update_sim()
test_that("update_sim() can add reps", {
  expect_type(sim$results, "list")
  expect_equal(length(sim$results), prev_ncol)
  expect_equal(nrow(sim$results), 2*prev_nrow)
  expect_equal(sim$results[1,], prev_row1)
})

# remove reps and levels
sim %<>% set_levels(
  estimator = c("estimator_1"),
  num_patients = c(50),
  ate = c(-7)
)
sim %<>% set_config(num_sim=4)

### update_sim removes extra reps/levels ###
suppressWarnings({ sim %<>% update_sim() })

test_that("update_sim() can remove extra reps/levels", {
  expect_type(sim$results, "list")
  expect_equal(length(sim$results), prev_ncol)
  expect_equal(nrow(sim$results), prev_nrow - 6)
  expect_equal(sim$results[1,], prev_row1)
})

# new sim, introduce errors and warnings
sim <- new_sim()

sim %<>% set_script(function() {
  if (L$index %% 2 != 0) {
    warning('Odd warning.')
    stop('Odd error.')
  }
  x <- sample(c(1,2),1)
  return (list("x"=x))
})

sim %<>% set_levels(index=1:10)

sim %<>% set_config(num_sim=2, parallel=FALSE)

sim %<>% run()
prev_ncol <- c(length(sim$errors), length(sim$warnings))
prev_nrow <- c(nrow(sim$errors), nrow(sim$warnings))
prev_row1 <- list(sim$errors[1,], sim$warnings[1,])

# add levels
sim %<>% set_levels(index=1:20)

### update_sim properly appends errors and warnings
sim %<>% update_sim()
test_that("update_sim() appends errors and warnings", {
  expect_type(sim$errors, "list")
  expect_type(sim$warnings, "list")
  expect_equal(length(sim$errors), prev_ncol[1])
  expect_equal(length(sim$warnings), prev_ncol[2])
  expect_equal(nrow(sim$errors), 2*prev_nrow[1])
  expect_equal(nrow(sim$warnings), 2*prev_nrow[2])
  expect_equal(sim$errors[1,], prev_row1[[1]])
  expect_equal(sim$warnings[1,], prev_row1[[2]])
})

# back to old levels
sim %<>% set_levels(index=1:10)

# reduce number of reps

sim %<>% set_config(num_sim=1, parallel=FALSE)

### update_sim properly removes extra errors and warnings
suppressWarnings({ sim %<>% update_sim() })
test_that("update_sim() removes extra errors and warnings", {
  expect_type(sim$errors, "list")
  expect_type(sim$warnings, "list")
  expect_equal(length(sim$errors), prev_ncol[1])
  expect_equal(length(sim$warnings), prev_ncol[2])
  expect_equal(nrow(sim$errors), 0.5*prev_nrow[1])
  expect_equal(nrow(sim$warnings), 0.5*prev_nrow[2])
  expect_equal(sim$errors[1,], prev_row1[[1]])
  expect_equal(sim$warnings[1,], prev_row1[[2]])
})

# new sim with no levels

sim <- new_sim()

sim %<>% set_script(function() {
  x <- sample(c(1,2),1)
  return (list("x"=x))
})

sim %<>% set_config(num_sim=100, parallel=FALSE)

sim %<>% run()
prev_ncol <- length(sim$results)
prev_nrow <- nrow(sim$results)
prev_row1 <- sim$results[1,]

sim %<>% set_config(num_sim=200, parallel=FALSE)

### update_sim doesn't break with no levels
sim %<>% update_sim()
test_that("update_sim() works with no levels", {
  expect_type(sim$results, "list")
  expect_equal(length(sim$results), prev_ncol)
  expect_equal(nrow(sim$results), 2*prev_nrow)
  expect_equal(sim$results[1,], prev_row1)
})

# Error handling of invalid levels
sim <- new_sim()
create_data <- function(n) { rpois(n, lambda=5) }
sim %<>% set_levels(n=c(10,100), est="M")
sim %<>% set_config(num_sim=5)
sim %<>% set_script(function() {
  dat <- create_data(L$n)
  return (list("lambda_hat"=mean(dat)))
})
sim %<>% run()
test_that("Correct handling of updated levels", {
  expect_error(sim %<>% set_levels(n=c(10,1000), est=c("M","V"), hey=2),
               paste0("You cannot change the level variables after they are in",
                      "itially set"))
})