fix selected

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 {

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

tests/regtest-stabsel.R

@@ -1,3 +1,4 @@
+require("gamboostLSS")
 ### Data generating process:
 set.seed(1907)
 x1 <- rnorm(500)