Fix agghoo for tree / rpart
[agghoo.git] / R / agghoo.R
... / ...
CommitLineData
1#' agghoo
2#'
3#' Run the agghoo procedure (or standard cross-validation).
4#' Arguments specify the list of models, their parameters and the
5#' cross-validation settings, among others.
6#'
7#' @param data Data frame or matrix containing the data in lines.
8#' @param target The target values to predict. Generally a vector,
9#' but possibly a matrix in the case of "soft classification".
10#' @param task "classification" or "regression". Default:
11#' regression if target is numerical, classification otherwise.
12#' @param gmodel A "generic model", which is a function returning a predict
13#' function (taking X as only argument) from the tuple
14#' (dataHO, targetHO, param), where 'HO' stands for 'Hold-Out',
15#' referring to cross-validation. Cross-validation is run on an array
16#' of 'param's. See params argument. Default: see R6::Model.
17#' @param params A list of parameters. Often, one list cell is just a
18#' numerical value, but in general it could be of any type.
19#' Default: see R6::Model.
20#' @param loss A function assessing the error of a prediction.
21#' Arguments are y1 and y2 (comparing a prediction to known values).
22#' loss(y1, y2) --> real number (error). Default: see R6::AgghooCV.
23#'
24#' @return
25#' An R6::AgghooCV object o. Then, call o$fit() and finally o$predict(newData)
26#'
27#' @examples
28#' # Regression:
29#' a_reg <- agghoo(iris[,-c(2,5)], iris[,2])
30#' a_reg$fit()
31#' pr <- a_reg$predict(iris[,-c(2,5)] + rnorm(450, sd=0.1))
32#' # Classification
33#' a_cla <- agghoo(iris[,-5], iris[,5])
34#' a_cla$fit()
35#' pc <- a_cla$predict(iris[,-5] + rnorm(600, sd=0.1))
36#'
37#' @references
38#' Guillaume Maillard, Sylvain Arlot, Matthieu Lerasle. "Aggregated hold-out".
39#' Journal of Machine Learning Research 22(20):1--55, 2021.
40#'
41#' @export
42agghoo <- function(data, target, task = NULL, gmodel = NULL, params = NULL, loss = NULL) {
43 # Args check:
44 if (!is.data.frame(data) && !is.matrix(data))
45 stop("data: data.frame or matrix")
46 if (is.data.frame(target) || is.matrix(target)) {
47 if (nrow(target) != nrow(data) || ncol(target) == 1)
48 stop("target probability matrix does not match data size")
49 }
50 else if (!is.numeric(target) && !is.factor(target) && !is.character(target))
51 stop("target: numeric, factor or character vector")
52 if (!is.null(task))
53 task = match.arg(task, c("classification", "regression"))
54 if (is.character(gmodel))
55 gmodel <- match.arg(gmodel, c("knn", "ppr", "rf", "tree"))
56 else if (!is.null(gmodel) && !is.function(gmodel))
57 # No further checks here: fingers crossed :)
58 stop("gmodel: function(dataHO, targetHO, param) --> function(X) --> y")
59 if (is.numeric(params) || is.character(params))
60 params <- as.list(params)
61 if (!is.list(params) && !is.null(params))
62 stop("params: numerical, character, or list (passed to model)")
63 if (is.function(gmodel) && !is.list(params))
64 stop("params must be provided when using a custom model")
65 if (is.list(params) && is.null(gmodel))
66 stop("model (or family) must be provided when using custom params")
67 if (!is.null(loss) && !is.function(loss))
68 # No more checks here as well... TODO:?
69 stop("loss: function(y1, y2) --> Real")
70
71 if (is.null(task)) {
72 if (is.numeric(target))
73 task = "regression"
74 else
75 task = "classification"
76 }
77 # Build Model object (= list of parameterized models)
78 model <- Model$new(data, target, task, gmodel, params)
79 # Return AgghooCV object, to run and predict
80 AgghooCV$new(data, target, task, model, loss)
81}