From e64737dc9320d5020aabe61d3dbc6cd39ab4ee74 Mon Sep 17 00:00:00 2001 From: Janek Date: Thu, 25 Aug 2016 10:20:02 +0200 Subject: [PATCH 1/2] change mstop definition for noncyclical fitting --- R/methods.R | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/R/methods.R b/R/methods.R index 35deee1..e3c08d4 100644 --- a/R/methods.R +++ b/R/methods.R @@ -66,6 +66,13 @@ mstop.mboostLSS <- function(object, parameter = names(object), ...){ names(RET) <- names(object)[parameter] if (length(RET) == 1) RET <- RET[[1]] + # change mstop for noncyclical fitting to scalar value with attribute of partitions + if (inherits(object, "nc_mboostLSS")) { + partitions = RET + RET = sum(RET) + attr(RET, "partitions") <- partitions + } + return(RET) } @@ -273,8 +280,11 @@ print.mboostLSS <- function(x, ...){ cat("\n") if (!is.null(attr(x, "call"))) cat("Call:\n", deparse(attr(x, "call")), "\n\n", sep = "") + m = mstop(x) + if (inherits(x, "nc_mboostLSS")) + m = attr(m, "partitions") cat("Number of boosting iterations (mstop): ", - paste(names(mstop(x)), mstop(x), sep = " = ", collapse = ", "), "\n") + paste(names(x), m, sep = " = ", collapse = ", "), "\n") nus <- sapply(x, function(xi) xi$control$nu) cat("Step size: ", paste(names(nus), nus, sep = " = ", collapse = ", "), "\n\n") @@ -328,10 +338,11 @@ summary.mboostLSS <- function(object, ...) { cat("\n") if (!is.null(attr(object, "call"))) cat("Call:\n", deparse(attr(object, "call")), "\n\n", sep = "") + m = mstop(object) + if (inherits(object, "nc_mboostLSS")) + m = attr(m, "partitions") cat("Number of boosting iterations (mstop): ", - paste(names(mstop(object)), mstop(object), - sep = " = ", collapse = ", "), - "\n") + paste(names(object), m, sep = " = ", collapse = ", "), "\n") nus <- sapply(object, function(xi) xi$control$nu) cat("Step size: ", paste(names(nus), nus, sep = " = ", collapse = ", "), "\n\n") From e377769df5f515917b34bef16bf249f5fb6aec53 Mon Sep 17 00:00:00 2001 From: Benjamin Hofner Date: Mon, 29 Aug 2016 19:22:35 +0200 Subject: [PATCH 2/2] use correct syntax; closes #19 --- R/methods.R | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/R/methods.R b/R/methods.R index e3c08d4..26a3bfb 100644 --- a/R/methods.R +++ b/R/methods.R @@ -68,9 +68,9 @@ mstop.mboostLSS <- function(object, parameter = names(object), ...){ RET <- RET[[1]] # change mstop for noncyclical fitting to scalar value with attribute of partitions if (inherits(object, "nc_mboostLSS")) { - partitions = RET - RET = sum(RET) - attr(RET, "partitions") <- partitions + partitions <- RET + RET <- sum(RET) + attr(RET, "partitions") <- partitions } return(RET) @@ -280,9 +280,9 @@ print.mboostLSS <- function(x, ...){ cat("\n") if (!is.null(attr(x, "call"))) cat("Call:\n", deparse(attr(x, "call")), "\n\n", sep = "") - m = mstop(x) + m <- mstop(x) if (inherits(x, "nc_mboostLSS")) - m = attr(m, "partitions") + m <- attr(m, "partitions") cat("Number of boosting iterations (mstop): ", paste(names(x), m, sep = " = ", collapse = ", "), "\n") nus <- sapply(x, function(xi) xi$control$nu) @@ -338,9 +338,9 @@ summary.mboostLSS <- function(object, ...) { cat("\n") if (!is.null(attr(object, "call"))) cat("Call:\n", deparse(attr(object, "call")), "\n\n", sep = "") - m = mstop(object) + m <- mstop(object) if (inherits(object, "nc_mboostLSS")) - m = attr(m, "partitions") + m <- attr(m, "partitions") cat("Number of boosting iterations (mstop): ", paste(names(object), m, sep = " = ", collapse = ", "), "\n") nus <- sapply(object, function(xi) xi$control$nu)