From f400b53c4cb270bea2e32343680bdac5fdea2b20 Mon Sep 17 00:00:00 2001 From: Janek Date: Mon, 22 Aug 2016 11:58:57 +0200 Subject: [PATCH 1/3] documentation and fix trace --- NAMESPACE | 1 + R/cvrisk.nc_mboostLSS.R | 24 ++++++++++++++++++++---- man/cvrisk.Rd | 16 ++++++++++++---- 3 files changed, 33 insertions(+), 8 deletions(-) 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..fbb47b5 100644 --- a/R/cvrisk.nc_mboostLSS.R +++ b/R/cvrisk.nc_mboostLSS.R @@ -24,11 +24,17 @@ cvrisk.nc_mboostLSS <- function(object, folds = cv(model.weights(object)), "[fold]\t[current mstop]\n", sep = "") if (is.null(fun)) { dummyfct <- function(i, weights, oobweights) { - ## make model with new weights and minimal mstop + ## make model with new weights and max mstop mod <- update(object, weights = weights, oobweights = oobweights, risk = "oobag", trace = FALSE, mstop = max(grid)) + if (trace) { + txt <- paste0(" [", i, "]\t", + paste0("[", paste(mstop(mod), collapse = ","), + "]"), "\n") + cat(txt) + } risks <- attr(mod, "combined_risk")()[grid] @@ -45,13 +51,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 +83,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 +97,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..04bfd33 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{mboost::cvrisk}} + is used. Hofner et al. (2015) provide a detailed description of cross-validation for \code{\link{gamboostLSS}} models and show a From d62ff7d3e2401d0b6a4fc3eac38fa0ab9bcc03df Mon Sep 17 00:00:00 2001 From: Janek Date: Mon, 22 Aug 2016 12:55:42 +0200 Subject: [PATCH 2/3] fix broken link --- man/cvrisk.Rd | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/man/cvrisk.Rd b/man/cvrisk.Rd index 04bfd33..fb0be6b 100644 --- a/man/cvrisk.Rd +++ b/man/cvrisk.Rd @@ -127,8 +127,8 @@ make.grid(max, length.out = 10, min = NULL, log = TRUE, 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{mboost::cvrisk}} - is used. + \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 From 674e677fd7f8efc390b3a373f96a9e467de4b371 Mon Sep 17 00:00:00 2001 From: Janek Date: Thu, 25 Aug 2016 09:25:07 +0200 Subject: [PATCH 3/3] nicer printer --- R/cvrisk.nc_mboostLSS.R | 16 +++++----------- 1 file changed, 5 insertions(+), 11 deletions(-) diff --git a/R/cvrisk.nc_mboostLSS.R b/R/cvrisk.nc_mboostLSS.R index fbb47b5..b48b086 100644 --- a/R/cvrisk.nc_mboostLSS.R +++ b/R/cvrisk.nc_mboostLSS.R @@ -20,21 +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) { + 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)) - - if (trace) { - txt <- paste0(" [", i, "]\t", - paste0("[", paste(mstop(mod), collapse = ","), - "]"), "\n") - cat(txt) - } + risk = "oobag", + mstop = max(grid), trace = trace) risks <- attr(mod, "combined_risk")()[grid]