address comments

R/tmb-methods.R

@@ -83,7 +83,7 @@ predict.mmrm_tmb <- function(object,
   newdata <- h_factor_ref_data(
     newdata,
     object$tmb_data$full_frame,
-    h_mmrm_vars(object$formula_parts)
+    object$formula_parts$model_var
   )
   tmb_data <- h_mmrm_tmb_data(
     object$formula_parts, newdata,
@@ -618,7 +618,7 @@ simulate.mmrm_tmb <- function(object,
   newdata <- h_factor_ref_data(
     newdata,
     object$tmb_data$full_frame,
-    h_mmrm_vars(object$formula_parts)
+    object$formula_parts$model_var
   )
   tmb_data <- h_mmrm_tmb_data(
     object$formula_parts, newdata,

R/tmb.R

@@ -18,6 +18,7 @@
 #' - `subject_var`: `string` with the subject variable name.
 #' - `group_var`: `string` with the group variable name. If no group specified,
 #'   this element is `NULL`.
+#' - `model_var`: `character` with the variables names of the formula, except `subject_var`.
 #'
 #' @keywords internal
 h_mmrm_tmb_formula_parts <- function(
@@ -37,7 +38,8 @@ h_mmrm_tmb_formula_parts <- function(
       is_spatial = covariance$type == "sp_exp",
       visit_var = covariance$visits,
       subject_var = covariance$subject,
-      group_var = if (length(covariance$group) < 1) NULL else covariance$group
+      group_var = if (length(covariance$group) < 1) NULL else covariance$group,
+      model_var = setdiff(all.vars(formula[[3]]), covariance$subject)
     ),
     class = "mmrm_tmb_formula_parts"
   )
@@ -135,10 +137,7 @@ h_mmrm_tmb_data <- function(formula_parts,
   # Weights is always the last column.
   weights_name <- colnames(data)[ncol(data)]
   # If `y` is allowed to be NA, then first replace y with 1:n, then replace it with original y.
-  if (allow_na_response) {
-    y_original <- eval(formula_parts$full_formula[[2]], envir = data)
-    vn <- deparse(formula_parts$full_formula[[2]])
-  } else {
+  if (!allow_na_response) {
     h_warn_na_action()
   }
   full_frame <- eval(
@@ -153,7 +152,8 @@ h_mmrm_tmb_data <- function(formula_parts,
     full_frame <- droplevels(full_frame, except = formula_parts$visit_var)
   }
   if (allow_na_response) {
-    keep_ind <- complete.cases(full_frame[, colnames(full_frame) != vn])
+    # response is always the first column
+    keep_ind <- complete.cases(full_frame[, -1L, drop = FALSE])
   } else {
     keep_ind <- complete.cases(full_frame)
   }

R/utils.R

@@ -351,16 +351,6 @@ h_factor_ref_data <- function(x, ref, vars) {
   x
 }
 
-#' Obtain Right Hand Side Variables of `mmrm_tmb_formula_parts` Object
-#'
-#' @param object (`mmrm_tmb_formula_parts`)\cr object.
-#'
-#' @keywords internal
-h_mmrm_vars <- function(object) {
-  assert_class(object, "mmrm_tmb_formula_parts")
-  setdiff(all.vars(object$formula[[3]]), object$subject_var)
-}
-
 #' Warn on na.action
 #' @keywords internal
 h_warn_na_action <- function() {

tests/testthat/test-tmb.R

@@ -35,7 +35,8 @@ test_that("h_mmrm_tmb_formula_parts works as expected", {
       is_spatial = FALSE,
       visit_var = "AVISIT",
       subject_var = "USUBJID",
-      group_var = NULL
+      group_var = NULL,
+      model_var = c("RACE", "SEX", "ARMCD", "AVISIT")
     ),
     class = "mmrm_tmb_formula_parts"
   )
@@ -53,7 +54,8 @@ test_that("h_mmrm_tmb_formula_parts works as expected", {
       is_spatial = FALSE,
       visit_var = "AVISIT",
       subject_var = "USUBJID",
-      group_var = "ARMCD"
+      group_var = "ARMCD",
+      model_var = c("RACE", "SEX", "ARMCD", "AVISIT")
     ),
     class = "mmrm_tmb_formula_parts"
   )
@@ -115,7 +117,8 @@ test_that("h_mmrm_tmb_formula_parts works without covariates", {
       is_spatial = FALSE,
       visit_var = "AVISIT",
       subject_var = "USUBJID",
-      group_var = NULL
+      group_var = NULL,
+      model_var = c("AVISIT")
     ),
     class = "mmrm_tmb_formula_parts"
   )
@@ -135,7 +138,8 @@ test_that("h_mmrm_tmb_formula_parts works as expected for antedependence", {
       is_spatial = FALSE,
       visit_var = "AVISIT",
       subject_var = "USUBJID",
-      group_var = NULL
+      group_var = NULL,
+      model_var = c("RACE", "SEX", "ARMCD", "AVISIT")
     ),
     class = "mmrm_tmb_formula_parts"
   )

tests/testthat/test-utils.R

@@ -330,11 +330,3 @@ test_that("emp_start works", {
     h_get_theta_from_cov(emp_mat)
   )
 })
-
-# h_mmrm_vars ----
-
-test_that("h_mmrm_vars works", {
-  fit <- get_mmrm()
-  expect_silent(v <- h_mmrm_vars(fit$formula_parts))
-  expect_identical(v, c("RACE", "SEX", "ARMCD", "AVISIT"))
-})