From 1e606c72e9db6776a87b17e89291e744280665ec Mon Sep 17 00:00:00 2001
From: Janek <janek.thomas@web.de>
Date: Tue, 2 May 2017 13:05:09 +0200
Subject: [PATCH] fix selected and adapt tests

---
 R/methods.R                       | 11 ++++++-----
 tests/regtest-noncyclic_fitting.R |  4 ++--
 tests/regtest-stabsel.R           |  1 +
 3 files changed, 9 insertions(+), 7 deletions(-)

diff --git a/R/methods.R b/R/methods.R
index 8a1c950..7085ce2 100644
--- a/R/methods.R
+++ b/R/methods.R
@@ -98,15 +98,16 @@ selected.mboostLSS <- function(object, merge = FALSE, parameter = names(object),
     if (merge) {
         if (inherits(object, "nc_mboostLSS")){
             
-## <FIXME> What should this return? At least when one parameter was never selected this is broken (and also the next lines)
-            RET <- names(attr(object, "combined_risk")())
+            #get the names of parameter selected in each iteration (drop initial offset risk values)
+            RET <- names(attr(object, "combined_risk")())[-seq_along(parameter)]
+            names(RET) <- RET #set the names of the vector as we will overwrite the values.
             
+            #overwrite names in the vector with the selected BLs in the correct order
             for(p in names(parameter)){
                 RET[RET == p] <- object[[p]]$xselect()
             }
-            RET <- as.numeric(RET)
-            names(RET) <- names(attr(object, "combined_risk")())
-## </FIXME>            
+            mode(RET) = "numeric" #ensure numeric values -> as.numeric drops the names
+         
             return(RET)
         }
         else {
diff --git a/tests/regtest-noncyclic_fitting.R b/tests/regtest-noncyclic_fitting.R
index a369f87..d174f2d 100644
--- a/tests/regtest-noncyclic_fitting.R
+++ b/tests/regtest-noncyclic_fitting.R
@@ -158,13 +158,13 @@ for( i in 1:500)
 dat <- data.frame(x1, x2, x3, x4, x5, x6, y)
 
 model <- glmboostLSS(y ~ ., families = NBinomialLSS(), data = dat,
-                     control = boost_control(mstop = 10),
+                     control = boost_control(mstop = 20),
                      center = TRUE, method = "cyclic")
 selected(model) # ok (at least in principle)
 selected(model, merge = TRUE) # ok
 
 model <- glmboostLSS(y ~ ., families = NBinomialLSS(), data = dat,
-                     control = boost_control(mstop = 10),
+                     control = boost_control(mstop = 20),
                      center = TRUE, method = "noncyclic")
 selected(model) # ok (at least in principle)
 selected(model, merge = TRUE) ## BROKEN
diff --git a/tests/regtest-stabsel.R b/tests/regtest-stabsel.R
index 5f3e146..aef6d31 100644
--- a/tests/regtest-stabsel.R
+++ b/tests/regtest-stabsel.R
@@ -1,3 +1,4 @@
+require("gamboostLSS")
 ### Data generating process:
 set.seed(1907)
 x1 <- rnorm(500)