r-gregmisc-users

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

[<nj...@us...>]

Revision: 959
Author:   nj7w
Date:     2006-05-05 11:29:44 -0700 (Fri, 05 May 2006)
ViewCVS:  http://svn.sourceforge.net/r-gregmisc/?rev=959&view=rev

Log Message:
-----------
Fixed an error: According to Marc Schwartz - there was an error when a matrix without dimnames(or names(dimnames)) was passed as x argument

Modified Paths:
--------------
    trunk/gmodels/R/CrossTable.R
    trunk/gmodels/man/CrossTable.Rd
Modified: trunk/gmodels/R/CrossTable.R
===================================================================
--- trunk/gmodels/R/CrossTable.R	2006-05-05 18:13:57 UTC (rev 958)
+++ trunk/gmodels/R/CrossTable.R	2006-05-05 18:29:44 UTC (rev 959)
@@ -1,3 +1,9 @@
+# Revision 2.2 2006/05/02
+# Fix a bug when a matrix is passed as the 'x' argument
+# Reported by Prof. Albert Sorribas same day
+# Fix involved creating default values for RowData and ColData
+# when there are no dimnames for the matrix
+
 # Revision 2.1 2005/06/26
 # Added 'dnn' argument to enable specification of dimnames
 # as per table()
@@ -18,7 +24,7 @@
                         prop.r = TRUE,
                         prop.c = TRUE,
                         prop.t = TRUE,
-                        prop.chisq=TRUE,
+                        prop.chisq = TRUE,
                         chisq = FALSE,
                         fisher = FALSE,
                         mcnemar = FALSE,
@@ -26,7 +32,7 @@
                         sresid = FALSE,
                         asresid = FALSE,
                         missing.include = FALSE,
-                        format=c("SAS","SPSS"),
+                        format = c("SAS", "SPSS"),
                         dnn = NULL,
                         ...
                         )
@@ -67,8 +73,20 @@
           if(any(x < 0) || any(is.na(x)))
             stop("all entries of x must be nonnegative and finite")
 
-          ## Add generic dimnames if required
-          ## check each dimname separately, in case user has defined one or the other
+          ## Check to see if x has names(dimnames) defined. If yes, use these for
+          ## 'RowData' and 'ColData' labels, else create blank ones
+          ## This can be overridden by setting 'dnn' values
+          if (is.null(names(dimnames(x))))
+            {
+              RowData <- ""
+              ColData <- ""
+            } else {            
+              RowData <- names(dimnames(x))[1]
+              ColData <- names(dimnames(x))[2]
+            }
+          
+          ## Add generic column and rownames if required
+          ## check each separately, in case user has defined one or the other
           if (is.null(rownames(x)))
             rownames(x) <- paste("[", 1:nrow(x), ",]", sep = "")
           if (is.null(colnames(x)))
@@ -272,7 +290,7 @@
                     digits = digits, format = "f",
                             width = CWidth-1), sep="  | ", collapse=""),
                 cat(SpaceSep2, sep = " | ", collapse = "\n"), sep="", collapse="")
