[Lme4-commits] r1638 - pkg/lme4Eigen/R

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

Author: bbolker
Date: 2012-03-02 19:42:06 +0100 (Fri, 02 Mar 2012)
New Revision: 1638

Modified:
   pkg/lme4Eigen/R/lmer.R
Log:

  give terms.merMod() a fixed.only= argument (default TRUE)
  change nrow(object at frame) to nobs(object) [definitely OK to assume R>2.13 by now!]



Modified: pkg/lme4Eigen/R/lmer.R
===================================================================
--- pkg/lme4Eigen/R/lmer.R	2012-03-01 22:10:32 UTC (rev 1637)
+++ pkg/lme4Eigen/R/lmer.R	2012-03-02 18:42:06 UTC (rev 1638)
@@ -683,6 +683,7 @@
 	ss <- as.vector(object at pp$RX() %*% object at beta)^2
 	names(ss) <- colnames(X)
 	terms <- terms(object)
+        ## FIXME: this setdiff() should be obsolete since terms now keeps only fixed effects by default
 	nmeffects <- setdiff(attr(terms, "term.labels"), names(object at flist))
 	if ("(Intercept)" %in% names(ss))
 	    nmeffects <- c("(Intercept)", nmeffects)
@@ -782,9 +783,7 @@
     ans <- matrix(nrow = ns + 1L, ncol = 2L,
                   dimnames =  list(c("<none>", scope), c("df", "AIC")))
     ans[1, ] <- extractAIC(object, scale, k = k, ...)
-    ## BMB: avoid nobs, to avoid dependence on 2.13
-    ## n0 <- nobs(object, use.fallback = TRUE)
-    n0 <- nrow(object at frame)
+    n0 <- nobs(object, use.fallback = TRUE)
     env <- environment(formula(object))
     for(i in seq(ns)) {
 	tt <- scope[i]
@@ -796,9 +795,7 @@
                        evaluate = FALSE)
 	nfit <- eval(nfit, envir = env) # was  eval.parent(nfit)
 	ans[i+1, ] <- extractAIC(nfit, scale, k = k, ...)
-        ## BMB: avoid nobs, to avoid dependence on 2.13
-        ## nnew <- nobs(nfit, use.fallback = TRUE)
-        nnew <- nrow(nfit at frame)
+        nnew <- nobs(nfit, use.fallback = TRUE)
         if(all(is.finite(c(n0, nnew))) && nnew != n0)
             stop("number of rows in use has changed: remove missing values?")
     }
@@ -1261,7 +1258,12 @@
 
 ##' @importFrom stats terms
 ##' @S3method terms merMod
-terms.merMod <- function(x, ...) attr(x at frame, "terms")
+terms.merMod <- function(x, fixed.only=TRUE, ...) {
+  tt <- attr(x at frame, "terms")
+  if (fixed.only) {
+    drop.terms(tt,match(names(x at flist),attr(tt,"term.labels")))
+  } else tt
+}
 
 ##' @importFrom stats update
 ##' @S3method update merMod