X-Git-Url: https://git.auder.net/?a=blobdiff_plain;f=R%2FR6_Model.R;h=05cb7d8dd4bd52cb261a4110b56103799a83c1f8;hb=17ea2f13e0c32c107db20677750bd7a98bb7e0f8;hp=96f892d4b8a3e9ec1c0e410f34b03652d907b5f9;hpb=7b5193cdf5eb7041710c52368764feeacbb36a7c;p=agghoo.git

diff --git a/R/R6_Model.R b/R/R6_Model.R
index 96f892d..05cb7d8 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)
@@ -77,10 +77,18 @@ Model <- R6::R6Class("Model",
             colnames(dataHO) <- paste0("V", 1:ncol(dataHO))
           df <- data.frame(cbind(dataHO, target=targetHO))
           model <- rpart::rpart(target ~ ., df, method=method, control=list(cp=param))
+          if (task == "regression")
+            type <- "vector"
+          else {
+            if (is.null(dim(targetHO)))
+              type <- "class"
+            else
+              type <- "prob"
+          }
           function(X) {
             if (is.null(colnames(X)))
               colnames(X) <- paste0("V", 1:ncol(X))
-            predict(model, as.data.frame(X))
+            predict(model, as.data.frame(X), type=type)
           }
         }
       }
@@ -115,7 +123,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 +133,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)))]
       }
@@ -139,7 +147,7 @@ Model <- R6::R6Class("Model",
         p <- ncol(data)
         # Use caret package to obtain the CV grid of mtry values
         require(caret)
-        caret::var_seq(p, classification = (task == "classificaton"),
+        caret::var_seq(p, classification = (task == "classification"),
                        len = min(10, p-1))
       }
       else if (family == "ppr")