diff --git a/NAMESPACE b/NAMESPACE index 33905d4..50dee1b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -53,6 +53,7 @@ S3method(cvrisk, mboostLSS) S3method(cvrisk, nc_mboostLSS) S3method(print, cvriskLSS) S3method(plot, cvriskLSS) +S3method(plot, nc_cvriskLSS) S3method(mstop, cvriskLSS) S3method(stabsel, mboostLSS) diff --git a/R/cvrisk.nc_mboostLSS.R b/R/cvrisk.nc_mboostLSS.R index 9397dfb..b48b086 100644 --- a/R/cvrisk.nc_mboostLSS.R +++ b/R/cvrisk.nc_mboostLSS.R @@ -20,15 +20,15 @@ cvrisk.nc_mboostLSS <- function(object, folds = cv(model.weights(object)), call <- deparse(attr(object, "call")) oobrisk <- matrix(0, nrow = ncol(folds), ncol = length(grid)) if (trace) - cat("Starting cross-validation...\n", - "[fold]\t[current mstop]\n", sep = "") + cat("Starting cross-validation...") if (is.null(fun)) { dummyfct <- function(i, weights, oobweights) { - ## make model with new weights and minimal mstop + if (trace) + cat("\n[Fold: ", i, "]\n", sep = "") + ## make model with new weights and max mstop mod <- update(object, weights = weights, oobweights = oobweights, - risk = "oobag", trace = FALSE, - mstop = max(grid)) - + risk = "oobag", + mstop = max(grid), trace = trace) risks <- attr(mod, "combined_risk")()[grid] @@ -45,13 +45,15 @@ cvrisk.nc_mboostLSS <- function(object, folds = cv(model.weights(object)), OOBweights[folds > 0] <- 0 if (all.equal(papply, mclapply) == TRUE) { oobrisk <- papply(1:ncol(folds), - function(i) dummyfct(weights = folds[, i], + function(i) dummyfct(i = i, + weights = folds[, i], oobweights = OOBweights[, i]), mc.preschedule = mc.preschedule, ...) } else { oobrisk <- papply(1:ncol(folds), - function(i) try(dummyfct(weights = folds[, i], + function(i) try(dummyfct(i = i, + weights = folds[, i], oobweights = OOBweights[, i])), ...) } @@ -75,7 +77,7 @@ cvrisk.nc_mboostLSS <- function(object, folds = cv(model.weights(object)), attr(oobrisk, "mstop") <- grid attr(oobrisk, "type") <- ifelse(!is.null(attr(folds, "type")), attr(folds, "type"), "user-defined") - class(oobrisk) <- "cvrisk" + class(oobrisk) <- c("nc_cvrisk", "cvrisk") oobrisk } @@ -89,3 +91,11 @@ risk.nc_mboostLSS <- function(object, merge = FALSE, } } + + +plot.nc_cvriskLSS <- function(x, ylab = attr(x, "risk"), + xlab = "Number of boosting iterations", + ylim = range(x), main = attr(x, "type"), ...) { + mboost:::plot.cvrisk(x, ylab, xlab, ylim, main, ...) +} + diff --git a/man/cvrisk.Rd b/man/cvrisk.Rd index 8ed7dc2..fb0be6b 100644 --- a/man/cvrisk.Rd +++ b/man/cvrisk.Rd @@ -4,6 +4,7 @@ \alias{cvrisk.nc_mboostLSS} \alias{make.grid} \alias{plot.cvriskLSS} +\alias{plot.nc_cvriskLSS} \title{ Cross-Validation } \description{ @@ -35,10 +36,14 @@ make.grid(max, length.out = 10, min = NULL, log = TRUE, bootstrap samples. } \item{grid}{ - a matrix of stopping parameters the empirical risk is to be - evaluated for. Each row represents a parameter combination. The - number of columns must be equal to the number of parameters of the - GAMLSS family. Per default, \code{make.grid(mstop(object))} is used. + a matrix of stopping parameters the empirical risk is to be evaluated for, + if the model was fitted with \code{method = "cyclical"}. Each row represents a + parameter combination. The number of columns must be equal to the number of + parameters of the GAMLSS family. Per default, \code{make.grid(mstop(object))} + is used. + Otherwise (i.e. \code{method = "inner"} or \code{method = "outer"}) one + vector of steps to check. Per default all steps up to \code{mstop(object)} + are used. } \item{papply}{ (parallel) apply function, defaults to \code{\link[parallel]{mclapply}}. @@ -121,6 +126,9 @@ make.grid(max, length.out = 10, min = NULL, log = TRUE, additionally shows information on the variability of the risk from fold to fold. The heatmap shows only the average risk but in a nicer fashion. + For the noncyclical fitting methods (i.e. \code{method = "inner"} or + \code{method = "outer"}) the plot function of \code{\link{cvrisk}} from the + packge \code{mboost} is used. Hofner et al. (2015) provide a detailed description of cross-validation for \code{\link{gamboostLSS}} models and show a