-      if (prop.r)
+          if (prop.r)
             cat(cat(SpaceSep1, sep=" | ", collapse=""),
                 cat(formatC(c(CPR[i, ]*100, 100*RS[i] / GT),
                             width = CWidth-1, digits = digits, format = "f"),

Modified: trunk/gmodels/man/CrossTable.Rd
===================================================================
--- trunk/gmodels/man/CrossTable.Rd	2006-05-05 18:13:57 UTC (rev 958)
+++ trunk/gmodels/man/CrossTable.Rd	2006-05-05 18:29:44 UTC (rev 959)
@@ -1,3 +1,9 @@
+%% Revision 2.2 2006/05/02
+%% Fix a bug when a matrix is passed as the 'x' argument
+%% Reported by Prof. Albert Sorribas same day
+%% Fix involved creating default values for RowData and ColData
+%% when there are no dimnames for the matrix
+
 %% Revision 2.1 2005/06/26
 %% Added 'dnn' argument to enable specification of dimnames
 %% names as per table()


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

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

[<nj...@us...>]

Revision: 964
Author:   nj7w
Date:     2006-06-05 13:59:50 -0700 (Mon, 05 Jun 2006)
ViewCVS:  http://svn.sourceforge.net/r-gregmisc/?rev=964&view=rev

Log Message:
-----------
Additions as per Randall C Johnson

Modified Paths:
--------------
    trunk/gmodels/R/ci.R
    trunk/gmodels/R/estimable.R
    trunk/gmodels/R/fit.contrast.R
    trunk/gmodels/R/to.est.R
Modified: trunk/gmodels/R/ci.R
===================================================================
--- trunk/gmodels/R/ci.R	2006-06-05 20:57:17 UTC (rev 963)
+++ trunk/gmodels/R/ci.R	2006-06-05 20:59:50 UTC (rev 964)
@@ -67,19 +67,19 @@
   retval
 }
 
-ci.lmer <- function(x,confidence=0.95,alpha=1-confidence,...)
-  {
-  est  <-  fixef(x)
-  se <- sqrt(diag(vcov(x)))
-  df <- getFixDF(x)
-  ci.low  <- est + qt(alpha/2, df) * se
-  ci.high <- est - qt(alpha/2, df) * se
-  retval  <- cbind(Estimate=est,
-                   "CI lower"=ci.low,
-                   "CI upper"=ci.high,
-                   "Std. Error"= se,
-                   "DF" = df,
-                   "p-value" = 2*(1-pt(abs(est/se), df)))
-  rownames(retval)  <-  names(est)
+ci.lmer <- function(x, confidence=0.95, alpha=1-confidence, sim.lmer=TRUE, n.sim=1000, ...) ################### changed this function
+{
+  if(!(require(coda, quietly=TRUE) & require(Matrix, quietly=TRUE)))
+    stop("coda and Matrix packages required for ci.lmer")
+  
+  x.effects <- fixef(x)
+  n <- length(x.effects)
+
+  retval <- est.lmer(obj = x, cm = diag(n), beta0 = rep(0, n),
+                     conf.int = confidence, show.beta0 = FALSE,
+                     n.sim = n.sim)[,c("Estimate", "Lower.CI", "Upper.CI", "Std. Error", "p value")]
+
+  colnames(retval)[c(2:3, 5)] <- c("CI lower", "CI upper", "p-value")
+  rownames(retval) <- names(x.effects)
   retval
 }

Modified: trunk/gmodels/R/estimable.R
===================================================================
--- trunk/gmodels/R/estimable.R	2006-06-05 20:57:17 UTC (rev 963)
+++ trunk/gmodels/R/estimable.R	2006-06-05 20:59:50 UTC (rev 964)
@@ -9,12 +9,11 @@
     }
   else if(is.list(cm))
     {
-      cm <- t(sapply(cm,
-                     .to.est, obj=obj)) 
-    }
+      cm <- matrix(.to.est(obj, cm), nrow=1) ################### changed 
+    }                                        ################### it seems that the names are lost with the way it used to be...
   else if(is.vector(cm))
     {
-      cm <- matrix(.to.est(obj, cm),nrow=1)
+      cm <- matrix(.to.est(obj, cm), nrow=1)
     }
   else
     {
@@ -43,24 +42,8 @@
     }
   else
     {
-      if ("lmer" %in% class(obj)) {
+      if ("lme" %in% class(obj)) {
         stat.name <- "t.stat"
-        cf <- as.matrix(fixef(obj))
-        vcv <- vcov(obj)
-        tmp <- cm
-        tmp[tmp==0] <- NA
-        df.all <- t(abs(t(tmp) * getFixDF(obj)))
-        df <- apply(df.all, 1, min, na.rm=TRUE)
-        problem <- apply(df.all != df, 1, any, na.rm=TRUE)
-        if (any(problem))
-          warning(paste("Degrees of fredom vary among parameters used to ",
-                        "constrct linear contrast(s): ",
-                        paste((1:nrow(tmp))[problem], collapse=", "),
-                        ". Using the smallest df among the set of parameters.",
-                        sep=""))
-      }
-      else if ("lme" %in% class(obj)) {
-        stat.name <- "t.stat"
         cf <- summary(obj)$tTable
         rho <- summary(obj)$cor
         vcv <- rho * outer(cf[, 2], cf[, 2])
@@ -113,7 +96,7 @@
         }
       else
         {
-          stop("obj must be of class 'lm', 'glm', 'aov', 'lme', 'lmer', 'gee', 'geese' or 'nlme'")
+          stop("obj must be of class 'lm', 'glm', 'aov', 'lme', 'gee', 'geese' or 'nlme'")
         }
       if (is.null(cm))
         cm <- diag(dim(cf)[1])
@@ -136,7 +119,7 @@
              },
              X2.stat={
                prob <- 1 - pchisq((ct.diff/vc)^2, df=1)
-             })
+             })                                                      ##################
 
       if (stat.name=="X2.stat")
         {
@@ -153,17 +136,19 @@
           dimnames(retval) <- list(rn, c("beta0", "Estimate", "Std. Error",
                                          "t value", "DF", "Pr(>|t|)"))
         }
