brm_data() test and brm_formula()

R/brm_data.R

@@ -106,6 +106,10 @@ brm_data_validate <- function(data) {
   assert_col(time, data)
   assert_col(patient, data)
   assert_col(covariates, data)
+  assert(
+    is.numeric(data[[outcome]]),
+    message = "outcome variable in the data must be numeric."
+  )
   for (column in c(base, group, time, patient, covariates)) {
     assert(
       !anyNA(data[[column]]),

R/brm_formula.R

@@ -5,18 +5,7 @@
 #' @return An object of class `"brmsformula"` returned from
 #'   `brms::brmsformula()`. It contains the fixed effect parameterization,
 #'   correlation structure, and residual variance structure.
-#' @param response Character of length 1, name of the response variable
-#'   in the data.
-#' @param group Character of length 1, name of the treatment group
-#'   variable in the data.
-#' @param base Character of length 1, name of the baseline response variable
-#'   in the data.
-#' @param time Character of length 1, name of the discrete time variable
-#'   in the data.
-#' @param patient Character of length 1, name of the patient ID variable
-#'   in the data.
-#' @param covariates Character vector of names of other covariates
-#'   in the data.
+#' @param data A classed data frame from [brm_data()].
 #' @param correlation Character of length 1, name of the correlation
 #'   structure. Only `"unstructured"` is currently supported.
 #' @param intercept `TRUE` to include an intercept, `FALSE` to omit.
@@ -31,20 +20,25 @@
 #' @param interaction_group `TRUE` to include treatment-group-by-time
 #'   interaction, `FALSE` to omit.
 #' @examples
-#' brm_formula()
-#' brm_formula(intercept = FALSE, effect_base = FALSE)
+#' set.seed(0)
+#' data <- brm_data(
+#'   data = tibble::as_tibble(brm_simulate()$data),
+#'   outcome = "response",
+#'   role = "response",
+#'   group = "group",
+#'   time = "time",
+#'   patient = "patient"
+#' )
+#' brm_formula(data)
+#' brm_formula(data = data, intercept = FALSE, effect_base = FALSE)
 #' brm_formula(
+#'   data = data,
 #'   intercept = FALSE,
 #'   effect_base = FALSE,
 #'   interaction_group = FALSE
 #' )
 brm_formula <- function(
-  response = "CHG",
-  base = "BASE",
-  group = "TRT01P",
-  time = "AVISIT",
-  patient = "USUBJID",
-  covariates = character(0),
+  data,
   intercept = TRUE,
   effect_base = TRUE,
   effect_group = TRUE,
@@ -53,12 +47,7 @@ brm_formula <- function(
   interaction_group = TRUE,
   correlation = "unstructured"
 ) {
-  assert_chr(response, "response arg must be a nonempty character string")
-  assert_chr(base, "base arg must be a nonempty character string")
-  assert_chr(group, "group arg must be a nonempty character string")
-  assert_chr(time, "time arg must be a nonempty character string")
-  assert_chr(patient, "patient arg must be a nonempty character string")
-  assert_chr_vec(covariates, "covariates arg must be a character vector")
+  brm_data_validate(data)
   assert_lgl(intercept)
   assert_lgl(effect_group)
   assert_lgl(effect_time)
@@ -77,18 +66,25 @@ brm_formula <- function(
       paste(correlations, collapse = ", ")
     )
   )
+  outcome <- attr(data, "outcome")
+  role <- attr(data, "role")
+  base <- attr(data, "base")
+  group <- attr(data, "group")
+  time <- attr(data, "time")
+  patient <- attr(data, "patient")
+  covariates <- attr(data, "covariates")
   terms <- c(
     term("0", !intercept),
     term(time, effect_time),
-    term(base, effect_base),
-    term(paste0(base, ":", time), interaction_base),
+    term(base, effect_base && !is.null(base)),
+    term(paste0(base, ":", time), interaction_base && !is.null(base)),
     term(group, effect_group),
     term(paste0(group, ":", time), interaction_group),
     covariates,
     term_correlation(correlation, time, patient)
   )
   right <- paste(terms, collapse = " + ")
-  formula <- stats::as.formula(paste(response, "~", right))
+  formula <- stats::as.formula(paste(outcome, "~", right))
   formula_sigma <- stats::as.formula(paste("sigma ~ 0 +", time))
   brms::brmsformula(formula = formula, formula_sigma)
 }

tests/testthat/test-brm_data.R

@@ -0,0 +1,101 @@
+test_that("brm_data() good", {
+  set.seed(0)
+  sim <- brm_simulate()
+  data <- tibble::as_tibble(sim$data)
+  data$factor1 <- data$patient
+  data$factor2 <- data$patient
+  data$factor3 <- data$patient
+  colnames(data) <- paste0("col_", colnames(data))
+  data <- data[- c(2L, 3L), ]
+  data <- data[sample.int(n = nrow(data)), ]
+  out <- brm_data(
+    data = data,
+    outcome = "col_response",
+    role = "response",
+    group = "col_group",
+    time = "col_time",
+    patient = "col_patient",
+    covariates = c("col_factor2", "col_factor3")
+  )
+  expect_s3_class(out, "brm_data")
+  expect_true(tibble::is_tibble(out))
+  expect_silent(brm_data_validate(out))
+  expect_true(all(is.na(out$col_response[c(2L, 3L)])))
+  expect_false(anyNA(out$col_response[- c(2L, 3L)]))
+  expect_equal(nrow(out), 800L)
+  expect_equal(
+    sort(colnames(out)),
+    sort(
+      c(
+        "col_patient",
+        "col_time",
+        "col_response",
+        "col_group",
+        "col_factor2",
+        "col_factor3"
+      )
+    )
+  )
+  expect_equal(
+    out$col_group,
+    as.factor(rep(c(1L, 2L), each = 400L))
+  )
+  expect_equal(
+    out$col_time,
+    as.factor(rep(seq_len(4L), times = 200L))
+  )
+  expect_equal(
+    sort(out$col_response[- c(2L, 3L)]),
+    sort(c(data$col_response))
+  )
+  expect_equal(out$col_patient, out$col_factor2)
+  expect_equal(out$col_patient, out$col_factor3)
+})
+
+test_that("brm_data() bad role", {
+  set.seed(0)
+  sim <- brm_simulate()
+  data <- tibble::as_tibble(sim$data)
+  data$factor1 <- data$patient
+  data$factor2 <- data$patient
+  data$factor3 <- data$patient
+  colnames(data) <- paste0("col_", colnames(data))
+  data <- data[- c(2L, 3L), ]
+  data <- data[sample.int(n = nrow(data)), ]
+  expect_error(
+    brm_data(
+      data = data,
+      outcome = "nope",
+      role = "response",
+      group = "col_group",
+      time = "col_time",
+      patient = "col_patient",
+      covariates = c("col_factor2", "col_factor3")
+    ),
+    class = "brm_error"
+  )
+})
+
+test_that("brm_data() bad group", {
+  set.seed(0)
+  sim <- brm_simulate()
+  data <- tibble::as_tibble(sim$data)
+  data$factor1 <- data$patient
+  data$factor2 <- data$patient
+  data$factor3 <- data$patient
+  colnames(data) <- paste0("col_", colnames(data))
+  data <- data[- c(2L, 3L), ]
+  data <- data[sample.int(n = nrow(data)), ]
+  expect_error(
+    brm_data(
+      data = data,
+      outcome = "col_response",
+      role = "response",
+      group = "nope",
+      time = "col_time",
+      patient = "col_patient",
+      covariates = c("col_factor2", "col_factor3")
+    ),
+    class = "brm_error"
+  )
+})