smarter predict_type handling

Author: mb706

R/PipeOp.R

@@ -364,9 +364,7 @@ PipeOp = R6Class("PipeOp",
     },
     predict_type = function(val) {
       if (!missing(val)) {
-        if (!identical(val, private$.learner)) {
-          stop("$predict_type is read-only.")
-        }
+        stop("$predict_type is read-only.")
       }
       return(NULL)
     },

R/PipeOpLearnerCV.R

@@ -161,6 +161,13 @@ PipeOpLearnerCV = R6Class("PipeOpLearnerCV",
       } else {
         multiplicity_recurse(self$state, clone_with_state, learner = private$.learner)
       }
+    },
+    predict_type = function(val) {
+      if (!missing(val)) {
+        assert_subset(val, names(mlr_reflections$learner_predict_types[[private$.learner$task_type]]))
+        private$.learner$predict_type = val
+      }
+      private$.learner$predict_type
     }
   ),
   private = list(

R/PipeOpTuneThreshold.R

@@ -89,6 +89,9 @@ PipeOpTuneThreshold = R6Class("PipeOpTuneThreshold",
       )
     }
   ),
+  active = list(
+    predict_type = function() "response"  # we are predict type "response" for now, so we don't break things. See discussion in #712
+  ),
   private = list(
     .train = function(input) {
       if(!all(input[[1]]$feature_types$type == "numeric")) {

tests/testthat/test_pipeop_learnercv.R

@@ -98,3 +98,25 @@ test_that("PipeOpLearnerCV - model active binding to state", {
   expect_null(po$learner$state)
   expect_equal(po$learner_model$state, po$state)
 })
+
+test_that("predict_type", {
+  expect_equal(po("learner_cv", lrn("classif.rpart", predict_type = "response"))$predict_type, "response")
+  expect_equal(po("learner_cv", lrn("classif.rpart", predict_type = "prob"))$predict_type, "prob")
+
+  lcv <- po("learner_cv", lrn("classif.rpart", predict_type = "prob"))
+
+  lcv$predict_type = "response"
+  expect_equal(lcv$predict_type, "response")
+  expect_equal(lcv$learner$predict_type, "response")
+
+  expect_equal(lcv$train(list(tsk("iris")))[[1]]$feature_names, "classif.rpart.response")
+
+  lcv$predict_type = "prob"
+
+  expect_equal(lcv$predict_type, "prob")
+  expect_equal(lcv$learner$predict_type, "prob")
+
+  expect_subset(c("classif.rpart.prob.virginica", "classif.rpart.prob.setosa", "classif.rpart.prob.versicolor"),
+    lcv$train(list(tsk("iris")))[[1]]$feature_names)
+
+})