[Lme4-commits] r1684 - pkg/lme4/R

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

Author: bbolker
Date: 2012-03-20 05:20:36 +0100 (Tue, 20 Mar 2012)
New Revision: 1684

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

  merged old and new formula.merMod definitions
  made formula return full (not just fixed) definition by default
  clean up terms() slightly



Modified: pkg/lme4/R/lmer.R
===================================================================
--- pkg/lme4/R/lmer.R	2012-03-20 03:50:54 UTC (rev 1683)
+++ pkg/lme4/R/lmer.R	2012-03-20 04:20:36 UTC (rev 1684)
@@ -774,6 +774,7 @@
 drop1.merMod <- function(object, scope, scale = 0, test = c("none", "Chisq"),
                          k = 2, trace = FALSE, ...) {
 ### FIXME: this is a hacked version of stats:::drop1.default and should be changed
+    ## FIXME: incorporate na.predict() stuff?
     tl <- attr(terms(object), "term.labels")
     if(missing(scope)) scope <- drop.scope(object)
     else {
@@ -877,7 +878,10 @@
 
 ##' @importFrom stats formula
 ##' @S3method fixef merMod
-formula.merMod <- function(x, ...) formula(getCall(x), ...)
+formula.merMod <- function(x, fixed.only=FALSE, ...) {
+    f <- formula(getCall(x),...)
+    if (fixed.only) as.formula(nobars(f)) else f
+}
 
 ##' @S3method isREML merMod
 isREML.merMod <- function(x, ...) as.logical(x at devcomp$dims["REML"])
@@ -1301,10 +1305,8 @@
 terms.merMod <- function(x, fixed.only=TRUE, ...) {
   tt <- attr(x at frame, "terms")
   if (fixed.only) {
-      ## FIXME: e.g. ~ Inoc * Cult + (1|Block) + (1|Cult)
-      ## need to use nobars() to get the right answer
-      ## drop.terms(tt,match(names(x at flist),attr(tt,"term.labels")))
-      mm <- model.frame(as.formula(nobars(formula(x)[-2])),data=model.frame(x))
+      ## do need to drop LHS (e.g. binomial example)
+      mm <- model.frame(formula(x,fixed.only=TRUE)[-2],data=model.frame(x))
       terms(mm)
   } else tt
 }
@@ -2002,7 +2004,4 @@
   opt
 }
 
-formula.merMod <- function(x,...) {
-    x at call$formula
-}