more testing for reveal, custom estimator, estimator_handler

R/declare_potential_outcomes.R

@@ -9,6 +9,7 @@
 #' @export
 #'
 #'
+#'
 #' @details
 #'
 #' A `declare_potential_outcomes` declaration returns a function. That function takes data and returns data with potential outcomes columns appended. These columns describe the outcomes that each unit would express if that unit were in the corresponding treatment condition.

R/reveal_outcomes.R

@@ -72,21 +72,24 @@ validation_fn(reveal_outcomes) <- function(ret, dots, label) {
 
 switching_equation <- function(data, outcome, assignment) {
 
-  R <- 1:nrow(data)
 
   potential_outcome_columns <- paste(outcome, assignment, data[[assignment]], sep = "_")
 
-  data <- data[ , unique(potential_outcome_columns), drop=FALSE]
-
-  C <- match(potential_outcome_columns, colnames(data))
+  upoc <- unique(potential_outcome_columns)
 
-  if(anyNA(C)) {
+  if(!(all(upoc %in% colnames(data)))){
     stop(
-      "You did not provide all the potential outcomes columns required to draw the outcome: ", outcome, ".\n",
-      paste("  * ", unique(potential_outcome_columns[is.na(C)], collapse="\n"))
+      "Must provide all potential outcomes columns referenced by the assignment variable (", assignment, ").\n",
+      "`data` did not include:\n",
+      paste("  * ", sort(setdiff(upoc, colnames(data))), collapse="\n")
     )
   }
 
+  data <- data[ , upoc, drop=FALSE]
+
+  R <- 1:nrow(data)
+  C <- match(potential_outcome_columns, colnames(data))
+
   data[cbind(R,C)]
 
 }

tests/testthat/test-diagnosands.R

@@ -20,11 +20,11 @@ my_design <- declare_design(my_population(),
 
 
 test_that("parallel works.", {
-  skip("Parallel tests only pass locally - check --as-cran auto fails any test that forks")
 
 
-  diag <- diagnose_design(my_design, sims = 2, bootstrap = FALSE, parallel = TRUE)
-
+  suppressWarnings(
+    diag <- diagnose_design(my_design, sims = 2, bootstrap = FALSE, parallel = TRUE, parallel_cores = 1)
+  )
   ## diagnose_design(my_design, sims = 2, bootstrap = FALSE, parallel = TRUE)
 
   expect_output(print(diag), regexp = "Research design diagnosis")

tests/testthat/test-estimators.R

@@ -238,3 +238,17 @@ test_that("default estimator handler validation fn", {
   expect_error(declare_estimator(model=I))
 })
 
+test_that("custom_estimator, handler does not take data", {
+  expect_error(custom_estimator(I), "function with a data argument")
+})
+
+test_that("estimator_handler runs directly", {
+
+  golden <- structure(list(coefficient_name = "group2", est = 1.58, se = 0.849091017238762,
+  p = 0.0791867142159381, ci_lower = -0.203874032287599, ci_upper = 3.3638740322876), .Names = c("coefficient_name",
+                                                                                                                "est", "se", "p", "ci_lower", "ci_upper"), row.names = 2L, class = "data.frame")
+
+  result <- estimator_handler(sleep, extra~group, model=lm, coefficient_name = "group2")
+
+  expect_equal(result, golden)
+})

tests/testthat/test-reveal-outcomes.R

@@ -117,5 +117,14 @@ test_that("missing PO stops",{
   )
 })
 
+test_that("Not all Potential outcome columns present",{
+
+  df <- data.frame(Z=sample(1:3, 100, replace=TRUE), Y_Z_0=1:100, Y_Z_1=1:100)
+
+  expect_error(
+    reveal_outcomes(df),
+    "Y_Z_3"
+  )
+})