[Lme4-commits] r1625 - pkg/lme4Eigen/tests

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

Author: mmaechler
Date: 2012-02-28 15:11:57 +0100 (Tue, 28 Feb 2012)
New Revision: 1625

Modified:
   pkg/lme4Eigen/tests/getME.R
Log:
more checks; no longer assuming that  getME(., "beta") has names
{but getME(.,"theta") still has}


Modified: pkg/lme4Eigen/tests/getME.R
===================================================================
--- pkg/lme4Eigen/tests/getME.R	2012-02-28 04:29:24 UTC (rev 1624)
+++ pkg/lme4Eigen/tests/getME.R	2012-02-28 14:11:57 UTC (rev 1625)
@@ -1,14 +1,43 @@
-## tests of getME: are names correct?
+library(lme4Eigen)
+#### tests of getME()
 
-library(lme4Eigen)
+###  are names correct? --------------
+if(getRversion() < "2.15")
+    paste0 <- function(...) paste(..., sep = '')
+hasInms <- function(x) grepl("(Intercept", names(x), fixed=TRUE)
+matchNms <- function(fm, PAR) {
+    stopifnot(is.character(vnms <- names(fm at cnms)))
+    mapply(grepl, paste0("^", vnms), names(PAR))
+}
+chkIMod <- function(fm) {## check "intercept only" model
+    b1 <- getME(fm,"beta")
+    f1 <- fixef(fm)
+    stopifnot(hasInms(f1), f1 == b1,
+              hasInms(t1 <- getME(fm,"theta")), matchNms(fm, t1))
+}
+
 fm1 <- lmer(diameter ~ (1|plate) + (1|sample), Penicillin)
-getME(fm1,"beta")
-getME(fm1,"theta")
+chkMod(fm1)
 
 fm2 <- lmer(angle ~ recipe * temperature + (1|recipe:replicate), cake)
-getME(fm2,"beta")
+stopifnot(fixef(fm2) == getME(fm2,"beta"))
 getME(fm2,"theta")
 
-getME(lmer(Reaction ~ Days + (Days|Subject), sleepstudy),"theta")
-getME(lmer(Reaction ~ Days + (1|Subject) + (0+Days|Subject),
-           sleepstudy),"theta")
+getME(fm3 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy),
+      "theta")
+getME(fm4 <- lmer(Reaction ~ Days + (1|Subject) + (0+Days|Subject), sleepstudy),
+      "theta")
+
+## internal consistency check ensuring that all allowed 'name's work (and are not empty):
+(nmME <- eval(formals(getME)$name))
+chkMEs <- function(fm, nms) {
+    stopifnot(is.character(nms))
+    str(parts <- sapply(nms, getME, object = fm, simplify=FALSE))
+    isN <- sapply(parts, is.null)
+    stopifnot(identical(names(isN), nms), !any(isN))
+}
+
+chkMEs(fm1, nmME)
+chkMEs(fm2, nmME)
+chkMEs(fm3, nmME)
+chkMEs(fm4, nmME)