[R-gregmisc-users] SF.net SVN: r-gregmisc: [1104] trunk/gmodels/R

[<wa...@us...>]

Revision: 1104
          http://r-gregmisc.svn.sourceforge.net/r-gregmisc/?rev=1104&view=rev
Author:   warnes
Date:     2007-07-25 17:10:03 -0700 (Wed, 25 Jul 2007)

Log Message:
-----------
Add estimable method for mlm objects

Modified Paths:
--------------
    trunk/gmodels/R/estimable.R

Added Paths:
-----------
    trunk/gmodels/R/estimable.mlm.R

Modified: trunk/gmodels/R/estimable.R
===================================================================
--- trunk/gmodels/R/estimable.R	2007-07-22 09:27:18 UTC (rev 1103)
+++ trunk/gmodels/R/estimable.R	2007-07-26 00:10:03 UTC (rev 1104)
@@ -4,7 +4,8 @@
     UseMethod("estimable")
   }
 
-estimable.default <- function (obj, cm, beta0, conf.int=NULL, show.beta0, joint.test=FALSE, ...)
+estimable.default <- function (obj, cm, beta0, conf.int=NULL,
+                               show.beta0, joint.test=FALSE, ...)
 {
   if (is.matrix(cm) || is.data.frame(cm))
     {
@@ -12,8 +13,8 @@
     }
   else if(is.list(cm))
     {
-      cm <- matrix(.to.est(obj, cm), nrow=1) ################### changed 
-    }                                        ################### it seems that the names are lost with the way it used to be...
+      cm <- matrix(.to.est(obj, cm), nrow=1)
+    }
   else if(is.vector(cm))
     {
       cm <- matrix(.to.est(obj, cm), nrow=1)
@@ -122,7 +123,7 @@
              },
              X2.stat={
                prob <- 1 - pchisq((ct.diff/vc)^2, df=1)
-             })                                                      ##################
+             })
 
       if (stat.name=="X2.stat")
         {

Added: trunk/gmodels/R/estimable.mlm.R
===================================================================
--- trunk/gmodels/R/estimable.mlm.R	                        (rev 0)
+++ trunk/gmodels/R/estimable.mlm.R	2007-07-26 00:10:03 UTC (rev 1104)
@@ -0,0 +1,30 @@
+`estimable.mlm` <-
+  function (object, ...) 
+{
+  coef <- coef(object)
+  ny <- ncol(coef)
+  effects <- object$effects
+  resid <- object$residuals
+  fitted <- object$fitted
+  ynames <- colnames(coef)
+  if (is.null(ynames)) {
+    lhs <- object$terms[[2]]
+    if (mode(lhs) == "call" && lhs[[1]] == "cbind") 
+      ynames <- as.character(lhs)[-1]
+    else ynames <- paste("Y", seq(ny), sep = "")
+  }
+  value <- vector("list", ny)
+  names(value) <- paste("Response", ynames)
+  cl <- oldClass(object)
+  class(object) <- cl[match("mlm", cl):length(cl)][-1]
+  for (i in seq(ny)) {
+    object$coefficients <- coef[, i]
+    object$residuals <- resid[, i]
+    object$fitted.values <- fitted[, i]
+    object$effects <- effects[, i]
+    object$call$formula[[2]] <- object$terms[[2]] <- as.name(ynames[i])
+    value[[i]] <- estimable(object, ...)
+  }
+  class(value) <- "listof"
+  value
+}


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.