Merge branch 'quosure-passthrough-tests' of https://github.com/topepo/parsnip into quosure-passthrough-tests

Author: topepo

tests/testthat/test_surv_reg_flexsurv.R

@@ -13,15 +13,17 @@ ctrl <- fit_control(verbosity = 1, catch = FALSE)
 caught_ctrl <- fit_control(verbosity = 1, catch = TRUE)
 quiet_ctrl <- fit_control(verbosity = 0, catch = TRUE)
 
+# ------------------------------------------------------------------------------
+
 test_that('flexsurv execution', {
   skip_if_not_installed("flexsurv")
-  
+
   library(flexsurv)
   data(bc)
-  
+
   set.seed(4566)
   bc$group2 <- bc$group
-  
+
   expect_error(
     res <- fit(
       surv_basic,
@@ -52,3 +54,25 @@ test_that('flexsurv execution', {
     )
   )
 })
+
+test_that('flexsurv prediction', {
+  skip_if_not_installed("flexsurv")
+
+  library(flexsurv)
+  data(bc)
+
+  set.seed(4566)
+  bc$group2 <- bc$group
+
+  res <- fit(
+    surv_basic,
+    Surv(recyrs, censrec) ~ group,
+    data = bc,
+    control = ctrl,
+    engine = "flexsurv"
+  )
+  exp_pred <- summary(res$fit, head(bc), type = "mean")
+  exp_pred <- do.call("rbind", unclass(exp_pred))
+  exp_pred <- tibble(.pred = exp_pred$est)
+  expect_equal(exp_pred, predict(res, head(bc)))
+})

tests/testthat/test_surv_reg_survreg.R

@@ -1,7 +1,7 @@
 library(testthat)
 library(parsnip)
-library(rlang)
 library(survival)
+library(tibble)
 
 # ------------------------------------------------------------------------------
 
@@ -15,6 +15,8 @@ ctrl <- fit_control(verbosity = 1, catch = FALSE)
 caught_ctrl <- fit_control(verbosity = 1, catch = TRUE)
 quiet_ctrl <- fit_control(verbosity = 0, catch = TRUE)
 
+# ------------------------------------------------------------------------------
+
 test_that('survival execution', {
 
   expect_error(
@@ -47,3 +49,29 @@ test_that('survival execution', {
     )
   )
 })
+
+test_that('survival prediction', {
+
+  res <- fit(
+    surv_basic,
+    Surv(time, status) ~ age + sex,
+    data = lung,
+    control = ctrl,
+    engine = "survreg"
+  )
+  exp_pred <- predict(res$fit, head(lung))
+  exp_pred <- tibble(.pred = unname(exp_pred))
+  expect_equal(exp_pred, predict(res, head(lung)))
+
+  exp_quant <- predict(res$fit, head(lung), p = (2:4)/5, type = "quantile")
+  exp_quant <-
+    apply(exp_quant, 1, function(x)
+      tibble(.pred = x, .quantile = (2:4) / 5))
+  exp_quant <- tibble(.pred = exp_quant)
+  obs_quant <- predict(res, head(lung), type = "quantile", quantile = (2:4)/5)
+
+  expect_equal(as.data.frame(exp_quant), as.data.frame(obs_quant))
+
+})
+
+