-
+      
       if (!is.null(conf.int))
         {
           if (conf.int <=0 || conf.int >=1)
             stop("conf.int should be between 0 and 1. Usual values are 0.95, 0.90")
           alpha <- 1 - conf.int
-          switch(stat.name, t.stat={
-            quant <- qt(1 - alpha/2, df)
-          }, X2.stat={
-            quant <- qt(1 - alpha/2, 100)
-          })
+          switch(stat.name,
+                 t.stat={
+                   quant <- qt(1 - alpha/2, df)
+                 },
+                 X2.stat={
+                   quant <- qt(1 - alpha/2, 100)
+                 })
           nm <- c(colnames(retval), "Lower.CI", "Upper.CI")
           retval <- cbind(retval, lower=ct.diff - vc * quant, upper=ct.diff +
                           vc * quant)
@@ -212,15 +197,65 @@
     print(as.data.frame(retval))
 }
 
+estimable.lmer <- function (obj, cm, beta0, conf.int=NULL,
+                            show.beta0, sim.lmer=TRUE, n.sim=1000)
+{
+  if (is.matrix(cm) || is.data.frame(cm))
+    {
+      cm <- t(apply(cm, 1, .to.est, obj=obj)) 
+    }
+  else if(is.list(cm))
+    {
+      cm <- matrix(.to.est(obj, cm), nrow=1)
+    }                                       
+  else if(is.vector(cm))
+    {
+      cm <- matrix(.to.est(obj, cm), nrow=1)
+    }
+  else
+    {
+      stop("`cm' argument must be of type vector, list, or matrix.")
+    }
 
-## this is how the DF are caclulated in the Matrix package (for lmer.summary objects)
-## it seems that this is not entirely correct, but will hopfully be improved upon shortly
-## see lmer.R from the Matrix package version 0.99-1
+  if(missing(show.beta0))
+    {
+      if(!missing(beta0))
+        show.beta0=TRUE
+      else
+        show.beta0=FALSE
+    }
 
-getFixDF <- function(obj)
-{
-          nc <- obj@nc[-seq(along = obj@Omega)]
-          p <- abs(nc[1]) - 1
-          n <- nc[2]
-          rep(n-p, p)
+
+  if (missing(beta0))
+    {
+      beta0 = rep(0, ifelse(is.null(nrow(cm)), 1, nrow(cm)))
+
+    }
+
+    if ("lmer" %in% class(obj)) {                                      
+      if(!require(Matrix, quietly=TRUE))                               
+        stop("Matrix package required for lmer objects")               
+                                                                       
+      if(sim.lmer)                                                     
+        return(est.lmer(obj=obj, cm=cm, beta0=beta0, conf.int=conf.int,
+                        show.beta0=show.beta0, n.sim=n.sim))           
+                                                                       
+      stat.name <- "lmer"                                              
+      cf <- as.matrix(fixef(obj))                                      
+      vcv <- as.matrix(vcov(obj))                                      
+      df <- NA                                                         
+    }
+    else {
+      stop("obj is not of class lmer")
+    }
+
+    retval <- cbind(hyp=beta0, est=ct, stderr=vc, "t value"=ct.diff/vc)
+    dimnames(retval) <- list(rn, c("beta0", "Estimate", "Std. Error",  
+                                   "t value"))
+
+    rownames(retval) <- make.unique(rownames(retval))
+    retval <- as.data.frame(retval)
+    if(!show.beta0) retval$beta0 <- NULL
+    return(retval)
+
 }

Modified: trunk/gmodels/R/fit.contrast.R
===================================================================
--- trunk/gmodels/R/fit.contrast.R	2006-06-05 20:57:17 UTC (rev 963)
+++ trunk/gmodels/R/fit.contrast.R	2006-06-05 20:59:50 UTC (rev 964)
@@ -4,9 +4,9 @@
                             conf.int=NULL, df=FALSE, ...)
 {
   # check class of model
-  if( !(any(class(model) %in% c("lm", "aov", "lme", "lmer") ) ))
-    stop("contrast.lm can only be applied to objects inheriting from 'lm'",
-         "and 'lme' (eg: lm,glm,aov,lme,lmer).")
+  if( !(any(class(model) %in% c("lm", "aov", "lme") ) ))                        ######
+    stop("contrast.lm can only be applied to objects inheriting from 'lm'",     ###### took lmer out of here
+         "and 'lme' (eg: lm,glm,aov,lme).")                                     ######
 
   # make sure we have the NAME of the variable
   if(!is.character(varname))
@@ -34,10 +34,7 @@
   colnames(cmat) <- cn
 
   # recall fitting method with the specified contrast
-  if(!("lmer" %in% class(model)))
-     m <- model$call
-  else
-     m <- model@call # lmer is class 4
+  m <- model$call                                     ###### deleted lmer specific/S4 portion
 
   if(is.null(m$contrasts))
     m$contrasts <- list()
@@ -49,23 +46,8 @@
     r <- eval(m)
 
   # now return the correct elements ....
-  if( 'lmer' %in% class(model) )
+  if( 'lme' %in% class(model) )              ####### took out lmer section
     {
-      est <- fixef(r) 
-      se  <- sqrt(diag(vcov(r)))
-      tval <- est/se
-      df.lmer   <- getFixDF(r)
-      retval <- cbind(
-                      "Estimate"= est,
-                      "Std. Error"= se,
-                      "t-value"= tval,
-                      "Pr(>|t|)"=  2 * (1 - pt(abs(tval), df.lmer)),
-                      "DF"=df.lmer
-                      )
-
-    }
-  else if( 'lme' %in% class(model) )
-    {
       est <- r$coefficients$fixed
       se  <- sqrt(diag(r$varFix))
       tval <- est/se
@@ -99,10 +81,7 @@
         }
       else
         {
-          if(!("lmer" %in% class(model))) # doesn't add this on in lmer
-            rn <- paste(varname,rownames(coeff),sep="")
-          else
-            rn <- varname
+          rn <- paste(varname,rownames(coeff),sep="")       ####### removed lmer portion
           ind <- match(rn,rownames(retval))
           retval <- retval[ind,,drop=FALSE]
         }
@@ -138,14 +117,89 @@
     fit.contrast.lm(model, varname, coeff, showall, conf.int, df)
   }
 
