[Desire-commits] r28 - packages/desire/R

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

Author: olafm
Date: 2008-05-31 00:23:08 +0200 (Sat, 31 May 2008)
New Revision: 28

Modified:
   packages/desire/R/composite_df.R
Log:
* Better handling of input to lm composite df


Modified: packages/desire/R/composite_df.R
===================================================================
--- packages/desire/R/composite_df.R	2008-05-30 22:22:18 UTC (rev 27)
+++ packages/desire/R/composite_df.R	2008-05-30 22:23:08 UTC (rev 28)
@@ -54,7 +54,7 @@
 
 compositeDF.function <- function(expr, d, ...) {
   ## FIXME: merge ... of ev and ... of cdf.f:
-  ev <- function(x, ...)
+  ev <- function(x, ...)    
       d(expr(x), ...)
   class(ev) <- "composite.desire.function"
   attr(ev, "composite.desc") <- paste("Function: ", deparse(substitute(expr)), "(x)", sep="")
@@ -66,10 +66,25 @@
   ## Calculate sigma
   sigma <- summary(expr)$sigma
   ev <- function(x, ...) {
+    ## Convert non data frame x arguments
+    if (!is.data.frame(x)) {
+      if (is.vector(x)) {
+        names(x) <- pnames
+        x <- as.data.frame(as.list(x))
+      } else if (is.matrix(x)) {
+        colnames(x) <- pnames
+        x <- as.data.frame(x)
+      } else {
+        stop("Cannot convert argument 'x' into a data.frame object.")
+      }      
+    }
     y <- predict(expr, newdata=x)
     ## If this is a realistic DF, pass sd on.
     d(y, sd=sigma, ...)
   }
+  ## Extract vector of names of preditor variables:
+  pnames <- attr(terms(expr), "term.labels")
+  print(pnames)
   attr(ev, "composite.desc") <- paste("Linear Model: ", deparse(expr$call))
   class(ev) <- "composite.desire.function"
   attr(ev, "desire.function") <- d