Fixed bug in cvrisk when no families are specified. Closes #9

boost-R · Mar 10, 2016 · a282304 · a282304
1 parent 8b93bdc
commit a282304
Show file tree

Hide file tree

Showing 2 changed files with 28 additions and 0 deletions.
diff --git a/patch/R/mboostLSS.R b/patch/R/mboostLSS.R
@@ -6,6 +6,8 @@
 mboostLSS <- function(formula, data = list(), families = GaussianLSS(),
                       control = boost_control(), weights = NULL, ...){
     cl <- match.call()
+    if(is.null(cl$families))
+        cl$families <- families
     fit <- mboostLSS_fit(formula = formula, data = data, families = families,
                          control = control, weights = weights, ...,
                          fun = mboost, funchar = "mboost", call = cl)
@@ -15,6 +17,8 @@ mboostLSS <- function(formula, data = list(), families = GaussianLSS(),
 glmboostLSS <- function(formula, data = list(), families = GaussianLSS(),
                         control = boost_control(), weights = NULL, ...){
     cl <- match.call()
+    if(is.null(cl$families))
+        cl$families <- families
     fit <- mboostLSS_fit(formula = formula, data = data, families = families,
                          control = control, weights = weights, ...,
                          fun = glmboost, funchar = "glmboost", call = cl)
@@ -24,6 +28,8 @@ glmboostLSS <- function(formula, data = list(), families = GaussianLSS(),
 gamboostLSS <- function(formula, data = list(), families = GaussianLSS(),
                         control = boost_control(), weights = NULL, ...){
     cl <- match.call()
+    if(is.null(cl$families))
+        cl$families <- families
     fit <- mboostLSS_fit(formula = formula, data = data, families = families,
                          control = control, weights = weights, ...,
                          fun = gamboost, funchar = "gamboost", call = cl)
@@ -33,6 +39,8 @@ gamboostLSS <- function(formula, data = list(), families = GaussianLSS(),
 blackboostLSS <- function(formula, data = list(), families = GaussianLSS(),
                           control = boost_control(), weights = NULL, ...){
     cl <- match.call()
+    if(is.null(cl$families))
+        cl$families <- families
     fit <- mboostLSS_fit(formula = formula, data = data, families = families,
                          control = control, weights = weights, ...,
                          fun = blackboost, funchar = "blackboost", call = cl)

diff --git a/patch/tests/bugfixes.R b/patch/tests/bugfixes.R
@@ -27,3 +27,23 @@ model[10]
 stopifnot(all.equal(selected(model),
                     list(mu = mboost::selected(model[[1]]),
                          sigma = mboost::selected(model[[2]]))))
+
+
+# If the families argument is not specified explicitly in mboostLSSone gets an
+# error in cvrisk.mboostLSS() (spotted by Almond Stöcker).
+# (https://github.com/boost-R/gamboostLSS/issues/9)
+set.seed(1907)
+x1 <- rnorm(1000)
+mu    <- 2*x1
+sigma <- rep(1, 1000)
+y <- numeric(1000)
+for( i in 1:1000)
+       y[i] <- rnorm(1, mean = mu[i], sd=sigma[i])
+dat <- data.frame(x1=x1, y=y)
+## model with default families
+model <- mboostLSS(y ~ bbs(x1), data = dat, control = boost_control(mstop = 2))
+## cvrisk.mboostLSS() does not work as families was not specified in model call
+cvr <- try(cvrisk(model, folds = cv(model.weights(model), B=3), trace=FALSE),
+           silent = TRUE)
+if (inherits(cvr, "try-error"))
+    stop("cvrisk does not work if no family was (explicitly) chosen")