Merge pull request #47 from RaphaelS1/parametric

fixbug
RaphaelS1 · Mar 9, 2024 · f418791 · f418791
2 parents 0344750 + 92f4337
commit f418791
Show file tree

Hide file tree

Showing 2 changed files with 17 additions and 1 deletion.
diff --git a/R/parametric.R b/R/parametric.R
@@ -31,8 +31,15 @@ parametric <- function(
   call <- match.call()
 
   data <- clean_train_data(formula, data, time_variable, status_variable, x, y, reverse)
+  olddata <- data.frame(data$x, data$y)
+  # HACKY MESS
+  form <- as.formula(sprintf(
+    "survival::Surv(%s) ~ %s",
+    paste0(colnames(data$y), collapse = ","),
+    paste0(colnames(data$x), collapse = "+")
+  ))
+  fit <- survival::survreg(form, olddata, x = TRUE, ...)
 
-  fit <- survival::survreg(survival::Surv(data$y) ~ data$x, x = TRUE, ...)
 
   location <- as.numeric(fit$coefficients[1])
 

diff --git a/tests/testthat/test_parametric.R b/tests/testthat/test_parametric.R
@@ -120,3 +120,12 @@ test_that("discrete = continuous when expected", {
   expect_equal(s_cont, t(p_disc$surv))
   }
 })
+
+test_that("fix formula bug", {
+  lung2 = survival::lung
+  lung2$status = lung2$status - 1
+  lung2 = lung2[-14, c("time", "status", "ph.ecog")]
+
+  fit = parametric(data = lung2, time_variable = "time", status_variable = "status")
+  expect_silent(predict(fit, newdata = lung2, form = "aft"))
+})