[Mboost-commits] r754 - in pkg: mboostDevel/R mboostPatch/R

[noreply at r-forge.r-project.org]

Author: hofner
Date: 2013-10-30 18:56:05 +0100 (Wed, 30 Oct 2013)
New Revision: 754

Modified:
   pkg/mboostDevel/R/mboost.R
   pkg/mboostPatch/R/mboost.R
Log:
- changed computation of subset (i.e. mod[mstop]):
  * predict is only computed if required which results in speed improvements
  * especially needed for gamboostLSS


Modified: pkg/mboostDevel/R/mboost.R
===================================================================
--- pkg/mboostDevel/R/mboost.R	2013-10-28 16:20:41 UTC (rev 753)
+++ pkg/mboostDevel/R/mboost.R	2013-10-30 17:56:05 UTC (rev 754)
@@ -292,14 +292,20 @@
     ### some models are CHANGED!
     RET$subset <- function(i) {
         if (i <= mstop || i <= length(xselect)) {
-            mstop <<- i
-            fit <<- RET$predict()
-            u <<- ngradient(y, fit, weights)
+            ## no need to recompute everything if mstop isn't changed
+            if (i != mstop) {
+                mstop <<- i
+                fit <<- RET$predict()
+                u <<- ngradient(y, fit, weights)
+            }
         } else {
-            ## first increase to "old" mstop
-            mstop <<- length(xselect)
-            fit <<- RET$predict()
-            u <<- ngradient(y, fit, weights)
+            ## if prior reduction of mstop,
+            ## first increase mstop to old value first
+            if (mstop != length(xselect)) {
+                mstop <<- length(xselect)
+                fit <<- RET$predict()
+                u <<- ngradient(y, fit, weights)
+            }
             ## now fit the rest
             tmp <- boost(i - mstop)
         }

Modified: pkg/mboostPatch/R/mboost.R
===================================================================
--- pkg/mboostPatch/R/mboost.R	2013-10-28 16:20:41 UTC (rev 753)
+++ pkg/mboostPatch/R/mboost.R	2013-10-30 17:56:05 UTC (rev 754)
@@ -292,14 +292,20 @@
     ### some models are CHANGED!
     RET$subset <- function(i) {
         if (i <= mstop || i <= length(xselect)) {
-            mstop <<- i
-            fit <<- RET$predict()
-            u <<- ngradient(y, fit, weights)
+            ## no need to recompute everything if mstop isn't changed
+            if (i != mstop) {
+                mstop <<- i
+                fit <<- RET$predict()
+                u <<- ngradient(y, fit, weights)
+            }
         } else {
-            ## first increase to "old" mstop
-            mstop <<- length(xselect)
-            fit <<- RET$predict()
-            u <<- ngradient(y, fit, weights)
+            ## if prior reduction of mstop,
+            ## first increase mstop to old value first
+            if (mstop != length(xselect)) {
+                mstop <<- length(xselect)
+                fit <<- RET$predict()
+                u <<- ngradient(y, fit, weights)
+            }
             ## now fit the rest
             tmp <- boost(i - mstop)
         }