├── NAMESPACE ├── man ├── mae.Rd ├── rmse.Rd ├── loess.fit.Rd ├── prune.medley.Rd ├── logloss.Rd ├── constant.Rd ├── medley.Rd ├── predict.constant.Rd ├── combine.medley.Rd ├── add.medley.Rd ├── predict.medley.Rd └── create.medley.Rd ├── R ├── medley-package.r ├── errfuncs.r ├── wrappers.r └── medley.r ├── DESCRIPTION ├── README.md └── LICENSE /NAMESPACE: -------------------------------------------------------------------------------- 1 | S3method(predict,constant) 2 | S3method(predict,medley) 3 | export(add.medley) 4 | export(combine.medley) 5 | export(constant) 6 | export(create.medley) 7 | export(loess.fit) 8 | export(logloss) 9 | export(mae) 10 | export(prune.medley) 11 | export(rmse) 12 | -------------------------------------------------------------------------------- /man/mae.Rd: -------------------------------------------------------------------------------- 1 | \name{mae} 2 | \alias{mae} 3 | \title{Calculate mean absolute error metric} 4 | \usage{ 5 | mae(true, pred) 6 | } 7 | \arguments{ 8 | \item{true}{the true response values} 9 | 10 | \item{pred}{the predicted response values} 11 | } 12 | \description{ 13 | Calculate mean absolute error metric 14 | } 15 | 16 | -------------------------------------------------------------------------------- /man/rmse.Rd: -------------------------------------------------------------------------------- 1 | \name{rmse} 2 | \alias{rmse} 3 | \title{Calculate root-mean-square error metric} 4 | \usage{ 5 | rmse(true, pred) 6 | } 7 | \arguments{ 8 | \item{true}{the true response values} 9 | 10 | \item{pred}{the predicted response values} 11 | } 12 | \description{ 13 | Calculate root-mean-square error metric 14 | } 15 | 16 | -------------------------------------------------------------------------------- /man/loess.fit.Rd: -------------------------------------------------------------------------------- 1 | \name{loess.fit} 2 | \alias{loess.fit} 3 | \title{Wrapper for loess fit} 4 | \usage{ 5 | loess.fit(x, y, ...) 6 | } 7 | \arguments{ 8 | \item{x}{the matrix of predictors} 9 | 10 | \item{y}{the vector of responses} 11 | 12 | \item{...}{other parameters to pass to \code{loess()}} 13 | } 14 | \description{ 15 | Wrapper for loess fit 16 | } 17 | 18 | -------------------------------------------------------------------------------- /man/prune.medley.Rd: -------------------------------------------------------------------------------- 1 | \name{prune.medley} 2 | \alias{prune.medley} 3 | \title{Prune the models in a medley} 4 | \usage{ 5 | prune.medley(object, prune.factor = 0.2) 6 | } 7 | \arguments{ 8 | \item{object}{the medley to prune} 9 | 10 | \item{prune.factor}{the proportion of the models to keep} 11 | } 12 | \description{ 13 | Prune the models in a medley 14 | } 15 | 16 | -------------------------------------------------------------------------------- /R/medley-package.r: -------------------------------------------------------------------------------- 1 | #' Greedy ensemble selection for regression model 2 | #' 3 | #' 4 | #' Medley is a package which implements the Caruana et al., 2004 algorithm for 5 | #' stepwise greedy ensemble selection in R, allowing disparate regression 6 | #' models to be combined easily. 7 | #' 8 | #' @author Martin O'Leary \email{m.e.w.oleary@@gmail.com} 9 | #' @name medley 10 | #' @docType package 11 | NULL 12 | -------------------------------------------------------------------------------- /man/logloss.Rd: -------------------------------------------------------------------------------- 1 | \name{logloss} 2 | \alias{logloss} 3 | \title{Calculate log-loss error metric} 4 | \usage{ 5 | logloss(true, pred, eps = 1e-15) 6 | } 7 | \arguments{ 8 | \item{true}{the true response values} 9 | 10 | \item{pred}{the predicted response values} 11 | 12 | \item{eps}{a lower bound on predicted probabilities} 13 | } 14 | \description{ 15 | Calculate log-loss error metric 16 | } 17 | 18 | -------------------------------------------------------------------------------- /man/constant.Rd: -------------------------------------------------------------------------------- 1 | \name{constant} 2 | \alias{constant} 3 | \title{Trivial regression model which returns a given constant} 4 | \usage{ 5 | constant(x, y, k) 6 | } 7 | \arguments{ 8 | \item{x}{the matrix of predictors} 9 | 10 | \item{y}{the vector of responses} 11 | 12 | \item{k}{the constant to return} 13 | } 14 | \description{ 15 | Trivial regression model which returns a given constant 16 | } 17 | 18 | -------------------------------------------------------------------------------- /man/medley.Rd: -------------------------------------------------------------------------------- 1 | \docType{package} 2 | \name{medley} 3 | \alias{medley} 4 | \alias{medley-package} 5 | \title{Greedy ensemble selection for regression model} 6 | \description{ 7 | Medley is a package which implements the Caruana et al., 8 | 2004 algorithm for stepwise greedy ensemble selection in 9 | R, allowing disparate regression models to be combined 10 | easily. 11 | } 12 | \author{ 13 | Martin O'Leary \email{m.e.w.oleary@gmail.com} 14 | } 15 | 16 | -------------------------------------------------------------------------------- /man/predict.constant.Rd: -------------------------------------------------------------------------------- 1 | \name{predict.constant} 2 | \alias{predict.constant} 3 | \title{Trivial regression model which returns a given constant} 4 | \usage{ 5 | \method{predict}{constant} (object, newdata, ...) 6 | } 7 | \arguments{ 8 | \item{object}{the model object} 9 | 10 | \item{newdata}{the matrix of new predictors} 11 | 12 | \item{...}{other parameters (unused)} 13 | } 14 | \description{ 15 | Trivial regression model which returns a given constant 16 | } 17 | 18 | -------------------------------------------------------------------------------- /man/combine.medley.Rd: -------------------------------------------------------------------------------- 1 | \name{combine.medley} 2 | \alias{combine.medley} 3 | \title{Recursively combine two or more medley objects for the same problem} 4 | \usage{ 5 | combine.medley(e1, e2 = NULL, ...) 6 | } 7 | \arguments{ 8 | \item{e1}{the first medley to combine} 9 | 10 | \item{e2}{the second medley to combine} 11 | 12 | \item{...}{further medleys to combine} 13 | } 14 | \description{ 15 | Recursively combine two or more medley objects for the 16 | same problem 17 | } 18 | 19 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: medley 2 | Maintainer: Martin O'Leary 3 | Author: Martin O'Leary 4 | Version: 0.1.0 5 | License: BSD 6 | Title: A system for blending predictive models 7 | Description: Medley is a package which implements the Caruana et al., 2004 8 | algorithm for stepwise greedy ensemble selection in R, allowing disparate 9 | regression models to be combined easily. 10 | Suggests: 11 | roxygen2, 12 | e1071 13 | Collate: 14 | 'medley-package.r' 15 | 'errfuncs.r' 16 | 'medley.r' 17 | 'wrappers.r' 18 | -------------------------------------------------------------------------------- /man/add.medley.Rd: -------------------------------------------------------------------------------- 1 | \name{add.medley} 2 | \alias{add.medley} 3 | \title{Add a new model to an existing medley} 4 | \usage{ 5 | add.medley(object, model, args = list(), 6 | predict.args = list(), feature.subset = NULL, 7 | folds = object$folds, postprocess = c()) 8 | } 9 | \arguments{ 10 | \item{object}{the medley to be added to} 11 | 12 | \item{model}{the model fitting function} 13 | 14 | \item{args}{a list of extra arguments to \code{model}} 15 | 16 | \item{predict.args}{a list of extra arguments to the 17 | predict function for \code{model}} 18 | 19 | \item{feature.subset}{a subset of the features to use} 20 | 21 | \item{folds}{the number of cross-validation folds to use} 22 | 23 | \item{postprocess}{an optional function to apply to the 24 | predicted values} 25 | } 26 | \description{ 27 | Add a new model to an existing medley 28 | } 29 | 30 | -------------------------------------------------------------------------------- /R/errfuncs.r: -------------------------------------------------------------------------------- 1 | #' Calculate root-mean-square error metric 2 | #' 3 | #' @param true the true response values 4 | #' @param pred the predicted response values 5 | #' @export 6 | 7 | rmse <- function (true, pred) { 8 | return(sqrt(mean((true - pred)^2))); 9 | } 10 | 11 | #' Calculate log-loss error metric 12 | #' 13 | #' @param true the true response values 14 | #' @param pred the predicted response values 15 | #' @param eps a lower bound on predicted probabilities 16 | #' @export 17 | 18 | logloss <- function (true, pred, eps=1e-15) { 19 | pred <- pmin(pmax(pred, eps), 1-eps); 20 | return(-mean(true * log(pred)) - mean((1 - true) * log(1 - pred))); 21 | } 22 | 23 | #' Calculate mean absolute error metric 24 | #' 25 | #' @param true the true response values 26 | #' @param pred the predicted response values 27 | #' @export 28 | 29 | mae <- function (true, pred) { 30 | return(mean(abs(true - pred))); 31 | } -------------------------------------------------------------------------------- /man/predict.medley.Rd: -------------------------------------------------------------------------------- 1 | \name{predict.medley} 2 | \alias{predict.medley} 3 | \title{Make a prediction based on a medley} 4 | \usage{ 5 | \method{predict}{medley} (object, newdata, seed = c(), 6 | min.members = 5, max.members = 100, baggs = 1, 7 | mixer = mean, ...) 8 | } 9 | \arguments{ 10 | \item{object}{the medley to predict from} 11 | 12 | \item{newdata}{a matrix of new predictor data} 13 | 14 | \item{seed}{indices of models which should be used for an 15 | initial ensemble} 16 | 17 | \item{min.members}{the minimum number of models in an 18 | ensemble (selected randomly)} 19 | 20 | \item{max.members}{the maximum number of models in an 21 | ensemble} 22 | 23 | \item{baggs}{the number of bagging iterations to perform} 24 | 25 | \item{mixer}{a function to combine model predictions} 26 | 27 | \item{...}{other arguments (unused)} 28 | } 29 | \description{ 30 | Make a prediction based on a medley 31 | } 32 | 33 | -------------------------------------------------------------------------------- /R/wrappers.r: -------------------------------------------------------------------------------- 1 | # Wrapper functions for uncooperative base models 2 | 3 | #' Trivial regression model which returns a given constant 4 | #' 5 | #' @param x the matrix of predictors 6 | #' @param y the vector of responses 7 | #' @param k the constant to return 8 | #' @export 9 | constant <- function (x, y, k) { 10 | model <- list(k=k); 11 | class(model) <- 'constant'; 12 | return(model); 13 | } 14 | 15 | #' Trivial regression model which returns a given constant 16 | #' 17 | #' @param object the model object 18 | #' @param newdata the matrix of new predictors 19 | #' @param ... other parameters (unused) 20 | #' @method predict constant 21 | #' @export 22 | predict.constant <- function(object, newdata, ...) { 23 | return(rep(object$k, nrow(newdata))); 24 | } 25 | 26 | #' Wrapper for loess fit 27 | #' 28 | #' @param x the matrix of predictors 29 | #' @param y the vector of responses 30 | #' @param ... other parameters to pass to \code{loess()} 31 | #' @export 32 | loess.fit <- function(x, y, ...) { 33 | model <- loess(y ~ x, ...); 34 | } -------------------------------------------------------------------------------- /man/create.medley.Rd: -------------------------------------------------------------------------------- 1 | \name{create.medley} 2 | \alias{create.medley} 3 | \title{Create a new (empty) medley object} 4 | \usage{ 5 | create.medley(x, y, label = "", errfunc = rmse, 6 | base.model = NULL, folds = 8) 7 | } 8 | \arguments{ 9 | \item{x}{matrix of predictors} 10 | 11 | \item{y}{vector of response values} 12 | 13 | \item{label}{a unique label for this medley (used in 14 | status messages)} 15 | 16 | \item{errfunc}{an error metric for this medley} 17 | 18 | \item{base.model}{a function to use as a baseline model} 19 | 20 | \item{folds}{the default number of cross-validation folds 21 | to use} 22 | } 23 | \description{ 24 | Create a new (empty) medley object 25 | } 26 | \examples{ 27 | require(e1071); 28 | data(swiss); 29 | x <- swiss[,1:5]; 30 | y <- swiss[,6]; 31 | train <- sample(nrow(swiss), 30); 32 | m <- create.medley(x[train,], y[train]); 33 | for (gamma in c(1e-3, 2e-3, 5e-3, 1e-2, 2e-2, 5e-2, 1e-1, 2e-1, 5e-1, 1)) { 34 | m <- add.medley(m, svm, list(gamma=gamma)); 35 | } 36 | p <- predict(m, x[-train,]); 37 | rmse(p, y[-train]); 38 | } 39 | 40 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## What is Medley? ## 2 | 3 | Medley is an R package which implements the Caruana et al., 2004 algorithm for 4 | greedy stepwise ensemble selection for regression models. 5 | 6 | The idea behind medley is to make the creation of "ensembles" or "blends" of 7 | models as simple as possible. Individual models can be produced by varying 8 | hyperparameters or input feature sets, as well as by changing the underlying 9 | model code. 10 | 11 | ## Usage example ## 12 | 13 | require(medley); 14 | require(randomForest); 15 | require(e1071); 16 | 17 | # x and y are the training predictors and responses respectively 18 | m <- create.medley(x, y, errfunc=rmse); 19 | 20 | # add SVMs for a variety of gamma parameters 21 | for (g in 1:10) { 22 | m <- add.medley(m, svm, list(gamma=1e-3 * g)); 23 | } 24 | 25 | # add random forests with varying mtry parameter 26 | for (mt in c(5, 10, 20, 50)) { 27 | m <- add.medley(m, randomForest, list(mtry=mt)); 28 | } 29 | 30 | # use only the best 80% of individual models 31 | m <- prune.medley(m, 0.8); 32 | 33 | # predict using new predictor matrix newx 34 | p <- predict(m, newx); 35 | 36 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2012, Martin O'Leary 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are met: 6 | 7 | * Redistributions of source code must retain the above copyright notice, this 8 | list of conditions and the following disclaimer. 9 | * Redistributions in binary form must reproduce the above copyright notice, 10 | this list of conditions and the following disclaimer in the documentation 11 | and/or other materials provided with the distribution. 12 | 13 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 14 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 15 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 16 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 17 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 18 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 19 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 20 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 21 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 22 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /R/medley.r: -------------------------------------------------------------------------------- 1 | #' Create a new (empty) medley object 2 | #' 3 | #' @param x matrix of predictors 4 | #' @param y vector of response values 5 | #' @param label a unique label for this medley (used in status messages) 6 | #' @param errfunc an error metric for this medley 7 | #' @param base.model a function to use as a baseline model 8 | #' @param folds the default number of cross-validation folds to use 9 | #' @export 10 | #' @examples 11 | #' require(e1071); 12 | #' data(swiss); 13 | #' x <- swiss[,1:5]; 14 | #' y <- swiss[,6]; 15 | #' train <- sample(nrow(swiss), 30); 16 | #' m <- create.medley(x[train,], y[train]); 17 | #' for (gamma in c(1e-3, 2e-3, 5e-3, 1e-2, 2e-2, 5e-2, 1e-1, 2e-1, 5e-1, 1)) { 18 | #' m <- add.medley(m, svm, list(gamma=gamma)); 19 | #' } 20 | #' p <- predict(m, x[-train,]); 21 | #' rmse(p, y[-train]); 22 | create.medley <- function (x, y, label='', errfunc=rmse, base.model=NULL, folds=8) { 23 | if (!is.null(base.model)) { 24 | base.y <- predict(base.model, x); 25 | } else { 26 | base.y <- rep(0, length(y)); 27 | } 28 | object <- list( 29 | x=as.matrix(x), 30 | y=y, 31 | base.y=base.y, 32 | mod.y=y - base.y, 33 | errfunc=errfunc, 34 | models=list(), 35 | args=list(), 36 | predict.args=list(), 37 | feature.subset=list(), 38 | fitted=list(), 39 | cv=list(), 40 | base.model=base.model, 41 | label=label, 42 | folds=folds, 43 | postprocess=list() 44 | ); 45 | class(object) <- 'medley'; 46 | return(object); 47 | } 48 | 49 | #' Recursively combine two or more medley objects for the same problem 50 | #' 51 | #' @param e1 the first medley to combine 52 | #' @param e2 the second medley to combine 53 | #' @param ... further medleys to combine 54 | #' @export 55 | combine.medley <- function (e1, e2=NULL, ...) { 56 | if (is.null(e2)) return(e1); 57 | 58 | e1$models <- c(e1$models, e2$models); 59 | e1$args <- c(e1$args, e2$args); 60 | e1$predict.args <- c(e1$predict.args, e2$predict.args); 61 | e1$feature.subset <- c(e1$feature.subset, e2$feature.subset); 62 | e1$fitted <- c(e1$fitted, e2$fitted); 63 | e1$cv <- c(e1$cv, e2$cv); 64 | e1$postprocess <- c(e1$postprocess, e2$postprocess); 65 | return(combine.medley(e1, ...)); 66 | } 67 | 68 | #' Add a new model to an existing medley 69 | #' 70 | #' @param object the medley to be added to 71 | #' @param model the model fitting function 72 | #' @param args a list of extra arguments to \code{model} 73 | #' @param predict.args a list of extra arguments to the predict function for \code{model} 74 | #' @param feature.subset a subset of the features to use 75 | #' @param folds the number of cross-validation folds to use 76 | #' @param postprocess an optional function to apply to the predicted values 77 | #' @export 78 | add.medley <- function (object, model, args=list(), predict.args=list(), feature.subset=NULL, folds=object$folds, postprocess=c()) { 79 | if (is.null(feature.subset)) { 80 | feature.subset <- c(1:ncol(object$x)); 81 | } 82 | n <- length(object$models) + 1; 83 | object$models[[n]] <- model; 84 | object$args[[n]] <- args; 85 | object$predict.args[[n]] <- predict.args; 86 | object$feature.subset[[n]] <- feature.subset; 87 | object$postprocess[[n]] <- function(x) x; 88 | 89 | pt <- proc.time()[[3]]; 90 | # Fit model to all data 91 | data <- list(x=object$x[,feature.subset], y=object$mod.y); 92 | object$fitted[[n]] <- do.call(model, c(data, args)); 93 | 94 | # Do cross-validation 95 | k <- length(object$y); 96 | cv.sets <- (seq_len(k) %% folds) + 1; 97 | 98 | pred <- numeric(k); 99 | for (i in 1:folds) { 100 | holdout <- which(cv.sets == i); 101 | data <- list(x=object$x[-holdout,feature.subset], y=object$mod.y[-holdout]); 102 | fitted <- do.call(model, c(data, args)); 103 | preddata <- list(fitted, newdata=object$x[holdout,feature.subset]) 104 | pred[holdout] <- do.call(predict, c(preddata, predict.args)); 105 | } 106 | object$cv[[n]] <- pred + object$base.y; 107 | pt <- proc.time()[[3]] - pt; 108 | cat(object$label, 'CV model', n, class(object$fitted[[n]]), substring(deparse(args, control=NULL), 5), 'time:', pt, 'error:', object$errfunc(object$y, object$cv[[n]]), '\n'); 109 | 110 | nn <- n; 111 | for (pp in postprocess) { 112 | nn <- nn + 1; 113 | object$models[[nn]] <- model; 114 | object$args[[nn]] <- args; 115 | object$predict.args[[nn]] <- predict.args; 116 | object$feature.subset[[nn]] <- feature.subset; 117 | object$postprocess[[nn]] <- pp; 118 | object$fitted[[nn]] <- object$fitted[[n]]; 119 | object$cv[[nn]] <- pp(pred) + object$base.y; 120 | cat(object$label, 'PP error:', object$errfunc(object$y, object$cv[[nn]]), '\n'); 121 | } 122 | 123 | return(object); 124 | } 125 | 126 | #' Prune the models in a medley 127 | #' 128 | #' @param object the medley to prune 129 | #' @param prune.factor the proportion of the models to keep 130 | #' @export 131 | prune.medley <- function (object, prune.factor=0.2) { 132 | n <- ceiling(length(object$models) * prune.factor); 133 | errs <- sapply(object$cv, function(pred) object$errfunc(object$y, pred)); 134 | keep <- order(errs)[1:n]; 135 | object$models <- object$models[keep]; 136 | object$args <- object$args[keep]; 137 | object$predict.args <- object$predict.args[keep]; 138 | object$feature.subset <- object$feature.subset[keep]; 139 | object$fitted <- object$fitted[keep]; 140 | object$cv <- object$cv[keep]; 141 | return(object); 142 | } 143 | 144 | #' Make a prediction based on a medley 145 | #' 146 | #' @param object the medley to predict from 147 | #' @param newdata a matrix of new predictor data 148 | #' @param seed indices of models which should be used for an initial ensemble 149 | #' @param min.members the minimum number of models in an ensemble (selected randomly) 150 | #' @param max.members the maximum number of models in an ensemble 151 | #' @param baggs the number of bagging iterations to perform 152 | #' @param mixer a function to combine model predictions 153 | #' @param ... other arguments (unused) 154 | #' @method predict medley 155 | #' @export 156 | predict.medley <- function (object, newdata, seed=c(), min.members=5, max.members=100, baggs=1, mixer=mean, ...) { 157 | newdata <- as.matrix(newdata); 158 | best.errs <- c(); 159 | big.mix <- c(); 160 | for (i in 1:baggs) { 161 | if (baggs == 1) { 162 | s <- 1:length(object$y); 163 | } else { 164 | s <- sample(length(object$y), replace=T); 165 | } 166 | model.sample <- sample(length(object$models), length(object$models) * .8); 167 | cat('Sampled...'); 168 | if (length(seed) == 0) { 169 | errs <- sapply(object$cv[model.sample], function(pred) object$errfunc(object$y[s], pred[s])); 170 | mix <- model.sample[order(errs)[1:min.members]]; 171 | 172 | } else { 173 | mix <- seed; 174 | } 175 | mixpred <- simplify2array(object$cv[mix]); 176 | 177 | best.err <- object$errfunc(object$y[s], apply(mixpred, 1, mixer)[s]); 178 | 179 | while(length(mix) < max.members) { 180 | errs <- sapply(object$cv[model.sample], function(pred) object$errfunc(object$y[s], apply(cbind(mixpred, pred), 1, mixer)[s])); 181 | best <- which.min(errs); 182 | if (best.err <= errs[best]) break; 183 | mix <- c(mix, model.sample[best]); 184 | best.err <- errs[best]; 185 | mixpred <- simplify2array(object$cv[mix]); 186 | } 187 | predictions <- list(); 188 | for (i in unique(sort(mix))) { 189 | preddata <- list(object$fitted[[i]], newdata=newdata[,object$feature.subset[[i]]]); 190 | predictions[[i]] <- object$postprocess[[i]](do.call(predict, c(preddata, object$predict.args[[i]]))); 191 | frac <- mean(mix == i); 192 | cat(format(frac*100, digits=1, nsmall=2), '%: ', i, class(object$fitted[[i]]), substring(deparse(object$args[[i]], control=NULL), 5), '\n'); 193 | } 194 | best.err <- object$errfunc(object$y, apply(mixpred, 1, mixer)); 195 | cat('CV error:', best.err, '\n'); 196 | if (length(unique(mix)) == 1) {pred <- predictions[[mix]]} 197 | else {pred <- apply(simplify2array(predictions[mix]), 1, mixer)} 198 | best.errs <- c(best.errs, best.err); 199 | big.mix <- cbind(big.mix, pred); 200 | } 201 | pred <- apply(big.mix, 1, mixer); 202 | if (!is.null(object$base.model)) { 203 | pred <- pred + predict(object$base.model, newdata); 204 | } 205 | attr(pred, 'cv.err') <- mean(best.errs); 206 | return(pred); 207 | } --------------------------------------------------------------------------------