[Analogue-commits] r281 - pkg/R

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

Author: gsimpson
Date: 2012-08-01 23:53:45 +0200 (Wed, 01 Aug 2012)
New Revision: 281

Added:
   pkg/R/predict.pcr.R
Log:
updates to reflect methods split out, plus updates to use fitPCR

Added: pkg/R/predict.pcr.R
===================================================================
--- pkg/R/predict.pcr.R	                        (rev 0)
+++ pkg/R/predict.pcr.R	2012-08-01 21:53:45 UTC (rev 281)
@@ -0,0 +1,30 @@
+`predict.pcr` <- function(object, newdata, ncomp = seq_len(object$ncomp),
+                          CV = c("none", "LOO", "bootstrap", "nfold"),
+                          verbose = FALSE, n.boot = 100, nfold = 5,
+                          ...) {
+    if(missing(newdata))
+        return(fitted(object))
+    ## store names of new samples
+    newSamp <- rownames(newdata)
+    newdata <- as.matrix(newdata)
+    if (missing(CV))
+        CV <- "none"
+    CV <- match.arg(CV)
+    Np <- NROW(newdata)
+    B <- coef(object)
+    if(identical(CV, "none")) {
+        want <- (spp.names <- colnames(object$data$x)) %in% colnames(newdata)
+        want <- spp.names[want]
+        newdata <- newdata[, want, drop = FALSE]
+        ## do predictions
+        ## matrix of predictions
+        pred <- matrix(ncol = length(ncomp), nrow = Np)
+        for(j in ncomp) {
+            B0 <- object$yMean - object$xMeans %*% B[, j]
+            pred[, j] <- newdata %*% B[, j] + rep(B0, Np)
+        }
+    }
+    rownames(pred) <- newSamp
+    colnames(pred) <- paste0("PC", ncomp)
+    pred
+}