tests/testthat/test-error-handling.R

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

# No errors, no warnings

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)

msg <- capture_messages(
  sim %<>% run()
)

test_that("run() behaves correctly; no errors", {
  expect_equal(msg, "Done. No errors or warnings detected.\n\n")
  expect_equal(sim$errors, "No errors")
  expect_equal(sim$warnings, "No warnings")
  expect_type(sim$results, "list")
  expect_equal(length(sim$results), 6)
  expect_equal(nrow(sim$results), 100)
  expect_equal(sim$results$sim_uid[1:5], c(1:5))
  expect_equal(sim$results$level_id[1:5], rep(1,5))
  expect_equal(sim$results$rep_id[1:5], c(1:5))
})


# No errors, some warnings (multiple per sim)

sim <- new_sim()

sim %<>% set_script(
  function() {
    warning('One warning.')
    warning('Two warnings.')
    x <- sample(c(1,2),1)
    return (list("x"=x))
  }
)

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

msg <- capture_messages(
  sim %<>% run()
)

test_that("run() behaves correctly; no errors and some warnings", {
  expect_equal(msg, "Done. No errors detected. Warnings detected in 100% of simulation replicates.\n\n")
  expect_equal(sim$errors, "No errors")
  expect_type(sim$results, "list")
  expect_type(sim$warnings, "list")
  expect_equal(length(sim$results), 6)
  expect_equal(length(sim$warnings), 6)
  expect_equal(nrow(sim$results), 100)
  expect_equal(nrow(sim$warnings), 100)
  expect_equal(sim$results$sim_uid[1:5], c(1:5))
  expect_equal(sim$results$level_id[1:5], rep(1,5))
  expect_equal(sim$results$rep_id[1:5], c(1:5))
  expect_equal(sim$warnings$sim_uid[1:5], c(1:5))
  expect_equal(sim$warnings$level_id[1:5], rep(1,5))
  expect_equal(sim$warnings$rep_id[1:5], c(1:5))
})



# Some errors

sim <- new_sim()

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

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

msg <- capture_messages(
  sim %<>% run()
)

pct_error <- nrow(sim$errors)

test_that("run() behaves correctly; some errors", {
  expect_equal(msg, paste0("Done. Errors detected in ", pct_error, "% of simulation replicates. Warnings detected in 0% of simulation replicates.\n\n"))
  expect_type(sim$results, "list")
  expect_type(sim$errors, "list")
  expect_equal(substring(sim$errors[1,"message"], 1, 14), "Lapack routine")
  expect_equal(sim$errors[1,"call"], "solve.default(x)")
})



# All errors

sim <- new_sim()

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

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

msg <- capture_messages(
  sim %<>% run()
)

test_that("run() behaves correctly; all errors", {
  expect_equal(msg, "Done. Errors detected in 100% of simulation replicates. Warnings detected in 0% of simulation replicates.\n\n")
  expect_type(sim$results, "character")
  expect_type(sim$errors, "list")
  expect_equal(substring(sim$errors[1,"message"], 1, 14), "Lapack routine")
  expect_equal(sim$errors[1,"call"], "solve.default(x)")
})

# stop at error

sim <- new_sim()

sim %<>% set_script(
  function() {
    stop('Stop_at_error test triggered.')
    return (list("x"=1))
  }
)

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

# Can't run a sim twice
sim <- new_sim()
sim %<>% set_script(function() { return(list(x=1)) })
sim %<>% run()
test_that("Can't run a simulation twice", {
  expect_error(run(sim), paste0("This simulation has already been run; use upd",
                                "ate_sim\\(\\) to add or remove replicates"))
})

# !!!!! For some reason, this test works when run manually but doesn't work
#       when run with SHFT+CTRL+T
# test_that("stop_at_error config option works", {
#   expect_error(run(sim), "Stop_at_error test triggered.")
# })

# Disallowed names (levels)
sim <- new_sim()
test_that("Disalllowed names (levels)", {
  expect_error(
    set_levels(sim, a=c(1,2), level_id=c(3,4)),
    "You cannot have a level named `level_id`."
  )
  expect_error(
    set_levels(sim, batch_id=c(1,2), level_id=c(3,4)),
    "You cannot have a level named `batch_id`."
  )
  expect_error(
    set_levels(sim, level_id=c(1,2), batch_id=c(3,4)),
    "You cannot have a level named `level_id`."
  )
})

# Disallowed names (return values)
sim <- new_sim()
sim %<>% set_levels(a=c(1,2), b=c(3,4))
test_that("Disalllowed names (return values)", {
  expect_error(
    { sim %<>% set_script(function(){return(list(runtime=1))}); run(sim); },
    paste0("Your simulation script cannot return a key-value pair with the key",
           " `runtime`.")
  )
  expect_error(
    {
      sim %<>% set_script(function(){return(list(x=1, level_id=1, y=2))})
      run(sim)
    },
    paste0("Your simulation script cannot return a key-value pair with the key",
           " `level_id`.")
  )
})