bug fix for Jackknife.

test fixes.

R/SIDR_Ravinew.R

@@ -21,7 +21,8 @@ SIDR_Ravinew <- function(X, Y,
     }else
     {
         initial <- as.vector(initial)
-        initial <- initial/initial[1]
+        if(initial[1] != 0)
+            initial <- initial/initial[1]
     }
 
     if (is.null(bandwidth))

R/jackknife.R

@@ -17,8 +17,7 @@ cross_validate <- function(original.object, progress = interactive()){
                 alpha = original.object$alpha,
                 intensity.covariates = attr(original.object$intensity.model, 'additional.covariates'),
                 outcome.covariates = attr(original.object$outcome.model, 'additional.covariates'),
-                End = original.object$End,
-                control = original.object$control
+                End = original.object$End
             ) |>
             prune_bootstrap_replication()
     }

R/sim_outcome_modeler.R

@@ -2,16 +2,17 @@
 #'
 #' @param formula The outcome model formula
 #' @param data The data to fit the outcome model to.
+#'             Should only include follow-up data, i.e. time > 0.
 #' @param kernel The kernel to use for the outcome model.
 #' @param method The optimization method to use for the outcome model, either "optim", "nlminb", or "nmk".
 #' @param ... Currently ignored, included for future compatibility.
 #'
 #' @return Object of class `PCORI::Single-index-outcome-model` which contains the outcome model portion.
 #' @export
 PCORI_sim_outcome_modeler <-
-function(formula, data, kernel = "K2_Biweight", method = "nmk", ...){
-  fu.data <- filter(data, ..time.. > 0)
-  mf <- model.frame(formula, data = fu.data, id = ..id..)
+function(formula, data, kernel = "K2_Biweight", method = "nmk", id = ..id.., ...){
+  id <- ensym(id)
+  mf <- rlang::inject(model.frame(formula, data = data, id = !!id))
   Xi <- model.matrix(formula, data = mf)
 
   Yi <- model.response(mf)
@@ -47,11 +48,15 @@ function(formula, data, kernel = "K2_Biweight", method = "nmk", ...){
 `model.matrix.PCORI::Single-index-outcome-model` <-
     function(object, data = model.frame(object), ...){
         model.matrix(terms(object), data = data, ...)
-    }#' @export
+    }
+#' @export
 `formula.PCORI::Single-index-outcome-model` <-
     function(x, ...){
         as.formula(terms(x))
     }
+#' @export
+`coef.PCORI::Single-index-outcome-model` <-
+    function(x, ...)x$coef
 
 #' @export
 `predict.PCORI::Single-index-outcome-model` <-

tests/testthat/test-influence_term1.R

@@ -27,6 +27,7 @@ test_that("Compute Influence term1 old vs. new methods", {
             ns(prev_outcome, df=3) +
             scale(Time) +
             scale(delta_time) - 1,
+        id = Subject_ID,
         data = followup.data)
 
 

tests/testthat/test-influence_term2.R

@@ -27,6 +27,7 @@ test_that("Compute Influence term2 old vs. new methods", {
             ns(prev_outcome, df=3) +
             scale(Time) +
             scale(delta_time) - 1,
+            id = Subject_ID,
         data = followup.data)