fix for formula only using subset of data

R/check_formula.R

@@ -0,0 +1,9 @@
+
+#
+check_formula <- function(formula) {
+
+  if (!"trt" %in% attr(terms(formula), "term.labels"))
+    stop("Treatment term, trt, is missing in the formula")
+
+  invisible()
+}

R/maic.R

@@ -47,7 +47,6 @@ maic_weights <- function(X_EM) {
 #' @keywords internal
 #' 
 maic.boot <- function(ipd, indices, formula, ald) {
-
   dat <- ipd[indices, ]  # bootstrap sample
 
   effect_modifier_names <- get_effect_modifiers(formula)
@@ -58,6 +57,7 @@ maic.boot <- function(ipd, indices, formula, ald) {
   # BC effect modifier means, assumed fixed
   mean_names <- get_mean_names(ald, effect_modifier_names)
 
+  browser()
   # centre AC effect modifiers on BC means
   dat_ALD_means <- ald[, mean_names][rep(1, nrow(X_EM)), ]
   X_EM <- X_EM - dat_ALD_means

R/mimR.R

@@ -47,8 +47,18 @@ mimR <- function(AC.IPD, BC.ALD, strategy, CI = 0.95, ...) {
   if (!inherits(strategy, "strategy"))
     stop("strategy argument must be of a class strategy.")
 
-  AC_mimR <- IPD_stats(strategy, ipd = AC.IPD, ald = BC.ALD, ...) 
-  BC_mimR <- ALD_stats(ald = BC.ALD) 
+  # select data according to formula
+  ipd <- model.frame(strategy$formula, data = AC.IPD)
+
+  term.labels <- attr(terms(strategy$formula), "term.labels")
+  mean_names <- paste0("mean.", term.labels)
+  sd_names <- paste0("sd.", term.labels)
+  keep_names <- c(mean_names, sd_names,
+                  "y.B.sum", "y.B.bar", "N.B", "y.C.sum", "y.C.bar", "N.C")
+  ald <- BC.ALD[keep_names]
+
+  AC_mimR <- IPD_stats(strategy, ipd = ipd, ald = ald, ...) 
+  BC_mimR <- ALD_stats(ald = ald) 
 
   upper <- 0.5 + CI/2
   ci_range <- c(1-upper, upper)

R/strategy_.R

@@ -37,6 +37,8 @@ strategy_maic <- function(formula = as.formula("y ~ X3 + X4 + trt*X1 + trt*X2"),
                           R = 1000) {
   if (class(formula) != "formula")
     stop("formula argument must be of formula class.")
+  browser()
+  check_formula(formula)
 
   default_args <- formals()
   args <- as.list(match.call())[-1]
@@ -76,6 +78,8 @@ strategy_stc <- function(formula =
   if (class(formula) != "formula")
     stop("formula argument must be of formula class.")
 
+  check_formula(formula)
+
   default_args <- formals()
   args <- as.list(match.call())[-1]
   args <- modifyList(default_args, args)

tests/testthat/test-mimR.R

@@ -14,37 +14,40 @@ test_that("mimR errors", {
 #
 test_that("different combinations of covariates in formula", {
 
-  # # maic
-  # strat_none <- strategy_maic(formula = as.formula("y ~ ."))
-  # strat_1 <- strategy_maic(formula = as.formula("y ~ X3 + X4 + trt*X1 + trt*X2"))
-  # strat_2 <- strategy_maic(formula = as.formula("y ~ X3 + X4 + X5 + trt*X1"))
-  # strat_no_trt <- strategy_maic(formula = as.formula("y ~ X3 + X4"))
-  # strat_31 <- strategy_maic(formula = as.formula("y ~ X3 + trt*X1"))
-  # strat_32 <- strategy_maic(formula = as.formula("y ~ trt*X1 + X3"))
-  # strat_no_X1 <- strategy_maic(formula = as.formula("y ~ trt*X1"))
-  # 
-  # expect_equal(mimR(AC.IPD, BC.ALD, strategy = strat_none))
-  # expect_equal(mimR(AC.IPD, BC.ALD, strategy = strat_1))
-  # expect_equal(mimR(AC.IPD, BC.ALD, strategy = strat_2))
-  # expect_equal(mimR(AC.IPD, BC.ALD, strategy = strat_no_trt))
-  # expect_equal(mimR(AC.IPD, BC.ALD, strategy = strat_31))
-  # expect_equal(mimR(AC.IPD, BC.ALD, strategy = strat_32))
-  # expect_equal(mimR(AC.IPD, BC.ALD, strategy = strat_no_X1))
-  # 
-  # # stc
-  # strat_none <- strategy_stc(formula = as.formula("y ~ ."))
-  # strat_1 <- strategy_stc(formula = as.formula("y ~ X3 + X4 + trt*X1 + trt*X2"))
-  # strat_2 <- strategy_stc(formula = as.formula("y ~ X3 + X4 + X5 + trt*X1"))
-  # strat_no_trt <- strategy_stc(formula = as.formula("y ~ X3 + X4"))
-  # strat_31 <- strategy_stc(formula = as.formula("y ~ X3 + trt*X1"))
-  # strat_32 <- strategy_stc(formula = as.formula("y ~ trt*X1 + X3"))
-  # strat_no_X1 <- strategy_stc(formula = as.formula("y ~ trt*X1"))
-  # 
-  # expect_equal(mimR(AC.IPD, BC.ALD, strategy = strat_none))
-  # expect_equal(mimR(AC.IPD, BC.ALD, strategy = strat_1))
-  # expect_equal(mimR(AC.IPD, BC.ALD, strategy = strat_2))
-  # expect_equal(mimR(AC.IPD, BC.ALD, strategy = strat_no_trt))
-  # expect_equal(mimR(AC.IPD, BC.ALD, strategy = strat_31))
-  # expect_equal(mimR(AC.IPD, BC.ALD, strategy = strat_32))
-  # expect_equal(mimR(AC.IPD, BC.ALD, strategy = strat_no_X1))
+  load(test_path("testdata/BC_ALD.RData"))
+  load(test_path("testdata/AC_IPD.RData"))
+
+  # maic
+  expect_error(strategy_maic(formula = as.formula("y ~ 1")),
+               regexp = "Treatment term, trt, is missing in the formula")
+
+  expect_error(strategy_maic(formula = as.formula("y ~ X3 + X4")),
+               regexp = "Treatment term, trt, is missing in the formula")
+
+  strat_1234 <- strategy_maic(formula = as.formula("y ~ X3 + X4 + trt*X1 + trt*X2"))
+  strat_31 <- strategy_maic(formula = as.formula("y ~ X3 + trt*X1"))
+  strat_13 <- strategy_maic(formula = as.formula("y ~ trt*X1 + X3"))
+  strat_1 <- strategy_maic(formula = as.formula("y ~ trt*X1"))
+
+  expect_length(mimR(AC_IPD, BC_ALD, strategy = strat_1234), 3)
+  expect_equal(mimR(AC_IPD, BC_ALD, strategy = strat_31))
+  expect_equal(mimR(AC_IPD, BC_ALD, strategy = strat_13))
+  expect_equal(mimR(AC_IPD, BC_ALD, strategy = strat_1))
+
+  # stc
+  expect_error(strategy_stc(formula = as.formula("y ~ 1")),
+               regexp = "Treatment term, trt, is missing in the formula")
+
+  expect_error(strategy_stc(formula = as.formula("y ~ X3 + X4")),
+               regexp = "Treatment term, trt, is missing in the formula")
+
+  strat_1234 <- strategy_stc(formula = as.formula("y ~ X3 + X4 + trt*X1 + trt*X2"))
+  strat_31 <- strategy_stc(formula = as.formula("y ~ X3 + trt*X1"))
+  strat_13 <- strategy_stc(formula = as.formula("y ~ trt*X1 + X3"))
+  strat_1 <- strategy_stc(formula = as.formula("y ~ trt*X1"))
+
+  expect_equal(mimR(AC_IPD, BC_ALD, strategy = strat_1234))
+  expect_equal(mimR(AC_IPD, BC_ALD, strategy = strat_31))
+  expect_equal(mimR(AC_IPD, BC_ALD, strategy = strat_13))
+  expect_equal(mimR(AC_IPD, BC_ALD, strategy = strat_1))
 })