Issue #625: solve aggregation issue for test.join with probs

R/aggregations.R

@@ -235,8 +235,13 @@ test.join = makeAggregation(
     df = as.data.frame(pred)
     f = if (length(group)) group[df$iter] else factor(rep(1L, nrow(df)))
     mean(vnapply(split(df, f), function(df) {
+      if (pred$predict.type == "response") y = df$response
+      if (pred$predict.type == "prob") {
+        y = df[,grepl("^prob[.]", colnames(df))]
+        colnames(y) = gsub("^prob[.]", "", colnames(y))
+      }
       npred = makePrediction(task.desc = pred$task.desc, row.names = rownames(df),
-        id = NULL, truth = df$truth, predict.type = pred$predict.type, y = df$response,
+        id = NULL, truth = df$truth, predict.type = pred$predict.type, y = y,
         time = NA_real_)
       performance(npred, measure)
     }))

tests/testthat/test_base_resample_cv.R

@@ -49,3 +49,15 @@ test_that("cv instance works is stochastic", {
   rin2 = makeResampleInstance(makeResampleDesc("CV", iters = 2L), size = 500)
   expect_true(!all(sort(rin1$test.inds[[1]]) == sort(rin2$test.inds[[1]])))
 })
+
+
+test_that("test.join works somehow", {
+  lrn = makeLearner("classif.rpart", predict.type = "prob")
+
+  # check if test.join computes acc correctly
+  mm = setAggregation(acc, test.join)
+  r = resample(lrn, sonar.task, cv2, measures = mm)
+  rpred = getRRPredictions(r)
+  expect_equal(as.numeric(r$aggr),
+    mean(getPredictionTruth(rpred) == getPredictionResponse(rpred)))
+})

tests/testthat/test_base_resample_holdout.R

@@ -19,3 +19,13 @@ test_that("holdout fixed instance works", {
   expect_equal(length(rin$train.inds[[1]]), 5)
   expect_equal(length(rin$test.inds[[1]]), 15)
 })
+
+test_that("holdout test.join works somehow", {
+  lrn = makeLearner("classif.rpart", predict.type = "prob")
+
+  # for holdout test.join and test.mean should be the same
+  rin = makeResampleDesc("Holdout")
+  mm = list(setAggregation(auc, test.join), auc)
+  r = resample(lrn, sonar.task, rin, measures = mm)
+  expect_equal(as.integer(diff(r$aggr)), 0)
+})

tests/testthat/test_base_resample_repcv.R

@@ -62,4 +62,8 @@ test_that("test.join works somehow", {
   res = resample(learner = lrn, task = task, resampling = rin, measures = measures)
   expect_equal(res$measures.test[, 2L], res$measures.test[, 3L])
   expect_true(diff(res$aggr) > 0)
+
+  lrn = setPredictType(lrn, predict.type = "prob")
+  res.prob = resample(learner = lrn, task = task, resampling = rin, measures = measures)
+  expect_equal(res.prob$measures.test[, 2L], res.prob$measures.test[, 3L])
 })