Merge pull request #51 from tdhock/fix50

consistent plot methods

Author: tdhock

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: mlr3resampling
 Type: Package
 Title: Resampling Algorithms for 'mlr3' Framework
-Version: 2025.9.24
+Version: 2025.11.19
 Encoding: UTF-8
 Authors@R: c(
     person("Toby", "Hocking",

NEWS

@@ -1,3 +1,7 @@
+Changes in version 2025.11.19 (PR#51)
+
+- plot() yields consistent Y axes (other on top) for score() and pvalue().
+
 Changes in version 2025.9.24
 
 - Newer resamplers vignette reproducibility section.

R/ResamplingSameOtherSizesCV.R

@@ -172,9 +172,10 @@ ResamplingSameOtherSizesCV = R6::R6Class(
         }
       }
       list(
-        iteration.dt=rbindlist(
-          iteration.dt.list
-        )[, iteration := .I][],
+        iteration.dt=rbindlist(iteration.dt.list)[, let(
+          iteration = .I,
+          Train_subsets = factor(train.subsets, c("all","same","other"))
+        )][],
         fold.dt=fold.dt)
     }
   )

R/pvalue.R

@@ -129,7 +129,7 @@ plot.pvalue <- function(x, ..., text.size=5, p.color="grey50", sd.seg.size=1){
         hi,
         Train_subsets,
         xend=lo, yend=Train_subsets),
-        size=sd.seg.size,
+        linewidth=sd.seg.size,
         data=x$stats)+
       ggplot2::geom_segment(ggplot2::aes(
         compare_mean, Train_subsets,

R/score.R

@@ -22,15 +22,15 @@ score <- function(bench.result, ...){
 }
 
 plot.score <- function(x, ..., value.var=NULL){
-  value <- train.subsets <- NULL
+  value <- Train_subsets <- NULL
   if(requireNamespace("ggplot2")){
     if(is.null(value.var)){
       value.var <- grep("classif|regr", names(x), value=TRUE)[1]
     }
     dt <- data.table(x)[, value := get(value.var)][]
     ggplot2::ggplot()+
       ggplot2::geom_point(ggplot2::aes(
-        value, train.subsets),
+        value, Train_subsets),
         shape=1,
         data=dt)+
       ggplot2::facet_grid(

tests/testthat/test-CRAN.R

@@ -663,7 +663,12 @@ test_that("proj_test down-samples proportionally", {
   expect_equal(sum(is.na(rpart_dt[["iteration"]])), 0)
 })
 
-test_that("set works after score", {
+last_lev <- function(x){
+  levs <- levels(factor(x))
+  levs[length(levs)]
+}
+
+test_that("set works after score(), other is last Y level", {
   N <- 80
   set.seed(1)
   reg.dt <- data.table(
@@ -696,6 +701,52 @@ test_that("set works after score", {
     SOAK))
   bench.result <- mlr3::benchmark(bench.grid)
   bench.score <- mlr3resampling::score(bench.result, mlr3::msr("regr.rmse"))
+  if(interactive())plot(bench.score)
   set(bench.score, j="foo", value=1)
   expect_is(bench.score, "score")
+  expect_identical(last_lev(bench.score$Train_subsets), "other")
+  bench.pvalue <- mlr3resampling::pvalue(bench.score)
+  if(interactive())plot(bench.pvalue)
+  expect_identical(last_lev(bench.pvalue$stats$Train_subsets), "other")
+})
+
+test_that("plot ok without other", {
+  N <- 80
+  set.seed(1)
+  reg.dt <- data.table(
+    x=runif(N, -2, 2),
+    person=rep(1:2, each=0.5*N))
+  reg.pattern.list <- list(
+    easy=function(x, person)x^2,
+    impossible=function(x, person)(x^2)*(-1)^person)
+  SAK <- mlr3resampling::ResamplingSameOtherSizesCV$new()
+  SAK$param_set$values$subsets <- "SA"
+  reg.task.list <- list()
+  for(pattern in names(reg.pattern.list)){
+    f <- reg.pattern.list[[pattern]]
+    yname <- paste0("y_",pattern)
+    reg.dt[, (yname) := f(x,person)+rnorm(N, sd=0.5)][]
+    task.dt <- reg.dt[, c("x","person",yname), with=FALSE]
+    task.obj <- mlr3::TaskRegr$new(
+      pattern, task.dt, target=yname)
+    task.obj$col_roles$stratum <- "person"
+    task.obj$col_roles$subset <- "person"
+    reg.task.list[[pattern]] <- task.obj
+  }
+  reg.learner.list <- list(
+    mlr3::LearnerRegrFeatureless$new())
+  if(requireNamespace("rpart")){
+    reg.learner.list$rpart <- mlr3::LearnerRegrRpart$new()
+  }
+  (bench.grid <- mlr3::benchmark_grid(
+    reg.task.list,
+    reg.learner.list,
+    SAK))
+  bench.result <- mlr3::benchmark(bench.grid)
+  bench.score <- mlr3resampling::score(bench.result, mlr3::msr("regr.rmse"))
+  if(interactive())plot(bench.score)
+  expect_identical(last_lev(bench.score$Train_subsets), "same")
+  bench.pvalue <- mlr3resampling::pvalue(bench.score)
+  if(interactive())plot(bench.pvalue)
+  expect_identical(last_lev(bench.pvalue$stats$Train_subsets), "same")
 })

tests/testthat/test-mlr3torch.R

@@ -1,3 +1,6 @@
+library(testthat)
+library(data.table)
+
 test_that("mlr3torch history saved", {
   N <- 80
   set.seed(1)
@@ -92,7 +95,7 @@ test_that("mlr3torch history saved", {
   expected_join_cols <- c(
     expected_csv_cols,
     "task_id", "learner_id", "resampling_id", "test.subset", "train.subsets",
-    "groups", "test.fold", "seed", "n.train.groups", "iteration")
+    "groups", "test.fold", "seed", "n.train.groups", "iteration", "Train_subsets")
   expect_identical(names(csv_data_list$learners.csv), expected_join_cols)
 })