+# I made rather dramatic changes here and do all calculations in fit.contrast.lmer rather than
+# fit.contrast.lm because of the simulation extras ... added sim.lmer and n.sim to the parameter list
 fit.contrast.lmer <- function(model, varname, coeff, showall=FALSE,
-                            conf.int=NULL, df=FALSE, ...)
+                            conf.int=NULL, sim.lmer=TRUE, n.sim=1000, ...)
+{
+  require(lme4)
+
+  # make sure we have the NAME of the variable
+  if(!is.character(varname))
+     varname <- deparse(substitute(varname))
+
+  # make coeff into a matrix
+  if(!is.matrix(coeff))
+    {
+       coeff <- matrix(coeff, nrow=1)
+     }
+
+  # make sure columns are labeled
+  if (is.null(rownames(coeff)))
+     {
+       rn <- vector(length=nrow(coeff))
+       for(i in 1:nrow(coeff))
+          rn[i] <- paste(" c=(",paste(coeff[i,],collapse=" "), ")")
+       rownames(coeff) <- rn
+     }
+
+  # now convert into the proper form for the contrast matrix
+  cmat <- make.contrasts(coeff, ncol(coeff) )
+  cn <- paste(" C",1:ncol(cmat),sep="")
+  cn[1:nrow(coeff)] <- rownames(coeff)
+  colnames(cmat) <- cn
+
+  m <- model@call
+
+  if(is.null(m$contrasts))
+    m$contrasts <- list()
+  m$contrasts[[varname]] <- cmat
+
+  if(is.R())
+    r <- eval(m, parent.frame())
+  else
+    r <- eval(m)
+  # now return the correct elements ....
+  r.effects <- fixef(r)
+  n <- length(r.effects)
+
+  if(sim.lmer)
   {
-    require(lme4)
-    fit.contrast.lm(model, varname, coeff, showall, conf.int, df)
+    retval <- est.lmer(obj = r, cm = diag(n), beta0 = rep(0, n),
+                       conf.int = conf.int, show.beta0 = FALSE,
+                       n.sim=n.sim)
+    rownames(retval) <- names(r.effects)
+  }else{
+    if(!is.null(conf.int))
+      warning("Confidence interval calculation for lmer objects requires simulation -- use sim.lmer = TRUE")
+
+    est <- fixef(r)
+    se  <- sqrt(diag(as.matrix(vcov(r))))
+    tval <- est/se
+    retval <- cbind(
+                    "Estimate"= est,
+                    "Std. Error"= se,
+                    "t-value"= tval
+                    )
   }
 
+  if( !showall )
+  {
+    if( !is.R() && ncol(cmat)==1 )
+    {
+      retval <- retval[varname,,drop=FALSE]
+      rownames(retval) <- rn
+    }else{
+      rn <- paste(varname,rownames(coeff),sep="")
+      ind <- match(rn,rownames(retval))
+      retval <- retval[ind,,drop=FALSE]
+    }
+  }
 
+  return(retval)
+}
+
+
 fit.contrast <- function(model, varname, coeff, ...)
   UseMethod("fit.contrast")
 

