Merge pull request #265 from tidymodels/naming-insensitivity

Author: EmilHvitfeldt

tests/testthat/helper-objects.R

@@ -28,3 +28,10 @@ spark_not_installed <- function() {
   }
   need_install
 }
+
+# ------------------------------------------------------------------------------
+
+expect_ptype <- function(x, ptype) {
+  expect_equal(x[0, names(ptype)], ptype)
+}
+

tests/testthat/test-survival-augment.R

@@ -32,12 +32,17 @@ test_that("augmenting survival models", {
 
   sr_aug <- augment(sr_fit, new_data = sim_tr, eval_time = time_points)
   expect_equal(nrow(sr_aug), nrow(sim_tr))
-  expect_equal(names(sr_aug), c(".pred", ".pred_time", "event_time", "X1", "X2"))
+  expect_named(
+    sr_aug,
+    c(".pred", ".pred_time", "event_time", "X1", "X2"),
+    ignore.order = TRUE
+  )
   expect_true(is.list(sr_aug$.pred))
-  expect_equal(
-    names(sr_aug$.pred[[1]]),
+  expect_named(
+    sr_aug$.pred[[1]],
     c(".eval_time", ".pred_survival", ".weight_time", ".pred_censored",
-      ".weight_censored")
+      ".weight_censored"),
+    ignore.order = TRUE
   )
 
   # proportional_hazards() -----------------------------------------------------
@@ -49,12 +54,17 @@ test_that("augmenting survival models", {
 
   glmn_aug <- augment(glmn_fit, new_data = sim_tr, eval_time = time_points)
   expect_equal(nrow(glmn_aug), nrow(sim_tr))
-  expect_equal(names(glmn_aug), c(".pred", ".pred_time", "event_time", "X1", "X2"))
+  expect_named(
+    glmn_aug,
+    c(".pred", ".pred_time", "event_time", "X1", "X2"),
+    ignore.order = TRUE
+  )
   expect_true(is.list(glmn_aug$.pred))
-  expect_equal(
-    names(glmn_aug$.pred[[1]]),
+  expect_named(
+    glmn_aug$.pred[[1]],
     c(".eval_time", ".pred_survival", ".weight_time", ".pred_censored",
-      ".weight_censored")
+      ".weight_censored"),
+    ignore.order = TRUE
   )
 })
 
@@ -118,11 +128,16 @@ test_that("augment() works for tune_results", {
   )
 
   expect_equal(nrow(aug_res), nrow(sim_tr))
-  expect_equal(names(aug_res), c(".pred", ".pred_time", "event_time", "X1", "X2"))
+  expect_named(
+    aug_res,
+    c(".pred", ".pred_time", "event_time", "X1", "X2"),
+    ignore.order = TRUE
+  )
   expect_true(is.list(aug_res$.pred))
-  expect_equal(
-    names(aug_res$.pred[[1]]),
-    c(".eval_time", ".pred_survival", ".weight_censored")
+  expect_named(
+    aug_res$.pred[[1]],
+    c(".eval_time", ".pred_survival", ".weight_censored"),
+    ignore.order = TRUE
   )
 
   expect_no_warning(
@@ -172,11 +187,16 @@ test_that("augment() works for resample_results", {
   aug_res <- augment(rs_mixed_res)
 
   expect_equal(nrow(aug_res), nrow(sim_tr))
-  expect_equal(names(aug_res), c(".pred", ".pred_time", "event_time", "X1", "X2"))
+  expect_named(
+    aug_res,
+    c(".pred", ".pred_time", "event_time", "X1", "X2"),
+    ignore.order = TRUE
+  )
   expect_true(is.list(aug_res$.pred))
-  expect_equal(
-    names(aug_res$.pred[[1]]),
-    c(".eval_time", ".pred_survival", ".weight_censored")
+  expect_named(
+    aug_res$.pred[[1]],
+    c(".eval_time", ".pred_survival", ".weight_censored"),
+    ignore.order = TRUE
   )
 })
 
@@ -215,10 +235,15 @@ test_that("augment() works for last fit", {
   aug_res <- augment(rs_mixed_res)
 
   expect_equal(nrow(aug_res), nrow(sim_te))
-  expect_equal(names(aug_res), c(".pred", ".pred_time", "event_time", "X1", "X2"))
+  expect_named(
+    aug_res,
+    c(".pred", ".pred_time", "event_time", "X1", "X2"),
+    ignore.order = TRUE
+  )
   expect_true(is.list(aug_res$.pred))
-  expect_equal(
-    names(aug_res$.pred[[1]]),
-    c(".eval_time", ".pred_survival", ".weight_censored")
+  expect_named(
+    aug_res$.pred[[1]],
+    c(".eval_time", ".pred_survival", ".weight_censored"),
+    ignore.order = TRUE
   )
 })

tests/testthat/test-survival-fit-resamples.R

@@ -63,9 +63,10 @@ test_that("resampling survival models with static metric", {
   # test structure of results --------------------------------------------------
 
   expect_false(".eval_time" %in% names(rs_static_res$.metrics[[1]]))
-  expect_equal(
-    names(rs_static_res$.predictions[[1]]),
-    c(".pred_time", ".row", "event_time", ".config")
+  expect_named(
+    rs_static_res$.predictions[[1]],
+    c(".pred_time", ".row", "event_time", ".config"),
+    ignore.order = TRUE
   )
 
   # test metric collection -----------------------------------------------------
@@ -82,7 +83,7 @@ test_that("resampling survival models with static metric", {
     )
 
   expect_true(nrow(metric_sum) == 1)
-  expect_equal(metric_sum[0,], exp_metric_sum)
+  expect_ptype(metric_sum, exp_metric_sum)
   expect_true(all(metric_sum$.metric == "concordance_survival"))
 
   metric_all <- collect_metrics(rs_static_res, summarize = FALSE)
@@ -96,7 +97,8 @@ test_that("resampling survival models with static metric", {
     )
 
   expect_true(nrow(metric_all) == 10)
-  expect_equal(metric_all[0,], exp_metric_all)
+  expect_ptype(metric_all, exp_metric_all)
+
   expect_true(all(metric_all$.metric == "concordance_survival"))
 
   # test prediction collection -------------------------------------------------
@@ -110,11 +112,11 @@ test_that("resampling survival models with static metric", {
   )
 
   unsum_pred <- collect_predictions(rs_static_res)
-  expect_equal(unsum_pred[0,], static_ptype)
+  expect_ptype(unsum_pred, static_ptype)
   expect_equal(nrow(unsum_pred), nrow(sim_tr))
 
   sum_pred <- collect_predictions(rs_static_res, summarize = TRUE)
-  expect_equal(sum_pred[0,], static_ptype[, names(static_ptype) != "id"])
+  expect_ptype(sum_pred, static_ptype[, names(static_ptype) != "id"])
   expect_equal(nrow(sum_pred), nrow(sim_tr))
 
 })
@@ -161,14 +163,17 @@ test_that("resampling survival models with integrated metric", {
   # test structure of results --------------------------------------------------
 
   expect_false(".eval_time" %in% names(rs_integrated_res$.metrics[[1]]))
-  expect_equal(
-    names(rs_integrated_res$.predictions[[1]]),
-    c(".pred", ".row", "event_time", ".config")
+  expect_named(
+    rs_integrated_res$.predictions[[1]],
+    c(".pred", ".row", "event_time", ".config"),
+    ignore.order = TRUE
   )
+
   expect_true(is.list(rs_integrated_res$.predictions[[1]]$.pred))
-  expect_equal(
-    names(rs_integrated_res$.predictions[[1]]$.pred[[1]]),
-    c(".eval_time", ".pred_survival", ".weight_censored")
+  expect_named(
+    rs_integrated_res$.predictions[[1]]$.pred[[1]],
+    c(".eval_time", ".pred_survival", ".weight_censored"),
+    ignore.order = TRUE
   )
   expect_equal(
     rs_integrated_res$.predictions[[1]]$.pred[[1]]$.eval_time,
@@ -189,7 +194,7 @@ test_that("resampling survival models with integrated metric", {
     )
 
   expect_true(nrow(metric_sum) == 1)
-  expect_equal(metric_sum[0,], exp_metric_sum)
+  expect_ptype(metric_sum, exp_metric_sum)
   expect_true(all(metric_sum$.metric == "brier_survival_integrated"))
 
   metric_all <- collect_metrics(rs_integrated_res, summarize = FALSE)
@@ -203,7 +208,7 @@ test_that("resampling survival models with integrated metric", {
     )
 
   expect_true(nrow(metric_all) == 10)
-  expect_equal(metric_all[0,], exp_metric_all)
+  expect_ptype(metric_all, exp_metric_all)
   expect_true(all(metric_all$.metric == "brier_survival_integrated"))
 
   # test prediction collection -------------------------------------------------
@@ -224,17 +229,17 @@ test_that("resampling survival models with integrated metric", {
     )
 
   unsum_pred <- collect_predictions(rs_integrated_res)
-  expect_equal(unsum_pred[0,], integrated_ptype)
+  expect_ptype(unsum_pred, integrated_ptype)
   expect_equal(nrow(unsum_pred), nrow(sim_tr))
 
-  expect_equal(unsum_pred$.pred[[1]][0,], integrated_list_ptype)
+  expect_ptype(unsum_pred$.pred[[1]], integrated_list_ptype)
   expect_equal(nrow(unsum_pred$.pred[[1]]), length(time_points))
 
   sum_pred <- collect_predictions(rs_integrated_res, summarize = TRUE)
-  expect_equal(sum_pred[0,], integrated_ptype[, names(integrated_ptype) != "id"])
+  expect_ptype(sum_pred, integrated_ptype[, names(integrated_ptype) != "id"])
   expect_equal(nrow(sum_pred), nrow(sim_tr))
 
-  expect_equal(sum_pred$.pred[[1]][0,], integrated_list_ptype)
+  expect_ptype(sum_pred$.pred[[1]], integrated_list_ptype)
   expect_equal(nrow(sum_pred$.pred[[1]]), length(time_points))
 
 })
@@ -281,14 +286,18 @@ test_that("resampling survival models with dynamic metric", {
   # test structure of results --------------------------------------------------
 
   expect_true(".eval_time" %in% names(rs_dynamic_res$.metrics[[1]]))
-  expect_equal(
-    names(rs_dynamic_res$.predictions[[1]]),
-    c(".pred", ".row", "event_time", ".config")
+
+  expect_named(
+    rs_dynamic_res$.predictions[[1]],
+    c(".pred", ".row", "event_time", ".config"),
+    ignore.order = TRUE
   )
   expect_true(is.list(rs_dynamic_res$.predictions[[1]]$.pred))
-  expect_equal(
-    names(rs_dynamic_res$.predictions[[1]]$.pred[[1]]),
-    c(".eval_time", ".pred_survival", ".weight_censored")
+
+  expect_named(
+    rs_dynamic_res$.predictions[[1]]$.pred[[1]],
+    c(".eval_time", ".pred_survival", ".weight_censored"),
+    ignore.order = TRUE
   )
   expect_equal(
     rs_dynamic_res$.predictions[[1]]$.pred[[1]]$.eval_time,
@@ -310,7 +319,7 @@ test_that("resampling survival models with dynamic metric", {
     )
 
   expect_true(nrow(metric_sum) == length(time_points))
-  expect_equal(metric_sum[0,], exp_metric_sum)
+  expect_ptype(metric_sum, exp_metric_sum)
   expect_true(all(metric_sum$.metric == "brier_survival"))
 
   metric_all <- collect_metrics(rs_dynamic_res, summarize = FALSE)
@@ -325,7 +334,7 @@ test_that("resampling survival models with dynamic metric", {
     )
 
   expect_true(nrow(metric_all) == length(time_points) * nrow(sim_rs))
-  expect_equal(metric_all[0,], exp_metric_all)
+  expect_ptype(metric_all, exp_metric_all)
   expect_true(all(metric_all$.metric == "brier_survival"))
 
   # test prediction collection -------------------------------------------------
@@ -346,17 +355,17 @@ test_that("resampling survival models with dynamic metric", {
     )
 
   unsum_pred <- collect_predictions(rs_dynamic_res)
-  expect_equal(unsum_pred[0,], dynamic_ptype)
+  expect_ptype(unsum_pred, dynamic_ptype)
   expect_equal(nrow(unsum_pred), nrow(sim_tr))
 
-  expect_equal(unsum_pred$.pred[[1]][0,], dynamic_list_ptype)
+  expect_ptype(unsum_pred$.pred[[1]], dynamic_list_ptype)
   expect_equal(nrow(unsum_pred$.pred[[1]]), length(time_points))
 
   sum_pred <- collect_predictions(rs_dynamic_res, summarize = TRUE)
-  expect_equal(sum_pred[0,], dynamic_ptype[, names(dynamic_ptype) != "id"])
+  expect_ptype(sum_pred, dynamic_ptype[, names(dynamic_ptype) != "id"])
   expect_equal(nrow(sum_pred), nrow(sim_tr))
 
-  expect_equal(sum_pred$.pred[[1]][0,], dynamic_list_ptype)
+  expect_ptype(sum_pred$.pred[[1]], dynamic_list_ptype)
   expect_equal(nrow(sum_pred$.pred[[1]]), length(time_points))
 
 })
@@ -404,14 +413,16 @@ test_that("resampling survival models mixture of metric types", {
   # test structure of results --------------------------------------------------
 
   expect_true(".eval_time" %in% names(rs_mixed_res$.metrics[[1]]))
-  expect_equal(
-    names(rs_mixed_res$.predictions[[1]]),
-    c(".pred", ".row", ".pred_time", "event_time", ".config")
+  expect_named(
+    rs_mixed_res$.predictions[[1]],
+    c(".pred", ".row", ".pred_time", "event_time", ".config"),
+    ignore.order = TRUE
   )
   expect_true(is.list(rs_mixed_res$.predictions[[1]]$.pred))
-  expect_equal(
-    names(rs_mixed_res$.predictions[[1]]$.pred[[1]]),
-    c(".eval_time", ".pred_survival", ".weight_censored")
+  expect_named(
+    rs_mixed_res$.predictions[[1]]$.pred[[1]],
+    c(".eval_time", ".pred_survival", ".weight_censored"),
+    ignore.order = TRUE
   )
   expect_equal(
     rs_mixed_res$.predictions[[1]]$.pred[[1]]$.eval_time,
@@ -433,7 +444,7 @@ test_that("resampling survival models mixture of metric types", {
     )
 
   expect_true(nrow(metric_sum) == length(time_points) + 2)
-  expect_equal(metric_sum[0,], exp_metric_sum)
+  expect_ptype(metric_sum, exp_metric_sum)
   expect_true(sum(is.na(metric_sum$.eval_time)) == 2)
   expect_equal(as.vector(table(metric_sum$.metric)), c(length(time_points), 1L, 1L))
 
@@ -449,7 +460,7 @@ test_that("resampling survival models mixture of metric types", {
     )
 
   expect_true(nrow(metric_all) == (length(time_points) + 2) * nrow(sim_rs))
-  expect_equal(metric_all[0,], exp_metric_all)
+  expect_ptype(metric_all, exp_metric_all)
   expect_true(sum(is.na(metric_all$.eval_time)) == 2* nrow(sim_rs))
   expect_equal(as.vector(table(metric_all$.metric)), c(length(time_points), 1L, 1L) * nrow(sim_rs))
 
@@ -472,17 +483,17 @@ test_that("resampling survival models mixture of metric types", {
     )
 
   unsum_pred <- collect_predictions(rs_mixed_res)
-  expect_equal(unsum_pred[0,], mixed_ptype)
+  expect_ptype(unsum_pred, mixed_ptype)
   expect_equal(nrow(unsum_pred), nrow(sim_tr))
 
-  expect_equal(unsum_pred$.pred[[1]][0,], mixed_list_ptype)
+  expect_ptype(unsum_pred$.pred[[1]], mixed_list_ptype)
   expect_equal(nrow(unsum_pred$.pred[[1]]), length(time_points))
 
   sum_pred <- collect_predictions(rs_mixed_res, summarize = TRUE)
-  expect_equal(sum_pred[0,], mixed_ptype[, names(mixed_ptype) != "id"])
+  expect_ptype(sum_pred, mixed_ptype[, names(mixed_ptype) != "id"])
   expect_equal(nrow(sum_pred), nrow(sim_tr))
 
-  expect_equal(sum_pred$.pred[[1]][0,], mixed_list_ptype)
+  expect_ptype(sum_pred$.pred[[1]], mixed_list_ptype)
   expect_equal(nrow(sum_pred$.pred[[1]]), length(time_points))
 
   # test show_best() -----------------------------------------------------------