[Mboost-commits] r850 - pkg/mboostDevel/R

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

Author: hofner
Date: 2015-04-22 14:35:22 +0200 (Wed, 22 Apr 2015)
New Revision: 850

Modified:
   pkg/mboostDevel/R/bl.R
Log:
(X_bbs) make sure to compute design matrix only once; issue warnings/errors if data outside boundary knots

Modified: pkg/mboostDevel/R/bl.R
===================================================================
--- pkg/mboostDevel/R/bl.R	2015-04-22 12:35:20 UTC (rev 849)
+++ pkg/mboostDevel/R/bl.R	2015-04-22 12:35:22 UTC (rev 850)
@@ -216,13 +216,14 @@
 
     stopifnot(is.data.frame(mf))
     mm <- lapply(which(colnames(mf) != vary), function(i) {
-        X <- bsplines(mf[[i]],
-                      knots = args$knots[[i]]$knots,
-                      boundary.knots = args$knots[[i]]$boundary.knots,
-                      degree = args$degree,
-                      Ts_constraint = args$Ts_constraint,
-                      deriv = args$deriv)
-        if (args$cyclic) {
+        if (!args$cyclic) {
+            X <- bsplines(mf[[i]],
+                          knots = args$knots[[i]]$knots,
+                          boundary.knots = args$knots[[i]]$boundary.knots,
+                          degree = args$degree,
+                          Ts_constraint = args$Ts_constraint,
+                          deriv = args$deriv)
+        } else { ## if cyclic spline
             X <- cbs(mf[[i]],
                      knots = args$knots[[i]]$knots,
                      boundary.knots = args$knots[[i]]$boundary.knots,
@@ -565,8 +566,13 @@
 }
 
 ### cyclic B-splines
-### adapted version of mgcv:cSplineDes from S.N. Wood
+### adapted version of mgcv::cSplineDes from S.N. Wood
 cbs <- function (x, knots, boundary.knots, degree = 3, deriv = 0L) {
+
+    if (any(x < boundary.knots[1]) | any(x > boundary.knots[2]))
+        stop("some ", sQuote("x"), " values are beyond ",
+             sQuote("boundary.knots"))
+
     nx <- names(x)
     x <- as.vector(x)
     ## handling of NAs
@@ -607,6 +613,11 @@
 
 bsplines <- function(x, knots, boundary.knots, degree,
                      Ts_constraint = "none", deriv = 0L){
+
+    if (any(x < boundary.knots[1]) | any(x > boundary.knots[2]))
+        warning("some ", sQuote("x"), " values are beyond ",
+                sQuote("boundary.knots"))
+
     nx <- names(x)
     x <- as.vector(x)
     ## handling of NAs