[Analogue-commits] r119 - pkg/R

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

Author: gsimpson
Date: 2009-04-26 15:12:28 +0200 (Sun, 26 Apr 2009)
New Revision: 119

Modified:
   pkg/R/getK.R
Log:
new getK method for predict.mat

Modified: pkg/R/getK.R
===================================================================
--- pkg/R/getK.R	2009-04-26 10:56:06 UTC (rev 118)
+++ pkg/R/getK.R	2009-04-26 13:12:28 UTC (rev 119)
@@ -24,7 +24,7 @@
 
 getK.bootstrap.mat <- function(object, which = c("bootstrap", "model"),
                                prediction = FALSE, ...) {
-  if (!inherits(object, "bootstrap.mat")) 
+  if (!inherits(object, "bootstrap.mat"))
     stop("Use only with \"bootstrap.mat\" objects")
   if(missing(which))
     which <- "bootstrap"
@@ -45,6 +45,26 @@
   return(retval)
 }
 
+getK.predict.mat <- function(object,
+                             which = c("model", "bootstrap"),
+                             ...) {
+    if(missing(which))
+        which <- "model"
+    which <- match.arg(which)
+    if(which == "bootstrap" && is.null()) {
+        which <- "model"
+        warning()
+    }
+    if(which == "model") {
+        retval <- object$predictions$model$k
+    } else {
+        retval <- object$predictions$bootstrap$k
+    }
+    attr(retval, "auto") <- object$auto
+    attr(retval, "weighted") <- object$weighted
+    return(retval)
+}
+
 "setK<-" <- function(object, weighted=FALSE, value) UseMethod("setK<-")
 
 "setK<-.default" <- function(object, weighted=FALSE, value) {