setClassUnion("OptionalNumeric", c("numeric", "NULL"))
setClassUnion("OptionalList", c("list","NULL"))
setClassUnion("OptionalCharacter", c("character","NULL"))
#' base_ensemble-class
#'
#' \strong{base_ensemble} is a S4 class that contains the base models
#' comprising the ensemble. Besides the base learning algorithms --
#' \code{base_models} -- base_ensemble class contains information
#' about other meta-data used to compute predictions for new upcoming data.
#'
#' @slot base_models a list comprising the base models;
#'
#' @slot pre_weights Normalized relative weights of the base learners according to
#' their performance on the available data;
#'
#' @slot form formula;
#'
#' @slot colnames names of the columns of the data used to train the \strong{base_models};
#'
#' @slot N number of base models;
#'
#' @slot model_distribution base learner distribution with respect to the type of learner.
#' That is, the number of Decision Trees, SVMs, etc.
#'
#' @keywords internal
#'
#' @export
setClass("base_ensemble",
slots = c(base_models = "list",
pre_weights = "OptionalNumeric",
form = "formula",
colnames = "OptionalCharacter",
N = "numeric",
model_distribution = "numeric")
)
#' base_ensemble
#'
#' \strong{base_ensemble} is a S4 class that contains the base models
#' comprising the ensemble. Besides the base learning algorithms --
#' \code{base_models} -- base_ensemble class contains information
#' about other meta-data used to compute predictions for new upcoming data.
#'
#' @param base_models a list comprising the base models;
#' @param pre_weights normalized relative weights of the base learners according to
#' their performance on the available data;
#' @param form formula;
#' @param colnames names of the columns of the data used to train the \strong{base_models};
#'
#' @export
base_ensemble <-
function(base_models, pre_weights, form, colnames) {
N <- length(base_models)
mnames <- sapply(names(base_models),
function(i) split_by_(i)[1])
model_distribution <- table(mnames)
unames <- names(model_distribution)
model_distribution <- as.vector(model_distribution)
names(model_distribution) <- unames
methods::new(
"base_ensemble",
base_models = base_models,
pre_weights = pre_weights,
form = form,
colnames = colnames,
N = N,
model_distribution = model_distribution
)
}
#' Setup base learning models
#'
#' This class sets up the base learning models and respective
#' parameters setting to learn the ensemble.
#'
#' @slot learner character vector with the base learners
#' to be trained. Currently available models are:
#' \describe{
#' \item{\strong{bm_gaussianprocess}}{Gaussian Process models, from the
#' \strong{kernlab} package. See \code{\link[kernlab]{gausspr}}
#' for a complete description and possible parametrization. See
#' \code{\link{bm_gaussianprocess}} for the function implementation.}
#'
#' \item{\strong{bm_ppr}}{Projection Pursuit Regression models, from the
#' \strong{stats} package. See \code{\link[stats]{ppr}}
#' for a complete description and possible parametrization. See
#' \code{\link{bm_ppr}} for the function implementation.}
#'
#' \item{\strong{bm_glm}}{Generalized Linear Models, from the
#' \strong{glmnet} package. See \code{\link[glmnet]{glmnet}}
#' for a complete description and possible parametrization. See
#' \code{\link{bm_glm}} for the function implementation.}
#'
#' \item{\strong{bm_gbm}}{Generalized Boosted Regression models, from the
#' \strong{gbm} package. See \code{\link[gbm]{gbm}}
#' for a complete description and possible parametrization. See
#' \code{\link{bm_gbm}} for the function implementation.}
#'
#' \item{\strong{bm_randomforest}}{Random Forest models, from the
#' \strong{ranger} package. See \code{\link[ranger]{ranger}}
#' for a complete description and possible parametrization. See
#' \code{\link{bm_randomforest}} for the function implementation.}
#'
#' \item{\strong{bm_cubist}}{M5 tree models, from the
#' \strong{Cubist} package. See \code{\link[Cubist]{cubist}}
#' for a complete description and possible parametrization. See
#' \code{\link{bm_cubist}} for the function implementation.}
#'
#' \item{\strong{bm_mars}}{Multivariate Adaptive Regression Splines models, from the
#' \strong{earth} package. See \code{\link[earth]{earth}}
#' for a complete description and possible parametrization. See
#' \code{\link{bm_mars}} for the function implementation.}
#'
#' \item{\strong{bm_svr}}{Support Vector Regression models, from the
#' \strong{kernlab} package. See \code{\link[kernlab]{ksvm}}
#' for a complete description and possible parametrization. See
#' \code{\link{bm_svr}} for the function implementation.}
#'
#' \item{\strong{bm_ffnn}}{Feedforward Neural Network models, from the
#' \strong{nnet} package. See \code{\link[nnet]{nnet}}
#' for a complete description and possible parametrization. See
#' \code{\link{bm_ffnn}} for the function implementation.}
#'
#' \item{\strong{bm_pls_pcr}}{Partial Least Regression and Principal
#' Component Regression models, from the \strong{pls} package.
#' See \code{\link[pls]{mvr}} for a complete description
#' and possible parametrization. See \code{\link{bm_pls_pcr}}
#' for the function implementation.}
#' }
#'
#' @slot learner_pars a list with parameter setting for the
#' \strong{learner}. For each model, a inner list should be created
#' with the specified parameters.
#'
#' Check each implementation to see the possible
#' variations of parameters (also examplified below).
#'
#' @examples
#' # A PPR model and a GLM model with default parameters
#' model_specs(learner = c("bm_ppr", "bm_glm"), learner_pars = NULL)
#'
#'
#' # A PPR model and a SVR model. The listed parameters are combined
#' # with a cartesian product.
#' # With these specifications an ensemble with 6 predictive base
#' # models will be created. Two PPR models, one with 2 nterms
#' # and another with 4; and 4 SVR models, combining the kernel
#' # and C parameters.
#' specs <- model_specs(
#' c("bm_ppr", "bm_svr"),
#' list(bm_ppr = list(nterms = c(2, 4)),
#' bm_svr = list(kernel = c("vanilladot", "polydot"), C = c(1,5)))
#' )
#'
#' # All parameters currently available (parameter values can differ)
#' model_specs(
#' learner = c("bm_ppr", "bm_svr", "bm_randomforest",
#' "bm_gaussianprocess", "bm_cubist", "bm_glm",
#' "bm_gbm", "bm_pls_pcr", "bm_ffnn", "bm_mars"
#' ),
#' learner_pars = list(
#' bm_ppr = list(
#' nterms = c(2,4),
#' sm.method = "supsmu"
#' ),
#' bm_svr = list(
#' kernel = "rbfdot",
#' C = c(1,5),
#' epsilon = .01
#' ),
#' bm_glm = list(
#' alpha = c(1, 0)
#' ),
#' bm_randomforest = list(
#' num.trees = 500
#' ),
#' bm_gbm = list(
#' interaction.depth = 1,
#' shrinkage = c(.01, .005),
#' n.trees = c(100)
#' ),
#' bm_mars = list(
#' nk = 15,
#' degree = 3,
#' thresh = .001
#' ),
#' bm_ffnn = list(
#' size = 30,
#' decay = .01
#' ),
#' bm_pls_pcr = list(
#' method = c("kernelpls", "simpls", "cppls")
#' ),
#' bm_gaussianprocess = list(
#' kernel = "vanilladot",
#' tol = .01
#' ),
#' bm_cubist = list(
#' committees = 50,
#' neighbors = 0
#' )
#' )
#' )
#'
#' @keywords internal
#'
#' @export
setClass("model_specs",
slots = c(learner = "character", learner_pars = "OptionalList")
)
#' Setup base learning models
#'
#' This class sets up the base learning models and respective
#' parameters setting to learn the ensemble.
#'
#' @param learner character vector with the base learners
#' to be trained. Currently available models are:
#' \describe{
#' \item{\strong{bm_gaussianprocess}}{Gaussian Process models, from the
#' \strong{kernlab} package. See \code{\link[kernlab]{gausspr}}
#' for a complete description and possible parametrization. See
#' \code{\link{bm_gaussianprocess}} for the function implementation.}
#'
#' \item{\strong{bm_ppr}}{Projection Pursuit Regression models, from the
#' \strong{stats} package. See \code{\link[stats]{ppr}}
#' for a complete description and possible parametrization. See
#' \code{\link{bm_ppr}} for the function implementation.}
#'
#' \item{\strong{bm_glm}}{Generalized Linear Models, from the
#' \strong{glmnet} package. See \code{\link[glmnet]{glmnet}}
#' for a complete description and possible parametrization. See
#' \code{\link{bm_glm}} for the function implementation.}
#'
#' \item{\strong{bm_gbm}}{Generalized Boosted Regression models, from the
#' \strong{gbm} package. See \code{\link[gbm]{gbm}}
#' for a complete description and possible parametrization. See
#' \code{\link{bm_gbm}} for the function implementation.}
#'
#' \item{\strong{bm_randomforest}}{Random Forest models, from the
#' \strong{ranger} package. See \code{\link[ranger]{ranger}}
#' for a complete description and possible parametrization. See
#' \code{\link{bm_randomforest}} for the function implementation.}
#'
#' \item{\strong{bm_cubist}}{M5 tree models, from the
#' \strong{Cubist} package. See \code{\link[Cubist]{cubist}}
#' for a complete description and possible parametrization. See
#' \code{\link{bm_cubist}} for the function implementation.}
#'
#' \item{\strong{bm_mars}}{Multivariate Adaptive Regression Splines models, from the
#' \strong{earth} package. See \code{\link[earth]{earth}}
#' for a complete description and possible parametrization. See
#' \code{\link{bm_mars}} for the function implementation.}
#'
#' \item{\strong{bm_svr}}{Support Vector Regression models, from the
#' \strong{kernlab} package. See \code{\link[kernlab]{ksvm}}
#' for a complete description and possible parametrization. See
#' \code{\link{bm_svr}} for the function implementation.}
#'
#' \item{\strong{bm_ffnn}}{Feedforward Neural Network models, from the
#' \strong{nnet} package. See \code{\link[nnet]{nnet}}
#' for a complete description and possible parametrization. See
#' \code{\link{bm_ffnn}} for the function implementation.}
#'
#' \item{\strong{bm_pls_pcr}}{Partial Least Regression and Principal
#' Component Regression models, from the \strong{pls} package.
#' See \code{\link[pls]{mvr}} for a complete description
#' and possible parametrization. See \code{\link{bm_pls_pcr}}
#' for the function implementation.}
#' }
#'
#' @param learner_pars a list with parameter setting for the
#' \strong{learner}. For each model, a inner list should be created
#' with the specified parameters.
#'
#' Check each implementation to see the possible
#' variations of parameters (also examplified below).
#'
#' @examples
#' # A PPR model and a GLM model with default parameters
#' model_specs(learner = c("bm_ppr", "bm_glm"), learner_pars = NULL)
#'
#'
#' # A PPR model and a SVR model. The listed parameters are combined
#' # with a cartesian product.
#' # With these specifications an ensemble with 6 predictive base
#' # models will be created. Two PPR models, one with 2 nterms
#' # and another with 4; and 4 SVR models, combining the kernel
#' # and C parameters.
#' specs <- model_specs(
#' c("bm_ppr", "bm_svr"),
#' list(bm_ppr = list(nterms = c(2, 4)),
#' bm_svr = list(kernel = c("vanilladot", "polydot"), C = c(1,5)))
#' )
#'
#' # All parameters currently available (parameter values can differ)
#' model_specs(
#' learner = c("bm_ppr", "bm_svr", "bm_randomforest",
#' "bm_gaussianprocess", "bm_cubist", "bm_glm",
#' "bm_gbm", "bm_pls_pcr", "bm_ffnn", "bm_mars"
#' ),
#' learner_pars = list(
#' bm_ppr = list(
#' nterms = c(2,4),
#' sm.method = "supsmu"
#' ),
#' bm_svr = list(
#' kernel = "rbfdot",
#' C = c(1,5),
#' epsilon = .01
#' ),
#' bm_glm = list(
#' alpha = c(1, 0)
#' ),
#' bm_randomforest = list(
#' num.trees = 500
#' ),
#' bm_gbm = list(
#' interaction.depth = 1,
#' shrinkage = c(.01, .005),
#' n.trees = c(100)
#' ),
#' bm_mars = list(
#' nk = 15,
#' degree = 3,
#' thresh = .001
#' ),
#' bm_ffnn = list(
#' size = 30,
#' decay = .01
#' ),
#' bm_pls_pcr = list(
#' method = c("kernelpls", "simpls", "cppls")
#' ),
#' bm_gaussianprocess = list(
#' kernel = "vanilladot",
#' tol = .01
#' ),
#' bm_cubist = list(
#' committees = 50,
#' neighbors = 0
#' )
#' )
#' )
#'
#' @export
model_specs <-
function(learner, learner_pars = NULL) {
.available_models <-
c("bm_gaussianprocess",
"bm_ppr",
"bm_glm",
"bm_gbm",
"bm_randomforest",
"bm_ffnn",
"bm_svr",
"bm_mars",
"bm_cubist",
"bm_pls_pcr",
"bm_xgb"
)
if (!all(learner %in% .available_models))
stop("One or more invalid base models.", call. = FALSE)
if (!is.null(learner_pars)) {
if (!all(names(learner_pars) %in% .available_models)) {
warning("Some model parameter name badly specified.
The parameter list must have the same names as the models.
Check ?model_specs for the available models and some examples.")
}
names_pars <- names(learner_pars)
for (model in learner)
if (is_model_in_pars(model,
learner,
names_pars)) {
are_pars_valid(model, learner_pars)
}
}
methods::new("model_specs",
learner = learner,
learner_pars = learner_pars)
}
setMethod("show",
signature("model_specs"),
function(object) {
mnames <- paste(object@learner, collapse = ",\n ")
cat("Ensemble setup with the individual models:\n", mnames,"\n\n")
if (is.null(object@learner_pars))
cat("Parameter setup will be set with default values.\n")
else {
m_tbl <- lapply(object@learner_pars, expand.grid)
null.pars <- !(object@learner %in% names(m_tbl))
set_up_models <- object@learner[!null.pars]
par_models <- paste(set_up_models, collapse = ", ")
cat(par_models,
"models will have the following parameters set up:\n\n")
for (m in set_up_models) {
cat(m, ": ")
cat(paste(names(object@learner_pars[[m]]), collapse = ", "), "\n")
}
null_par_models <-
paste(object@learner[null.pars], collapse = ", ")
cat(null_par_models,
"models will be set up with default parameters.\n")
N <- sum(sapply(m_tbl, nrow)) + sum(null.pars)
cat("\nWith these specs, the ensemble size is:", N)
}
}
)
#' Arbitrated Dynamic Ensemble
#'
#' Arbitrated Dynamic Ensemble (ADE) is an ensemble approach
#' for adaptively combining forecasting models. A metalearning
#' strategy is used that specializes base models
#' across the time series. Each meta-learner is specifically
#' designed to model how apt its base counterpart is to make
#' a prediction for a given test example. This is accomplished
#' by analysing how the error incurred by a given learning model
#' relates to the characteristics of the data. At test time,
#' the base-learners are weighted according to their degree
#' of competence in the input observation, estimated by the
#' predictions of the meta-learners.
#'
#' @slot base_ensemble object of class \code{\link{base_ensemble-class}}.
#' It contains the base models used that can be used for predicting
#' new data or forecasting future values;
#'
#' @slot meta_model a list containing the meta models, one for
#' each base model. The meta-models are random forests;
#'
#' @slot form formula;
#'
#' @slot specs object of class \code{\link{model_specs-class}}. Contains
#' the parameter setting information for training the
#' base models;
#'
#' @slot lambda window size. Number of observations to compute
#' the recent performance of the base models, according to the
#' committee ratio \strong{omega}. Essentially, the top \emph{omega}
#' models are selected and weighted at each prediction instance, according
#' to their performance in the last \emph{lambda} observations.
#' Defaults to 50 according to empirical experiments;
#'
#' @slot omega committee ratio size. Essentially, the top \emph{omega} * 100
#' percent of models are selected and weighted at each prediction instance, according
#' to their performance in the last \emph{lambda} observations.
#' Defaults to .5 according to empirical experiments;
#'
#' @slot select_best Logical. If true, at each prediction time,
#' a single base model is picked to make a prediction. The picked
#' model is the one that has the lowest loss prediction from
#' the meta models. Defaults to FALSE;
#'
#' @slot all_models Logical. If true, at each prediction time,
#' all base models are picked to make a prediction. The
#' models are weighted according to their predicted loss
#' and the \code{aggregation} function. Defaults to FALSE;
#'
#' @slot aggregation Type of aggregation used to combine the
#' predictions of the base models. The options are:
#' \describe{
#' \item{softmax}{default}
#' \item{erfc}{the complementary Gaussian error function}
#' \item{linear}{a linear scaling}
#' }
#'
#' @slot sequential_reweight Besides ensemble heterogeneity we encourage diversity
#' explicitly during the aggregation of the output of experts.
#' This is achieved by taking into account not only predictions
#' of performance produced by the arbiters, but also the
#' correlation among experts in a recent window of observations.
#'
#' @slot recent_series the most recent \code{lambda} observations.
#'
#' @slot out_of_bag Out of bag observations used to train arbiters.
#'
#' @slot meta_model_type meta model to use -- defaults to random forest
#'
#' @references Cerqueira, Vitor; Torgo, Luis; Pinto, Fabio;
#' and Soares, Carlos. "Arbitrated Ensemble for Time Series
#' Forecasting" to appear at: Joint European Conference on Machine Learning and
#' Knowledge Discovery in Databases. Springer International
#' Publishing, 2017.
#'
#' V. Cerqueira, L. Torgo, and C. Soares, “Arbitrated ensemble for
#' solar radiation forecasting,” in International Work-Conference on
#' Artificial Neural Networks. Springer, Cham, 2017, pp. 720–732
#'
#' @seealso \code{\link{model_specs-class}} for setting up the ensemble parameters
#' for an \strong{ADE} model;
#' \code{\link{predict}} for the method that predicts new held out observations;
#' \code{\link{update_weights}} for the method used to update the
#' weights of an \strong{ADE} model between successive predict or forecast calls;
#' \code{\link{update_ade_meta}} for updating (retraining) the meta models
#' of an \strong{ADE} model; \code{\link{update_base_models}} for
#' the updating (retraining) the base models of an \strong{ADE} ensemble (and respective
#' weights); \code{\link{ade_hat-class}} for the object that results from
#' predicting with an \strong{ADE} model; and \code{\link{update_ade}} to update an ADE
#' model, combining functions \strong{update_base_models}, \strong{update_meta_ade}, and
#' \strong{update_weights}.
#'
#' @examples
#' specs <- model_specs(
#' learner = c("bm_ppr", "bm_glm", "bm_mars"),
#' learner_pars = list(
#' bm_glm = list(alpha = c(0, .5, 1)),
#' bm_svr = list(kernel = c("rbfdot", "polydot"),
#' C = c(1, 3)),
#' bm_ppr = list(nterms = 4)
#' )
#' )
#'
#' data("water_consumption")
#' train <- embed_timeseries(water_consumption, 5)
#' train <- train[1:300, ] # toy size for checks
#'
#' model <- ADE(target ~., train, specs)
#'
#' @keywords internal
#'
#' @export
setClass("ADE",
slots = c(base_ensemble = "base_ensemble",
meta_model = "list",
form = "formula",
specs = "model_specs",
lambda = "numeric",
omega = "OptionalNumeric",
select_best = "logical",
all_models = "logical",
aggregation = "character",
sequential_reweight = "logical",
recent_series = "data.frame",
out_of_bag = "OptionalList",
meta_model_type = "character")
)
#' Arbitrated Dynamic Ensemble
#'
#' Arbitrated Dynamic Ensemble (ADE) is an ensemble approach
#' for adaptively combining forecasting models. A metalearning
#' strategy is used that specializes base models
#' across the time series. Each meta-learner is specifically
#' designed to model how apt its base counterpart is to make
#' a prediction for a given test example. This is accomplished
#' by analysing how the error incurred by a given learning model
#' relates to the characteristics of the data. At test time,
#' the base-learners are weighted according to their degree
#' of competence in the input observation, estimated by the
#' predictions of the meta-learners.
#'
#' @param form formula;
#'
#' @param data data to train the base models
#'
#' @param specs object of class \code{\link{model_specs-class}}. Contains
#' the parameter setting information for training the
#' base models;
#'
#' @param lambda window size. Number of observations to compute
#' the recent performance of the base models, according to the
#' committee ratio \strong{omega}. Essentially, the top \emph{omega}
#' models are selected and weighted at each prediction instance, according
#' to their performance in the last \emph{lambda} observations.
#' Defaults to 50 according to empirical experiments;
#'
#' @param omega committee ratio size. Essentially, the top \emph{omega} * 100
#' percent of models are selected and weighted at each prediction instance, according
#' to their performance in the last \emph{lambda} observations.
#' Defaults to .5 according to empirical experiments;
#'
#' @param select_best Logical. If true, at each prediction time,
#' a single base model is picked to make a prediction. The picked
#' model is the one that has the lowest loss prediction from
#' the meta models. Defaults to FALSE;
#'
#' @param all_models Logical. If true, at each prediction time,
#' all base models are picked to make a prediction. The
#' models are weighted according to their predicted loss
#' and the \code{aggregation} function. Defaults to FALSE;
#'
#' @param aggregation Type of aggregation used to combine the
#' predictions of the base models. The options are:
#' \describe{
#' \item{softmax}{default}
#' \item{erfc}{the complementary Gaussian error function}
#' \item{linear}{a linear scaling}
#' }
#'
#' @param sequential_reweight Besides ensemble heterogeneity we encourage diversity
#' explicitly during the aggregation of the output of experts.
#' This is achieved by taking into account not only predictions
#' of performance produced by the arbiters, but also the
#' correlation among experts in a recent window of observations.
#'
#' @param meta_loss_fun Besides
#'
#' @param meta_model_type meta model to use -- defaults to random forest
#'
#' @param num_cores A numeric value to specify the number of cores used to
#' train base and meta models. num_cores = 1
#' leads to sequential training of models. num_cores > 1
#' splits the training of the base models across num_cores cores.
#'
#' @references Cerqueira, Vitor; Torgo, Luis; Pinto, Fabio;
#' and Soares, Carlos. "Arbitrated Ensemble for Time Series
#' Forecasting" to appear at: Joint European Conference on Machine Learning and
#' Knowledge Discovery in Databases. Springer International
#' Publishing, 2017.
#'
#' V. Cerqueira, L. Torgo, and C. Soares, “Arbitrated ensemble for
#' solar radiation forecasting,” in International Work-Conference on
#' Artificial Neural Networks. Springer, Cham, 2017, pp. 720–732
#'
#' @seealso \code{\link{model_specs-class}} for setting up the ensemble parameters
#' for an \strong{ADE} model;
#' \code{\link{predict}} for the method that predicts new held out observations;
#' \code{\link{update_weights}} for the method used to update the
#' weights of an \strong{ADE} model between successive predict or forecast calls;
#' \code{\link{update_ade_meta}} for updating (retraining) the meta models
#' of an \strong{ADE} model; \code{\link{update_base_models}} for
#' the updating (retraining) the base models of an \strong{ADE} ensemble (and respective
#' weights); \code{\link{ade_hat-class}} for the object that results from
#' predicting with an \strong{ADE} model; and \code{\link{update_ade}} to update an ADE
#' model, combining functions \strong{update_base_models}, \strong{update_meta_ade}, and
#' \strong{update_weights}.
#'
#' @examples
#' specs <- model_specs(
#' learner = c("bm_ppr", "bm_glm", "bm_mars"),
#' learner_pars = list(
#' bm_glm = list(alpha = c(0, .5, 1)),
#' bm_svr = list(kernel = c("rbfdot", "polydot"),
#' C = c(1, 3)),
#' bm_ppr = list(nterms = 4)
#' )
#' )
#'
#' data("water_consumption")
#' train <- embed_timeseries(water_consumption, 5)
#' train <- train[1:300, ] # toy size for checks
#'
#' model <- ADE(target ~., train, specs)
#'
#' @export
"ADE" <-
function(form,
data,
specs,
lambda = 50,
omega = .5,
select_best = FALSE,
all_models = FALSE,
aggregation = "linear",
sequential_reweight = FALSE,
meta_loss_fun = ae,
meta_model_type = "randomforest",
num_cores = 1) {
if (select_best && is.numeric(omega))
warning(
"ADE setup with both selection of best learner and
a committee (\"omega\" parameter).
\"omega\" parameter will be ignored."
)
if (all_models && is.numeric(omega))
warning(
"ADE setup with both selection of all learners and
a committee (\"omega\" parameter).
\"omega\" parameter will be ignored."
)
if (select_best && all_models)
stop("Choose either \"select_best\" or \"all_models\" option.",
call. = FALSE)
if (!is.null(omega))
if (omega >= 1 | omega <= 0)
stop("\"omega\" parameter must be a double between 0 and 1",
call. = FALSE)
if (lambda < 1 | lambda > nrow(data))
stop("\"lambda\" parameter must be a positive integer < nrow(data)",
call. = FALSE)
M <-
train_ade(
form = form,
train = data,
specs = specs,
lambda = lambda,
lfun = meta_loss_fun,
meta_model_type = meta_model_type,
num_cores = num_cores)
methods::new(
"ADE",
base_ensemble = M$base_ensemble,
meta_model = M$meta_model,
form = form,
specs = specs,
lambda = lambda,
omega = omega,
select_best = select_best,
all_models = all_models,
aggregation = aggregation,
sequential_reweight = sequential_reweight,
recent_series = M$recent_series,
out_of_bag = M$OOB,
meta_model_type = meta_model_type
)
}
#' Quick Arbitrated Dynamic Ensemble
#'
#' @rdname ADE
#'
#' @export
"quickADE" <-
function(form,
data,
specs,
lambda = 50,
omega = .5,
select_best = FALSE,
all_models = FALSE,
aggregation = "linear",
sequential_reweight = FALSE,
meta_loss_fun = ae,
meta_model_type = "randomforest",
num_cores = 1) {
if (select_best && is.numeric(omega))
warning(
"ADE setup with both selection of best learner and
a committee (\"omega\" parameter).
\"omega\" parameter will be ignored."
)
if (all_models && is.numeric(omega))
warning(
"ADE setup with both selection of all learners and
a committee (\"omega\" parameter).
\"omega\" parameter will be ignored."
)
if (select_best && all_models)
stop("Choose either \"select_best\" or \"all_models\" option.",
call. = FALSE)
if (!is.null(omega))
if (omega >= 1 | omega <= 0)
stop("\"omega\" parameter must be a double between 0 and 1",
call. = FALSE)
if (lambda < 1 | lambda > nrow(data))
stop("\"lambda\" parameter must be a positive integer < nrow(data)",
call. = FALSE)
M <-
train_ade_quick(
form = form,
train = data,
specs = specs,
lambda = lambda,
lfun = meta_loss_fun,
meta_model_type = meta_model_type,
num_cores = num_cores)
methods::new(
"ADE",
base_ensemble = M$base_ensemble,
meta_model = M$meta_model,
form = form,
specs = specs,
lambda = lambda,
omega = omega,
select_best = select_best,
all_models = all_models,
aggregation = aggregation,
sequential_reweight = sequential_reweight,
recent_series = M$recent_series,
out_of_bag = M$OOB,
meta_model_type = meta_model_type
)
}
#' Predictions by an ADE ensemble
#'
#' Predictions produced by a \code{\link{ADE-class}} object.
#' It contains \strong{y_hat}, the combined predictions,
#' \strong{Y_hat}, the predictions of each base model,
#' \strong{Y_committee}, the base models used for prediction
#' at each time point, and \strong{E_hat}, the loss predictions
#' by each meta-model.
#'
#' @slot y_hat combined predictions of the ensemble
#' \code{\link{ADE-class}}. A numeric vector;
#'
#' @slot Y_hat a matrix containing the predictions made by
#' individual models;
#'
#' @slot Y_committee a list describing the models selected for
#' predictions at each time point (according to \strong{lambda}
#' and \strong{omega});
#'
#' @slot E_hat predictions of error of each base model, estimated
#' by their respective meta model associate;
#'
#' @seealso \code{\link{ADE}} for generating an ADE ensemble.
#'
#' @family ensemble predictions
#'
#' @keywords internal
#'
#' @export
setClass("ade_hat",
slots = c(y_hat = "numeric",
Y_hat = "data.frame",
Y_committee = "OptionalList",
E_hat = "data.frame")
)
#' Predictions by an ADE ensemble
#'
#' Predictions produced by a \code{\link{ADE-class}} object.
#' It contains \strong{y_hat}, the combined predictions,
#' \strong{Y_hat}, the predictions of each base model,
#' \strong{Y_committee}, the base models used for prediction
#' at each time point, and \strong{E_hat}, the loss predictions
#' by each meta-model.
#'
#' @param y_hat combined predictions of the ensemble
#' \code{\link{ADE}}. A numeric vector;
#'
#' @param Y_hat a matrix containing the predictions made by
#' individual models;
#'
#' @param Y_committee a list describing the models selected for
#' predictions at each time point (according to \strong{lambda}
#' and \strong{omega});
#'
#' @param E_hat predictions of error of each base model, estimated
#' by their respective meta model associate;
#'
#' @family ensemble predictions
#'
#' @seealso \code{\link{ADE-class}} for generating an ADE ensemble.
#'
#' @keywords internal
#'
#' @export
ade_hat <- function(y_hat, Y_hat, Y_committee, E_hat) {
if (missing(Y_committee)) Y_committee <- NULL
methods::new(
"ade_hat",
y_hat = y_hat,
Y_hat = Y_hat,
Y_committee = Y_committee,
E_hat = E_hat
)
}
#' Dynamic Ensemble for Time Series
#'
#' A Dynamic Ensemble for Time Series (DETS). The DETS ensemble
#' method we present settles on individually pre-trained models
#' which are dynamically combined at run-time to make a prediction.
#' The combination rule is reactive to changes in the environment,
#' rendering an online combined model. The main properties of the ensemble
#' are:
#' \describe{
#' \item{heterogeneity}{Heterogeneous ensembles are those
#' comprised of different types of base learners. By employing
#' models that follow different learning strategies, use different
#' features and/or data observations we expect that individual
#' learners will disagree with each other, introducing a natural
#' diversity into the ensemble that helps in handling different
#' dynamic regimes in a time series forecasting setting;}
#' \item{responsiveness}{We promote greater responsiveness of
#' heterogeneous ensembles in time series tasks by making the
#' aggregation of their members' predictions time-dependent.
#' By tracking the loss of each learner over time, we weigh
#' the predictions of individual learners according to their
#' recent performance using a non-linear function. This strategy
#' may be advantageous for better detecting regime changes and
#' also to quickly adapt the ensemble to new regimes.}
#' }
#'
#' @slot base_ensemble object of class \code{\link{base_ensemble-class}}.
#' It contains the base models used that can be used for predicting
#' new data or forecasting future values;
#'
#' @slot form formula;
#'
#' @slot specs object of class \code{\link{model_specs-class}}. Contains
#' the parameter setting information for training the
#' base models;
#'
#' @slot lambda window size. Number of observations to compute
#' the recent performance of the base models, according to the
#' committee ratio \strong{omega}. Essentially, the top \emph{omega}
#' models are selected and weighted at each prediction instance, according
#' to their performance in the last \emph{lambda} observations.
#' Defaults to 50 according to empirical experiments;
#'
#' @slot omega committee ratio size. Essentially, the top \emph{omega}
#' models are selected and weighted at each prediction instance, according
#' to their performance in the last \emph{lambda} observations.
#' Defaults to .5 according to empirical experiments;
#'
#' @slot select_best Logical. If true, at each prediction time,
#' a single base model is picked to make a prediction. The picked
#' model is the one that has the lowest loss prediction from
#' the meta models. Defaults to FALSE;
#'
#' @slot recent_series the most recent \code{lambda} observations.
#'
#' @references Cerqueira, Vitor; Torgo, Luis; Oliveira, Mariana,
#' and Bernhard Pfahringer. "Dynamic and Heterogeneous Ensembles
#' for Time Series Forecasting." Data Science and Advanced
#' Analytics (DSAA), 2017 IEEE International Conference on. IEEE, 2017.
#'
#' @seealso \code{\link{model_specs-class}} for setting up the ensemble parameters
#' for an \strong{DETS} model;
#' \code{\link{predict}} for the method that predicts new held out observations;
#' \code{\link{update_weights}} for the method used to update the
#' weights of an \strong{DETS} model between successive predict or forecast calls;
#' \code{\link{update_base_models}} for the updating (retraining)
#' the base models of an \strong{DETS} ensemble (and respective
#' weights); and \code{\link{dets_hat-class}} for the object that results from
#' predicting with an \strong{DETS} model.
#'
#' @examples
#' specs <- model_specs(
#' c("bm_ppr", "bm_svr"),
#' list(bm_ppr = list(nterms = c(2, 4)),
#' bm_svr = list(kernel = c("vanilladot"), C = c(1,5)))
#' )
#'
#' data("water_consumption")
#' train <- embed_timeseries(water_consumption, 5)[1:500,]
#'
#' model <- DETS(target ~., train, specs, lambda = 30, omega = .2)
#'
#' @keywords internal
#'
#' @export
setClass("DETS",
slots = c(base_ensemble = "base_ensemble",
form = "formula",
specs = "model_specs",
lambda = "OptionalNumeric",
omega = "OptionalNumeric",
select_best = "logical",
recent_series = "data.frame")
)
#' Dynamic Ensemble for Time Series
#'
#' A Dynamic Ensemble for Time Series (DETS). The DETS ensemble
#' method we present settles on individually pre-trained models
#' which are dynamically combined at run-time to make a prediction.
#' The combination rule is reactive to changes in the environment,
#' rendering an online combined model. The main properties of the ensemble
#' are:
#' \describe{
#' \item{heterogeneity}{Heterogeneous ensembles are those
#' comprised of different types of base learners. By employing
#' models that follow different learning strategies, use different
#' features and/or data observations we expect that individual
#' learners will disagree with each other, introducing a natural
#' diversity into the ensemble that helps in handling different
#' dynamic regimes in a time series forecasting setting;}
#' \item{responsiveness}{We promote greater responsiveness of
#' heterogeneous ensembles in time series tasks by making the
#' aggregation of their members' predictions time-dependent.
#' By tracking the loss of each learner over time, we weigh
#' the predictions of individual learners according to their
#' recent performance using a non-linear function. This strategy
#' may be advantageous for better detecting regime changes and
#' also to quickly adapt the ensemble to new regimes.}
#' }
#'
#' @param form formula;
#'
#' @param data data frame to train the base models;
#'
#' @param specs object of class \code{\link{model_specs-class}}. Contains
#' the parameter setting information for training the
#' base models;
#'
#' @param lambda window size. Number of observations to compute
#' the recent performance of the base models, according to the
#' committee ratio \strong{omega}. Essentially, the top \emph{omega}
#' models are selected and weighted at each prediction instance, according
#' to their performance in the last \emph{lambda} observations.
#' Defaults to 50 according to empirical experiments;
#'
#' @param omega committee ratio size. Essentially, the top \emph{omega}
#' models are selected and weighted at each prediction instance, according
#' to their performance in the last \emph{lambda} observations.
#' Defaults to .5 according to empirical experiments;
#'
#' @param select_best Logical. If true, at each prediction time,
#' a single base model is picked to make a prediction. The picked
#' model is the one that has the lowest loss prediction from
#' the meta models. Defaults to FALSE;
#'
#' @param num_cores A numeric value to specify the number of cores used to
#' train base and meta models. num_cores = 1
#' leads to sequential training of models. num_cores > 1
#' splits the training of the base models across num_cores cores.
#'
#' @references Cerqueira, Vitor; Torgo, Luis; Oliveira, Mariana,
#' and Bernhard Pfahringer. "Dynamic and Heterogeneous Ensembles
#' for Time Series Forecasting." Data Science and Advanced
#' Analytics (DSAA), 2017 IEEE International Conference on. IEEE, 2017.
#'
#' @seealso \code{\link{model_specs-class}} for setting up the ensemble parameters
#' for an \strong{DETS} model;
#' \code{\link{predict}} for the method that predicts new held out observations;
#' \code{\link{update_weights}} for the method used to update the
#' weights of an \strong{DETS} model between successive predict or forecast calls;
#' \code{\link{update_base_models}} for the updating (retraining)
#' the base models of an \strong{DETS} ensemble (and respective
#' weights); and \code{\link{dets_hat-class}} for the object that results from
#' predicting with an \strong{DETS} model.
#'
#' @examples
#' specs <- model_specs(
#' c("bm_ppr", "bm_svr"),
#' list(bm_ppr = list(nterms = c(2, 4)),
#' bm_svr = list(kernel = c("vanilladot", "polydot"), C = c(1,5)))
#' )
#'
#' data("water_consumption");
#' train <- embed_timeseries(water_consumption, 5);
#'
#' model <- DETS(target ~., train, specs, lambda = 30, omega = .2)
#'
#' @export
"DETS" <-
function(form,
data,
specs,
lambda = 50,
omega = .5,
select_best = FALSE,
num_cores=1) {
M <- build_base_ensemble(form, data, specs, num_cores)
recent_lambda_k <- recent_lambda_observations(data, lambda)
methods::new(
"DETS",
base_ensemble = M,
form = form,
specs = specs,
lambda = lambda,
omega = omega,
select_best = select_best,
recent_series = recent_lambda_k
)
}
#' Predictions by an DETS ensemble
#'
#' @slot y_hat combined predictions of the ensemble
#' \code{\link{DETS-class}}. A numeric vector;
#'
#' @slot Y_hat a matrix containing the predictions made by
#' individual models;
#'
#' @slot Y_committee a list describing the models selected for
#' predictions at each time point (according to \strong{lambda}
#' and \strong{omega});
#'
#' @slot W a matrix with the weights of the base models at each prediction
#' time.
#'
#' @family ensemble predictions
#'
#' @keywords internal
#'
#' @export
setClass("dets_hat",
slots = c(y_hat = "numeric",
Y_hat = "data.frame",
Y_committee = "OptionalList",
W = "data.frame")
)
#' Predictions by an DETS ensemble
#'
#' @param y_hat combined predictions of the ensemble
#' \code{\link{DETS}}. A numeric vector;
#'
#' @param Y_hat a matrix containing the predictions made by
#' individual models;
#'
#' @param Y_committee a list describing the models selected for
#' predictions at each time point (according to \strong{lambda}
#' and \strong{omega});
#'
#' @param W a matrix with the weights of the base models at each prediction
#' time.
#'
#' @family ensemble predictions
#'
#' @return Set of results from predicting with a \code{DETS}
#' ensemble
#'
#' @keywords internal
#'
#' @export
dets_hat <- function(y_hat, Y_hat, Y_committee, W) {
if (missing(Y_committee)) Y_committee <- NULL
methods::new(
"dets_hat",
y_hat = y_hat,
Y_hat = Y_hat,
Y_committee = Y_committee,
W = W
)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.