test: use more specialised test functions (#1408)

Author: m-muecke

DESCRIPTION

@@ -75,7 +75,7 @@ Suggests:
     remotes,
     RhpcBLASctl,
     rpart,
-    testthat (>= 3.2.0)
+    testthat (>= 3.3.0)
 Encoding: UTF-8
 Config/testthat/edition: 3
 Config/testthat/parallel: false

inst/testthat/helper_expectations.R

@@ -116,7 +116,7 @@ expect_backend = function(b) {
   checkmate::expect_list(b$distinct(rn, "_not_existing_"), len = 0L, names = "named")
   d = b$distinct(rn, c("_not_existing_", rev(cn), "_also_not_existing_"))
   checkmate::expect_list(d, names = "unique")
-  testthat::expect_equal(names(d), rev(cn))
+  checkmate::expect_names(names(d), identical.to = rev(cn))
 
   d = b$distinct(rn1, cn)
   checkmate::expect_list(d, len = length(cn), names = "unique", any.missing = FALSE)
@@ -159,15 +159,15 @@ expect_iris_backend = function(b, n_missing = 0L) {
 
   x = b$head(2)
   checkmate::expect_data_table(x, nrows  = 2L, ncols  = 6L, any.missing = FALSE)
-  checkmate::expect_set_equal(names(x), c(names(iris), b$primary_key))
+  checkmate::expect_names(names(x), permutation.of = c(names(iris), b$primary_key))
 
   x = b$distinct(b$rownames, "Species")
   checkmate::expect_list(x, "character", len = 1)
   checkmate::expect_set_equal(x$Species, levels(iris$Species))
 
   x = b$data(rows = 2:10, cols = c(b$primary_key, "Species", "Sepal.Width"))
   checkmate::expect_data_table(x, nrows  = 9L, ncols  = 3L)
-  checkmate::expect_set_equal(names(x), c(b$primary_key, "Species", "Sepal.Width"))
+  checkmate::expect_names(names(x), identical.to = c(b$primary_key, "Species", "Sepal.Width"))
   checkmate::expect_set_equal(x[[b$primary_key]], 2:10)
 
   if (is.factor(x$Species)) {
@@ -693,11 +693,11 @@ expect_resultdata = function(rdata, consistency = TRUE) {
   data = rdata$data
 
   proto = mlr3:::star_init()
-  checkmate::expect_set_equal(names(data), names(proto))
+  checkmate::expect_names(names(data), identical.to = names(proto))
 
   for (nn in names(proto)) {
     checkmate::expect_data_table(data[[nn]], key = data.table::key(proto[[nn]]))
-    testthat::expect_equal(names(data[[nn]]), names(proto[[nn]]))
+    checkmate::expect_names(names(data[[nn]]), identical.to = names(proto[[nn]]))
   }
 
   checkmate::expect_character(data$uhashes$uhash, unique = TRUE)

tests/testthat/test_DataBackendRename.R

@@ -6,8 +6,8 @@ test_that("DataBackendRename", {
   expect_backend(b)
 
   expect_set_equal(b$colnames, c(new, "..row_id"))
-  expect_set_equal(names(b$data(b$rownames, b$colnames)), c(new, "..row_id"))
-  expect_set_equal(names(b$head()), c(new, "..row_id"))
+  expect_names(names(b$data(b$rownames, b$colnames)), identical.to =  c(new, "..row_id"))
+  expect_names(names(b$head()), identical.to = c(new, "..row_id"))
 
   expect_data_table(b$data(rows = b$rownames, cols = old), ncols = 0)
   expect_data_table(b$data(rows = b$rownames, cols = new), ncols = 5)
@@ -26,8 +26,8 @@ test_that("DataBackendRename / partial rename", {
   expected = c(map_values(names(iris), old, new), "..row_id")
   expect_set_equal(b$colnames, expected)
 
-  expect_set_equal(names(b$data(b$rownames, b$colnames)), expected)
-  expect_set_equal(names(b$head()), expected)
+  expect_names(names(b$data(b$rownames, b$colnames)), identical.to = expected)
+  expect_names(names(b$head()), identical.to = expected)
 
   expect_data_table(b$data(rows = b$rownames, cols = expected), ncols = 6)
 

tests/testthat/test_Learner.R

@@ -49,7 +49,7 @@ test_that("learner timings", {
   learner = lrn("regr.rpart")
   t = learner$timings
   expect_equal(unname(t), as.double(c(NA, NA)))
-  expect_equal(names(t), c("train", "predict"))
+  expect_names(names(t), identical.to = c("train", "predict"))
 
 
   learner$train(tsk("mtcars"))

tests/testthat/test_PredictionClassif.R

@@ -109,7 +109,7 @@ test_that("confusion", {
   expect_matrix(cm, nrows = 3, ncols = 3, any.missing = FALSE)
   expect_equal(colnames(p$confusion), task$class_names)
   expect_equal(rownames(p$confusion), task$class_names)
-  expect_equal(names(dimnames(cm)), c("response", "truth"))
+  expect_names(names(dimnames(cm)), identical.to =  c("response", "truth"))
 })
 
 test_that("c", {

tests/testthat/test_Task.R

@@ -4,7 +4,7 @@ test_that("Feature columns can be reordered", {
 
   task$col_roles$feature = new_order
   expect_equal(task$feature_names, new_order)
-  expect_equal(names(task$data(rows = 1)), c("median_house_value", new_order))
+  expect_names(names(task$data(rows = 1)), identical.to = c("median_house_value", new_order))
 })
 
 test_that("Task duplicates rows", {
@@ -781,12 +781,12 @@ test_that("rbind with weights", {
 
   # Check combined weights
   combined_weights_lrn = task$weights_learner
-  expect_equal(nrow(combined_weights_lrn), task$nrow)
+  expect_shape(combined_weights_lrn, nrow = task$nrow)
   expect_equal(setkeyv(combined_weights_lrn[row_id %in% original_row_ids], "row_id"), original_weights_lrn)
   expect_equal(combined_weights_lrn[row_id %in% 151:160]$weight, 1001:1010)
 
   combined_weights_msr = task$weights_measure
-  expect_equal(nrow(combined_weights_msr), task$nrow)
+  expect_shape(combined_weights_msr, nrow = task$nrow)
   # expect_equal(combined_weights_msr[row_id %in% original_row_ids], original_weights_msr) # ordering issue with join
   expect_equal(setkeyv(combined_weights_msr[list(original_row_ids), on = "row_id"], "row_id"), original_weights_msr)
   expect_equal(combined_weights_msr[row_id %in% 151:160]$weight, 2010:2001)
@@ -827,11 +827,11 @@ test_that("cbind with weights", {
   expect_true("weights_measure" %in% task$properties)
 
   weights_lrn = task$weights_learner
-  expect_equal(nrow(weights_lrn), task$nrow)
+  expect_shape(weights_lrn, nrow = task$nrow)
   expect_equal(weights_lrn$weight, 1:150)
 
   weights_msr = task$weights_measure
-  expect_equal(nrow(weights_msr), task$nrow)
+  expect_shape(weights_msr, nrow = task$nrow)
   expect_equal(weights_msr$weight, 150:1)
 
   # Check that original features/target are still there

tests/testthat/test_benchmark.R

@@ -480,17 +480,17 @@ test_that("param_values in benchmark", {
   bmr = benchmark(design)
   expect_benchmark_result(bmr)
   expect_equal(bmr$n_resample_results, 1)
-  expect_equal(nrow(as.data.table(bmr)), 3)
+  expect_shape(as.data.table(bmr), nrow = 3L)
   learner = bmr$resample_result(1)$learner
   expect_equal(learner$param_set$values$x, 1)
-  expect_equal(nrow(as.data.table(bmr)), 3)
+  expect_shape(as.data.table(bmr), nrow = 3L)
 
   # multiple parameters set via manual design
   design = data.table(task = tasks, learner = learners, resampling = resamplings, param_values = list(list(list(x = 1), list(x = 0.5))))
   bmr = benchmark(design)
   expect_benchmark_result(bmr)
   expect_equal(bmr$n_resample_results, 2)
-  expect_equal(nrow(as.data.table(bmr)), 6)
+  expect_shape(as.data.table(bmr), nrow = 6L)
   learner = bmr$resample_result(1)$learner
   expect_equal(learner$param_set$values$x, 1)
   learner = bmr$resample_result(2)$learner

tests/testthat/test_encapsulate.R

@@ -32,7 +32,7 @@ test_that("evaluate / single step", {
   expect_message(expect_warning(disable_encapsulation(learner)$predict(task, row_ids = 101:150)))
   log = learner$log[stage == "predict"]
   expect_data_table(log)
-  expect_equal(nrow(log), 0)
+  expect_shape(log, nrow = 0L)
 
   p = enable_encapsulation(learner)$predict(task, row_ids = 101:150)
   log = learner$log[stage == "predict"]

tests/testthat/test_resample.R

@@ -31,18 +31,18 @@ test_that("resample with no or multiple measures", {
   for (measures in list(mlr_measures$mget(c("classif.ce", "classif.acc")), list())) {
     tab = rr$score(measures, ids = FALSE, predictions = TRUE)
     expect_data_table(tab, ncols = length(mlr_reflections$rr_names) + length(learner$predict_sets) + length(measures), nrows = 3L)
-    expect_set_equal(names(tab), c(mlr_reflections$rr_names, ids(measures), paste0("prediction_", learner$predict_sets)))
+    expect_names(names(tab), permutation.of = c(mlr_reflections$rr_names, ids(measures), paste0("prediction_", learner$predict_sets)))
     perf = rr$aggregate(measures)
     expect_numeric(perf, any.missing = FALSE, len = length(measures), names = "unique")
-    expect_equal(names(perf), unname(ids(measures)))
+    expect_names(names(perf), identical.to = unname(ids(measures)))
   }
 })
 
 test_that("as_benchmark_result.ResampleResult", {
   measures = list(msr("classif.ce"), msr("classif.acc"))
   bmr = as_benchmark_result(rr)
   expect_benchmark_result(bmr)
-  expect_equal(nrow(get_private(bmr)$.data), nrow(get_private(rr)$.data))
+  expect_identical(nrow(get_private(bmr)$.data), nrow(get_private(rr)$.data))
   expect_set_equal(bmr$uhashes, rr$uhash)
   aggr = bmr$aggregate()
   expect_data_table(aggr, nrows = 1)
@@ -61,9 +61,9 @@ test_that("inputs are cloned", {
 })
 
 test_that("memory footprint", {
-  expect_equal(nrow(get_private(rr)$.data$data$learners), 1L)
-  expect_equal(nrow(get_private(rr)$.data$data$tasks), 1L)
-  expect_equal(nrow(get_private(rr)$.data$data$resamplings), 1L)
+  expect_shape(get_private(rr)$.data$data$learners, nrow = 1L)
+  expect_shape(get_private(rr)$.data$data$tasks, nrow = 1L)
+  expect_shape(get_private(rr)$.data$data$resamplings, nrow = 1L)
 })
 
 test_that("predict_type is checked", {