Bugfix: Aggregation of probabilities (mlr-org#2579)

Author: mllg

NEWS.md

@@ -3,6 +3,7 @@
 ## learners - general
 
 - `classif.liquidSVM` and `regr.liquidSVM` have been removed because `liquidSVM` has been removed from CRAN.
+- fixed a bug that caused an incorrect aggregation of probabilities in some cases. The bug existed since quite some time and was exposed due to the change of `data.table`s default in `rbindlist()`. See #2578 for more information. (@mllg, #2579)
 
 # mlr 2.14.0
 

R/BenchmarkResult_operators.R

@@ -118,14 +118,14 @@ getBMRObjects = function(bmr, task.ids = NULL, learner.ids = NULL, fun, as.df =
       return(p)
     })
     if (as.df) {
-      xs = setDF(rbindlist(xs, fill = TRUE))
+      xs = setDF(rbindlist(xs, fill = TRUE, use.names = TRUE))
     } else {
       xs = setNames(xs, learner.ids)
     }
     return(xs)
   })
   if (as.df) {
-    res = setDF(rbindlist(res, fill = TRUE))
+    res = setDF(rbindlist(res, fill = TRUE, use.names = TRUE))
   } else {
     res = setNames(res, task.ids)
     if (drop) {
@@ -242,7 +242,7 @@ getBMROptResults = function(bmr, task.ids = NULL, learner.ids = NULL, as.df = FA
 
       if (inherits(x$learner, wrapper.class)) {
         xs = lapply(x$extract, fun)
-        xs = setDF(rbindlist(lapply(seq_along(xs), function(i) cbind(iter = i, xs[[i]])), fill = TRUE))
+        xs = setDF(rbindlist(lapply(seq_along(xs), function(i) cbind(iter = i, xs[[i]])), fill = TRUE, use.names = TRUE))
       } else {
         NULL
       }

R/ResamplePrediction.R

@@ -22,10 +22,10 @@ makeResamplePrediction = function(instance, preds.test, preds.train, task.desc)
   if (any(tenull)) pr.te = preds.test[!tenull] else pr.te = preds.test
   if (any(trnull)) pr.tr = preds.train[!trnull] else pr.tr = preds.train
 
-  data = setDF(rbind(
-    rbindlist(lapply(seq_along(pr.te), function(X) cbind(pr.te[[X]]$data, iter = X, set = "test"))),
-    rbindlist(lapply(seq_along(pr.tr), function(X) cbind(pr.tr[[X]]$data, iter = X, set = "train")))
-  ))
+  data = setDF(rbindlist(c(
+    lapply(seq_along(pr.te), function(X) cbind(pr.te[[X]]$data, iter = X, set = "test")),
+    lapply(seq_along(pr.tr), function(X) cbind(pr.tr[[X]]$data, iter = X, set = "train"))
+  ), use.names = TRUE))
 
   if (!any(tenull) && instance$desc$predict %in% c("test", "both")) {
     p1 = preds.test[[1L]]

R/generateCalibration.R

@@ -115,8 +115,8 @@ generateCalibrationData.list = function(obj, breaks = "Sturges", groups = NULL,
     }
     list(data = df, proportion = df[, fun(.SD), by = "bin"])
   })
-  data = rbindlist(lapply(out, function(x) x$data), idcol = "Learner")
-  proportion = rbindlist(lapply(out, function(x) x$proportion), idcol = "Learner")
+  data = rbindlist(lapply(out, function(x) x$data), idcol = "Learner", use.names = TRUE)
+  proportion = rbindlist(lapply(out, function(x) x$proportion), idcol = "Learner", use.names = TRUE)
   if (length(td$class.levels) == 2L) {
     proportion = proportion[, !td$negative, with = FALSE]
     data = data[data$Class != td$negative, ]
@@ -166,7 +166,7 @@ generateCalibrationData.list = function(obj, breaks = "Sturges", groups = NULL,
 #' names(pred) = c("rpart", "nnet")
 #' out = generateCalibrationData(pred, groups = 3)
 #' plotCalibration(out)
-#' 
+#'
 #' fit = lapply(lrns, train, task = sonar.task)
 #' pred = lapply(fit, predict, task = sonar.task)
 #' names(pred) = c("rpart", "lda")

R/generatePartialDependence.R

@@ -97,7 +97,7 @@
 #' fit = train(lrn, bh.task)
 #' pd = generatePartialDependenceData(fit, bh.task, "lstat")
 #' plotPartialDependence(pd, data = getTaskData(bh.task))
-#' 
+#'
 #' lrn = makeLearner("classif.rpart", predict.type = "prob")
 #' fit = train(lrn, iris.task)
 #' pd = generatePartialDependenceData(fit, iris.task, "Petal.Width")
@@ -222,7 +222,7 @@ generatePartialDependenceData = function(obj, input, features = NULL,
       out = parallelMap(doDerivativeMarginalPrediction, x = features, more.args = args)
     }
   }
-  out = rbindlist(out, fill = TRUE)
+  out = rbindlist(out, fill = TRUE, use.names = TRUE)
 
   if (length(target) == 1L) {
     if (!multi.fun) {

R/generateThreshVsPerf.R

@@ -97,7 +97,7 @@ generateThreshVsPerfData.list = function(obj, measures, gridsize = 100L, aggrega
     out = out[[1L]]
     colnames(out)[!colnames(out) %in% c("iter", "threshold", "learner")] = mids
   } else {
-    out = setDF(rbindlist(lapply(out, as.data.table), fill = TRUE, idcol = "learner"))
+    out = setDF(rbindlist(lapply(out, as.data.table), fill = TRUE, idcol = "learner", use.names = TRUE))
     colnames(out)[!colnames(out) %in% c("iter", "threshold", "learner")] = mids
   }
 
@@ -242,11 +242,11 @@ plotThreshVsPerf = function(obj, measures = obj$measures,
 #' pred = predict(fit, task = sonar.task)
 #' roc = generateThreshVsPerfData(pred, list(fpr, tpr))
 #' plotROCCurves(roc)
-#' 
+#'
 #' r = bootstrapB632plus(lrn, sonar.task, iters = 3)
 #' roc_r = generateThreshVsPerfData(r, list(fpr, tpr), aggregate = FALSE)
 #' plotROCCurves(roc_r)
-#' 
+#'
 #' r2 = crossval(lrn, sonar.task, iters = 3)
 #' roc_l = generateThreshVsPerfData(list(boot = r, cv = r2), list(fpr, tpr), aggregate = FALSE)
 #' plotROCCurves(roc_l)

R/getNestedTuneResults.R

@@ -52,8 +52,7 @@ getNestedTuneResultsOptPathDf = function(r, trafo = FALSE) {
   if (trafo) ops = lapply(ops, trafoOptPath)
   op.dfs = lapply(ops, as.data.frame)
   op.dfs = setDF(rbindlist(lapply(seq_along(op.dfs), function(i) {
-
     op.dfs[[i]][, "iter"] = i
     op.dfs[[i]]
-  }), fill = TRUE))
+  }), fill = TRUE, use.names = TRUE))
 }

R/listLearners.R

@@ -17,7 +17,7 @@ getLearnerTable = function() {
       properties = list(row$properties),
       note = row$note %??% ""
     )
-  }))
+  }), use.names = TRUE)
 
   # set learner type (classif, regr, surv, ...)
   tab$type = vcapply(stri_split_fixed(tab$id, ".", n = 2L), head, 1L)
