Merge pull request #402 from m-muecke/testthat

tests: migrate to testthat 3

DESCRIPTION

@@ -75,7 +75,7 @@ Suggests:
     set6 (>= 0.2.6),
     simsurv,
     survAUC,
-    testthat,
+    testthat (>= 3.0.0),
     vdiffr,
     abind,
     Ecdat,
@@ -86,6 +86,7 @@ Remotes:
     xoopR/distr6,
     xoopR/param6,
     xoopR/set6
+Config/testthat/edition: 3
 ByteCompile: true
 Encoding: UTF-8
 LazyData: true

inst/testthat/helper_expectations.R

@@ -2,7 +2,7 @@ expect_task_dens = function(task) {
   expect_class(task, "TaskDens")
   expect_task(task)
   expect_class(task$data(), "data.table")
-  expect_equal(task$ncol, 1L)
+  expect_identical(task$ncol, 1L)
 
   f = task$formula()
   expect_formula(f)
@@ -31,7 +31,7 @@ expect_prediction_surv = function(p) {
   checkmate::expect_data_table(data.table::as.data.table(p), nrows  = length(p$row_ids))
   checkmate::expect_atomic_vector(p$missing)
   if ("distr" %in% p$predict_types && !is.null(p$distr)) {
-    expect_true(class(p$distr)[[1]] %in% c("VectorDistribution", "Matdist", "Arrdist", "WeightedDiscrete"))
+    expect_true(class(p$distr)[[1L]] %in% c("VectorDistribution", "Matdist", "Arrdist", "WeightedDiscrete"))
   }
   expect_true(inherits(p, "PredictionSurv"))
 }

tests/testthat/helper.R

@@ -1,6 +1,6 @@
-library(mlr3proba)
 library(checkmate)
-library(testthat)
+library(mlr3)
+library(mlr3misc)
 
 # source helper files from mlr3 and mlr3proba
 lapply(list.files(system.file("testthat", package = "mlr3"), pattern = "^helper.*\\.[rR]",
@@ -18,9 +18,6 @@ assert_ro_binding = function(rhs) {
 reshape_distr_to_3d = function(p, num_seq = seq(0.1, 0.2, 0.05)) {
   p2 = p$clone()
   surv_mat = p2$data$distr
-  p2$data$distr = abind::abind(
-    sapply(num_seq, function(n) {surv_mat - n}, simplify = FALSE),
-    along = 3
-  )
+  p2$data$distr = abind::abind(map(num_seq, function(n) surv_mat - n), along = 3L)
   p2
 }

tests/testthat/helper_pipeops.R

@@ -40,19 +40,19 @@ expect_pipeop = function(po) {
   expect_flag(po$is_trained, label = label)
   expect_output(print(po), "PipeOp:", label = label)
   expect_character(po$packages, any.missing = FALSE, unique = TRUE, label = label)
-  expect_function(po$train, nargs = 1)
-  expect_function(po$predict, nargs = 1)
-  expect_function(po$.__enclos_env__$private$.train, nargs = 1)
-  expect_function(po$predict, nargs = 1)
-  expect_function(po$.__enclos_env__$private$.predict, nargs = 1)
+  expect_function(po$train, nargs = 1L)
+  expect_function(po$predict, nargs = 1L)
+  expect_function(po$.__enclos_env__$private$.train, nargs = 1L)
+  expect_function(po$predict, nargs = 1L)
+  expect_function(po$.__enclos_env__$private$.predict, nargs = 1L)
   expect_data_table(po$input, any.missing = FALSE)
   expect_names(names(po$input), permutation.of = c("name", "train", "predict"))
   expect_data_table(po$output, any.missing = FALSE)
   expect_names(names(po$output), permutation.of = c("name", "train", "predict"))
-  expect_int(po$innum, lower = 1)
-  expect_int(po$outnum, lower = 1)
+  expect_int(po$innum, lower = 1L)
+  expect_int(po$outnum, lower = 1L)
   # at least one of "train" or "predict" must be in every parameter's tag
-  testthat::expect_true(every(po$param_set$tags, function(x) {
+  expect_true(every(po$param_set$tags, function(x) {
     length(intersect(c("train", "predict"), x)) > 0
   }))
 
@@ -130,7 +130,8 @@ expect_deep_clone = function(one, two) {
           sprintf(" '%s'", if (is.character(index)) i else objnames[[i]])
         } else {
           ""
-        })))
+        }
+      )))
     }
   }
   expect_references_differ(one, two, "ROOT")

