Bug fix for when specifying model modifications.

UofUEpiBio · Nov 22, 2024 · f4c7a85 · f4c7a85
1 parent 1150c45
commit f4c7a85
Show file tree

Hide file tree

Showing 2 changed files with 33 additions and 19 deletions.
diff --git a/R/PCORI_within_group_model.R b/R/PCORI_within_group_model.R
@@ -67,7 +67,7 @@ fit_SensIAT_within_group_model <- function(
         influence.args = list(),
         spline.degree = 3
 ){
-    ##### Input clean and capture -------------------------------------------
+    ###### Input clean and capture -------------------------------------------
     # Variables
     id.var <- ensym(id)
     outcome.var <- ensym(outcome)
@@ -95,32 +95,27 @@ fit_SensIAT_within_group_model <- function(
 
     # Pass through Argument Lists
     intensity.args <- match.names(intensity.args, c("model.modifications", 'bandwidth'), FALSE)
-    outcome.args <- match.names(outcome.args, c("model.modifications"))
+    outcome.args   <- match.names(outcome.args  , c("model.modifications"))
     influence.args <- match.names(influence.args, c("tolerance"))
 
     # Function
     outcome_modeler <- match.fun(outcome_modeler)
     if(is.null(End)){
         End <- rlang::eval_tidy( max({{time.var}}, na.rm = TRUE) + 1, data = group.data, env =parent.frame())
     }
-    # Create usable data
-    mf <- rlang::inject(
-            !!outcome.var ~ !!id.var + !!time.var +
-            !!(rlang::f_rhs(intensity.args$model.modifications %||% ~.)) +
-            !!(rlang::f_rhs(outcome.args$model.modifications %||% ~.))
-        ) |>
-        model.frame(data=filter(group.data, (!!time.var) <= !!End), na.action = na.pass) |>
-        arrange(!!id.var, !!time.var)
-
-
-
-    group.data2 <- filter(group.data, !!time.var <= End)
-
-    u_hv <- group.data2 |> select(!!id.var) |> distinct() |> pull()
-    N <- pull(summarize(group.data2, n_distinct(!!id.var)))
-
-
 
+    ###### Create Model Frame -----------------------------------------------
+    outcome.extra.vars <- all.vars(outcome.args$model.modifications) |>
+        setdiff(c('..id..', '..time..', '..prev_outcome..', '..delta_time..', '..visit_number..', '..outcome..'))
+    intensity.extra.vars <- all.vars(intensity.args$model.modifications) |>
+        setdiff(c('..id..', '..time..', '..prev_outcome..', '..delta_time..', '..visit_number..', '..outcome..'))
+
+    mf <- group.data |>
+        filter((!!time.var) <= !!End) |>
+        select(!!id.var, !!time.var, !!outcome.var,
+               any_of(outcome.extra.vars),
+               any_of(intensity.extra.vars)) |>
+        arrange(!!id.var, !!time.var)
 
     data_all_with_transforms <- mf |>
         rename(
@@ -146,6 +141,7 @@ fit_SensIAT_within_group_model <- function(
         ) |>
         ungroup()
 
+
     ######   Andersen-Gill model stratifying by assessment number ------
     ######   Intensity model  ##################################################
     #' @section Intensity Arguments:

diff --git a/tests/testthat/test-PCORI_within_group_model.R b/tests/testthat/test-PCORI_within_group_model.R
@@ -0,0 +1,18 @@
+test_that("Altering models", {
+    model <-
+        fit_SensIAT_within_group_model(
+            group.data = SensIAT_example_data,
+            outcome_modeler = SensIAT_sim_outcome_modeler,
+            alpha = c(-0.6, -0.3, 0, 0.3, 0.6),
+            id = Subject_ID,
+            outcome = Outcome,
+            time = Time,
+            End = 830,
+            knots = c(60,260,460),
+            outcome.args = list(
+                model=~ns(..prev_outcome.., knots=c(9/6, 16/6)) + scale(..delta_time..)
+            )
+        )
+    model$models$outcome |> formula() |>
+    expect_equal(..outcome..~ns(..prev_outcome.., knots=c(9/6, 16/6)) + scale(..delta_time..), ignore_attr=TRUE)
+})