@@ -140,7 +140,7 @@ listLearners.character = function(obj = NA_character_, properties = character(0L
 
   tab$package = vcapply(tab$package, collapse)
   properties = listLearnerProperties()
-  tab = cbind(tab, rbindlist(lapply(tab$properties, function(x) setNames(as.list(properties %in% x), properties))))
+  tab = cbind(tab, rbindlist(lapply(tab$properties, function(x) setNames(as.list(properties %in% x), properties)), use.names = TRUE))
   tab$properties = NULL
   setnames(tab, "id", "class")
   setDF(tab)

R/mergeBenchmarkResults.R

@@ -42,7 +42,7 @@ mergeBenchmarkResults = function(bmrs) {
   existing.combos = rbindlist(lapply(bmrs, function(bmr) {
 
     getBMRAggrPerformances(bmr, as.df = TRUE)[, c("task.id", "learner.id")]
-  }))
+  }), use.names = TRUE)
   existing.combos = stri_paste(existing.combos$task.id, existing.combos$learner.id, sep = " - ")
   if (!identical(sort(existing.combos), sort(all.combos))) {
     dupls = existing.combos[duplicated(existing.combos)]

R/relativeOverfitting.R

@@ -61,7 +61,7 @@ estimateRelativeOverfitting.ResamplePrediction = function(predish, measures, tas
     pred.train = makePrediction(task$task.desc, row.names(data), data$id, data$truth, predish$predict.type, predish$predict.threshold, data$response, predish$time[i])
 
     estimateRelativeOverfitting(pred.test, measures, task, pred.train = pred.train, iter = i)
-  }))
+  }), use.names = TRUE)
 }
 
 #' @export