Modified: trunk/gmodels/R/to.est.R
===================================================================
--- trunk/gmodels/R/to.est.R	2006-06-05 20:57:17 UTC (rev 963)
+++ trunk/gmodels/R/to.est.R	2006-06-05 20:59:50 UTC (rev 964)
@@ -45,7 +45,10 @@
                   )
         }
 
-      est[names(params)] <- params
+      if(is.list(params))                      #####################
+        est[names(params)] <- unlist(params)   ##################### changed
+      else                                     #####################
+        est[names(params)] <- params           #####################
     }
 
   return(est)


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

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

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

Revision: 1025
          http://svn.sourceforge.net/r-gregmisc/?rev=1025&view=rev
Author:   warnes
Date:     2006-11-28 14:38:11 -0800 (Tue, 28 Nov 2006)

Log Message:
-----------
Remove extraneous comma that causes errors in R 2.5.0

Modified Paths:
--------------
    trunk/gmodels/R/ci.R
    trunk/gmodels/R/estimable.R
    trunk/gmodels/R/fast.prcomp.R

Modified: trunk/gmodels/R/ci.R
===================================================================
--- trunk/gmodels/R/ci.R	2006-11-28 00:59:53 UTC (rev 1024)
+++ trunk/gmodels/R/ci.R	2006-11-28 22:38:11 UTC (rev 1025)
@@ -12,7 +12,7 @@
                Estimate=est,
                "CI lower"=ci.low,
                "CI upper"=ci.high,
-               "Std. Error"=stderr,
+               "Std. Error"=stderr
                )
 
   retval

Modified: trunk/gmodels/R/estimable.R
===================================================================
--- trunk/gmodels/R/estimable.R	2006-11-28 00:59:53 UTC (rev 1024)
+++ trunk/gmodels/R/estimable.R	2006-11-28 22:38:11 UTC (rev 1025)
@@ -1,7 +1,12 @@
 # $Id$
+estimable <- function (obj, cm, beta0, conf.int=NULL, joint.test=FALSE,
+                       show.beta0, ...)
+  {
+    UseMethod("estimable")
+  }
 
-estimable <- function (obj, cm, beta0, conf.int=NULL, joint.test=FALSE,
-                           show.beta0)
+estimable.default <- function (obj, cm, beta0, conf.int=NULL, joint.test=FALSE,
+                           show.beta0, ...)
 {
   if (is.matrix(cm) || is.data.frame(cm))
     {
@@ -198,7 +203,7 @@
 }
 
 estimable.lmer <- function (obj, cm, beta0, conf.int=NULL,
-                            show.beta0, sim.lmer=TRUE, n.sim=1000)
+                            show.beta0, sim.lmer=TRUE, n.sim=1000, ...)
 {
   if (is.matrix(cm) || is.data.frame(cm))
     {

Modified: trunk/gmodels/R/fast.prcomp.R
===================================================================
--- trunk/gmodels/R/fast.prcomp.R	2006-11-28 00:59:53 UTC (rev 1024)
+++ trunk/gmodels/R/fast.prcomp.R	2006-11-28 22:38:11 UTC (rev 1025)
@@ -30,7 +30,7 @@
         s$d <- s$d/sqrt(max(1, nrow(x) - 1))
 
         dimnames(s$vt) <- list(paste("PC", seq(len = nrow(s$vt)), sep = ""),
-                               colnames(x), )
+                               colnames(x) )
         r <- list(sdev = s$d, rotation = t(s$vt) )
         if (retx)
             r$x <- x %*% t(s$vt)


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

[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.