From: Benjamin Auder <benjamin.auder@somewhere>
Date: Tue, 15 Jun 2021 05:40:33 +0000 (+0200)
Subject: Fix gmodel == tree for regression
X-Git-Url: https://git.auder.net/doc/html/css/current/scripts/R.css?a=commitdiff_plain;h=c152ea666f61e36b095bf8b42ab99efe9eab2dba;p=agghoo.git

Fix gmodel == tree for regression
---

diff --git a/R/R6_AgghooCV.R b/R/R6_AgghooCV.R
index c555641..81ddbe1 100644
--- a/R/R6_AgghooCV.R
+++ b/R/R6_AgghooCV.R
@@ -89,7 +89,7 @@ AgghooCV <- R6::R6Class("AgghooCV",
         return (invisible(NULL))
       }
       V <- length(private$pmodels)
-      oneLineX <- as.data.frame(t(as.matrix(X[1,])))
+      oneLineX <- t(as.matrix(X[1,]))
       if (length(private$pmodels[[1]]$model(oneLineX)) >= 2)
         # Soft classification:
         return (Reduce("+", lapply(private$pmodels, function(m) m$model(X))) / V)
diff --git a/R/R6_Model.R b/R/R6_Model.R
index 96f892d..3c84812 100644
--- a/R/R6_Model.R
+++ b/R/R6_Model.R
@@ -40,7 +40,7 @@ Model <- R6::R6Class("Model",
       if (is.null(params))
         # Here, gmodel is a string (= its family),
         # because a custom model must be given with its parameters.
-        params <- as.list(private$getParams(gmodel, data, target))
+        params <- as.list(private$getParams(gmodel, data, target, task))
       private$params <- params
       if (is.character(gmodel))
         gmodel <- private$getGmodel(gmodel, task)
@@ -115,7 +115,7 @@ Model <- R6::R6Class("Model",
       }
     },
     # Return a default list of parameters, given a gmodel family
-    getParams = function(family, data, target) {
+    getParams = function(family, data, target, task) {
       if (family == "tree") {
         # Run rpart once to obtain a CV grid for parameter cp
         require(rpart)
@@ -125,13 +125,13 @@ Model <- R6::R6Class("Model",
           minsplit = 2,
           minbucket = 1,
           xval = 0)
-        r <- rpart(target ~ ., df, method="class", control=ctrl)
+        method <- ifelse(task == "classification", "class", "anova")
+        r <- rpart(target ~ ., df, method=method, control=ctrl)
         cps <- r$cptable[-1,1]
-        if (length(cps) <= 11) {
-          if (length(cps == 0))
-            stop("No cross-validation possible: select another model")
+        if (length(cps) <= 1)
+          stop("No cross-validation possible: select another model")
+        if (length(cps) <= 11)
           return (cps)
-        }
         step <- (length(cps) - 1) / 10
         cps[unique(round(seq(1, length(cps), step)))]
       }