tests/testthat/test_PredictionDens.R

@@ -12,7 +12,7 @@ test_that("Internally constructed Prediction", {
 })
 
 test_that("c", {
-  resampling = rsmp("cv", folds = 3)
+  resampling = rsmp("cv", folds = 3L)
   rr = resample(task, lrn, resampling)
 
   preds = rr$predictions()

tests/testthat/test_PredictionSurv.R

@@ -1,5 +1,5 @@
-set.seed(1)
-task = tsk("rats")$filter(sample(300, 20))
+set.seed(1L)
+task = tsk("rats")$filter(sample(300, 20L))
 
 test_that("Construction", {
   p = PredictionSurv$new(row_ids = task$row_ids, truth = task$truth(), crank = runif(task$nrow))
@@ -18,28 +18,28 @@ test_that("Internally constructed Prediction", {
 lrn = lrn("surv.kaplan")
 
 test_that("c", {
-  set.seed(1)
-  resampling = rsmp("cv", folds = 2)
+  set.seed(1L)
+  resampling = rsmp("cv", folds = 2L)
   rr = resample(task, lrn, resampling)
 
   preds = rr$predictions()
 
   # combining survival matrices
   # same number of time points (columns) but different values
-  distr1 = preds[[1]]$data$distr
-  distr2 = preds[[2]]$data$distr
+  distr1 = preds[[1L]]$data$distr
+  distr2 = preds[[2L]]$data$distr
   times1 = as.integer(colnames(distr1))
   times2 = as.integer(colnames(distr2))
-  expect_true(length(times1) == length(times2))
+  expect_length(times1, length(times2))
   expect_false(all(times1 == times2))
 
   pred = do.call(c, preds)
   expect_prediction_surv(pred)
   surv_mat = pred$data$distr
-  expect_class(surv_mat, "matrix")
+  expect_matrix(surv_mat)
   # check that time points are properly combined
   times = as.integer(colnames(surv_mat))
-  expect_true(all(times == sort(union(times1, times2), decreasing = F)))
+  expect_true(all(times == sort(union(times1, times2))))
 
   # data.table conversion
   dt = as.data.table(pred)
@@ -48,34 +48,34 @@ test_that("c", {
   # different number of time points
   # add extra time point on the 2nd prediction object
   preds2 = rr$predictions()
-  preds2[[2]]$data$distr = cbind(distr2,
-    matrix(data = rep(0.3, 10), ncol = 1, dimnames = list(NULL, 108)))
-  distr1 = preds2[[1]]$data$distr
-  distr2 = preds2[[2]]$data$distr
+  preds2[[2L]]$data$distr = cbind(distr2,
+    matrix(data = rep(0.3, 10), ncol = 1L, dimnames = list(NULL, 108)))
+  distr1 = preds2[[1L]]$data$distr
+  distr2 = preds2[[2L]]$data$distr
   times1 = as.integer(colnames(distr1))
   times2 = as.integer(colnames(distr2))
   expect_false(length(times1) == length(times2))
 
   pred2 = do.call(c, preds2)
   expect_prediction_surv(pred2)
   surv_mat2 = pred2$data$distr
-  expect_class(surv_mat2, "matrix")
+  expect_matrix(surv_mat2)
   # check that time points are properly combined
   times = as.integer(colnames(surv_mat2))
-  expect_true(all(times == sort(union(times1, times2), decreasing = F)))
+  expect_true(all(times == sort(union(times1, times2))))
 
   # combining survival arrays
-  arr_preds = mlr3misc::map(preds2, reshape_distr_to_3d)
+  arr_preds = map(preds2, reshape_distr_to_3d)
   arr_pred = do.call(c, arr_preds)
   expect_prediction_surv(arr_pred)
-  expect_class(arr_pred$data$distr, "array")
-  expect_class(arr_pred$distr, "Arrdist")
+  expect_array(arr_pred$data$distr)
+  expect_r6(arr_pred$distr, "Arrdist")
   # check that time points are properly combined
-  times1 = as.integer(colnames(arr_preds[[1]]$data$distr))
-  times2 = as.integer(colnames(arr_preds[[2]]$data$distr))
-  times  = as.integer(colnames(arr_pred$data$distr))
+  times1 = as.integer(colnames(arr_preds[[1L]]$data$distr))
+  times2 = as.integer(colnames(arr_preds[[2L]]$data$distr))
+  times = as.integer(colnames(arr_pred$data$distr))
   expect_equal(as.integer(colnames(arr_pred$data$distr)),
-    sort(union(times1, times2), decreasing = F))
+    sort(union(times1, times2)))
 
   p1 = lrn("surv.kaplan")$train(task)$predict(task)
   p2 = suppressWarnings(lrn("surv.coxph")$train(task))$predict(task)
@@ -84,18 +84,18 @@ test_that("c", {
   # combining predictions with exactly the same time points
   p1 = lrn("surv.kaplan")$train(task)$predict(task)
   p2 = p1$clone()
-  expect_equal(length(c(p1, p2, keep_duplicates = TRUE)$row_ids), 40)
-  expect_equal(length(c(p1, p2, keep_duplicates = FALSE)$row_ids), 20)
+  expect_length(c(p1, p2, keep_duplicates = TRUE)$row_ids, 40L)
+  expect_length(c(p1, p2, keep_duplicates = FALSE)$row_ids, 20L)
   preds = list(p1, p2)
   p12 = do.call(c, preds)
-  expect_class(p12$data$distr, "matrix") # combination is a matrix
+  expect_matrix(p12$data$distr) # combination is a matrix
   expect_equal(colnames(p12$data$distr), colnames(p1$data$distr)) # same time points
 
   arr_p1 = reshape_distr_to_3d(p1)
   arr_p2 = reshape_distr_to_3d(p2)
   arr_preds = list(arr_p1, arr_p2)
   arr_pred = do.call(c, arr_preds)
-  expect_class(arr_pred$data$distr, "array") # combination is an array
+  expect_array(arr_pred$data$distr) # combination is an array
   expect_equal(colnames(arr_pred$data$distr), colnames(arr_p1$data$distr)) # same time points
 
   # combining distr6::Distribution objects of the same type
@@ -104,15 +104,15 @@ test_that("c", {
   p2$data$distr = p2$distr
   preds2 = list(p1, p2)
   pred2 = do.call(c, preds2)
-  expect_class(pred2$data$distr, "matrix")
+  expect_matrix(pred2$data$distr)
   expect_true(all(pred2$data$distr == p12$data$distr))
 
   # Arrdist
   arr_p1$data$distr = arr_p1$distr
   arr_p2$data$distr = arr_p2$distr
   arr_preds2 = list(arr_p1, arr_p2)
   arr_pred2 = do.call(c, arr_preds2)
-  expect_class(arr_pred2$data$distr, "array")
+  expect_array(arr_pred2$data$distr)
   expect_true(all(arr_pred2$data$distr == arr_pred$data$distr))
 
   # combining distr6::Distribution objects of different types
@@ -147,8 +147,8 @@ test_that("c", {
   expect_array(p2$data$distr, d = 3)
   # add extra time point in the survival matrix
   p1$data$distr = cbind(p1$data$distr,
-    matrix(data = rep(0.3, 20), ncol = 1, dimnames = list(NULL, 108)))
-  expect_matrix(p1$data$distr, nrows = 20)
+    matrix(data = rep(0.3, 20), ncol = 1L, dimnames = list(NULL, 108)))
+  expect_matrix(p1$data$distr, nrows = 20L)
   preds = list(p1, p2)
   pred = do.call(c, preds)
   expect_prediction_surv(pred)
@@ -196,19 +196,19 @@ test_that("filtering", {
   expect_set_equal(p2$data$row_ids, c(20, 37, 42))
   expect_set_equal(p3$data$row_ids, c(20, 37, 42))
   expect_set_equal(p4$data$row_ids, c(20, 37, 42))
-  expect_numeric(p$data$crank, any.missing = FALSE, len = 3)
-  expect_numeric(p2$data$crank, any.missing = FALSE, len = 3)
-  expect_numeric(p3$data$crank, any.missing = FALSE, len = 3)
-  expect_numeric(p4$data$crank, any.missing = FALSE, len = 3)
-  expect_numeric(p$data$lp, any.missing = FALSE, len = 3)
-  expect_numeric(p2$data$lp, any.missing = FALSE, len = 3)
-  expect_numeric(p3$data$lp, any.missing = FALSE, len = 3)
-  expect_numeric(p4$data$lp, any.missing = FALSE, len = 3)
-  expect_matrix(p$data$distr, nrows = 3)
+  expect_numeric(p$data$crank, any.missing = FALSE, len = 3L)
+  expect_numeric(p2$data$crank, any.missing = FALSE, len = 3L)
+  expect_numeric(p3$data$crank, any.missing = FALSE, len = 3L)
+  expect_numeric(p4$data$crank, any.missing = FALSE, len = 3L)
+  expect_numeric(p$data$lp, any.missing = FALSE, len = 3L)
+  expect_numeric(p2$data$lp, any.missing = FALSE, len = 3L)
+  expect_numeric(p3$data$lp, any.missing = FALSE, len = 3L)
+  expect_numeric(p4$data$lp, any.missing = FALSE, len = 3L)
+  expect_matrix(p$data$distr, nrows = 3L)
   expect_array(p2$data$distr, d = 3)
-  expect_equal(nrow(p2$data$distr), 3)
-  expect_true(inherits(p3$data$distr, "Matdist"))
-  expect_true(inherits(p4$data$distr, "Arrdist"))
+  expect_identical(nrow(p2$data$distr), 3L)
+  expect_r6(p3$data$distr, "Matdist")
+  expect_r6(p4$data$distr, "Arrdist")
 
   # edge case: filter to 1 observation
   p$filter(20)
@@ -219,11 +219,11 @@ test_that("filtering", {
   expect_prediction_surv(p2)
   expect_prediction_surv(p3)
   expect_prediction_surv(p4)
-  expect_matrix(p$data$distr, nrows = 1)
+  expect_matrix(p$data$distr, nrows = 1L)
   expect_array(p2$data$distr, d = 3)
-  expect_equal(nrow(p2$data$distr), 1)
-  expect_true(inherits(p3$data$distr, "WeightedDiscrete")) # from Matdist!
-  expect_true(inherits(p4$data$distr, "Arrdist")) # remains an Arrdist!
+  expect_identical(nrow(p2$data$distr), 1L)
+  expect_r6(p3$data$distr, "WeightedDiscrete") # from Matdist!
+  expect_r6(p4$data$distr, "Arrdist") # remains an Arrdist!
 
   # filter to 0 observations using non-existent (positive) id
   p$filter(42)

tests/testthat/test_TaskDens.R

@@ -1,12 +1,10 @@
-context("TaskDens")
-
 test_that("Basic ops on BostonHousing task", {
   task = tsk("precip")
   expect_task(task)
   expect_task_dens(task)
 
   f = task$formula()
-  expect_class(f, "formula")
+  expect_formula(f)
 })
 
 test_that("TaskDens: 0 feature task", {
@@ -26,13 +24,13 @@ test_that("as_task_dens", {
   t2 = as_task_dens(t1, clone = TRUE)
   expect_task_dens(t2)
   t1$filter(1:10)
-  expect_equal(t1$nrow, 10L)
-  expect_equal(t2$nrow, 70L)
+  expect_identical(t1$nrow, 10L)
+  expect_identical(t2$nrow, 70L)
 
   t1 = tsk("precip")
   t2 = as_task_dens(t1, clone = FALSE)
   expect_task_dens(t2)
   t1$filter(1:10)
-  expect_equal(t1$nrow, 10L)
-  expect_equal(t2$nrow, 10L)
+  expect_identical(t1$nrow, 10L)
+  expect_identical(t2$nrow, 10L)
 })