lmerTest/ 0000755 0001762 0000144 00000000000 15131411367 012053 5 ustar ligges users lmerTest/tests/ 0000755 0001762 0000144 00000000000 15127254360 013220 5 ustar ligges users lmerTest/tests/test_lmerTest_paper.R 0000644 0001762 0000144 00000005277 15125475223 017404 0 ustar ligges users # test_lmerTest_paper.R
library(lmerTest)
# Kenward-Roger only available with pbkrtest and only then validated in R >= 3.3.3
# (faulty results for R < 3.3.3 may be due to unstated dependencies in pbkrtest)
has_pbkrtest <- requireNamespace("pbkrtest", quietly = TRUE) && getRversion() >= "3.3.3"
# Read in data set
load(system.file("testdata","test_paper_objects.RData", package="lmerTest"))
# Evaluate code from paper:
## Section 8.2:
tv <- lmer(Sharpnessofmovement ~ TVset * Picture + (1 | Assessor) +
(1 | Assessor:TVset) + (1 | Assessor:Picture), data = TVbo,
control=lmerControl(optimizer="bobyqa"))
(an8.2 <- anova(tv))
if(has_pbkrtest)
(ankr8.2 <- anova(tv, type=2, ddf="Kenward-Roger"))
## Section 8.3:
m.carrots <- lmer(Preference ~ sens1 + sens2 + (1 + sens1 + sens2 | Consumer) +
(1 | Product), data=carrots,
control=lmerControl(optimizer="bobyqa"))
(sum8.3 <- coef(summary(m.carrots)))
## Section 8.4:
tv <- lmer(Sharpnessofmovement ~ TVset * Picture +
(1 | Assessor:TVset) + (1 | Assessor:Picture) +
(1 | Assessor:Picture:TVset) + (1 | Repeat) + (1 | Repeat:Picture) +
(1 | Repeat:TVset) + (1 | Repeat:TVset:Picture) + (1 | Assessor),
data = TVbo,
control=lmerControl(optimizer="bobyqa"))
st <- step(tv)
(elim_tab_random8.4 <- st$random)
(elim_tab_fixed8.4 <- st$fixed)
(an8.4 <- anova(get_model(st)))
## Section 8.5:
# L <- matrix(0, ncol = 12, nrow = 6)
# L[1, 7] <- L[2, 8] <- L[3, 9] <- L[4, 10] <- L[5, 11] <- L[6, 12] <- 1
L <- cbind(array(0, dim=c(6, 6)), diag(6))
(con1_8.5 <- calcSatterth(tv, L))
(con2_8.5 <- contest(tv, L))
## Section C:
# m.carrots <- lmer(Preference ~ sens1 + sens2 + (1 + sens1 + sens2 | Consumer) +
# (1 | product), data = carrots)
# step(m.carrots, reduce.fixed = FALSE)
(ran_C <- ranova(m.carrots))
# Compare to validated outputs:
TOL <- 1e-4
stopifnot(
isTRUE(all.equal(an8.2_save, an8.2, check.attributes = FALSE, tolerance=TOL)),
isTRUE(all.equal(sum8.3_save, sum8.3, check.attributes = FALSE, tolerance=TOL)),
isTRUE(all.equal(elim_tab_random8.4_save, elim_tab_random8.4,
check.attributes = FALSE, tolerance=TOL)),
isTRUE(all.equal(elim_tab_fixed8.4_save, elim_tab_fixed8.4,
check.attributes = FALSE, tolerance=TOL)),
isTRUE(all.equal(an8.4_save, an8.4, check.attributes = FALSE, tolerance=TOL)),
isTRUE(all.equal(con1_8.5_save, con1_8.5, check.attributes = FALSE, tolerance=TOL)),
isTRUE(all.equal(con2_8.5_save, con2_8.5, check.attributes = FALSE, tolerance=TOL))
)
if(has_pbkrtest) {
stopifnot(
isTRUE(all.equal(ankr8.2_save, ankr8.2, check.attributes = FALSE, tolerance=TOL))
)
}
lmerTest/tests/test_a_utils.R 0000644 0001762 0000144 00000001152 15125475223 016042 0 ustar ligges users # test_a_utils.R
library(lmerTest)
# test safeDeparse() - equivalence and differences to deparse():
deparse_args <- formals(deparse)
safeDeparse_args <- formals(lmerTest:::safeDeparse)
stopifnot(
all.equal(names(deparse_args), names(safeDeparse_args)),
all.equal(deparse_args[!names(deparse_args) %in% c("control", "width.cutoff")],
safeDeparse_args[!names(safeDeparse_args) %in% c("control", "width.cutoff")]),
all.equal(deparse_args[["width.cutoff"]], 60L),
all(eval(safeDeparse_args[["control"]]) %in% eval(deparse_args[["control"]])),
all.equal(safeDeparse_args[["width.cutoff"]], 500L)
)
lmerTest/tests/test_contrast_utils.R 0000644 0001762 0000144 00000003767 15125475223 017475 0 ustar ligges users # test_contrast_utils.R
library(lmerTest)
##########
# Test that a message is printed if some cells have zero data:
# Missing a single cell:
data("cake", package="lme4")
cake4 <- cake
cake4$temperature <- factor(cake4$temperature, ordered=FALSE)
cake4 <- droplevels(subset(cake4, !(recipe == "A" & temperature == "175") ))
with(cake4, table(recipe, temperature))
fm1 <- lmer(angle ~ recipe * temperature + (1|recipe:replicate), cake4)
an <- anova(fm1)
txt <- capture.output(an <- anova(fm1), type = "message")
stopifnot(length(grep("Missing cells for:", txt)) > 0,
length(grep("Interpret type III hypotheses with care.", txt)) > 0)
##########
# Test that a message is printed if some cells have zero data:
# Missing diagonal:
cake4 <- cake
cake4$temperature <- factor(cake4$temperature, ordered=FALSE)
cake4 <- droplevels(subset(cake4, temperature %in% levels(cake4$temperature)[1:3]))
cake4 <- droplevels(subset(cake4, !((recipe == "A" & temperature == "175") |
(recipe == "B" & temperature == "185") |
(recipe == "C" & temperature == "195") )))
cake4$temp0 <- cake4$temp - mean(cake4$temp)
with(cake4, table(recipe, temperature))
fm1 <- lmer(angle ~ recipe * temperature + (1|recipe:replicate), cake4)
an <- anova(fm1)
txt <- capture.output(an <- anova(fm1), type = "message")
stopifnot(length(grep("Missing cells for:", txt)) > 0,
length(grep("Interpret type III hypotheses with care.", txt)) > 0)
##########
# Test that a message is NOT printed with centered covariates:
fm1 <- lmer(angle ~ recipe * temp0 + (1|recipe:replicate), cake4)
an <- anova(fm1)
txt <- capture.output(an <- anova(fm1), type = "message")
stopifnot(length(grep("Missing cells for:", txt)) == 0,
length(grep("Interpret type III hypotheses with care.", txt)) == 0)
# Note: in many cases a message would not be printed anyway because the
# columns sums in the rdX design matrix would not be exactly zero but just a
# small number very close to zero.
lmerTest/tests/test_legacy.R 0000644 0001762 0000144 00000006412 15126231756 015654 0 ustar ligges users # test_legacy.R
library(lmerTest)
TOL <- 1e-4
#####################################################################
# Read in data set
load(system.file("testdata", "legacy_fits.RData", package="lmerTest"))
# Generated with the following code using lmerTest version 2.0-37.9002
#
# library("lmerTest")
# packageVersion("lmerTest")
# fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy)
# (an1 <- anova(fm1))
# (sfm1 <- summary(fm1))
#
# fm2 <- lmer(Informed.liking ~ Product + Information + Gender +
# (1|Product:Consumer) , data=ham)
# (an2 <- anova(fm2))
# (sfm2 <- summary(fm2))
#
# save(fm1, an1, sfm1, fm2, an2, sfm2,
# file="~/GitHub/lmerTestR/package/inst/testdata/legacy_fits.RData")
#######################################
### Check that arguments for merModLmerTest and lmerModLmerTest methods match up:
stopifnot(
isTRUE(all.equal(formals(lmerTest:::anova.merModLmerTest),
formals(lmerTest:::anova.lmerModLmerTest))),
isTRUE(all.equal(formals(lmerTest:::summary.merModLmerTest),
formals(lmerTest:::summary.lmerModLmerTest))),
isTRUE(all.equal(formals(lmerTest:::drop1.merModLmerTest),
formals(lmerTest:::drop1.lmerModLmerTest))),
isTRUE(all.equal(formals(lmerTest:::step.merModLmerTest),
formals(lmerTest:::step.lmerModLmerTest))),
isTRUE(all.equal(formals(lmerTest:::ls_means.merModLmerTest),
formals(lmerTest:::ls_means.lmerModLmerTest))),
isTRUE(all.equal(formals(lmerTest:::difflsmeans.merModLmerTest),
formals(lmerTest:::difflsmeans.lmerModLmerTest))))
#######################################
## Tests for fm1:
(an1new <- anova(fm1))
(sfm1new <- summary(fm1))
stopifnot(
isTRUE(all.equal(an1new, an1, check.attributes=FALSE, tol=TOL)),
isTRUE(all.equal(coef(sfm1new), coef(sfm1), tol=TOL))
)
contest(fm1, c(0, 1))
contest(fm1, c(0, 1), joint=FALSE)
drop1(fm1)
ranova(fm1)
step(fm1)
fm1new <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy,
control=lmerControl(optimizer="bobyqa"))
stopifnot(
isTRUE(all.equal(drop1(fm1), drop1(fm1new), tol=TOL)),
isTRUE(all.equal(ranova(fm1), ranova(fm1new), tol=TOL)),
isTRUE(all.equal(contest(fm1, c(0, 1)), contest(fm1new, c(0, 1)), tol=TOL)),
isTRUE(all.equal(contest(fm1, c(0, 1), joint=FALSE),
contest(fm1new, c(0, 1), joint=FALSE), tol=TOL))
)
# Test that lme4 methods work:
coef(fm1)
fixef(fm1)
resid(fm1)
#######################################
## Tests for fm2:
(an2new <- anova(fm2))
(sfm2new <- summary(fm2))
stopifnot(
isTRUE(all.equal(an2new, an2, check.attributes=FALSE, tol=TOL)),
isTRUE(all.equal(coef(sfm2new), coef(sfm2), tol=TOL))
)
drop1(fm2)
ranova(fm2)
ls_means(fm2)
difflsmeans(fm2)
nbeta <- length(fixef(fm2))
L <- diag(nbeta)
L[1:4, ] <- 0
contest(fm2, L)
contest(fm2, diag(nbeta), joint=FALSE)
step(fm2)
fm2new <- lmer(Informed.liking ~ Product + Information + Gender +
(1|Product:Consumer), data=ham)
stopifnot(
isTRUE(all.equal(drop1(fm2), drop1(fm2new), tol=TOL)),
isTRUE(all.equal(ranova(fm2), ranova(fm2new), tol=TOL)),
isTRUE(all.equal(ls_means(fm2), ls_means(fm2new), tol=TOL)),
isTRUE(all.equal(difflsmeans(fm2), difflsmeans(fm2new), tol=TOL))
)
# Test that lme4 methods work:
coef(fm2)
fixef(fm2)
resid(fm2)
lmerTest/tests/test_summary.R 0000644 0001762 0000144 00000010260 15125475223 016077 0 ustar ligges users # test_summary.R
# WRE says "using if(requireNamespace("pkgname")) is preferred, if possible."
# even in tests:
assertError <- function(expr, ...)
if(requireNamespace("tools")) tools::assertError(expr, ...) else invisible()
assertWarning <- function(expr, ...)
if(requireNamespace("tools")) tools::assertWarning(expr, ...) else invisible()
# Kenward-Roger only available with pbkrtest and only then validated in R >= 3.3.3
# (faulty results for R < 3.3.3 may be due to unstated dependencies in pbkrtest)
has_pbkrtest <- requireNamespace("pbkrtest", quietly = TRUE) && getRversion() >= "3.3.3"
library(lmerTest)
data("sleepstudy", package="lme4")
data("cake", package="lme4")
# Fit basic model and compute summary:
fm <- lmer(Reaction ~ Days + (1|Subject) + (0+Days|Subject), sleepstudy)
(sfm <- summary(fm))
## Test class:
stopifnot(all(
class(sfm) == c("summary.lmerModLmerTest", "summary.merMod"),
all(c("df", "Pr(>|t|)") %in% colnames(coef(sfm)))
))
stopifnot(class(summary(fm, ddf="lme4")) == "summary.merMod")
## Test coefficient table names:
mat <- coef(summary(fm))
stopifnot(all( # colnames
colnames(mat) == c("Estimate", "Std. Error", "df", "t value", "Pr(>|t|)")
))
stopifnot(all( # rownames
names(fixef(fm)) == rownames(mat)
))
## Test pass of 'correlation' argument to lme4:::summary.merMod:
x <- capture.output(summary(fm))
x_nocor <- capture.output(summary(fm, correlation=FALSE))
txt <- "Correlation of Fixed Effects:"
stopifnot(
any(grep(txt, x)),
!any(grepl(txt, x_nocor))
)
# Test warning with unrecognized arguments (caught by lme4:::summary.merMod):
assertWarning(summary(fm, false_arg=FALSE))
## Test pass of extra arguments to lme4:::print.summary.merMod:
x <- capture.output(print(summary(fm), signif.stars=TRUE))
x_nocor <- capture.output(print(summary(fm), signif.stars=FALSE))
txt <- "Signif. codes:"
stopifnot(
any(grep(txt, x)),
!any(grepl(txt, x_nocor))
)
####### ddf argument:
(an1 <- summary(fm)) # Also testing print method.
(an2 <- summary(fm, ddf="Satterthwaite"))
stopifnot(isTRUE(
all.equal(an1, an2)
))
(an3 <- summary(fm, ddf="Sat")) ## Abbreviated argument
stopifnot(isTRUE(
all.equal(an1, an3)
))
(summary(fm, ddf="lme4"))
if(has_pbkrtest) {
(summary(fm, ddf="Kenward-Roger"))
assertError(summary(fm, ddf="KR")) ## Error on incorrect arg.
}
## lme4 method:
an1 <- summary(fm, ddf="lme4")
an2 <- summary(as(fm, "lmerMod"))
stopifnot(isTRUE(
all.equal(an1, an2)
))
# Test printed output
# - Satterthwaite
x <- capture.output(sfm) # equal to output of 'print(sfm)'
txt <- c("lmerModLmerTest", "t-tests use Satterthwaite's method",
"df", "t value", "Pr(>|t|)")
stopifnot(all(
sapply(txt, function(text) any(grepl(text, x)))
))
# Test printed output
# - KR
if(has_pbkrtest) {
(sfm <- summary(fm, ddf="Kenward-Roger"))
x <- capture.output(sfm)
txt <- c("lmerModLmerTest", "t-tests use Kenward-Roger's method",
"df", "t value", "Pr(>|t|)")
stopifnot(all(
sapply(txt, function(text) any(grepl(text, x)))
))
}
####################################
## Test 'boundary' fixef structures:
####################################
# Example with no fixef:
m <- lmer(Reaction ~ -1 + (Days | Subject), sleepstudy)
# m <- lmer(Reaction ~ 0 + (Days | Subject), sleepstudy) # alternative
stopifnot(length(fixef(m)) == 0L)
stopifnot(
nrow(coef(summary(m))) == 0L,
nrow(coef(summary(m, ddf="lme4"))) == 0L
)
if(has_pbkrtest){
stopifnot(nrow(coef(summary(m, ddf="Kenward-Roger"))) == 0L)
}
# Example with intercept only:
m <- lmer(Reaction ~ (Days | Subject), sleepstudy)
# m <- lmer(Reaction ~ 1 + (Days | Subject), sleepstudy) # alternative
stopifnot(length(fixef(m)) == 1L,
names(fixef(m)) == "(Intercept)")
stopifnot(
nrow(coef(summary(m))) == 1L,
nrow(coef(summary(m, ddf="lme4"))) == 1L
)
if(has_pbkrtest){
stopifnot(nrow(coef(summary(m, ddf="Kenward-Roger"))) == 1L)
}
# Example with >1 fixef without intercept:
m <- lmer(Reaction ~ Days - 1 + I(Days^2) + (Days | Subject), sleepstudy)
stopifnot(length(fixef(m)) == 2L,
names(fixef(m)) == c("Days", "I(Days^2)"))
stopifnot(
nrow(coef(summary(m))) == 2L,
nrow(coef(summary(m, ddf="lme4"))) == 2L
)
if(has_pbkrtest){
stopifnot(nrow(coef(summary(m, ddf="Kenward-Roger"))) == 2L)
}
lmerTest/tests/test_contest1D.R 0000644 0001762 0000144 00000006472 15125475223 016260 0 ustar ligges users # test_contest1D.R
library(lmerTest)
# WRE says "using if(requireNamespace("pkgname")) is preferred, if possible."
# even in tests:
assertError <- function(expr, ...)
if(requireNamespace("tools")) tools::assertError(expr, ...) else invisible()
assertWarning <- function(expr, ...)
if(requireNamespace("tools")) tools::assertWarning(expr, ...) else invisible()
TOL <- 1e-4
# Kenward-Roger only available with pbkrtest and only then validated in R >= 3.3.3
# (faulty results for R < 3.3.3 may be due to unstated dependencies in pbkrtest)
has_pbkrtest <- requireNamespace("pbkrtest", quietly = TRUE) && getRversion() >= "3.3.3"
data("sleepstudy", package="lme4")
####################################
## Tests of contest1D
####################################
fm <- lmer(Reaction ~ Days + I(Days^2) + (1|Subject) + (0+Days|Subject),
sleepstudy)
# Basic tests:
L <- c(0, 1, 0)
contest1D(fm, L)
contest1D(fm, L, confint = TRUE)
contest1D(fm, L, confint = TRUE, level=0.99)
if(has_pbkrtest)
contest1D(fm, L, ddf="Kenward-Roger")
# Test too long L
assertError(contest1D(fm, c(0, 1, 1, 1)))
# Test too short L
assertError(contest1D(fm, c(0, 1)))
# Test matrix L
contest1D(fm, matrix(L, nrow=1))
contest1D(fm, matrix(L, ncol=1))
assertError(contest1D(fm, matrix(c(0, 1), ncol=1)))
assertError(contest1D(fm, matrix(c(0, 1, 0, 0), nrow=1)))
L <- matrix(numeric(0L), ncol=3)
assertError(contest1D(fm, L)) # "empty" matrix
assertError(contest1D(fm, matrix(1, ncol=3, nrow=2)))
# Test list L
assertError(contest1D(fm, list(c(0, 1, 0))))
# Test equivalence to coef(summary(fm)):
Lmat <- diag(length(fixef(fm)))
(coef_mat <- lmerTest:::rbindall(lapply(1:ncol(Lmat), function(i)
contest1D(fm, Lmat[i, ]))))
(coef_mat_lme4 <- coef(summary(fm, ddf="lme4")))
rownames(coef_mat) <- rownames(coef_mat_lme4)
stopifnot(isTRUE(
all.equal(as.data.frame(coef_mat_lme4),
coef_mat[, c("Estimate", "Std. Error", "t value")], tolerance=TOL)
))
if(has_pbkrtest) {
(coef_mat_KR <- lmerTest:::rbindall(lapply(1:ncol(Lmat), function(i)
contest1D(fm, Lmat[i, ], ddf="Kenward-Roger"))))
rownames(coef_mat_KR) <- rownames(coef_mat_lme4)
stopifnot(isTRUE(
all.equal(as.data.frame(coef_mat_lme4),
coef_mat_KR[, c("Estimate", "Std. Error", "t value")], tolerance=TOL)
))
}
# Test of 0-length beta
fm1 <- lmer(Reaction ~ 0 + (1|Subject) + (0+Days|Subject),
sleepstudy)
stopifnot(length(fixef(fm1)) == 0L)
if(has_pbkrtest) {
(ans <- contest1D(fm1, numeric(0L), ddf="Kenward-Roger"))
stopifnot(nrow(ans) == 0L)
}
## Test rhs argument:
fm <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy)
contest1D(fm, L=cbind(0, 1))
contest1D(fm, L=cbind(0, 1), rhs=10)
if(has_pbkrtest) {
contest1D(fm, L=cbind(0, 1), ddf="Kenward-Roger")
contest1D(fm, L=cbind(0, 1), ddf="Kenward-Roger", rhs=10)
}
contest1D(fm, L=c(0, 1), rhs = 10.467)
(ct1 <- contest1D(fm, L=cbind(c(0, 1)), rhs = 10))
(ct2 <- contestMD(fm, L=rbind(c(0, 1)), rhs = 10))
stopifnot(
isTRUE(all.equal(ct1[, "t value"]^2, ct2[, "F value"], tolerance=1e-6))
)
## Test 'lmerMod' method:
fm <- lme4::lmer(Reaction ~ Days + I(Days^2) + (1|Subject) + (0+Days|Subject),
sleepstudy)
# Basic tests:
L <- c(0, 1, 0)
contest1D(fm, L)
contest1D(fm, L, confint = TRUE)
contest1D(fm, L, confint = TRUE, level=0.99)
if(has_pbkrtest)
contest1D(fm, L, ddf="Kenward-Roger")
lmerTest/tests/test_devfun_vp.R 0000644 0001762 0000144 00000013707 15127254305 016405 0 ustar ligges users # test_devfun_vp.R
# library(devtools)
# # has_devel()
# r2path <- "~/GitHub/lmerTestR/lmerTest"
# # document(pkg=r2path)
# load_all(r2path)
#
# # ?`Covariance-class`
library(lmerTest)
has_pkgs <- requireNamespace("utils", quietly = TRUE) &&
requireNamespace("numDeriv", quietly = TRUE) &&
requireNamespace("lme4", quietly = TRUE)
is_lme4_2_0_0 <- utils::packageVersion("lme4") >= "2.0.0"
if(has_pkgs && is_lme4_2_0_0) {
## Functions:
devfun_vp <- lmerTest:::devfun_vp
getOptPar <- lmerTest:::getOptPar
getVarPar <- lmerTest:::getVarPar
## Unstructured
fm1.us <- lme4::lmer(Reaction ~ Days + us(Days | Subject), sleepstudy)
## Diagional
fm1.diag <- lme4::lmer(Reaction ~ Days + diag(Days | Subject), sleepstudy)
fm1.diag.hom <- lme4::lmer(Reaction ~ Days + diag(Days | Subject, hom = TRUE),
sleepstudy)
## Compound symmetry
fm1.cs <- lme4::lmer(Reaction ~ Days + cs(Days | Subject), sleepstudy)
fm1.cs.hom <- lme4::lmer(Reaction ~ Days + cs(Days | Subject, hom = TRUE),
sleepstudy)
## Auto-regressive order 1
sleepstudy$Daysf <- factor(sleepstudy$Days, ordered = TRUE)
fm1.ar1 <- lme4::lmer(Reaction ~ Daysf + ar1(0 + Daysf | Subject, hom = TRUE),
sleepstudy, REML = TRUE)
lme4models <- namedList(fm1.us,
fm1.diag,
fm1.diag.hom,
fm1.cs,
fm1.cs.hom,
fm1.ar1)
for(model in lme4models) { # model <- lme4models[[1]]
## Native devfun:
devfun <- update(model, devFunOnly=TRUE)
## Evaluate native devfun at optimum:
devfun(getOptPar(model))
## Check that devfun returns the same value as that saved in the model object:
stopifnot(
all.equal(unname(getME(model, "devcomp")$cmp["REML"]),
devfun(getOptPar(model)), tolerance=1e-6) # TRUE
)
## Get varpar (including residual SD):
(varpar <- getVarPar(model))
## Evaluate devfun_vp at the optimum:
devfun_vp(varpar, devfun, reml=TRUE)
## Check that devfun_vp returns the same value as native devfun:
stopifnot(
all.equal(unname(getME(model, "devcomp")$cmp["REML"]),
devfun(getOptPar(model))) # TRUE
)
}
## Here we also want to check that devfun and and devfun_vp returns the same
## value at non-optimum values of varpar.
## Because sigma is profiled out of devfun this cannot be done right away.
## We need to optimize over all parameters to get equivalence.
## We should be able to set one of the parameters in common to a
## particular value and optimize the rest. This will build confidence that
## the likelihood in devfun_vp is the same as that returned by
## lme4::lmer(., devFunOnly=TRUE).
do_trace <- 0
for(i in seq_along(lme4models)) { # i <- 4
if(do_trace) print(i)
model <- lme4models[[i]]
devfun <- update(model, devFunOnly=TRUE)
(optpar <- getOptPar(model))
(varpar <- getVarPar(model))
(optpar2 <- optpar * 1.1)
(varpar2 <- c(optpar2, varpar[length(varpar)]))
## Evaluate gradients to ensure that devfun and devfun_vp are both
## functions with optima at optpar and varpar respectively:
(g_devfun <- numDeriv::grad(devfun, optpar))
(g_devfun_vp <- numDeriv::grad(devfun_vp, varpar, devfun=devfun, reml=TRUE))
stopifnot(
if(i != 4) all(abs(g_devfun) < 1e-3) else all(abs(g_devfun) < 1e-2),
if(i != 4) all(abs(g_devfun_vp) < 1e-3) else all(abs(g_devfun_vp) < 1e-2)
)
## These are not zero as expected:
(g_devfun <- numDeriv::grad(devfun, optpar2))
(g_devfun_vp <- numDeriv::grad(devfun_vp, varpar2, devfun=devfun, reml=TRUE))
## Try optimizing devfun_vp:
x <- nlminb(start=varpar2, objective = devfun_vp, devfun=devfun, reml=TRUE,
control=list(trace=do_trace))
## Check that the optimum is re-achieved:
stopifnot(
all(abs(varpar - x$par) < 1e-4),
abs(devfun_vp(varpar, devfun=devfun, reml=TRUE) -
devfun_vp(x$par, devfun=devfun, reml=TRUE)) < 1e-6
)
## Optimize devfun and devfun_vp over all but one of the parameters in turn to
## check that devfun and devfun_vp gives the same deviance and parameter values
## for settings away from the REML optimum. This is to build confidence that
## devfun_vp is a valid implementation of the deviance function from LLMs.
if(length(optpar) > 1) for(j in seq_along(optpar)) { # j <- 1
## Check that all parameters are within bounds:
stopifnot(
model@lower < optpar,
optpar < attr(model, "upper"),
model@lower < optpar2,
optpar2 < attr(model, "upper")
)
## Evaluate deviance function at optimum (for safety):
devfun(optpar)
## Optimize devfun over all but the j'th parameter:
(startpar <- optpar[-j])
res <- nlminb(start=startpar, objective = function(p) {
(Par <- optpar2)
(Par[-j] <- p)
devfun(Par)
}, control = list(trace=do_trace),
lower = model@lower[-j],
upper = attr(model, "upper")[-j])
## Evaluate devfun_vp:
devfun_vp(varpar, devfun=devfun, reml=TRUE)
## Optimize devfun_vp over all but the j'th parameter:
(startpar_vp <- varpar[-j])
(np <- length(startpar_vp))
res_vp <- nlminb(start=startpar_vp, objective = function(p) {
(Par <- optpar2)
(Par[-j] <- p[-np])
Par <- c(Par, p[np])
devfun_vp(Par, devfun=devfun, reml=TRUE)
}, control = list(trace=do_trace),
lower = c(model@lower[-j], 0),
upper = c(attr(model, "upper")[-j], Inf))
## Compare parameter estimates (except for sigma):
res$objective - res_vp$objective
res$par - res_vp$par[seq_along(res$par)]
## Check that parameter estimates and deviance values agree:
stopifnot(
abs(res$objective - res_vp$objective) < 1e-8,
all(abs(res$par - res_vp$par[seq_along(res$par)]) < 1e-4)
)
}
}
}
lmerTest/tests/test_zerovar.R 0000644 0001762 0000144 00000002173 15125475223 016076 0 ustar ligges users # test_zerovar.R
library(lmerTest)
data("sleepstudy", package="lme4")
# Baseline fit:
m0 <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy,
control=lmerControl(optimizer="bobyqa"))
## default optimizer does not converge proporly
m0
(an0 <- anova(m0))
# Make a fit with a zero variance estimate:
n <- nrow(sleepstudy)
g <- factor(rep(1:2, c(n - 10, 10)))
m <- lmer(Reaction ~ Days + (Days | Subject) + (1|g), sleepstudy,
control=lmerControl(optimizer="bobyqa"))
m
(an <- anova(m))
# check that fit has a zero variance
vc <- as.data.frame(VarCorr(m))
stopifnot(isTRUE(
all.equal(0, vc[vc$grp == "g", "sdcor"], tolerance=1e-4)
))
# The hessian/vcov is actually positive definite:
stopifnot(isTRUE(
all(eigen(m@vcov_varpar, only.values = TRUE)$values > 0)
))
# Check that ANOVA tables are the same:
stopifnot(isTRUE(
all.equal(an0[, 1:5], an[, 1:5], tolerance=1e-4)
))
stopifnot(isTRUE( # Equality of summary tables
all.equal(coef(summary(m0)), coef(summary(m)), tolerance=1e-4)
))
stopifnot(isTRUE( # Equality of lme4-anova tables
all.equal(anova(m0, ddf="lme4"), anova(m, ddf="lme4"), tolerance=1e-4)
))
lmerTest/tests/test_lmer.R 0000644 0001762 0000144 00000011003 15125475223 015335 0 ustar ligges users # test_lmer.R
stopifnot(!"lmerTest" %in% .packages()) # ensure that lmerTest is NOT attached
data("sleepstudy", package="lme4")
f <- function(form, data) lmerTest::lmer(form, data=data)
form <- "Reaction ~ Days + (Days|Subject)"
fm <- f(form, data=sleepstudy)
anova(fm)
summary(fm)
# cf. GitHub issue #2:
test <- function() {
tmp <- sleepstudy
m <- lmerTest::lmer(Reaction ~ Days + (Days | Subject), data = tmp)
summary(m)
}
test()
test <- function() {
tmp <- sleepstudy
m <- lme4::lmer(Reaction ~ Days + (Days | Subject), data = tmp)
if(requireNamespace("lmerTest", quietly = TRUE)) {
summary(lmerTest::as_lmerModLmerTest(m))
}
}
test()
library(lmerTest)
# WRE says "using if(requireNamespace("pkgname")) is preferred, if possible."
# even in tests:
assertError <- function(expr, ...)
if(requireNamespace("tools")) tools::assertError(expr, ...) else invisible()
assertWarning <- function(expr, ...)
if(requireNamespace("tools")) tools::assertWarning(expr, ...) else invisible()
TOL <- 1e-4
#####################################################################
# Check that lme4::lmer and lmerTest::lmer have the same arguments
lmer_args <- formals(lme4::lmer)
names(lmer_args)
lmerTest_args <- formals(lmerTest::lmer)
seq_args <- seq_along(lmerTest_args)
if(packageVersion("lme4") > '1.1.21') {
stopifnot(
all.equal(names(lmer_args), names(lmerTest_args)),
all.equal(lmer_args, lmerTest_args)
)
} else { # Older versions of 'lme4' has a "..." argument:
stopifnot(
all.equal(names(lmer_args)[seq_args], names(lmerTest_args[seq_args])),
all.equal(lmer_args[seq_args], lmerTest_args[seq_args])
)
}
#####################################################################
# Test evaluation of update inside a function:
myupdate <- function(m, ...) {
update(m, ...)
}
data("sleepstudy", package="lme4")
fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy)
tmp <- sleepstudy
rm(sleepstudy)
fmA <- update(fm1, data = tmp) # works
fmB <- myupdate(fm1, data = tmp) # also works
# Same except for 'call':
fmB@call <- fmA@call
stopifnot(isTRUE(all.equal(fmA, fmB, tolerance=TOL)))
# Based on bug-report by Henrik Singmann, github issue #3
#####################################################################
# Test update when formula is a character vector:
form <- "Informed.liking ~ Product+Information+
(1|Consumer) + (1|Product:Consumer) + (1|Information:Consumer)"
m <- lmer(form, data=ham)
class(m)
class(update(m, ~.- Product))
stopifnot(inherits(update(m, ~.- Product), "lmerModLmerTest"))
# In version < 3.0-1.9002 class(update(m, ~.- Product)) was "lmerMod"
#####################################################################
# Test error message from as_lmerModLmerTest:
data("sleepstudy", package="lme4")
myfit <- function(formula, data) {
lme4::lmer(formula = formula, data = data)
}
fm2 <- myfit(Reaction ~ Days + (Days|Subject), sleepstudy)
m <- assertError(as_lmerModLmerTest(fm2))
stopifnot(
grepl("Unable to extract deviance function from model fit", m[[1]], fixed=TRUE)
)
#####################################################################
# Check that devFunOnly argument works:
data("sleepstudy", package="lme4")
fun <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy, devFunOnly = TRUE)
stopifnot(is.function(fun)) # && names(formals(fun)[1]) == "theta")
fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy)
fun <- update(fm1, devFunOnly=TRUE)
stopifnot(is.function(fun)) # && names(formals(fun)[1]) == "theta")
# devFunOnly = FALSE:
notfun <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy, devFunOnly = FALSE)
stopifnot(inherits(notfun, "lmerModLmerTest"))
# Partial matching:
notfun <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy, devFun = FALSE)
stopifnot(inherits(notfun, "lmerModLmerTest"))
#####################################################################
# Use of as_lmerModLmerTest
data("sleepstudy", package="lme4")
m <- lme4::lmer(Reaction ~ Days + (Days | Subject), sleepstudy)
bm <- lmerTest:::as_lmerModLmerTest(m)
stopifnot(
inherits(bm, "lmerModLmerTest"),
!inherits(m, "lmerModLmerTest"),
inherits(bm, "lmerMod"),
all(c("vcov_varpar", "Jac_list", "vcov_beta", "sigma") %in% slotNames(bm))
)
#####################################################################
# Update method
m <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy)
m1 <- update(m, ~.-Days)
m2 <- lmer(Reaction ~ (Days | Subject), sleepstudy)
stopifnot(
inherits(m, "lmerModLmerTest"),
inherits(m1, "lmerModLmerTest"),
inherits(m2, "lmerModLmerTest"),
all.equal(m1, m2, tolerance=1e-6)
)
lmerTest/tests/test_drop1.R 0000644 0001762 0000144 00000005263 15125475223 015436 0 ustar ligges users # test_drop1.R
library(lmerTest)
# WRE says "using if(requireNamespace("pkgname")) is preferred, if possible."
# even in tests:
assertError <- function(expr, ...)
if(requireNamespace("tools")) tools::assertError(expr, ...) else invisible()
assertWarning <- function(expr, ...)
if(requireNamespace("tools")) tools::assertWarning(expr, ...) else invisible()
TOL <- 1e-4
# Kenward-Roger only available with pbkrtest and only then validated in R >= 3.3.3
# (faulty results for R < 3.3.3 may be due to unstated dependencies in pbkrtest)
has_pbkrtest <- requireNamespace("pbkrtest", quietly = TRUE) && getRversion() >= "3.3.3"
data("sleepstudy", package="lme4")
######### Basic usage
data("cake", package="lme4")
cake2 <- cake
cake2$temperature <- factor(cake2$temperature, ordered = FALSE)
fm <- lmer(angle ~ recipe + temperature + (1|recipe:replicate), cake2)
(an1 <- drop1(fm))
(an2 <- drop1(fm, force_get_contrasts = TRUE))
drop1(fm, ddf="lme4", test="Chi")
if(has_pbkrtest)
drop1(fm, ddf="Kenward-Roger")
tests1 <- show_tests(an1)
tests2 <- show_tests(an2)
stopifnot(
# Tests are the same:
isTRUE(all.equal(an1, an2, check.attributes = FALSE, tolerance=TOL)),
# But contrast matrices are not:
all(!mapply(function(x, y) isTRUE(all.equal(x, y)), tests1, tests2))
)
fm <- lmer(angle ~ recipe * temperature + (1|recipe:replicate), cake2)
drop1(fm)
drop1(fm, ddf="lme4")
if(has_pbkrtest)
drop1(fm, ddf="Kenward-Roger")
# Incorrect arguments:
assertError(drop1(fm, scope="recipe")) # Correct Error
assertError(drop1(fm, scope=3)) # Correct Error
assertError(drop1(fm, scope=list("recipe"))) # Correct Error
# Polynomial terms:
fm <- lmer(Reaction ~ 0 + (Days|Subject), sleepstudy)
(an0 <- drop1(fm)) # No fixef!
fm <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy)
(an1 <- drop1(fm))
fm <- lmer(Reaction ~ Days + I(Days^2) + (Days|Subject), sleepstudy)
(an2 <- (drop1(fm)))
fm <- lmer(Reaction ~ poly(Days, 2) + (Days|Subject), sleepstudy)
(an3 <- drop1(fm))
stopifnot(
nrow(an0) == 0L,
nrow(an1) == 1L,
nrow(an2) == 2L,
nrow(an3) == 1L
)
# Consider a rank-deficient design matrix:
fm <- lmer(angle ~ recipe + temp + temperature + (1|recipe:replicate), cake)
# Here temp accounts for the linear effect of temperature, and
# temperature is an (ordered) factor that accounts for the remaining
# variation between temperatures (4 df).
(an4 <- drop1(fm))
# While temperature is in the model, we cannot test the effect of dropping
# temp. After removing temperature we can test the effect of dropping temp:
(an5 <- drop1(update(fm, ~.-temperature)))
stopifnot(
nrow(an4) == 3,
rownames(an4)[2] == "temp",
all(is.na(an4[2, ])),
all(!is.na(an4[-2, ])),
all(rownames(an5) == c("recipe", "temp"))
)
lmerTest/tests/test_ranova_step.R 0000644 0001762 0000144 00000024765 15127446140 016740 0 ustar ligges users # test_ranova.R
# Test functionality _before_ attaching lmerTest
stopifnot(!"lmerTest" %in% .packages()) # ensure that lmerTest is NOT attached
data("sleepstudy", package="lme4")
f <- function(form, data) lmerTest::lmer(form, data=data)
form <- "Reaction ~ Days + (Days|Subject)"
fm <- f(form, data=sleepstudy)
lmerTest::ranova(fm)
lmerTest::rand(fm)
lmerTest::step(fm)
library(lmerTest)
# WRE says "using if(requireNamespace("pkgname")) is preferred, if possible."
# even in tests:
assertError <- function(expr, ...)
if(requireNamespace("tools")) tools::assertError(expr, ...) else invisible()
assertWarning <- function(expr, ...)
if(requireNamespace("tools")) tools::assertWarning(expr, ...) else invisible()
TOL <- 1e-4
#####################################################################
data("sleepstudy", package="lme4")
# Test reduction of (Days | Subject) to (1 | Subject):
fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy)
(an <- rand(fm1)) # 2 df test
(an <- ranova(fm1)) # 2 df test
step(fm1)
stopifnot(
nrow(an) == 2L,
an[2L, "Df"] == 2L
)
# This test can also be achieved with anova():
fm2 <- lmer(Reaction ~ Days + (1|Subject), sleepstudy)
(stp <- step(fm2))
get_model(stp)
(ana <- anova(fm1, fm2, refit=FALSE))
stopifnot(
all.equal(an[2L, "LRT"], ana[2L, "Chisq"], tolerance=TOL)
)
# Illustrate complete.test argument:
# Test removal of (Days | Subject):
(an <- ranova(fm1, reduce.terms = FALSE)) # 3 df test
# The likelihood ratio test statistic is in this case:
fm3 <- lm(Reaction ~ Days, sleepstudy)
LRT <- 2*c(logLik(fm1, REML=TRUE) - logLik(fm3, REML=TRUE)) # LRT
stopifnot(
nrow(an) == 2L,
an[2L, "Df"] == 3L,
all.equal(an[2L, "LRT"], LRT, tolerance=TOL)
)
## _NULL_ model:
fm <- lmer(Reaction ~ -1 + (1|Subject), sleepstudy)
step(fm)
ranova(fm)
lm1 <- lm(Reaction ~ 0, data=sleepstudy)
LRT <- 2*c(logLik(fm, REML=FALSE) - logLik(lm1, REML=FALSE))
## Tests of ML-fits agree with anova():
fm1 <- lmer(Reaction ~ Days + (1|Subject), sleepstudy, REML=FALSE)
step(fm1)
lm2 <- lm(Reaction ~ Days, sleepstudy)
(an1 <- ranova(fm1))
(an2 <- anova(fm1, lm2))
j <- grep("Chi Df|Df", colnames(an2))
stopifnot(
all.equal(an1[2, "LRT"], an2[2, "Chisq"], tolerance=TOL),
all.equal(an1[2, "Df"], an2[2, j[length(j)]], tolerance=TOL),
all.equal(an1[1:2, "logLik"], an2[2:1, "logLik"], tolerance=TOL)
)
## Note that lme4 version <1.1-22 use "Chi Df" while >=1.1-22 use "Df"
# Expect warnings when old (version < 3.0-0) arguments are used:
assertWarning(step(fm, reduce.fixed = FALSE, reduce.random = FALSE,
type=3, fixed.calc = FALSE, lsmeans.calc = FALSE,
difflsmeans.calc = TRUE, test.effs = 42, keep.e="save"))
assertWarning(step(fm, reduce.fixed = FALSE, reduce.random = FALSE,
lsmeans=3))
check_nrow <- function(obj, expect_nrow) {
stopifnot(
is.numeric(expect_nrow),
nrow(obj) == expect_nrow
)
}
# Statistical nonsense, but it works:
fm1 <- lmer(Reaction ~ Days + (1 | Subject) + (0 + Days|Subject), sleepstudy)
step(fm1)
(an <- ranova(fm1))
check_nrow(an, 3)
ranova(fm1, reduce.terms = FALSE)
# Statistical nonsense, but it works:
fm1 <- lmer(Reaction ~ Days + (0 + Days|Subject), sleepstudy)
step(fm1)
(an <- ranova(fm1)) # no test of non-nested models
stopifnot(
nrow(an) == 2L,
an[2L, "Df"] == 0,
all(is.na(an[2L, "Pr(>Chisq)"]))
)
fm0 <- lmer(Reaction ~ Days + (1|Subject), sleepstudy)
step(fm0)
(an2 <- anova(fm1, fm0, refit=FALSE))
stopifnot(
(packageVersion("lme4")<="1.1.23" && an2[2L, "Pr(>Chisq)"] == 1) ||
is.na(an2[2L, "Pr(>Chisq)"])
)
ranova(fm1, reduce.terms = FALSE)
fm1 <- lmer(Reaction ~ Days + (-1 + Days|Subject), sleepstudy)
step(fm1)
(an3 <- ranova(fm1)) # no test of non-nested models
stopifnot(
all.equal(an, an3, check.attributes=FALSE, tolerance=TOL)
)
# Example where comparison of non-nested models is generated
fm <- lmer(Reaction ~ poly(Days, 2) + (0 + poly(Days, 2) | Subject), sleepstudy)
step(fm)
an <- ranova(fm)
stopifnot(
nrow(an) == 2L,
an[2, "Pr(>Chisq)"] == 1
)
ranova(fm, reduce.terms = FALSE) # test of nested models
# These models are nested, though:
fm <- lmer(Reaction ~ poly(Days, 2) + (1 + poly(Days, 2) | Subject), sleepstudy)
step(fm)
ranova(fm)
fm0 <- lmer(Reaction ~ poly(Days, 2) + (1 | Subject), sleepstudy)
step(fm0)
anova(fm0, fm, refit=FALSE)
ranova(fm, reduce.terms = FALSE)
# A model with ||-notation:
fm1 <- lmer(Reaction ~ Days + (Days||Subject), sleepstudy)
step(fm1)
ranova(fm1)
# What about models with nested factors?
fm <- lmer(Coloursaturation ~ TVset*Picture + (1|Assessor:TVset) + (1|Assessor),
data=TVbo)
step(fm)
(an1 <- ranova(fm))
fm <- lmer(Coloursaturation ~ TVset * Picture +
(1|Assessor/TVset), data=TVbo)
step(fm)
(an2 <- ranova(fm))
stopifnot(
all.equal(an1, an2, check.attributes=FALSE, tolerance=TOL)
)
#####################################################################
# Test evaluation within functions, i.e. in other environments etc.
attach(sleepstudy)
fm <- lmer(Reaction ~ Days + (Days|Subject))
step(fm)
ranova(fm) # OK
detach(sleepstudy)
# Evaluating in a function works:
f <- function(form, data) lmer(form, data=data)
form <- "Informed.liking ~ Product+Information+
(1|Consumer) + (1|Product:Consumer) + (1|Information:Consumer)"
fm <- f(form, data=ham)
ranova(fm)
step_res <- step(fm)
stopifnot(
all(c("Sum Sq", "Mean Sq", "NumDF", "DenDF", "F value", "Pr(>F)") %in%
colnames(step_res$fixed))
)
###########################
# Evaluation in function without the formula:
# Reported by Uwe Ligges 2025-01-16.
f <- function(data) {
lmer(Petal.Length ~ Sepal.Length + (1|Species), data=data)
}
res <- f(iris)
ranova(res) # used to fail - now it works
data <- iris
ranova(res) # now it works
###########################
# Evaluation in function without the formula(2):
# A model with ||-notation:
f2 <- function(data) {
lmer(Reaction ~ Days + (Days||Subject), data)
}
res <- f2(sleepstudy)
ranova(res)
# A model with multiple RE terms:
f3 <- function(data) {
lmer(Coloursaturation ~ TVset*Picture + (1|Assessor:TVset) + (1|Assessor), data)
}
res <- f3(TVbo)
ranova(res)
###########################
# Check that step works when form is a character vector
m <- lmer(form, data=ham)
step_res <- step(m)
(drop1_table <- attr(step_res, "drop1"))
stopifnot(
all(c("Sum Sq", "Mean Sq", "NumDF", "DenDF", "F value", "Pr(>F)") %in%
colnames(drop1_table))
)
# In version < 3.0-1.9002 attr(step_res, "drop1") picked up lme4::drop1.merMod
# and returned an AIC table after the model had been update'd.
#####################################################################
# Model with 2 ranef covarites:
# Model of the form (x1 + x2 | gr):
model <- lmer(Preference ~ sens2 + Homesize + (sens1 + sens2 | Consumer)
, data=carrots)
step(model)
stopifnot(
nrow(ranova(model)) == 3L,
nrow(ranova(model, reduce.terms = FALSE)) == 2L
)
# Model of the form (f1 + f2 | gr):
model <- lmer(Preference ~ sens2 + Homesize + Gender +
(Gender+Homesize|Consumer), data=carrots)
step(model)
stopifnot(
nrow(ranova(model)) == 3L,
nrow(ranova(model, reduce.terms = FALSE)) == 2L
)
# Model of the form (-1 + f2 | gr):
model <- lmer(Preference ~ sens2 + Homesize + Gender +
(Gender -1 |Consumer), data=carrots)
step(model)
an1 <- ranova(model)
an1b <- ranova(model, reduce.terms = FALSE)
model <- lmer(Preference ~ sens2 + Homesize + Gender +
(0 + Gender|Consumer), data=carrots)
step(model)
an2 <- ranova(model)
an2b <- ranova(model, reduce.terms = FALSE)
stopifnot(
all.equal(an1, an2, check.attributes=FALSE, tolerance=TOL),
all.equal(an1b, an2b, check.attributes=FALSE, tolerance=TOL)
)
####### Polynomial terms:
model <- lmer(Preference ~ sens2 + Gender + (poly(sens2, 2) | Consumer),
data=carrots)
(an <- ranova(model))
step(model)
model <- lmer(Preference ~ sens2 + Gender + (sens2 + I(sens2^2) | Consumer),
data=carrots)
(an2 <- ranova(model))
step(model)
stopifnot(
nrow(an) == 2L,
an[2L, "Df"] == 5L,
nrow(an2) == 3L,
all(an2[2:3, "Df"] == 3L)
)
######## Functions of terms in random effects:
model <- lmer(Preference ~ sens2 + Gender + (log(10+sens2) | Consumer),
data=carrots)
ranova(model) # Works
step(model)
#####################################################################
# Missing values changes the number of observations in use:
m <- lmer(Preference ~ sens2 + Homesize +
(1 |Consumer:Income), data=carrots)
assertError(step(m))
ans <- try(ranova(m), silent = TRUE)
stopifnot(
inherits(ans, "try-error"),
grepl("number of rows in use has changed", ans)
)
## Removing missing values solves the problem:
m2 <- lmer(Preference ~ sens2 + Homesize +
(1 |Consumer:Income), data=carrots[complete.cases(carrots), ])
ranova(m2) # Works
step(m2)
## Including the variable with missing values (Income) among the fixed effects
## also solves the problem:
m <- lmer(Preference ~ sens2 + Homesize + Income + #(1 + sens2 | Consumer) +
(1 |Consumer:Income), data=carrots)
ranova(m)
step(m)
# Missing values in a an insignificant fixed effect causes the an error in step:
m0 <- lmer(Preference ~ sens2 + Homesize + Income + #(1 + sens2 | Consumer) +
(1 |Consumer), data=carrots)
ranova(m0)
ans <- try(step(m0), silent = TRUE)
stopifnot(
inherits(ans, "try-error"),
grepl("number of rows in use has changed", ans)
)
# Check that step still works for linear models (etc.)
flm <- lm(Coloursaturation ~ TVset * Picture, data=TVbo)
res <- step(flm, trace=0)
stopifnot(
inherits(res, "lm")
)
##################### Using reduce and keep args:
# Fit a model to the ham dataset:
m <- lmer(Informed.liking ~ Product*Information+
(1|Consumer) + (1|Product:Consumer)
+ (1|Information:Consumer), data=ham)
# Backward elimination using terms with default alpha-levels:
(step_res <- step(m))
(step_res <- step(m, reduce.random = FALSE))
(step_res <- step(m, reduce.fixed = FALSE))
(step_res <- step(m, reduce.fixed = FALSE, reduce.random = FALSE))
(step_res <- step(m, reduce.random = FALSE, keep="Information"))
(step_res <- step(m, reduce.random = FALSE, keep="Product:Information"))
###########################
## Test that `step` works even if all random terms are reduced away:
set.seed(101)
test <- data.frame(TM = factor(rep(rep(c("org","min"),each=3),3)),
dep = runif(18,0,20),
ind = runif(18,0,7),
dorp = factor(rep(1:3,each=6)))
full.model <- lmer(dep ~ TM + ind + (1 | dorp), data=test)
res <- step(full.model)
# res$random
# res$fixed
# attr(res, "model")
# attr(res, "drop1")
lmerTest/tests/test_re_covar_structures.R 0000644 0001762 0000144 00000006532 15127712300 020504 0 ustar ligges users # test_re_covar_structure.R
library(lmerTest)
# WRE says "using if(requireNamespace("pkgname")) is preferred, if possible."
# even in tests:
assertError <- function(expr, ...)
if(requireNamespace("tools")) tools::assertError(expr, ...) else invisible()
assertWarning <- function(expr, ...)
if(requireNamespace("tools")) tools::assertWarning(expr, ...) else invisible()
# Kenward-Roger only available with pbkrtest and only then validated in R >= 3.3.3
# (faulty results for R < 3.3.3 may be due to unstated dependencies in pbkrtest)
has_pbkrtest <- requireNamespace("pbkrtest", quietly = TRUE) && getRversion() >= "3.3.3"
data("sleepstudy", package="lme4")
TOL <- 1e-4
####################################
## Test that lmerMod objects can be coerced to lmerModLmerTest and
## that the deviance function can be evaluated with expected results
####################################
####################################
## Basic tests of new (lme4 >= 2.0.0) covariance structure
## - simple sleepstudy data (random coefficient)
####################################
has_pkgs <- requireNamespace("utils", quietly = TRUE) &&
requireNamespace("lme4", quietly = TRUE) &&
requireNamespace("pbkrtest", quietly = TRUE) &&
getRversion() >= "3.3.3"
is_lme4_2_0_0 <- utils::packageVersion("lme4") >= "2.0.0"
if(has_pkgs && is_lme4_2_0_0) {
## From the examples of ?`Covariance-class`:
## Unstructured
fm1.us <- lmer(Reaction ~ Days + us(Days | Subject), sleepstudy)
## Diagional
fm1.diag <- lmer(Reaction ~ Days + diag(Days | Subject), sleepstudy)
fm1.diag.hom <- lmer(Reaction ~ Days + diag(Days | Subject, hom = TRUE),
sleepstudy)
## Compound symmetry
fm1.cs <- lmer(Reaction ~ Days + cs(1 + Days | Subject), sleepstudy)
fm1.cs.hom <- lmer(Reaction ~ Days + cs(1 + Days | Subject, hom = TRUE),
sleepstudy)
## Auto-regressive order 1
sleepstudy$Daysf <- factor(sleepstudy$Days, ordered = TRUE)
fm1.ar1 <- lmer(Reaction ~ Daysf + ar1(0 + Daysf | Subject, hom = TRUE),
sleepstudy, REML = TRUE)
## Also adding a double-vertical-bar model (though not from
## 'Covariance-class' examples):
fm1.bv <- lmer(Reaction ~ Days + (Days || Subject), sleepstudy)
ltmodels <- namedList(fm1.us,
fm1.diag,
fm1.diag.hom,
fm1.cs,
fm1.cs.hom,
fm1.ar1,
fm1.bv)
## Run various methods on all models:
for(model in ltmodels) {
# model <- ltmodels[[5]]
print(model)
print(summary(model))
# model
# summary(model)
L <- diag(c(0, rep(1, length(fixef(model)) -1)))
contest(model, L, joint = TRUE)
contest(model, L[2, ], joint = FALSE)
(an <- anova(model)) ## ddf is Satterthwaite
anova(model, ddf = "Ken")
anova(model, ddf="lme4")
anova(model, type="I")
anova(model, type="II")
anova(model, type="III")
show_tests(an)
drop1(model)
ranova(model)
ranova(model, reduce.terms = FALSE)
step(model)
(lsm <- ls_means(model))
show_tests(lsm)
(dlsm <- difflsmeans(model))
show_tests(dlsm)
}
}
####################################
## Basic tests of new (lme4 >= 2.0.0) covariance structure
## - Unbalanced categorical dataset with multiple RE terms
####################################
lmerTest/tests/zlmerTest_zeroDenom.R 0000644 0001762 0000144 00000001366 15125475223 017365 0 ustar ligges users library(lmerTest)
# Read in data set
load(system.file("testdata","potdata.RData", package="lmerTest"))
# Mixed model
lmerout <- lmer(biomass ~ CO2*nutrients + (1|chamber),data=potdata)
summary(lmerout)
an.sat <- anova(lmerout)
anova(lmerout, ddf="lme4")
TOL <- 1e-5
stopifnot(isTRUE(all.equal(
an.sat[,"DenDF"], c(2, 10, 10), tolerance=TOL
)))
stopifnot(isTRUE(
all.equal(an.sat[,"Pr(>F)"], c(0.0224955602, 1e-11, 0.020905569), tolerance=TOL)
))
# if(require(pbkrtest))
# an.kr <- anova(lmerout, ddf="Kenward-Roger")
#
# TOL <- 1e-7
# stopifnot(all.equal(an.kr[,"Pr(>F)"], c(0.0224955602, 1e-11, 0.020905569) ,
# tol=TOL),
# all.equal(an.kr[,"DenDF"],
# c(2, 10, 10) , tol=TOL),
# TRUE)
lmerTest/tests/test_contestMD.R 0000644 0001762 0000144 00000010136 15125475223 016304 0 ustar ligges users # test_contestMD.R
library(lmerTest)
# WRE says "using if(requireNamespace("pkgname")) is preferred, if possible."
# even in tests:
assertError <- function(expr, ...)
if(requireNamespace("tools")) tools::assertError(expr, ...) else invisible()
assertWarning <- function(expr, ...)
if(requireNamespace("tools")) tools::assertWarning(expr, ...) else invisible()
# Kenward-Roger only available with pbkrtest and only then validated in R >= 3.3.3
# (faulty results for R < 3.3.3 may be due to unstated dependencies in pbkrtest)
has_pbkrtest <- requireNamespace("pbkrtest", quietly = TRUE) && getRversion() >= "3.3.3"
data("sleepstudy", package="lme4")
####################################
## Tests of contestMD
####################################
fm <- lmer(Reaction ~ Days + I(Days^2) + (1|Subject) + (0+Days|Subject),
sleepstudy)
# Basic tests:
L <- diag(3L)
contestMD(fm, L)
# Tests of ddf arg:
contestMD(fm, L, ddf="Sat")
if(has_pbkrtest)
contestMD(fm, L, ddf="Kenward-Roger")
assertError(contestMD(fm, L, ddf="sat")) # Invalid ddf arg.
# Tests of simple 2-df test:
(ans <- contestMD(fm, L[2:3, ], ddf="Sat"))
stopifnot(nrow(ans) == 1L,
ans$NumDF == 2L)
if(has_pbkrtest) {
(ans <- contestMD(fm, L[2:3, ], ddf="Kenward-Roger"))
stopifnot(nrow(ans) == 1L,
ans$NumDF == 2L)
}
# Tests of simple 1-df test:
(ans <- contestMD(fm, L[3, , drop=FALSE], ddf="Sat"))
stopifnot(nrow(ans) == 1L,
ans$NumDF == 1L)
if(has_pbkrtest) {
(ans <- contestMD(fm, L[3, , drop=FALSE], ddf="Kenward-Roger"))
stopifnot(nrow(ans) == 1L,
ans$NumDF == 1L)
}
# Test of vector input:
(ans <- contestMD(fm, L[3, ], ddf="Sat")) # OK since length(L[3, ]) == length(fixef(fm))
stopifnot(nrow(ans) == 1L,
ans$NumDF == 1L)
assertError(contestMD(fm, c(1, 0))) # L is too short
assertError(contestMD(fm, c(1, 0, 1, 1))) # L is too long
# Test of list input:
assertError(contestMD(fm, list(L[3, , drop=FALSE]), ddf="Sat")) # Need L to be a matrix
# zero-row L's are allowed (if ncol(L) is correct):
ans1 <- contestMD(fm, L[0, , drop=FALSE], ddf="Sat")
stopifnot(nrow(ans1) == 0L)
if(has_pbkrtest) {
ans2 <- contestMD(fm, L[0, , drop=FALSE], ddf="Kenward-Roger")
stopifnot(nrow(ans2) == 0L)
}
# Test wrong ncol(L):
assertError(contestMD(fm, L[2:3, 2:3])) # need ncol(L) == length(fixef(fm))
# row-rank deficient L are allowed:
L <- rbind(c(1, 0, 1),
c(0, 1, 0),
c(1, -1, 1))
ans <- contestMD(fm, L)
stopifnot(nrow(L) == 3L,
qr(L)$rank == 2,
ans$NumDF == 2)
if(has_pbkrtest) {
ans_KR <- contestMD(fm, L, ddf="Kenward-Roger")
stopifnot(ans_KR$NumDF == 2)
}
# Test of 0-length beta
fm1 <- lmer(Reaction ~ 0 + (1|Subject) + (0+Days|Subject),
sleepstudy)
stopifnot(length(fixef(fm1)) == 0L)
L <- numeric(0L)
(ans <- contestMD(fm1, L))
stopifnot(nrow(ans) == 0L)
L <- matrix(numeric(0L), ncol=0L)
(ans <- contestMD(fm1, L))
stopifnot(nrow(ans) == 0L)
## rhs argument:
data("cake", package="lme4")
model <- lmer(angle ~ recipe * temp + (1|recipe:replicate), cake)
(L <- diag(length(fixef(model)))[2:3, ])
(an <- anova(model, type="marginal"))
ct <- contestMD(model, L, rhs = 0)
ct2 <- contestMD(model, L, rhs = c(2, 2))
stopifnot(
isTRUE(all.equal(ct[1, ], an[1, ], check.attributes=FALSE, tolerance=1e-6)),
ct[, "F value"] < ct2[, "F value"]
)
L2 <- rbind(L, L[1, ] + L[2, ]) # rank deficient!
contestMD(model, L2, rhs = c(0, 0, 0)) # no warning
assertWarning(contestMD(model, L2, rhs = c(2, 2, 2))) # warning since L2 is rank def.
if(has_pbkrtest)
assertWarning(contestMD(model, L2, rhs = c(2, 2, 2), ddf="Kenward-Roger"))
fm <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy)
contestMD(fm, L=cbind(0, 1))
contestMD(fm, L=cbind(0, 1), rhs=10)
if(has_pbkrtest) {
contestMD(fm, L=cbind(0, 1), ddf="Kenward-Roger")
contestMD(fm, L=cbind(0, 1), ddf="Kenward-Roger", rhs=10)
}
## Test 'lmerMod' method:
fm <- lme4::lmer(Reaction ~ Days + (Days|Subject), sleepstudy)
contestMD(fm, L=cbind(0, 1))
contestMD(fm, L=cbind(0, 1), rhs=10)
if(has_pbkrtest) {
contestMD(fm, L=cbind(0, 1), ddf="Kenward-Roger")
contestMD(fm, L=cbind(0, 1), ddf="Kenward-Roger", rhs=10)
}
lmerTest/tests/test_compare_sas.R 0000644 0001762 0000144 00000012645 15125475223 016707 0 ustar ligges users # test_compare_sas.R
library(lmerTest)
# WRE says "using if(requireNamespace("pkgname")) is preferred, if possible."
# even in tests:
assertError <- function(expr, ...)
if(requireNamespace("tools")) tools::assertError(expr, ...) else invisible()
assertWarning <- function(expr, ...)
if(requireNamespace("tools")) tools::assertWarning(expr, ...) else invisible()
#####################################################################
# Use contrasts to get particular estimates for the summary table:
l <- list(Frequency="contr.SAS", Income="contr.SAS")
m.carrots <- lmer(Preference ~ sens2*Frequency*Income
+(1+sens2|Consumer), data=carrots, contrasts=l)
an.m <- anova(m.carrots)
TOL <- 1e-4
TOL2 <- 1e-5
# with 4 decimals should agree with SAS output
# numbers before decimals should agree with SAS output
stopifnot(
all.equal(an.m[,"Pr(>F)"],
c(2e-5, 0.15512, 0.06939, 0.08223, 0.52459, 0.03119, 0.48344),
tolerance = TOL),
all.equal(round(an.m$DenDF), c(83, 83, 83, 83, 83, 83, 83))
)
sm <- summary(m.carrots)
stopifnot(
isTRUE(all.equal(sm$coefficients[,"Pr(>|t|)"],
c(1e-10, 0.005061, 0.6865554, 0.342613, 0.129157,
0.088231, 0.846000, 0.354472, 0.526318, 0.020646, 0.010188,
0.031242, 0.055356, 0.694689, 0.099382, 0.28547,
0.977774, 0.855653, 0.427737, 0.321086, 0.417465 , 0.204385, 0.784437,
0.681434, 0.106180, 0.149122, 0.390870, 0.273686), tolerance=TOL,
check.attributes = FALSE))
)
# Takes too long to run:
# if(requireNamespace("pbkrtest", quietly = TRUE)) {
# sm.kr <- summary(m.carrots, ddf = "Kenward-Roger")
#
# ## coefficients for Sat and KR agree in this example
# # cbind(sm$coefficients[,"Pr(>|t|)"], sm.kr$coefficients[,"Pr(>|t|)"])
# all.equal(sm$coefficients[,"Pr(>|t|)"], sm.kr$coefficients[,"Pr(>|t|)"],
# tol=TOL)
# }
################################################################################
## checking lsmeans and difflsmeans
## compare with SAS output
m <- lmer(Informed.liking ~ Product*Information*Gender
+ (1|Product:Consumer) + (1|Consumer) , data=ham)
lsm <- lsmeansLT(m, which = "Product")
# head(lsm)
stopifnot(
isTRUE(all.equal(lsm[, "Estimate"], c(5.8084, 5.1012, 6.0909, 5.9256),
tol=TOL, check.attributes = FALSE)),
isTRUE(all.equal(round(lsm[, "t value"], 2), c(24.93, 21.89, 26.14, 25.43), tolerance=TOL,
check.attributes = FALSE)),
isTRUE(all.equal(lsm[, "lower"], c(5.3499, 4.6428, 5.6324, 5.4672), tolerance=TOL,
check.attributes = FALSE)),
isTRUE(all.equal(lsm[, "upper"], c(6.2668, 5.5597, 6.5493, 6.3840), tolerance=TOL,
check.attributes = FALSE))
)
################################################################################
# Not actually 'hard-coded' tests versus SAS results...
m.carrots <- lmer(Preference ~ 0 + sens2 + Homesize +
(1+sens2 | Consumer), data=carrots,
control=lmerControl(optimizer="bobyqa"))
summary(m.carrots)
(an.1 <- anova(m.carrots, type=1))
(an.3 <- anova(m.carrots))
(an.lme4 <- anova(m.carrots, ddf = "lme4")) # difference in SSQ MS and F-values
# Is this a problem with lme4?
# fm <- lm(Preference ~ 0 + sens2 + Homesize, data=carrots)
# anova(fm)
# coef(summary(fm))
# Here the F value is a little greater than the squared t-value (as expected)
stopifnot(all.equal(an.1[, "F value"], c(56.5394, 4169.87), tolerance = TOL2),
all.equal(an.3[, "F value"], c(54.8206, 4169.87), tolerance = TOL2))
################################################################################
# Check exmaple from GLM SAS report
### example from the paper GLM SAS 101 report
a <- factor(c(1,1,1,2,2,2,2,2,1,2))
b <- factor(c(1,1,2,1,2,2,2,2,2,1))
f=factor(c(1,2,1,2,1,2,1,2,1,2))
y <- c(12,14,11,20,17,23,35,46,15,16)
dd <- data.frame(a=a, b=b, y=y, f=f)
## check type 2 is order independent
model <- lmer(y ~ a*b + (1|f), data=dd)
model2 <- lmer(y ~ b*a + (1|f), data=dd)
(an <- anova(model, type=2))
(an2 <- anova(model2, type=2))
stopifnot(
isTRUE(all.equal(an,an2[c(2,1,3),], check.attributes = FALSE, tolerance=TOL2))
)
## check the results are the same as from SAS proc mixed
stopifnot(
isTRUE(all.equal(an[,"F value"], c(3.90131, 1.32753, 0.99565), tolerance=TOL2))
)
################################################################################
## Check type II and III anova tables versus SAS
m.carrots <- lmer(Preference ~ sens2*Homesize
+(1+sens2|Consumer), data=carrots)
(ancar <- anova(m.carrots, type=2))
stopifnot(
isTRUE(all.equal(ancar[,"F value"], c(54.8361, 5.16138, 1.03035), tolerance = TOL))
)
m <- lmer(Informed.liking ~ Product*Age
+ (1|Consumer) , data=ham)
(an <- anova(m, type=2))
stopifnot(
isTRUE(all.equal(an[,"F value"], c(2.48135, .005387, 1.48451), tolerance = TOL2))
)
fm <- lmer(Preference ~ sens2*Homesize*sens1 + (1|Product),
data=carrots)
(ant2 <- anova(fm, type=2))
(ant3 <- anova(fm, type=3))
stopifnot(
isTRUE(all.equal(ant2[,"F value"],
c(16.4842, 14.0010, .526076, 1.18144,
.107570, .335177, 1.05946), tolerance = TOL)),
isTRUE(all.equal(ant3[,"F value"],
c(16.9140, 14.0010,.481148, 1.18144,
.074201, .335177, 1.05946), tolerance = TOL))
)
################################################################################
lmerTest/tests/test_ls_means.R 0000644 0001762 0000144 00000010556 15125475223 016213 0 ustar ligges users # test_lsmeans.R
library(lmerTest)
TOL <- 1e-4
# Kenward-Roger only available with pbkrtest and only then validated in R >= 3.3.3
# (faulty results for R < 3.3.3 may be due to unstated dependencies in pbkrtest)
has_pbkrtest <- requireNamespace("pbkrtest", quietly = TRUE) && getRversion() >= "3.3.3"
########### Basic model structures:
# Factor * covariate:
data("cake", package="lme4")
model <- lmer(angle ~ recipe * temp + (1|recipe:replicate), cake)
(lsm <- ls_means(model))
stopifnot(
nrow(lsm) == 3L,
ncol(lsm) == 7L,
# Balanced, so LS-means equal raw means:
isTRUE(all.equal(c(with(cake, tapply(angle, recipe, mean))), lsm[, "Estimate"],
check.attributes=FALSE, tolerance=TOL))
)
# Pairwise differences of LS-means:
plsm <- ls_means(model, pairwise = TRUE)
plsm2 <- difflsmeans(model)
C <- as.matrix(lmerTest:::get_pairs(rownames(lsm)))
stopifnot(
isTRUE(all.equal(plsm, plsm2, tolerance=TOL)),
isTRUE(all.equal(plsm[, "Estimate"], c(lsm[, "Estimate"] %*% C),
check.attributes=FALSE, tolerance=TOL))
)
# Contrasts vectors:
show_tests(lsm)
show_tests(plsm)
# Factor * Ordered:
model <- lmer(angle ~ recipe * temperature + (1|recipe:replicate), cake)
(lsm2 <- ls_means(model))
stopifnot(
nrow(lsm2) == 3 + 6 + 3*6,
ncol(lsm) == 7L,
# Balanced, so LS-means equal raw means:
isTRUE(all.equal(lsm[1:3, ], lsm2[1:3, ],
check.attributes=FALSE, tolerance=TOL))
)
# Factor * Factor:
cake2 <- cake
cake2$temperature <- factor(cake2$temperature, ordered = FALSE)
model <- lmer(angle ~ recipe * temperature + (1|recipe:replicate), cake2)
(lsm3 <- ls_means(model))
stopifnot(
isTRUE(all.equal(lsm2, lsm3, check.attributes=FALSE, tolerance=TOL))
)
# Covariate (only):
data("sleepstudy", package="lme4")
m <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy)
(lsm <- ls_means(m))
stopifnot(
nrow(lsm) == 0L,
ncol(lsm) == 7L
)
# No fixef:
m <- lmer(Reaction ~ 0 + (Days | Subject), sleepstudy)
(lsm <- ls_means(m))
stopifnot(
nrow(lsm) == 0L,
ncol(lsm) == 7L
)
########### Arguments and options:
# which
model <- lmer(angle ~ recipe * temperature + (1|recipe:replicate), cake2)
(lsm4 <- ls_means(model, which = "recipe"))
stopifnot(
nrow(lsm4) == 3L,
ncol(lsm4) == 7L,
isTRUE(all.equal(lsm3[1:3, ], lsm4, check.attributes=FALSE, tolerance=TOL))
)
# KR:
if(has_pbkrtest)
(lsm5 <- ls_means(model, which = "recipe", ddf = "Kenward-Roger"))
# level:
(lsm6 <- ls_means(model, which = "recipe", level=0.99))
stopifnot(
all(lsm6[, "lower"] < lsm4[, "lower"]),
all(lsm6[, "upper"] > lsm4[, "upper"])
)
########### Missing cels -> unestimable contrasts:
# Missing cell:
cake3 <- cake
cake3$temperature <- factor(cake3$temperature, ordered=FALSE)
cake3 <- droplevels(subset(cake3, temperature %in% levels(cake3$temperature)[1:3]))
cake3 <- droplevels(subset(cake3, !(recipe == "C" & temperature == "195") ))
str(cake3)
with(cake3, table(recipe, temperature))
model <- lmer(angle ~ recipe * temperature + (1|recipe:replicate), cake3)
(lsm7 <- ls_means(model))
# Using show_tests with options:
show_tests(lsm7, fractions = TRUE)
show_tests(lsm7, fractions = TRUE, names = FALSE)
# Missing diagonal:
cake4 <- cake
cake4$temperature <- factor(cake4$temperature, ordered=FALSE)
cake4 <- droplevels(subset(cake4, temperature %in% levels(cake4$temperature)[1:3]))
cake4 <- droplevels(subset(cake4, !((recipe == "A" & temperature == "175") |
(recipe == "B" & temperature == "185") |
(recipe == "C" & temperature == "195") )))
# str(cake4)
with(cake4, table(recipe, temperature))
model <- lmer(angle ~ recipe * temperature + (1|recipe:replicate), cake4)
ls_means(model)
########### Various contrasts codings:
model <- lmer(angle ~ recipe * temperature + (1|recipe:replicate), cake3,
contrasts = list(recipe="contr.sum", temperature="contr.helmert"))
(lsm8 <- ls_means(model))
# show_tests(lsm7)
# show_tests(lsm8)
stopifnot(
isTRUE(all.equal(lsm7, lsm8, check.attributes=FALSE, tolerance=TOL))
)
# ambient contrasts not contr.treatment:
options("contrasts")
options(contrasts = c("contr.sum", "contr.poly"))
model <- lmer(angle ~ recipe * temperature + (1|recipe:replicate), cake3)
(lsm9 <- ls_means(model))
options(contrasts = c("contr.treatment", "contr.poly"))
options("contrasts")
stopifnot(
isTRUE(all.equal(lsm7, lsm9, check.attributes=FALSE, tolerance=TOL))
)
lmerTest/tests/test_anova.R 0000644 0001762 0000144 00000030633 15125475223 015514 0 ustar ligges users # test_anova.R
library(lmerTest)
# WRE says "using if(requireNamespace("pkgname")) is preferred, if possible."
# even in tests:
assertError <- function(expr, ...)
if(requireNamespace("tools")) tools::assertError(expr, ...) else invisible()
assertWarning <- function(expr, ...)
if(requireNamespace("tools")) tools::assertWarning(expr, ...) else invisible()
# Kenward-Roger only available with pbkrtest and only then validated in R >= 3.3.3
# (faulty results for R < 3.3.3 may be due to unstated dependencies in pbkrtest)
has_pbkrtest <- requireNamespace("pbkrtest", quietly = TRUE) && getRversion() >= "3.3.3"
data("sleepstudy", package="lme4")
TOL <- 1e-4
####################################
## Basic anova tests
####################################
m <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy)
####### ddf argument:
(an1 <- anova(m)) # Also testing print method.
(an2 <- anova(m, ddf="Satterthwaite"))
(an2b <- anova(m, ddf="Satterthwaite", type=3))
(an2c <- anova(m, ddf="Satterthwaite", type=2))
stopifnot(isTRUE(
all.equal(an1, an2, tolerance=TOL)
))
(an3 <- anova(m, ddf="Sat")) ## Abbreviated argument
stopifnot(isTRUE(
all.equal(an1, an3, tolerance=TOL)
))
if(has_pbkrtest) {
(anova(m, ddf="Kenward-Roger"))
(anova(m, ddf="Kenward-Roger", type=3))
}
(an1 <- anova(m, ddf="lme4"))
(an2 <- anova(m, ddf="lme4", type=3)) # 'type' is ignored with ddf="lme4"
stopifnot(isTRUE(
all.equal(an1, an2, tolerance=TOL)
))
res <- assertError(anova(m, ddf="KR")) ## Error on incorrect arg.
stopifnot(
grepl("'arg' should be one of ", unlist(res[[1]])$message)
)
## lme4 method:
an1 <- anova(m, ddf="lme4")
an2 <- anova(as(m, "lmerMod"))
stopifnot(isTRUE(
all.equal(an1, an2, tolerance=TOL)
))
###### type argument:
(an1 <- anova(m, type="1")) # valid type arg.
(an2 <- anova(m, type="I")) # same
stopifnot(isTRUE(
all.equal(an1, an2, tolerance=TOL)
))
(an3 <- anova(m, type=1)) # Not strictly valid, but accepted
stopifnot(isTRUE(
all.equal(an1, an3, tolerance=TOL)
))
(an1 <- anova(m, type="2")) # valid type arg.
(an2 <- anova(m, type="II")) # same
stopifnot(isTRUE(
all.equal(an1, an2, tolerance=TOL)
))
(an3 <- anova(m, type=3)) # Not strictly valid, but accepted
stopifnot(isTRUE(
all.equal(an1, an3, check.attributes=FALSE, tolerance=TOL)
))
(an1 <- anova(m, type="3")) # valid type arg.
(an2 <- anova(m, type="III")) # same
stopifnot(isTRUE(
all.equal(an1, an2, tolerance=TOL)
))
(an3 <- anova(m, type=3)) # Not strictly valid, but accepted
stopifnot(isTRUE(
all.equal(an1, an3, tolerance=TOL)
))
assertError(anova(m, type=0)) # Not valid arg.
assertError(anova(m, type="i")) # Not valid arg.
####### Model comparison:
fm <- lm(Reaction ~ Days, sleepstudy)
(an <- anova(m, fm))
stopifnot(
nrow(an) == 2L,
rownames(an)[2] == "m"
)
m2 <- lmer(Reaction ~ Days + I(Days^2) + (Days | Subject), sleepstudy)
(an <- anova(m, m2, refit=FALSE))
stopifnot(
nrow(an) == 2L,
rownames(an)[1] == "m"
)
####################################
## Example with factor fixef:
####################################
## 'temp' is continuous, 'temperature' an ordered factor with 6 levels
data("cake", package="lme4")
m <- lmer(angle ~ recipe * temp + (1|recipe:replicate), cake)
(an <- anova(m))
(an_lme4 <- anova(m, ddf="lme4"))
if(has_pbkrtest) {
(an_KR <- anova(m, ddf="Kenward-Roger"))
# res <- all.equal(an[, c("Sum Sq", "Mean Sq", "F value")],
# an_lme4[, c("Sum Sq", "Mean Sq", "F value")])
# stopifnot(isTRUE(res))
res <- all.equal(an[, c("Sum Sq", "Mean Sq", "F value")],
an_KR[, c("Sum Sq", "Mean Sq", "F value")], tolerance=TOL)
stopifnot(isTRUE(res))
}
stopifnot(all.equal(c(2, 1, 2), an$NumDF, tol=1e-6),
all.equal(c(254.0157612, 222, 222), an$DenDF, tol=TOL))
an3 <- anova(m, type=3)
an2 <- anova(m, type=2)
an1 <- anova(m, type=1)
## Data is balanced, so Type II and III should be identical:
## One variable is continuous, so Type I and II/III are different:
stopifnot(
isTRUE(all.equal(an3, an2, check.attributes=FALSE, tolerance=TOL)),
!isTRUE(all.equal(an1, an2, check.attributes=FALSE, tolerance=1e-8))
)
# Using an ordered factor:
m <- lmer(angle ~ recipe * temperature + (1|recipe:replicate), cake)
(an1 <- anova(m, type=1))
(an2 <- anova(m, type=2))
# Type 3 is also available with ordered factors:
(an3 <- anova(m, type=3))
## Balanced data and only factors: Type I, II and III should be the same:
stopifnot(
isTRUE(all.equal(an1, an2, check.attributes=FALSE, tolerance=TOL)),
isTRUE(all.equal(an1, an3, check.attributes=FALSE, tolerance=TOL))
)
(an <- anova(m, type=1))
(an_lme4 <- anova(m, type=1, ddf="lme4"))
res <- all.equal(an[, c("Sum Sq", "Mean Sq", "F value")],
an_lme4[, c("Sum Sq", "Mean Sq", "F value")], tolerance=TOL)
stopifnot(isTRUE(res))
if(has_pbkrtest) {
(an_KR <- anova(m, type=1, ddf="Kenward-Roger"))
res <- all.equal(an[, c("Sum Sq", "Mean Sq", "F value")],
an_KR[, c("Sum Sq", "Mean Sq", "F value")], tolerance=TOL)
stopifnot(isTRUE(res))
}
stopifnot(all.equal(c(2, 5, 10), an$NumDF, tolerance=TOL),
all.equal(c(42, 210, 210), an$DenDF, tolerance=TOL))
########
## Make case with balanced unordered factors:
cake2 <- cake
cake2$temperature <- factor(cake2$temperature, ordered = FALSE)
# str(cake2)
stopifnot(
!is.ordered(cake2$temperature)
)
m <- lmer(angle ~ recipe * temperature + (1|recipe:replicate), cake2)
(an1 <- anova(m, type=1))
(an2 <- anova(m, type=2))
(an3 <- anova(m, type=3))
## Balanced data and only factors: Type I, II, and III should be the same:
stopifnot(
isTRUE(all.equal(an1, an2, check.attributes=FALSE, tolerance=TOL)),
isTRUE(all.equal(an3, an2, check.attributes=FALSE, tolerance=TOL))
)
########
# No intercept:
m <- lmer(angle ~ 0 + recipe * temp + (1|recipe:replicate), cake)
(an <- anova(m, type=1))
(an2 <- anova(m, type=2))
(an2 <- anova(m, type=3))
if(has_pbkrtest)
(an_KR <- anova(m, ddf="Kenward-Roger"))
(an_lme4 <- anova(m, ddf="lme4"))
res <- all.equal(an[, c("Sum Sq", "Mean Sq", "F value")],
an_lme4[, c("Sum Sq", "Mean Sq", "F value")], tolerance=TOL)
stopifnot(isTRUE(res))
# ML-fit:
m <- lmer(angle ~ recipe * temp + (1|recipe:replicate), cake, REML=FALSE)
(an <- anova(m, type=1))
if(has_pbkrtest)
assertError(an <- anova(m, ddf="Kenward-Roger")) # KR fits should be REML
(an_lme4 <- anova(m, ddf="lme4"))
res <- all.equal(an[, c("Sum Sq", "Mean Sq", "F value")],
an_lme4[, c("Sum Sq", "Mean Sq", "F value")], tolerance=TOL)
stopifnot(isTRUE(res))
####################################
## Using contr.sum:
####################################
m <- lmer(angle ~ recipe * temp + (1|recipe:replicate), cake,
contrasts = list('recipe' = "contr.sum"))
(an <- anova(m, type=1))
(an2 <- anova(m, type=2))
(an3 <- anova(m, type=3))
stopifnot(
isTRUE(all.equal(an2, an3, check.attributes=FALSE, tolerance=TOL))
)
if(has_pbkrtest)
(an_KR <- anova(m, type=1, ddf="Kenward-Roger"))
(an_lme4 <- anova(m, ddf="lme4"))
res <- all.equal(an[, c("Sum Sq", "Mean Sq", "F value")],
an_lme4[, c("Sum Sq", "Mean Sq", "F value")], tolerance=TOL)
stopifnot(isTRUE(res))
####################################
## Example with continuous fixef:
####################################
# Example with no fixef:
m <- lmer(Reaction ~ -1 + (Days | Subject), sleepstudy)
# m <- lmer(Reaction ~ 0 + (Days | Subject), sleepstudy) # alternative
stopifnot(length(fixef(m)) == 0L)
(an <- anova(m, type=1))
(an_2 <- anova(m, type=2))
(an_3 <- anova(m, type=3))
stopifnot(nrow(an) == 0L,
nrow(an_2) == 0L,
nrow(an_3) == 0L)
# anova(m, ddf="lme4") # Bug in lme4 it seems
if(has_pbkrtest) {
(an_KR <- anova(m, ddf="Kenward-Roger"))
stopifnot(
nrow(an_KR) == 0L
)
}
# Example with intercept only:
m <- lmer(Reaction ~ (Days | Subject), sleepstudy)
# m <- lmer(Reaction ~ 1 + (Days | Subject), sleepstudy) # alternative
stopifnot(length(fixef(m)) == 1L,
names(fixef(m)) == "(Intercept)")
(an <- anova(m))
(an_2 <- anova(m, type=2))
(an_3 <- anova(m, type=3))
(an_lme4 <- anova(m, ddf="lme4"))
stopifnot(nrow(an) == 0L,
nrow(an_2) == 0L,
nrow(an_3) == 0L,
nrow(an_lme4) == 0L)
if(has_pbkrtest) {
(an_KR <- anova(m, ddf="Kenward-Roger"))
stopifnot(
nrow(an_KR) == 0L
)
}
# Example with 1 fixef without intercept:
# for packageVersion("lme4") < 1.1.20
# mOld <- lmer(Reaction ~ Days - 1 + (Days | Subject), sleepstudy)
# for packageVersion("lme4") >= 1.1.20 we need to specify the old default
# optimizer to get the model to converge well enough.
m <- lmer(Reaction ~ Days - 1 + (Days | Subject), sleepstudy,
control=lmerControl(optimizer="bobyqa"))
# m <- lmer(Reaction ~ 0 + Days + (Days | Subject), sleepstudy) # alternative
stopifnot(length(fixef(m)) == 1L,
names(fixef(m)) == "Days")
(an <- anova(m))
(an_2 <- anova(m, type=2))
(an_3 <- anova(m, type=3))
(an_lme4 <- anova(m, ddf="lme4"))
stopifnot(nrow(an) == 1L,
nrow(an_2) == 1L,
nrow(an_3) == 1L,
nrow(an_lme4) == 1L)
if(has_pbkrtest) {
(an_KR <- anova(m, ddf="Kenward-Roger"))
stopifnot(
nrow(an_KR) == 1L
)
}
res <- all.equal(an[, c("Sum Sq", "Mean Sq", "F value")],
an_lme4[, c("Sum Sq", "Mean Sq", "F value")], tolerance=TOL)
stopifnot(isTRUE(res))
stopifnot(isTRUE(all.equal(
c(1, 17), unname(unlist(an[, c("NumDF", "DenDF")])), tolerance=TOL
)))
# Example with >1 fixef without intercept:
m <- lmer(Reaction ~ Days - 1 + I(Days^2) + (Days | Subject), sleepstudy)
stopifnot(length(fixef(m)) == 2L,
names(fixef(m)) == c("Days", "I(Days^2)"))
(an <- anova(m))
(an_2 <- anova(m, type=2))
(an_3 <- anova(m, type=3))
(an_lme4 <- anova(m, ddf="lme4"))
stopifnot(nrow(an) == 2L,
nrow(an_3) == 2L,
nrow(an_lme4) == 2L)
if(has_pbkrtest) {
(an_KR <- anova(m, ddf="Kenward-Roger"))
stopifnot(
nrow(an_KR) == 2L
)
}
# Here is a diff in SSQ which doesn't seem well-defined anyway...
# SSQ for I(Days^2) agree though.
# t-statistics also agree:
coef(summary(m))
Lmat <- diag(length(fixef(m)))
lmerTest:::rbindall(lapply(1:nrow(Lmat), function(i) contest1D(m, Lmat[i, ])))
# Example with >1 fixef and intercept:
m <- lmer(Reaction ~ Days + I(Days^2) + (Days | Subject), sleepstudy)
stopifnot(length(fixef(m)) == 3L)
(an <- anova(m, type=1))
(an_2 <- anova(m, type=2))
(an_3 <- anova(m, type=3))
(an_lme4 <- anova(m, ddf="lme4"))
res <- all.equal(an[, c("Sum Sq", "Mean Sq", "F value")],
an_lme4[, c("Sum Sq", "Mean Sq", "F value")], tolerance=TOL)
stopifnot(isTRUE(res))
if(has_pbkrtest) {
(an_KR <- anova(m, ddf="Kenward-Roger"))
res <- all.equal(an_3[, c("Sum Sq", "Mean Sq", "DenDF", "F value")],
an_KR[, c("Sum Sq", "Mean Sq", "DenDF", "F value")], tolerance=TOL)
stopifnot(isTRUE(res))
}
## FIXME: Test the use of refit arg to lme4:::anova.merMod
##############################
# Test that type III anova is the same regardless of contrast coding:
# 3 x 3 factorial with missing diagonal
data("cake", package="lme4")
cake4 <- cake
cake4$temperature <- factor(cake4$temperature, ordered=FALSE)
cake4 <- droplevels(subset(cake4, temperature %in% levels(cake4$temperature)[1:3]))
cake4 <- droplevels(subset(cake4, !((recipe == "A" & temperature == "175") |
(recipe == "B" & temperature == "185") |
(recipe == "C" & temperature == "195") )))
str(cake4)
with(cake4, table(recipe, temperature))
# load_all(r2path)
fm1 <- lmer(angle ~ recipe * temperature + (1|recipe:replicate), cake4)
fm2 <- lmer(angle ~ recipe * temperature + (1|recipe:replicate), cake4,
contrasts=list(recipe="contr.sum", temperature="contr.SAS"))
fm3 <- lmer(angle ~ recipe * temperature + (1|recipe:replicate), cake4,
contrasts=list(recipe="contr.sum", temperature="contr.poly"))
fm4 <- lmer(angle ~ recipe * temperature + (1|recipe:replicate), cake4,
contrasts=list(recipe=contr.helmert, temperature="contr.poly"))
(an1 <- anova(fm1))
(an2 <- anova(fm2))
(an3 <- anova(fm3))
(an4 <- anova(fm4))
options("contrasts")
options(contrasts = c("contr.sum", "contr.poly"))
fm5 <- lmer(angle ~ recipe * temperature + (1|recipe:replicate), cake4)
(an5 <- anova(fm5))
options(contrasts = c("contr.treatment", "contr.poly"))
options("contrasts")
stopifnot(
isTRUE(all.equal(an1, an2, check.attributes=FALSE, tolerance=TOL)),
isTRUE(all.equal(an1, an3, check.attributes=FALSE, tolerance=TOL)),
isTRUE(all.equal(an1, an4, check.attributes=FALSE, tolerance=TOL)),
isTRUE(all.equal(an1, an5, check.attributes=FALSE, tolerance=TOL))
)
lmerTest/MD5 0000644 0001762 0000144 00000007472 15131411367 012375 0 ustar ligges users 031b902a8fe4a85f584108112402bbce *DESCRIPTION
91825fa1815509000a7fae9f454f322a *NAMESPACE
8fdab2b6b9b5705591b5178060ebd030 *NEWS.md
e88b281cc58cdab80c395a38ede1b3c5 *R/anova_contrasts.R
c46ce5fec0361561dd91177510052cd4 *R/contest.R
0e8eac77c31eaef06c2b630a5fa382bb *R/contrast_utils.R
7898c46b20ee1a96e9a7a04e36cf7224 *R/data_documentation.R
29be40f6381c629084612fb295f692d2 *R/drop1.R
efd9f5022cf03fe6048461554a5598dd *R/estimability.R
37a994fa78a14c024559fa54e59ad98d *R/legacy.R
07145599bcf1d3576f281efcf6789800 *R/lmer.R
25b36d40caf82b1e0660a30b836c6003 *R/lmerTest.R
14a242da0588cd09e3ff5e5916bab10f *R/lmer_anova.R
b2e400cf9c551f7edc647e5d30fe428d *R/lmer_summary.R
0941c122808e3f4487aa0b2360231616 *R/ls_means.R
e088287c2f11810d0c06ff65d81456aa *R/ranova.R
d18ffe5e9ca935fb2035b30d6305dfd3 *R/step.R
4ad12d8c94a113ed6ac709eb99115893 *R/terms_utils.R
6c4b7299cbb9ba886bc489d2ecc0216e *R/utils.R
12159babfadcc754550690dcccad6dc1 *R/zzz.R
14b928552563309e6a84b8d953cda4e4 *data/TVbo.rda
065f9c791eb699c1379340273efeb8c7 *data/carrots.rda
fee30b6b64fd268d3fc1910ee4366bee *data/ham.rda
a41990003b4730c1ac9377a73b1c6acb *inst/CITATION
c102b64864f3738ee0acd18043331119 *inst/testdata/legacy_fits.RData
044f2503813a6ca6f71c97aa5a08b1a3 *inst/testdata/potdata.RData
ff67466d3b56f474455968dc122e2490 *inst/testdata/test_paper_objects.RData
8e05a7c12777816eab4c106006b7d8c2 *man/TVbo.Rd
e73777bff1ee201758387b5597ca800e *man/anova.lmerModLmerTest.Rd
42290867a073d2dc3955ea2b4acf8b8b *man/as.data.frame.ls_means.Rd
d1043abb4725e992da1bf19c5a8fdfdd *man/as_lmerModLmerTest.Rd
48d32097fab3ab38c7191b9cf7901558 *man/carrots.Rd
c6e71f37db047bf40d01f433c5e1c371 *man/contest.Rd
c7abd68f74b26a4265f8ad90907cb47d *man/contest.lmerModLmerTest.Rd
cd30f6697a3453e9855c26bfb4733e37 *man/contest1D.lmerModLmerTest.Rd
c97254772be0aa54875d8501a535a9e4 *man/contestMD.lmerModLmerTest.Rd
0e2a9babd46168955559d3be9590555b *man/drop1.lmerModLmerTest.Rd
694c357e7338c15a3a9f1e3e82d5ed30 *man/get_model.Rd
5d75be9c7111999d031a1a5d71d32c03 *man/ham.Rd
efadd20d97919cbb1dbf4bde336fec9d *man/legacy.Rd
76507f65d5a5694b6bb64875e77d9b9e *man/lmer.Rd
ba1fc9cb9d0d6b06233b2b6c5f7a7d4b *man/lmerModLmerTest-class.Rd
9e750946e85e8974e6cef5ae4c4ae0bf *man/lmerTest-package.Rd
fcc75d0724e94e9ab93929609e273904 *man/ls_means.Rd
4a2b2426381bce0c2945ee2e5e4815b3 *man/ls_means.lmerModLmerTest.Rd
5ec03c1e9cf15c3044fc986a2ad54512 *man/merModLmerTest-class.Rd
401db0036840b98ec716380aadb88f5f *man/plot.ls_means.Rd
f9c0e13dc1ec87783b85a2357a4fa7e0 *man/plot.step_list.Rd
dac1877c160733b4641a47486dea584a *man/ranova.Rd
eb749cb7f59827df144371b3ef77dba2 *man/show_tests.Rd
6ee1da6f462a277f99c7bca35b222d88 *man/show_tests.anova.Rd
80725e09eff994432f579d60d0835aa1 *man/show_tests.ls_means.Rd
a0f9deb02c62822eb28f92f7b92d8f56 *man/step.Rd
66bef4ba57f140e057eae329907812dc *man/step.lmerModLmerTest.Rd
207cc8cd2caf0cfb82096b1227ce3df4 *man/summary.lmerModLmerTest.Rd
f84f566591b90a31db81722a328b86c6 *tests/test_a_utils.R
8c44145814b3c016b5e6c94540b003ab *tests/test_anova.R
1782fd04b6408fb0e916dde52106df54 *tests/test_compare_sas.R
4c92878bb2e16d1f9b1947b0d5cd5a36 *tests/test_contest1D.R
edc042ecb75d6d37b0a458e668b7126c *tests/test_contestMD.R
9cd6eb69465a5f3db726ddd2df20a96c *tests/test_contrast_utils.R
7189e65dce086db08a07538121d1a3fb *tests/test_devfun_vp.R
61b56963b69bb0a918d6f0068a31c960 *tests/test_drop1.R
9528b31cd6f714204c200c35de9d4d82 *tests/test_legacy.R
4287b08d1a687f0b77baf7d9d8267ea1 *tests/test_lmer.R
bc49940e3c950e447dc3a5a8ec7eddab *tests/test_lmerTest_paper.R
26d8f42e8cc43a44bc5355e4f650977e *tests/test_ls_means.R
8a6dbc62ab08b8aaab124180285022a7 *tests/test_ranova_step.R
32914c2595f2b1fa9b65904a921eeb7f *tests/test_re_covar_structures.R
d6116771ee3a2c4299ec9d9930790732 *tests/test_summary.R
45baa7c308b815bc2e03a1ff0db52f17 *tests/test_zerovar.R
191c0b12e0277651920d1acb1da6c1d9 *tests/zlmerTest_zeroDenom.R
lmerTest/R/ 0000755 0001762 0000144 00000000000 15131226370 012252 5 ustar ligges users lmerTest/R/terms_utils.R 0000644 0001762 0000144 00000017432 15131137167 014763 0 ustar ligges users #############################################################################
# Copyright (c) 2013-2026 Alexandra Kuznetsova, Per Bruun Brockhoff, and
# Rune Haubo Bojesen Christensen
#
# This file is part of the lmerTest package for R (*lmerTest*)
#
# *lmerTest* is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# *lmerTest* is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# A copy of the GNU General Public License is available at
# and/or
# .
#############################################################################
#
# terms_utils.R - utilities for computing on terms objects and friends
# ------- Contents: --------
#
# --- utility functions: ---
#
# term2colX
# need_yates
# no_yates
# numeric_terms
# get_model_matrix
# get_contrast_coding
# get_min_data
# get_var_list
# get_fac_list
# get_num_list
# get_pairs
# get_trts
#
##############################################
######## term2colX()
##############################################
term2colX <- function(terms, X) {
# Compute map from terms to columns in X using the assign attribute of X.
# Returns a list with one element for each term containing indices of columns
# in X belonging to that term.
if(is.null(asgn <- attr(X, "assign")))
stop("Invalid design matrix:",
"design matrix 'X' should have a non-null 'assign' attribute",
call. = FALSE)
term_names <- attr(terms, "term.labels")
has_intercept <- attr(terms, "intercept") > 0
col_terms <- if(has_intercept) c("(Intercept)", term_names)[asgn + 1] else
term_names[asgn[asgn > 0]]
if(!length(col_terms) == ncol(X)) # should never happen.
stop("An error happended when mapping terms to columns of X")
# get names of terms (including aliased terms)
nm <- union(unique(col_terms), term_names)
res <- lapply(setNames(as.list(nm), nm), function(x) numeric(0L))
map <- split(seq_along(col_terms), col_terms)
res[names(map)] <- map
res[nm] # order appropriately
}
##############################################
######## need_yates()
##############################################
need_yates <- function(model) {
## Do not need yates for:
## - continuous variables
## - factors that are not contained in other factors
## Need yates for all other terms, i.e. terms which are:
## - contained in other terms, AND
## - which are not numeric/continuous
term_names <- attr(terms(model), "term.labels")
cont <- containment(model)
is_contained <- names(cont[sapply(cont, function(x) length(x) > 0)])
nmt <- numeric_terms(model)
num_terms <- names(nmt[nmt])
term_names[!term_names %in% num_terms &
term_names %in% is_contained]
}
##############################################
######## no_yates()
##############################################
no_yates <- function(model) {
setdiff(attr(terms(model), "term.labels"), need_yates(model))
}
##############################################
######## numeric_terms()
##############################################
#' @importFrom stats delete.response terms
numeric_terms <- function(model) {
## Determines for all terms (not just all variables) if the 'dataClass'
## is numeric
## (interactions involving one or more numerics variables are numeric).
Terms <- delete.response(terms(model))
all_vars <- all.vars(attr(Terms, "variables"))
data_classes <- attr(terms(model, fixed.only=FALSE), "dataClasses")
var_class <- data_classes[names(data_classes) %in% all_vars]
factor_vars <- names(var_class[var_class %in% c("factor", "ordered")])
num_vars <- setdiff(all_vars, factor_vars)
term_names <- attr(terms(model), "term.labels")
# term_names <- setNames(as.list(term_names), term_names)
sapply(term_names, function(term) {
vars <- unlist(strsplit(term, ":"))
any(vars %in% num_vars)
})
}
##############################################
######## get_model_matrix()
##############################################
#' Extract or remake model matrix from model
#'
#' Extract or remake model matrix from model and potentially change the
#' contrast coding
#'
#' @param model an \code{lm} or \code{lmerMod} model object.
#' @param type extract or remake model matrix?
#' @param contrasts contrasts settings. These may be restored to those in the
#' model or they may be changed. If a length one character vector (e.g.
#' \code{"contr.SAS"}) this is applied to all factors in the model, but it can
#' also be a list naming factors for which the contrasts should be set as specified.
#'
#' @return the model (or 'design') matrix.
#' @keywords internal
#' @noRd
#' @author Rune Haubo B Christensen
get_model_matrix <- function(model, type=c("extract", "remake"),
contrasts="restore") {
type <- match.arg(type)
stopifnot(inherits(model, "lm") || inherits(model, "lmerMod"))
if(type == "extract") return(model.matrix(model))
# Set appropriate contrasts:
Contrasts <- get_contrast_coding(model, contrasts=contrasts)
model.matrix(terms(model), data=model.frame(model),
contrasts.arg = Contrasts)
}
##############################################
######## get_contrast_coding()
##############################################
get_contrast_coding <- function(model, contrasts="restore") {
# Compute a list of contrasts for all factors in model
Contrasts <- contrasts
if(length(contrasts) == 1 && is.character(contrasts) &&
contrasts == "restore") {
Contrasts <- attr(model.matrix(model), "contrasts")
} else if(length(contrasts) == 1 && is.character(contrasts) &&
contrasts != "restore") {
Contrasts <- .getXlevels(terms(model), model.frame(model))
Contrasts[] <- contrasts
Contrasts
}
Contrasts
}
get_min_data <- function(model, FUN=mean)
# Get a minimum complete model.frame based on the variables in the model
do.call(expand.grid, get_var_list(model, FUN=FUN))
get_var_list <- function(model, FUN=mean)
# Extract a named list of variables in the model containing the levels of
# factors and the mean value of numeric variables
c(get_fac_list(model), get_num_list(model, FUN=FUN))
#' @importFrom stats .getXlevels
get_fac_list <- function(model) {
# Extract a named list of factor levels for each factor in the model
res <- .getXlevels(Terms=terms(model), m=model.frame(model))
if(is.null(res)) list() else res
}
get_num_list <- function(model, FUN=mean) { # FUN=function(x) mean(x, na.rm=TRUE)) {
# Extract named list of mean/FUN values of numeric variables in model
Terms <- terms(model)
mf <- model.frame(model)
xvars <- sapply(attr(Terms, "variables"), deparse2)[-1L]
if((yvar <- attr(Terms, "response")) > 0)
xvars <- xvars[-yvar]
if(!length(xvars)) return(list())
xlev <- lapply(mf[xvars], function(x) {
if (is.numeric(x)) FUN(x) else NULL
})
res <- xlev[!vapply(xlev, is.null, NA)]
if(is.null(res)) list() else res
}
#' @importFrom utils combn
get_pairs <- function(levs) {
stopifnot(is.character(levs), length(levs) > 1)
combs <- combn(seq_along(levs), 2)
ind <- seq_len(ncombs <- ncol(combs))
A <- as.data.frame(array(0, dim=c(length(levs), ncombs)))
dimnames(A) <- list(levs, paste(levs[combs[1, ]], levs[combs[2, ]], sep=" - "))
A[cbind(combs[1, ], ind)] <- 1
A[cbind(combs[2, ], ind)] <- -1
A
}
get_trts <- function(levs) {
nlevs <- length(levs)
ans <- t(cbind(-1, diag(nlevs - 1)))
rownames(ans) <- levs
colnames(ans) <- paste(levs[-1], levs[1], sep=" - ")
ans
}
# get_trts(letters[1:5])
# get_pairs(letters[1:5])
lmerTest/R/contrast_utils.R 0000644 0001762 0000144 00000034077 15131137167 015472 0 ustar ligges users #############################################################################
# Copyright (c) 2013-2026 Alexandra Kuznetsova, Per Bruun Brockhoff, and
# Rune Haubo Bojesen Christensen
#
# This file is part of the lmerTest package for R (*lmerTest*)
#
# *lmerTest* is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# *lmerTest* is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# A copy of the GNU General Public License is available at
# and/or
# .
#############################################################################
#
# contrast-utils.R - utility functions for contrasts, terms and anova
# -------- Contents: --------
#
# containment
# term_contain
# relatives
# doolittle
# ensure_full_rank
# get_rdX
# extract_contrasts_type3
# get_yates_contrast
##############################################
######## containment()
##############################################
#' Determine the Containment Structure for All Terms in a Model
#'
#' See \code{\link{term_contain}} for details about containment.
#'
#' @param object a model object, e.g. of class \code{lm} or \code{merMod}.
#'
#' @return a list with one element for each term in the model. Each element/term
#' is a character vector of terms that the term is contained in.
#' @importFrom stats terms setNames
#' @noRd
#' @keywords internal
containment <- function(object) { # lm or merMod
# For all terms 'T' in object compute the terms
# Return a list:
# for each term 'T' a vector of terms that contain 'T'.
terms <- terms(object)
data_classes <- attr(terms(object, fixed.only=FALSE), "dataClasses")
# Note: need fixed.only for merMod objects to get dataClasses
term_names <- attr(terms, "term.labels")
factor_mat <- attr(terms, "factors")
lapply(setNames(term_names, term_names), function(term) {
term_names[term_contain(term, factor_mat, data_classes, term_names)]
})
}
##############################################
######## term_contain()
##############################################
#' Determine which Terms Contain a Term
#'
#' The definition of \emph{containment} follows from the SAS documentation on
#' "The Four Types of Estimable Functions".
#'
#' Containment is defined for two model terms, say, F1 and F2 as:
#' F1 is contained in F2 (F2 contains F1) if
#' \enumerate{
#' \item F1 and F2 involve the same continuous variables (if any)
#' \item F2 involve more factors than F1
#' \item All factors in F1 (if any) are part of F2
#' }
#' The intercept, though not really a model term, is defined by SAS to be
#' contained in all factor terms, but it is not contained in any
#' effect involving a continuous variable.
#'
#' @param term character; name of a model term and one of \code{term_names}.
#' @param factors the result of \code{attr(terms_object, "factors")}.
#' @param dataClasses the result of
#' \code{attr(terms(model, fixed.only=FALSE), "dataClasses")}. Note that
#' \code{fixed.only=FALSE} is only needed for \code{merMod} objects, but does
#' no harm for \code{lm} objects.
#' @param term_names the result of \code{attr(terms_object, "term.labels")}.
#'
#' @return a logical vector indicating for each term in \code{term_names} if
#' it contains \code{term}.
#' @importFrom stats setNames
#' @noRd
#' @keywords internal
term_contain <- function(term, factors, dataClasses, term_names) {
get_vars <- function(term)
# Extract vector of names of all variables in a term
rownames(factors)[factors[, term] == 1]
contain <- function(F1, F2) {
# Returns TRUE if F1 is contained in F2 (i.e. if F2 contains F1)
# F1, F2: Names of terms, i.e. attr(terms_object, "term.labels")
all(vars[[F1]] %in% vars[[F2]]) && # all variables in F1 are also in F2
length(setdiff(vars[[F2]], vars[[F1]])) > 0L && # F2 involve more variables than F1
setequal(numerics[[F1]], numerics[[F2]]) # F1 and F2 involve the same covariates (if any)
}
# Get (named) list of all variables in terms:
vars <- lapply(setNames(term_names, term_names), get_vars)
# Get (named) list of all _numeric_ variables in all terms:
numerics <- lapply(vars, function(varnms)
varnms[which(dataClasses[varnms] == "numeric")])
# Check if 'term' is contained in each model term:
sapply(term_names, function(term_nm) contain(term, term_nm))
}
##############################################
######## relatives()
##############################################
# relatives <- function(classes.term, term, term_names, factors) {
# ## checks if the terms have the same number of covariates (if any)
# checkCovContain <- function(term1, term2) {
# num.numeric <- which(classes.term=="numeric")
# num.numeric.term1 <- which((num.numeric %in% which(factors[,term1]!=0))==TRUE)
# num.numeric.term2 <- which((num.numeric %in% which(factors[,term2]!=0))==TRUE)
# if((length(num.numeric.term1)>0 && length(num.numeric.term2)>0)||
# (length(num.numeric.term1)==0 && length(num.numeric.term2)==0))
# return(all(num.numeric.term2 == num.numeric.term1))
# else
# return(FALSE)
# }
# is.relative <- function(term1, term2) {
# all(!(factors[, term1] & (!factors[, term2]))) && checkCovContain(term1, term2)
# }
# if(length(term_names) == 1) return(NULL)
# which.term <- which(term == term_names)
# (1:length(term_names))[-which.term][sapply(term_names[-which.term],
# function(term2) is.relative(term, term2))]
# }
##############################################
######## doolittle()
##############################################
#' Doolittle Decomposition
#'
#' @param x a numeric square matrix with at least 2 columns/rows.
#' @param eps numerical tolerance on the whether to normalize with components
#' in \code{L} with the diagonal elements of \code{U}.
#'
#' @return a list with two matrices of the same dimension as \code{x}:
#' \item{L}{lower-left unit-triangular matrix}
#' \item{U}{upper-right triangular matrix (\emph{not} unit-triangular)}
#'
#' @noRd
#' @keywords internal
doolittle <- function(x, eps = 1e-6) {
if(!is.matrix(x) || ncol(x) != nrow(x) || !is.numeric(x))
stop("argument 'x' should be a numeric square matrix")
stopifnot(ncol(x) > 1L)
n <- nrow(x)
L <- U <- matrix(0, nrow=n, ncol=n)
diag(L) <- rep(1, n)
for(i in 1:n) {
ip1 <- i + 1
im1 <- i - 1
for(j in 1:n) {
U[i,j] <- x[i,j]
if (im1 > 0) {
for(k in 1:im1) {
U[i,j] <- U[i,j] - L[i,k] * U[k,j]
}
}
}
if ( ip1 <= n ) {
for ( j in ip1:n ) {
L[j,i] <- x[j,i]
if ( im1 > 0 ) {
for ( k in 1:im1 ) {
L[j,i] <- L[j,i] - L[j,k] * U[k,i]
}
}
L[j, i] <- if(abs(U[i, i]) < eps) 0 else L[j,i] / U[i,i]
}
}
}
L[abs(L) < eps] <- 0
U[abs(U) < eps] <- 0
list( L=L, U=U )
}
##############################################
######## ensure_full_rank()
##############################################
#' Ensure a Design Matrix has Full (Column) Rank
#'
#' Determine and drop redundant columns using the \code{\link{qr}}
#' decomposition.
#'
#' @param X a design matrix as produced by \code{model.matrix}.
#' @param tol \code{qr} tolerance.
#' @param silent throw message if columns are dropped from \code{X}? Default
#' is \code{FALSE}.
#' @param test.ans Test if the resulting/returned matrix has full rank? Default
#' is \code{FALSE}.
#'
#' @return A design matrix in which redundant columns are dropped
#' @noRd
#' @keywords internal
ensure_full_rank <- function(X, tol = 1e-7, silent = FALSE, test.ans = FALSE) {
### works if ncol(X) >= 0 and nrow(X) >= 0
## test and match arguments:
stopifnot(is.matrix(X))
silent <- as.logical(silent)[1]
## perform the qr-decomposition of X using LINPACK methods:
qr.X <- qr(X, tol = tol, LAPACK = FALSE)
if(qr.X$rank == ncol(X)) {
## return X if X has full column rank
return(X)
}
if(!silent) ## message the no. dropped columns:
message(gettextf("Design is column rank deficient so dropping %d coef",
ncol(X) - qr.X$rank))
## return the columns correponding to the first qr.x$rank pivot
## elements of X:
keep <- with(qr.X, pivot[seq_len(rank)])
newX <- X[, keep, drop = FALSE]
sel <- with(qr.X, pivot[-seq_len(rank)])
## Copy old attributes:
if(!is.null(contr <- attr(X, "contrasts"))) attr(newX, "contrasts") <- contr
if(!is.null(asgn <- attr(X, "assign"))) attr(newX, "assign") <- asgn[-sel]
## did we succeed? stop-if-not:
if(test.ans && qr.X$rank != qr(newX)$rank)
stop(gettextf("Determination of full column rank design matrix failed"),
call. = FALSE)
return(newX)
}
##############################################
######## get_rdX()
##############################################
#' Compute the 'Full' Rank-Deficient Design Matrix
#'
#'
#' @param model a model object; lmerMod or lmerModLmerTest.
#' @param do.warn throw a message if there is no data for some factor
#' combinations.
#'
#' @return the rank-deficien design matrix
#' @author Rune Haubo B. Christensen
#' @noRd
#' @keywords internal
#'
#' @importFrom stats as.formula model.frame terms model.matrix
get_rdX <- function(model, do.warn=TRUE) {
# Compute rank-deficient design-matrix X usign contr.treatment coding.
#
# model: terms(model), model.frame(model), fixef(model)
Terms <- terms(model, fixed.only=TRUE)
term_names <- attr(Terms, "term.labels")
df <- model.frame(model)
# Compute rank-deficient (full) design-matrix, X:
rdXi <- if(length(term_names)) lapply(term_names, function(trm) {
form <- as.formula(paste0("~ 0 + ", trm))
model.matrix(form, data=df) # no contrast arg
}) else list(model.matrix(~ 1, data=df)[, -1, drop=FALSE])
rdX <- do.call(cbind, rdXi)
param_names <- unlist(lapply(rdXi, colnames))
# Potentially add intercept:
has_intercept <- attr(Terms, "intercept") != 0
if(has_intercept) {
rdX <- cbind('(Intercept)'=rep(1, nrow(rdX)), rdX)
param_names <- c("(Intercept)", param_names)
}
colnames(rdX) <- param_names
# Warn/message if there are cells without data:
is_zero <- which(apply(rdX, 2, function(x) all(x == 0)))
if(do.warn && length(is_zero)) {
txt <- sprintf("Missing cells for: %s. ",
paste(param_names[is_zero], collapse = ", "))
# warning(paste(txt, "\nInterpret type III hypotheses with care."), call.=FALSE)
message(paste(txt, "\nInterpret type III hypotheses with care."))
}
rdX
}
##############################################
######## extract_contrasts_type3
##############################################
#' @importFrom MASS ginv
#' @importFrom stats terms resid lm.fit
extract_contrasts_type3 <- function(model, X=NULL) {
# Computes contrasts for type III tests with reference to treatment contrast coding
# X: Optional full rank design matrix in contr.treatment coding
Terms <- terms(model)
term_names <- attr(Terms, "term.labels")
if(is.null(X)) {
X <- get_model_matrix(model, type="remake", contrasts="contr.treatment")
X <- ensure_full_rank(X)
}
# Get 'complete' design matrix:
rdX <- get_rdX(model, do.warn = TRUE) # treatment contrasts
# cols for aliased coefs should be removed in X; not in rdX.
# This makes ginv(X) unique!
L <- zapsmall(t(MASS::ginv(X) %*% rdX)) # basic contrast matrix
dimnames(L) <- list(colnames(rdX), colnames(X))
# Orthogonalize contrasts for terms which are contained in other terms:
map <- term2colX(Terms, X)
is_contained <- containment(model)
# Orthogonalize higher order terms before lower order terms:
terms_order <- attr(Terms, "order")
orthog_order <- term_names[order(terms_order, decreasing = TRUE)]
for(term in orthog_order) {
# if term is contained in other terms:
if(length(contains <- is_contained[[term]]) > 0) {
# orthogonalize cols in L for 'term' wrt. cols that contain 'term':
L[, map[[term]]] <-
zapsmall(resid(lm.fit(x=L[, unlist(map[contains]), drop=FALSE],
y=L[, map[[term]], drop=FALSE])))
}
}
# Keep rows in L corresponding to model coefficients:
L <- L[colnames(X), , drop=FALSE]
# Extract list of contrast matrices from L - one for each term:
Llist <- lapply(map[term_names], function(term) t(L[, term, drop=FALSE]))
# Keep all non-zero rows:
lapply(Llist, function(L) L[rowSums(abs(L)) > 1e-8, , drop=FALSE])
}
##############################################
######## get_yates_contrast()
##############################################
get_yates_contrast <- function(model, which=NULL) {
term_names <- attr(terms(model), "term.labels")
if(is.null(which)) which <- term_names
stopifnot(is.character(which), all(which %in% term_names))
which <- setNames(as.list(which), which)
var_list <- get_var_list(model)
grid <- get_min_data(model)
form <- formula(model)[-2]
if(inherits(model, "lmerMod")) form <- nobars(form)
coef_nm <- if(inherits(model, "lmerMod")) colnames(model.matrix(model)) else
names(coef(model))[!is.na(coef(model))]
uX <- model.matrix(form, data=grid)
# Compute LS-means contrast:
Llist <- lapply(which, function(term) {
Lt <- model.matrix(formula(paste0("~ 0 + ", term)), data=grid)
wts <- 1/colSums(Lt) # Yates' weights
# Lt * c(Lt %*% wts)
# L <- diag(wts) %*% t(Lt)
L <- t(sweep(Lt, 2, wts, "*"))
L %*% uX
})
# Check estimability:
XX <- model.matrix(terms(model), data=model.frame(model))
# Restore contrast coding here.
nullspaceX <- nullspace(XX)
not_estim <- sapply(Llist, function(L)
any(!is_estimable(L, nullspace = nullspaceX)))
if(any(not_estim))
warning(sprintf("Yates contrast is not uniquely defined for: %s",
paste(names(Llist[not_estim]), collapse = ", ")),
call. = FALSE)
# Make contrast for joint test of contrast among LS-means:
lapply(Llist, function(L) {
(t(get_trts(rownames(L))) %*% L)[, coef_nm, drop=FALSE]
})
}
lmerTest/R/anova_contrasts.R 0000644 0001762 0000144 00000022536 15131137167 015616 0 ustar ligges users #############################################################################
# Copyright (c) 2013-2026 Alexandra Kuznetsova, Per Bruun Brockhoff, and
# Rune Haubo Bojesen Christensen
#
# This file is part of the lmerTest package for R (*lmerTest*)
#
# *lmerTest* is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# *lmerTest* is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# A copy of the GNU General Public License is available at
# and/or
# .
#############################################################################
#
# anova_contrasts.R - functions of the form get_contrasts_xxxx() used by anova
# to get contrasts for model terms.
# Functions in this file:
# Standard contrast functions:
# get_contrast_type3 # type = 3
# get_contrast_type2_unfolded # type = 2
# get_contrast_type1 # type = 1
# get_contrast_marginal # type = marginal
#
# get_contrast_yates # type = yates
# get_contrast_type2 # type = 2b
##############################################
######## get_contrasts_type3
##############################################
#' Contrasts for Type III Tests
#'
#' @param model model object.
#' @param which optional character vector naming terms for which to compute the
#' the contrasts.
#'
#' @return list of contrast matrices.
#' @importFrom stats terms
#' @noRd
#' @keywords internal
get_contrasts_type3 <- function(model, which=NULL) {
term_names <- attr(terms(model), "term.labels")
# Extract original design matrix:
Xorig <- model.matrix(model)
# Assumes Xorig is full (column) rank
if(is.null(which)) {
which <- term_names
# If model has at most one term return Type I contrasts:
if(ncol(Xorig) <= 1L || length(term_names) <= 1L)
return(get_contrasts_type1(model))
} else stopifnot(is.character(which), all(which %in% term_names))
# Extract contrast coding in Xorig:
codings <- unlist(attr(Xorig, "contrast"))
# If only treatment contrasts are used we can just return the type 3
# contrasts for contr.treatment coding:
if(length(codings) > 0 &&
all(is.character(codings)) && all(codings %in% c("contr.treatment")))
return(extract_contrasts_type3(model, X=Xorig))
# otherwise we need to map the type III contrasts to whatever contrast
# coding was used:
X <- get_model_matrix(model, type="remake", contrasts="contr.treatment")
# Ensure that X is full (column) rank:
X <- ensure_full_rank(X, silent=TRUE, test.ans=FALSE)
# Extract contrasts assuming contr.treatment coding:
type3ctr <- extract_contrasts_type3(model, X=X)
map <- zapsmall(ginv(X) %*% Xorig) # Maps between contrast codings
rownames(map) <- colnames(X)
lapply(type3ctr[which], function(L) L %*% map)
}
##############################################
######## get_contrasts_type2_unfolded
##############################################
#' @importFrom stats model.matrix terms
get_contrasts_type2_unfolded <- function(model, which=NULL) {
# Computes the 'genuine type II contrast' for all terms that are
# contained in other terms. For all terms which are not contained in other
# terms, the simple marginal contrast is computed.
X <- model.matrix(model)
Terms <- terms(model)
term_names <- attr(Terms, "term.labels")
if(is.null(which)) {
which <- term_names
# If model has at most one term return Type I contrasts:
if(ncol(X) <= 1L || length(term_names) <= 1L)
return(get_contrasts_type1(model))
} else stopifnot(is.character(which), all(which %in% term_names))
is_contained <- containment(model)
do_marginal <- names(is_contained)[sapply(is_contained, length) == 0L]
do_type2 <- setdiff(term_names, do_marginal)
if(!length(do_marginal)) list() else
Llist <- get_contrasts_marginal(model, which=do_marginal)
if(length(do_type2))
Llist <- c(Llist, get_contrasts_type2(model, which=do_type2))
Llist[term_names]
}
##############################################
######## get_contrasts_type1
##############################################
#' Type I ANOVA table contrasts
#'
#' @param model a model object with \code{terms} and \code{model.matrix} methods.
#'
#' @return List of contrast matrices - one contrast matrix for each model term.
#' @importFrom stats setNames
#' @author Rune Haubo B. Christensen
#'
#' @keywords internal
#' @noRd
get_contrasts_type1 <- function(model) {
terms <- terms(model)
X <- model.matrix(model)
p <- ncol(X)
if(p == 0L) return(list(matrix(numeric(0L), nrow=0L))) # no fixef
if(p == 1L && attr(terms, "intercept")) # intercept-only model
return(list(matrix(numeric(0L), ncol=1L)))
# Compute 'normalized' doolittle factorization of XtX:
L <- if(p == 1L) matrix(1L) else t(doolittle(crossprod(X))$L)
dimnames(L) <- list(colnames(X), colnames(X))
# Determine which rows of L belong to which term:
ind.list <- term2colX(terms, X)[attr(terms, "term.labels")]
lapply(ind.list, function(rows) L[rows, , drop=FALSE])
}
##############################################
######## get_contrasts_marginal
##############################################
#' @importFrom stats model.matrix terms
get_contrasts_marginal <- function(model, which=NULL) {
# Computes marginal contrasts.
#
# No tests of conformity with coefficients are implemented
#
# returns a list
X <- model.matrix(model)
terms <- terms(model)
term_names <- attr(terms, "term.labels")
if(is.null(which)) {
which <- term_names
# If model has at most one term return Type I contrasts:
if(ncol(X) <= 1L || length(term_names) <= 1L)
return(get_contrasts_type1(model))
} else stopifnot(is.character(which), all(which %in% term_names))
## FIXME: test use of 'which' arg.
# Compute map from terms to columns in X and contrasts matrix
term2colX <- term2colX(terms, X)
L <- structure(diag(ncol(X)), dimnames = list(colnames(X), colnames(X)))
# Extract contrast for each term - return as named list:
which <- setNames(as.list(which), which)
lapply(which, function(term) {
L[term2colX[[term]], , drop=FALSE]
})
}
##############################################
######## get_contrasts_yates
##############################################
get_contrasts_yates <- function(model) {
# Is this really type 4?
X <- model.matrix(model)
Terms <- terms(model)
term_names <- attr(Terms, "term.labels")
is_contained <- containment(model)
do_marginal <- names(is_contained)[sapply(is_contained, length) == 0L]
not_marginal <- setdiff(term_names, do_marginal)
# Split not_marginal in do_yates and do_type2:
do_yates <- need_yates(model)
do_type2 <- setdiff(not_marginal, do_yates)
if(!length(do_marginal)) list() else
Llist <- get_contrasts_marginal(model, which=do_marginal)
if(length(do_yates))
Llist <- c(Llist, get_yates_contrast(model, which=do_yates))
if(length(do_type2)) {
data_classes <- attr(terms(model, fixed.only=FALSE), "dataClasses")
Llist <- c(Llist, get_contrasts_type2(model, which=do_type2))
}
Llist[term_names]
}
##############################################
######## get_contrasts_type2
##############################################
get_contrasts_type2 <- function(model, which=NULL) {
# Computes the type 2 contrasts - either for all terms or for those
# included in 'which' (a chr vector naming model terms).
# returns a list
X <- model.matrix(model)
terms <- terms(model)
data_classes <- attr(terms(model, fixed.only=FALSE), "dataClasses")
if(is.null(asgn <- attr(X, "assign")))
stop("design matrix 'X' should have a non-null 'assign' attribute")
term_names <- attr(terms, "term.labels")
if(is.null(which)) {
which <- term_names
# If model has at most one term return Type I contrasts:
if(ncol(X) <= 1L || length(term_names) <= 1L)
return(get_contrasts_type1(model))
} else stopifnot(is.character(which), all(which %in% term_names))
which <- setNames(as.list(which), which)
# Compute containment:
is_contained <- containment(model)
# Compute term asignment list: map from terms to columns in X
has_intercept <- attr(terms, "intercept") > 0
col_terms <- if(has_intercept) c("(Intercept)", term_names)[asgn + 1] else
term_names[asgn[asgn > 0]]
if(!length(col_terms) == ncol(X)) # should never happen.
stop("An error happended when computing Type II contrasts")
term2colX <- split(seq_along(col_terms), col_terms)[unique(col_terms)]
# Compute contrast for each term - return as named list:
lapply(which, function(term) {
# Reorder the cols in X to [, unrelated_to_term, term, contained_in_term]
cols_term <- unlist(term2colX[c(term, is_contained[[term]])])
Xnew <- cbind(X[, -cols_term, drop=FALSE], X[, cols_term, drop=FALSE])
# Compute order of terms in Xnew:
newXcol_terms <- c(col_terms[-cols_term], col_terms[cols_term])
# Compute Type I contrasts for the reordered X:
Lc <- t(doolittle(crossprod(Xnew))$L)
dimnames(Lc) <- list(colnames(Xnew), colnames(Xnew))
# Extract rows for term and get original order of columns:
Lc[newXcol_terms == term, colnames(X), drop=FALSE]
})
}
lmerTest/R/legacy.R 0000644 0001762 0000144 00000014610 15131137167 013650 0 ustar ligges users #############################################################################
# Copyright (c) 2013-2026 Alexandra Kuznetsova, Per Bruun Brockhoff, and
# Rune Haubo Bojesen Christensen
#
# This file is part of the lmerTest package for R (*lmerTest*)
#
# *lmerTest* is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# *lmerTest* is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# A copy of the GNU General Public License is available at
# and/or
# .
#############################################################################
#
# legacy.R - support for lecacy 'merModLmerTest' objects.
# ------- Contents: --------
#
# --- Classes: ---
#
# merModLmerTest
#
# --- methods: ---
#
# anova.merModLmerTest
# summary.merModLmerTest
# ls_means.merModLmerTest
# lsmeansLT.merModLmerTest
# difflsmeans.merModLmerTest
# drop1.merModLmerTest
#
##############################################
######## merModLmerTest class
##############################################
#' Legacy lmerTest representation of Linear Mixed-Effects Models
#'
#' The \code{merModLmerTest} class extends \code{lmerMod} (which extends
#' \code{merMod}) from the \pkg{lme4}-package.
#'
#' @export
#' @keywords internal
#' @author Rune Haubo B. Christensen
#' @importClassesFrom lme4 lmerMod
merModLmerTest <- setClass("merModLmerTest", contains = c("lmerMod"))
##############################################
######## anova method for merModLmerTest
##############################################
#' Methods for Legacy lmerTest Objects
#'
#' Methods are defined for legacy lmerTest objects of class
#' \code{merModLmerTest} generated with \pkg{lmerTest} version \code{< 3.0-0}.
#' These methods are defined by interfacing code for \code{lmerModLmerTest}
#' methods and therefore behaves like these methods do (which may differ from
#' the behavior of \pkg{lmerTest} version \code{< 3.0-0}.)
#'
#' @inheritParams anova.lmerModLmerTest
#' @param ... for the anova method optionally additional models; for other
#' methods see the corresponding \code{lmerModLmerTest} methods for details.
#' @rdname legacy
#' @aliases legacy
#' @keywords internal
#' @author Rune Haubo B. Christensen
#' @export
#' @examples
#' # Load model fits fm1 and fm2 generated with lmerTest version 2.3-37:
#' load(system.file("testdata","legacy_fits.RData", package="lmerTest"))
#'
#' # Apply some methods defined by lmerTest:
#' anova(fm1)
#' summary(fm1)
#' contest(fm1, c(0, 1))
#' contest(fm1, c(0, 1), joint=FALSE)
#' drop1(fm1)
#' ranova(fm1)
#'
#' # lme4-methods also work:
#' fixef(fm1)
#'
#' # Ditto for second model fit:
#' anova(fm2)
#' summary(fm2)
#' ls_means(fm2)
#' difflsmeans(fm2)
anova.merModLmerTest <- function(object, ..., type = c("III", "II", "I", "3", "2", "1"),
ddf = c("Satterthwaite", "Kenward-Roger", "lme4")) {
class(object) <- "lmerMod"
dots <- list(...)
models <- if (length(dots))
sapply(dots, is, "merModLmerTest") | sapply(dots, is, "lmerModLmerTest") |
sapply(dots, is, "merMod") | sapply(dots, is, "lm")
else logical(0)
if(any(models)) return(NextMethod())
df <- match.arg(ddf)
if (df == "lme4")
return(anova(object, ...))
object <- as_lmerModLmerTest(object)
anova(object, ..., type=type, ddf=ddf)
}
##############################################
######## summary method for merModLmerTest
##############################################
#' @rdname legacy
#' @export
summary.merModLmerTest <- function(object, ...,
ddf=c("Satterthwaite", "Kenward-Roger", "lme4")) {
class(object) <- "lmerMod"
object <- as_lmerModLmerTest(object)
summary.lmerModLmerTest(object=object, ..., ddf=ddf)
}
##############################################
######## ls_means method for merModLmerTest
##############################################
#' @rdname legacy
#' @inheritParams ls_means.lmerModLmerTest
#' @export
ls_means.merModLmerTest <- function(model, which=NULL, level=0.95,
ddf=c("Satterthwaite", "Kenward-Roger"),
pairwise=FALSE, ...) {
class(model) <- "lmerMod"
model <- as_lmerModLmerTest(model)
ls_means(model=model, which=which, level=level, ddf=ddf, pairwise=pairwise)
}
##############################################
######## lsmeansLT method for merModLmerTest
##############################################
#' @rdname legacy
#' @export
lsmeansLT.merModLmerTest <- ls_means.merModLmerTest
##############################################
######## difflsmeans method for merModLmerTest
##############################################
#' @rdname legacy
#' @export
difflsmeans.merModLmerTest <- function(model, which=NULL, level=0.95,
ddf=c("Satterthwaite", "Kenward-Roger"), ...) {
ls_means(model, which=which, level=level, ddf=ddf, pairwise = TRUE)
}
##############################################
######## drop1 method for merModLmerTest
##############################################
#' @rdname legacy
#' @inheritParams drop1.lmerModLmerTest
#' @export
drop1.merModLmerTest <- function(object, scope, ddf=c("Satterthwaite", "Kenward-Roger", "lme4"),
force_get_contrasts=FALSE, ...) {
class(object) <- "lmerMod"
object <- as_lmerModLmerTest(object)
drop1(object=object, scope=scope, ddf=ddf, force_get_contrasts=FALSE, ...)
}
##############################################
######## step method for merModLmerTest
##############################################
#' @rdname legacy
#' @inheritParams step.lmerModLmerTest
#' @export
step.merModLmerTest <- function(object, ddf=c("Satterthwaite", "Kenward-Roger"),
alpha.random=0.1, alpha.fixed=0.05,
reduce.fixed=TRUE, reduce.random=TRUE,
keep, ...) {
class(object) <- "lmerMod"
object <- as_lmerModLmerTest(object)
step(object, ddf=ddf, alpha.random=alpha.random, alpha.fixed=alpha.fixed,
reduce.fixed=reduce.fixed, reduce.random=reduce.random,
keep=keep, ...)
}
lmerTest/R/lmerTest.R 0000644 0001762 0000144 00000016566 15131137167 014217 0 ustar ligges users #############################################################################
# Copyright (c) 2013-2026 Alexandra Kuznetsova, Per Bruun Brockhoff, and
# Rune Haubo Bojesen Christensen
#
# This file is part of the lmerTest package for R (*lmerTest*)
#
# *lmerTest* is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# *lmerTest* is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# A copy of the GNU General Public License is available at
# and/or
# .
#############################################################################
#
# lmerTest.R - package documentation page
#' lmerTest: Tests in Linear Mixed Effects Models
#'
#' The \pkg{lmerTest} package provides p-values in type I, II or III
#' \code{anova} and \code{summary}
#' tables for linear mixed models (\code{\link{lmer}} model fits cf. \pkg{lme4})
#' via Satterthwaite's degrees of freedom method; a Kenward-Roger method is also
#' available via the \pkg{pbkrtest} package.
#' Model selection and assessment methods include \code{\link{step}},
#' \code{\link{drop1}}, anova-like tables for random effects (\code{\link{ranova}}),
#' least-square means (LS-means; \code{\link{ls_means}})
#' and tests of linear contrasts of fixed effects (\code{\link{contest}}).
#'
#'
#' @section Key Functions and Methods:
#'
#' \describe{
#' \item{lmer}{overloads \code{lme4::lmer} and produced an object of class
#' \code{lmerModLmerTest} which inherits from \code{lmerMod}. In addition to
#' computing the model (using \code{lme4::lmer}), \code{lmerTest::lmer}
#' computes a couple of components needed for the evaluation of Satterthwaite's
#' denominator degrees of freedom.}
#' \item{anova}{anova method for \code{\link{lmer}} model fits produces
#' type I, II, and III anova tables for fixed-effect terms with
#' Satterthwaite and Kenward-Roger methods for denominator degrees of freedom
#' for F-tests.}
#' \item{summary}{summary method for \code{\link{lmer}} model fits adds
#' denominator degrees of freedom and p-values to the coefficient table.}
#' \item{ranova}{anova-like table of random effects via likelihood ratio tests
#' with methods for both \code{lmerMod} and \code{lmerModLmerTest} objects.
#' \code{ranova} can either test reduction of random-effect terms to simpler
#' structures or it can test removal of entire random-effect terms.}
#' \item{drop1}{F-tests of fixed-effect terms using Satterthwaite or
#' Kenward-Roger methods for denominator degrees of freedom. These 'single term
#' deletion' tables are useful for model selection and tests of marginal terms.
#' Compared to the likelihood ratio tests of \code{lme4::drop1} the F-tests and
#' p-values of \code{lmerTest::drop1} are more accurate and considerably faster
#' since no additional model fitting is required.}
#' \item{contest}{tests of contrasts, i.e. tests of linear functions of the
#' fixed-effect coefficients. A user-friendly interface for tests of contrasts
#' with outputs either as a summary-like table of t-tests or an anova-like table
#' of F-tests (or a list of either). Contrasts can optionally be tested for
#' estimability. Contrasts are allowed to be rank-deficient as the rank is
#' automatically detected and appropriate adjustments made. Methods for
#' \code{lmerModLmerTest} as well as \code{lmerMod} objects -- the latter avoids
#' the Satterthwaite specific computations when the Kenward-Roger method is used.}
#' \item{show_test}{a function which operates on anova tables and LS-means tables
#' makes it possible to see exactly which
#' functions of the coefficients are being tested. This is helpful when
#' differences between type I, II and III anova tables are being considered and
#' discussed.}
#' \item{ls_means}{computes the so-called least-squares means (classical Yates
#' contrasts) as well as pairwise differences of these.}
#' \item{step}{performs automatic backward model selection of fixed and random
#' parts of the linear mixed model.}
#' \item{as_lmerModLmerTest}{an explicit coerce function from class
#' \code{lmerMod} to \code{lmerModLmerTest}.}
#' }
#'
#' @section Details:
#' The computational approach is to let \code{lmerTest::lmer} compute the
#' Hessian and derivatives needed for evaluation of degrees of freedom and
#' t- and F-tests and to store these in the model object. The
#' Hessian and derivatives are therefore computed only once per model fit
#' and reused with each call to \code{anova}, \code{summary}, etc. Evaluation of
#' t and F-tests does not involve model re-fitting.
#'
#' \code{lmerTest::lmer} roughly amounts to calling \code{lme4::lmer} followed by
#' \code{lmerTest::as_lmerModLmerTest}, so for computationally intensive model
#' fits it can make sense to use \code{lme4::lmer} rather than \code{lmerTest::lmer}
#' if computational time is an issue and summary tables and anova tables will
#' not be needed.
#'
#' @author Alexandra Kuznetsova, Per Bruun Brockhoff, Rune Haubo Bojesen Christensen
#'
#' @references
#'
#' Alexandra Kuznetsova, Per B. Brockhoff and Rune H. B. Christensen (2017)
#' lmerTest Package: Tests in Linear Mixed Effects Models.
#' \emph{Journal of Statistical Software}, 82(13), 1--26. doi:10.18637/jss.v082.i13
#'
#'
#' @keywords internal
"_PACKAGE"
#' @name lmerTest-package
#' @aliases lmerTest
#'
#' @examples
#'
#' ## load lmerTest package
#' library(lmerTest)
#'
#' ## Fit linear mixed model to the ham data:
#' fm <- lmer(Informed.liking ~ Gender + Information * Product + (1 | Consumer) +
#' (1 | Consumer:Product), data=ham)
#'
#' ## Summary including coefficient table with p-values for t-statistics using
#' ## Satterthwaite's method for denominator degrees of freedom:
#' summary(fm)
#'
#' ## Type III anova table with p-values for F-tests based on Satterthwaite's
#' ## method:
#' (aov <- anova(fm))
#'
#' ## Inspect the contrast matrix for the Type III test of Product:
#' show_tests(aov, fractions = TRUE)$Product
#'
#' ## Choose type II anova table with Kenward-Roger method for the F-test:
#' \dontrun{
#' if(requireNamespace("pbkrtest", quietly = TRUE))
#' anova(fm, type=2, ddf="Kenward-Roger")
#' }
#'
#' ## Anova-like table of random-effect terms using likelihood ratio tests:
#' ranova(fm)
#'
#' ## F-tests of 'single term deletions' for all marginal terms:
#' drop1(fm)
#'
#' ## Least-Square means and pairwise differences:
#' (lsm <- ls_means(fm))
#' ls_means(fm, which = "Product", pairwise = TRUE)
#'
#' ## ls_means also have plot and as.data.frame methods:
#' \dontrun{
#' plot(lsm, which=c("Product", "Information"))
#' as.data.frame(lsm)
#' ## Inspect the LS-means contrasts:
#' show_tests(lsm, fractions=TRUE)$Product
#' }
#'
#' ## Contrast test (contest) using a custom contrast:
#' ## Here we make the 2-df joint test of the main effects of Gender and Information
#' (L <- diag(length(fixef(fm)))[2:3, ])
#' contest(fm, L = L)
#'
#' ## backward elimination of non-significant effects:
#' step_result <- step(fm)
#'
#' ## Elimination tables for random- and fixed-effect terms:
#' step_result
#'
#' # Extract the model that step found:
#' final_model <- get_model(step_result)
#'
NULL
lmerTest/R/step.R 0000644 0001762 0000144 00000035277 15131137167 013373 0 ustar ligges users #############################################################################
# Copyright (c) 2013-2026 Alexandra Kuznetsova, Per Bruun Brockhoff, and
# Rune Haubo Bojesen Christensen
#
# This file is part of the lmerTest package for R (*lmerTest*)
#
# *lmerTest* is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# *lmerTest* is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# A copy of the GNU General Public License is available at
# and/or
# .
#############################################################################
#
# step.R - implementation of backward elimination for lmerModLmerTest objects
# ------- Contents: --------
#
# --- Generics: ---
#
# step
# get_model
#
# --- methods: ---
#
# step.lmerModLmerTest
# step.default
# get_model.step_list
# print.step_list
# plot.step_list
#
# --- other exported function: ---
#
# --- utility functions: ---
#
# ran_redTable
# fix_redTable
# reduce_random
# ranova_lm
# reduce_fixed
#
##############################################
######## step()
##############################################
#' Generic Step Function
#'
#' Generic step function with default method \code{stats::step}. This
#' construction ensures that \code{stats::step} still works on \code{lm}
#' objects etc. after loading the \pkg{lmerTest} package.
#'
#' @param object a model object.
#' @param ... currently not used.
#'
#' @author Rune Haubo B. Christensen
#' @seealso \code{\link[=step.lmerModLmerTest]{step}}
#' @export
#' @keywords internal
step <- function(object, ...) UseMethod("step")
##############################################
######## step.default()
##############################################
#' @rdname step
#' @export
#' @keywords internal
step.default <- function(object, ...) stats::step(object, ...)
##############################################
######## step.lmerModLmerTest()
##############################################
#' Backward Elimination for Linear Mixed Models
#'
#' Backward elimination of random-effect terms followed by backward elimination
#' of fixed-effect terms in linear mixed models.
#'
#' Tests of random-effects are performed using \code{\link{ranova}} (using
#' \code{reduce.terms = TRUE}) and tests of fixed-effects are performed using
#' \code{\link[=drop1.lmerModLmerTest]{drop1}}.
#'
#' The step method for \code{\link{lmer}} fits has a print method.
#'
#' @param object a fitted model object. For the \code{lmerModLmerTest} method
#' an \code{\link{lmer}} model fit (of class \code{"lmerModLmerTest"}.)
#' @param ddf the method for computing the denominator degrees of freedom and
#' F-statistics. \code{ddf="Satterthwaite"} (default) uses Satterthwaite's method;
#' \code{ddf="Kenward-Roger"} uses Kenward-Roger's method.
#' @param alpha.random alpha for random effects elimination
#' @param alpha.fixed alpha for fixed effects elimination
#' @param reduce.fixed reduce fixed effect structure? \code{TRUE} by default.
#' @param reduce.random reduce random effect structure? \code{TRUE} by default.
#' @param keep an optional character vector of fixed effect terms which should
#' not be considered for eliminated. Valid terms are given by
#' \code{attr(terms(object), "term.labels")}. Terms that are marginal to terms
#' in keep will also not be considered for eliminations.
#' @param ... currently not used.
#'
#' @return \code{step} returns a list with elements \code{"random"} and
#' \code{"fixed"} each
#' containing anova-like elimination tables. The \code{"fixed"} table is
#' based on \code{drop1} and the \code{"random"} table is
#' based on \code{ranova} (a \code{drop1}-like table for random effects). Both
#' tables have a column \code{"Eliminated"} indicating the order in which terms
#' are eliminated from the model with zero (\code{0}) indicating that the term
#' is not eliminated from the model.
#'
#' The \code{step} object also contains the final model as an attribute which
#' is extractable with \code{get_model()}.
#' @seealso \code{\link[=drop1.lmerModLmerTest]{drop1}} for tests of marginal
#' fixed-effect terms and \code{\link{ranova}} for a
#' \code{\link[=drop1.lmerModLmerTest]{drop1}}-like table of reduction of
#' random-effect terms.
#' @author Rune Haubo B. Christensen and Alexandra Kuznetsova
#' @export
#' @examples
#'
#' # Fit a model to the ham dataset:
#' fm <- lmer(Informed.liking ~ Product*Information+
#' (1|Consumer) + (1|Product:Consumer)
#' + (1|Information:Consumer), data=ham)
#'
#' # Backward elimination using terms with default alpha-levels:
#' (step_res <- step(fm))
#' final <- get_model(step_res)
#' anova(final)
#'
#' \dontrun{
#' # Fit 'big' model:
#' fm <- lmer(Informed.liking ~ Product*Information*Gender*Age +
#' + (1|Consumer) + (1|Consumer:Product) +
#' (1|Consumer:Information), data=ham)
#' step_fm <- step(fm)
#' step_fm # Display elimination results
#' final_fm <- get_model(step_fm)
#' }
#'
step.lmerModLmerTest <- function(object, ddf=c("Satterthwaite", "Kenward-Roger"),
alpha.random=0.1, alpha.fixed=0.05,
reduce.fixed=TRUE, reduce.random=TRUE,
keep, ...) {
# Check for and warn about deprecated arguments:
ignored <- c("type", "fixed.calc", "lsmeans.calc", "difflsmeans.calc",
"test.effs")
dots <- list(...)
for(nm in ignored) if(any(pmatch(names(dots), nm, nomatch = 0)))
warning(paste0("Argument '", nm, "' is deprecated and ignored."))
if(any(pmatch(names(dots), "keep.effs", nomatch = 0)))
warning("Argument 'keep.effs' is deprecated: use 'keep' instead")
# reduce random and fixed parts?
if(!reduce.random) alpha.random <- 1
if(!reduce.fixed) alpha.fixed <- 1
if(missing(keep)) keep <- character(0L)
# Reduce random and fixed parts:
red_random <- eval.parent(reduce_random(object, alpha=alpha.random))
model <- attr(red_random, "model")
# 'model' may be 'lmerMod' rather than 'lmerModLmerTest', so we coerce to
# 'lmerModLmerTest' if required:
if(inherits(model, "lmerMod") && !inherits(model, "lmerModLmerTest"))
model <- as_lmerModLmerTest(model)
stopifnot(inherits(model, "lmerModLmerTest") || inherits(model, "lm"))
red_fixed <- eval.parent(reduce_fixed(model, ddf=ddf,
alpha=alpha.fixed, keep=keep))
# get 'reduction' tables:
step_random <- ran_redTable(red_random)
step_fixed <- fix_redTable(red_fixed)
# organize results and return:
step_list <- list(random=step_random, fixed=step_fixed)
class(step_list) <- "step_list"
attr(step_list, "model") <- attr(red_fixed, "model")
attr(step_list, "drop1") <- attr(red_fixed, "drop1")
step_list
}
##############################################
######## get_model()
##############################################
#' Extract Model from an Object
#'
#' @param x an object.
#' @param ... currently not used.
#'
#' @seealso \code{\link{get_model.step_list}}
#' @export
#' @keywords internal
get_model <- function(x, ...) UseMethod("get_model")
##############################################
######## get_model.step_list()
##############################################
#' @rdname step.lmerModLmerTest
#' @param x a step object.
#' @export
get_model.step_list <- function(x, ...) {
attr(x, "model")
}
##############################################
######## print.step_list()
##############################################
#' @importFrom stats formula
#' @export
#' @keywords internal
print.step_list <- function(x, digits = max(getOption("digits") - 2L, 3L),
signif.stars = getOption("show.signif.stars"),
...) {
print(x[["random"]])
cat("\n")
print(x[["fixed"]])
cat("\nModel found:", deparse2(formula(attr(x, "model"))), sep="\n")
invisible(x)
}
##############################################
######## plot.step_list()
##############################################
#' Plot LS-means for Backward Reduced Model
#'
#' Computes the LS-means for the final backward reduced model and passes these
#' to \code{\link{plot.ls_means}}.
#'
#' Error bars are confidence intervals - the default is 95% CI but the confidence
#' level can be changed.
#'
#' @param x a \code{step_list} object; the result of running
#' \code{\link[=step.lmerModLmerTest]{step}}.
#' @param y not used and ignored with a warning.
#' @param which optional character vector naming factors for which LS-means should
#' be plotted. If \code{NULL} (default) plots for all LS-means are generated.
#' @param mult if \code{TRUE} and there is more than one term for which to plot
#' LS-means the plots are organized in panels with \code{facet_wrap}.
#' @param pairwise pairwise differences of LS-means?
#' @param level confidence level.
#' @param ddf denominator degree of freedom method.
#' @param ... currently not used.
#'
#' @export
#' @author Rune Haubo B. Christensen and Alexandra Kuznetsova
#' @seealso \code{\link[=ls_means.lmerModLmerTest]{ls_means}} and
#' \code{\link{plot.ls_means}}
#' @keywords internal
#' @examples
#'
#' \dontrun{
#' # Fit example model:
#' tv <- lmer(Sharpnessofmovement ~ TVset * Picture +
#' (1 | Assessor:TVset) + (1 | Assessor:Picture) +
#' (1 | Assessor:Picture:TVset) + (1 | Repeat) + (1 | Repeat:Picture) +
#' (1 | Repeat:TVset) + (1 | Repeat:TVset:Picture) + (1 | Assessor),
#' data = TVbo)
#'
#' # Backward reduce the model:
#' (st <- step(tv)) # takes ~10 sec to run
#'
#' # Pairwise comparisons of LS-means for Picture and TVset:
#' plot(st, which=c("Picture", "TVset"), pairwise = TRUE)
#' }
#'
plot.step_list <- function(x, y=NULL, which=NULL, pairwise=FALSE, mult=TRUE,
level=0.95, ddf=c("Satterthwaite", "Kenward-Roger"),
...) {
plot(ls_means(get_model(x), pairwise=pairwise, level=level, ddf=ddf),
y=y, which=which, mult=mult)
}
##############################################
######## step utility functions below
##############################################
ran_redTable <- function(table) {
aov <- attr(table, "ranova")[-1, , drop=FALSE]
stopifnot(nrow(table) >= 1)
tab <- rbind(cbind("Eliminated"=c(NA_real_, seq_len(nrow(table)-1)), table),
cbind("Eliminated"=rep(0, nrow(aov)), aov))
class(tab) <- c("anova", "data.frame")
attr(tab, "heading") <- "Backward reduced random-effect table:\n"
tab
}
fix_redTable <- function(table) {
aov <- attr(table, "drop1")
tab <- rbind(cbind("Eliminated"=seq_len(nrow(table)), table),
cbind("Eliminated"=rep(0, nrow(aov)), aov))
class(tab) <- c("anova", "data.frame")
attr(tab, "heading") <- "Backward reduced fixed-effect table:"
if(!is.null(ddf <- attr(table, "ddf"))) {
ddf <- switch(ddf, "Satterthwaite" = "Satterthwaite",
"Kenward-Roger" = "Kenward-Roger")
attr(tab, "heading") <-
c(attr(tab, "heading"), paste("Degrees of freedom method:", ddf, "\n"))
}
tab
}
#' @importFrom stats formula update
#' @importFrom lme4 getME
reduce_random <- function(model, alpha=0.1) {
ran <- ranova(model)
reduced <- ran[1L, ]
newfit <- model
newform <- formula(model)
forms <- attr(ran, "formulae")
pvals <- ran[-1, "Pr(>Chisq)"]
above <- (!is.na(pvals) & pvals > alpha)
while(any(above)) {
remove <- which.max(pvals)
newform <- forms[[remove]]
reduced <- rbind(reduced, ran[1 + remove, ])
if(!has_ranef(newform)) { # If no random effects: fit with lm
reml <- getME(newfit, "is_REML")
lm_call <- get_lm_call(newfit, formula=newform)
newfit <- eval.parent(as.call(lm_call))
ran <- ranova_lm(newfit, REML=reml)
break
}
newfit <- eval.parent(update(newfit, formula. = newform))
# newfit <- update(newfit, formula = newform)
ran <- ranova(newfit)
forms <- attr(ran, "formulae")
pvals <- ran[-1, "Pr(>Chisq)"]
above <- (!is.na(pvals) & pvals > alpha)
}
attr(reduced, "model") <- newfit
attr(reduced, "formula") <- newform
attr(reduced, "ranova") <- ran
reduced
}
ranova_lm <- function(model, REML=TRUE) {
# Compute a ranova table for an lm-object only containing a '' row
# and the right header.
aov <- mk_LRtab(get_logLik(model, REML=REML))
rownames(aov) <- ""
head <- c("ANOVA-like table for random-effects: Single term deletions",
"\nModel:", deparse2(formula(model)))
# attr(aov, "formulae") <- new_forms
structure(aov, heading = head, class = c("anova", "data.frame"))
}
#' @importFrom stats nobs formula
reduce_fixed <- function(model, ddf=c("Satterthwaite", "Kenward-Roger"), alpha=0.05,
keep) {
if(missing(keep)) keep <- character(0L)
stopifnot(is.character(keep))
term_names <- attr(terms(model), "term.labels")
# Test validity of
if(!all(keep %in% term_names)) {
offending <- paste(setdiff(keep, term_names), collapse = " ")
txt1 <- sprintf("Invalid 'keep' ignored: %s.", offending)
txt2 <- sprintf("Valid terms are: %s.", paste(term_names, collapse = " "))
warning(paste(txt1, txt2, sep="\n"), call. = FALSE)
}
ddf <- match.arg(ddf)
aov <- if(inherits(model, "lmerMod")) drop1.lmerModLmerTest(model, ddf=ddf) else
drop1(model, test="F")[-1L, , drop=FALSE]
reduced <- aov[0L, ]
newfit <- model
newform <- orig_form <- formula(model)
nobs_model <- nobs(model)
terms <- rownames(aov)
consider <- setdiff(terms, keep)
pvals <- aov[consider, "Pr(>F)"]
above <- (!is.na(pvals) & pvals > alpha)
if(any(above)) while(any(above)) {
remove <- consider[which.max(pvals)]
newform <- rm_complete_terms(remove, orig_form)[[1L]]
reduced <- rbind(reduced, aov[remove, ])
newfit <- eval.parent(update(newfit, formula = newform))
# newfit <- update(newfit, formula = newform)
nobs_newfit <- nobs(newfit)
if(all(is.finite(c(nobs_model, nobs_newfit))) && nobs_newfit != nobs_model)
stop("number of rows in use has changed: remove missing values?",
call.=FALSE)
aov <- if(inherits(newfit, "lmerMod")) drop1.lmerModLmerTest(newfit, ddf=ddf) else
drop1(newfit, test="F")[-1L, , drop=FALSE]
# aov <- drop1(newfit)
orig_form <- formula(newfit)
terms <- rownames(aov)
consider <- setdiff(terms, keep)
pvals <- aov[consider, "Pr(>F)"]
above <- (!is.na(pvals) & pvals > alpha)
}
attr(reduced, "model") <- newfit
attr(reduced, "formula") <- newform
attr(reduced, "drop1") <- aov
attr(reduced, "ddf") <- if(inherits(model, "lmerMod")) ddf else NULL
reduced
}
lmerTest/R/drop1.R 0000644 0001762 0000144 00000016216 15131137167 013435 0 ustar ligges users #############################################################################
# Copyright (c) 2013-2026 Alexandra Kuznetsova, Per Bruun Brockhoff, and
# Rune Haubo Bojesen Christensen
#
# This file is part of the lmerTest package for R (*lmerTest*)
#
# *lmerTest* is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# *lmerTest* is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# A copy of the GNU General Public License is available at
# and/or
# .
#############################################################################
#
# drop1.R - drop1 method for lmerModLmerTest objects
# ------- Contents: --------
#
# drop1.lmerModLmerTest
#
# --- Utility functions: ---
#
# get_Ldiffmat
# get_Ldiffmat2
#
##############################################
######## drop1.lmerModLmerTest
##############################################
#' Drop Marginal Terms from Model
#'
#' Computes the F-test for all marginal terms, i.e. terms that can be dropped
#' from the model while respecting the hierarchy of terms in the model.
#'
#' Simple marginal contrasts are used for all marginal terms unless the design
#' matrix is rank deficient. In that case (and if \code{force_get_contrasts} is
#' \code{TRUE}) the contrasts (i.e. restriction matrices on the design matrix
#' of the full model) are computed by comparison of the design matrices
#' for full and restricted models. The set of marginal terms considered for
#' dropping are computed using \code{drop.scope(terms(object))}.
#'
#' Since all tests are based on tests of contrasts in the full model, no
#' models are being (re)fitted.
#'
#' @param object an \code{\link{lmer}} model fit (of class
#' \code{"lmerModLmerTest"}.)
#' @param scope optional character vector naming terms to be dropped from the
#' model. Note that only marginal terms can be dropped. To see which terms are
#' marginal, use \code{drop.scope(terms(object))}.
#' @param ddf the method for computing the denominator degrees of freedom and
#' F-statistics. \code{ddf="Satterthwaite"} (default) uses Satterthwaite's method;
#' \code{ddf="Kenward-Roger"} uses Kenward-Roger's method.
#' \code{ddf = "lme4"} returns the \code{drop1} table for \code{merMod} objects
#' as defined in package \pkg{lme4}.
#' @param force_get_contrasts enforce computation of contrast matrices by a
#' method in which the design matrices for full and restricted models are
#' compared.
#' @param ... currently not used.
#'
#' @author Rune Haubo B. Christensen
#' @seealso \code{\link{ranova}} for tests of marginal random terms.
#' @return An anova-like table with F-tests of marginal terms.
#' @export
#'
#' @importFrom stats drop1 drop.scope terms formula
#' @importFrom reformulas nobars
#'
#' @examples
#'
#' # Basic usage:
#' fm <- lmer(angle ~ recipe + temp + (1|recipe:replicate), cake)
#' drop1(fm) # Using Satterthwaite degrees of freedom
#' if(requireNamespace("pbkrtest", quietly = TRUE))
#' drop1(fm, ddf="Kenward-Roger") # Alternative DenDF and F-test method
#' drop1(fm, ddf="lme4", test="Chi") # Asymptotic Likelihood ratio tests
#'
#' # Consider a rank-deficient design matrix:
#' fm <- lmer(angle ~ recipe + temp + temperature + (1|recipe:replicate), cake)
#' # Here temp accounts for the linear effect of temperature, and
#' # temperature is an (ordered) factor that accounts for the remaining
#' # variation between temperatures (4 df).
#' drop1(fm)
#' # While temperature is in the model, we cannot test the effect of dropping
#' # temp. After removing temperature we can test the effect of dropping temp:
#' drop1(lmer(angle ~ recipe + temp + (1|recipe:replicate), cake))
#'
#' # Polynomials:
#' # Note that linear terms should usually not be dropped before squared terms.
#' # Therefore 'Days' should not be dropped before 'I(Days^2)' despite it being
#' # tested here:
#' fm <- lmer(Reaction ~ Days + I(Days^2) + (Days|Subject), sleepstudy)
#' drop1(fm)
#' # Using poly() provides a test of the whole polynomial structure - not a
#' # separate test for the highest order (squared) term:
#' fm <- lmer(Reaction ~ poly(Days, 2) + (Days|Subject), sleepstudy)
#' drop1(fm)
#'
drop1.lmerModLmerTest <- function(object, scope, ddf=c("Satterthwaite", "Kenward-Roger", "lme4"),
force_get_contrasts=FALSE, ...) {
ddf <- match.arg(ddf)
if(ddf == "lme4") return(NextMethod())
marg_terms <- drop.scope(terms(object))
if(missing(scope)) scope <- marg_terms else {
if(length(scope) == 0 || !is.character(scope))
stop("'scope' should be a character vector naming terms to be dropped")
if(!all(scope %in% marg_terms))
stop("Only marginal terms can be dropped from the model")
}
# Get contrasts for marginal terms:
X <- model.matrix(object)
Llist <- get_contrasts_marginal(object)
if(length(scope)) {
Llist <- Llist[scope] # retain contrasts for terms in scope
if(!is.null(attr(X, "col.dropped")) || force_get_contrasts) {
# Compute L directly if model is rank deficient or force_get_contrasts is TRUE:
orig_form <- formula(object)
new_forms <- lapply(rm_complete_terms(scope, orig_form), nobars)
# Compute list of contrast matrices as 'diffs' to orig. X:
Llist <- if(!length(new_forms)) list() else
lapply(new_forms, function(form) {
suppressWarnings(x <- model.matrix(form[-2], data=model.frame(object),
contrasts.arg = attr(X, "contrasts")))
L <- get_Ldiffmat2(x, X) # L may be length 0 if x == X (rank-deficint fits.)
if(!length(L)) rep(NA_real_, ncol(X)) else L
})
}
}
# Compute anova-like table:
aov <- rbindall(lapply(Llist, function(L) contestMD(object, L, ddf = ddf)))
# Format results:
method <- switch(ddf, "Satterthwaite" = "Satterthwaite's",
"Kenward-Roger" = "Kenward-Roger's")
attr(aov, "heading") <-
c(paste("Single term deletions using", method, "method:"),
"\nModel:", deparse2(formula(object)))
attr(aov, "hypotheses") <- Llist
attr(aov, "ddf") <- ddf
class(aov) <- c("anova", "data.frame")
aov
}
get_Ldiffmat <- function(A0, A) {
Rank <- function(X) qr(X)$rank
Q <- qr.Q(qr(cbind(A0, A)))
rA0 <- Rank(A0)
rA <- Rank(A)
set <- if(rA0 < rA) (rA0+1):rA else numeric(0L)
Q2 <- Q[, set, drop=FALSE]
L <- t(Q2) %*% A
L <- t(qr.Q(qr(t(L)))) # Orthonormalize contrast
L
}
#' @importFrom stats .lm.fit resid
get_Ldiffmat2 <- function(X0, X) {
# X : design matrix for the full model
# X0: design matrix for the restricted model
# R is the residual of the orthogonal projection of X on X0, thus
# R is orthogonal to X0 and a subspace of X, and
# Lt is a restriction matrix on X.
R <- resid(.lm.fit(x=X0, y=X))
R <- R[, colSums(abs(R)) > 1e-8]
Lt <- crossprod(X, R)
Lt[] <- zapsmall(qr.Q(qr(Lt))) # orthonormalize contrasts
t(Lt)
}
lmerTest/R/contest.R 0000644 0001762 0000144 00000060757 15131137167 014100 0 ustar ligges users #############################################################################
# Copyright (c) 2013-2026 Alexandra Kuznetsova, Per Bruun Brockhoff, and
# Rune Haubo Bojesen Christensen
#
# This file is part of the lmerTest package for R (*lmerTest*)
#
# *lmerTest* is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# *lmerTest* is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# A copy of the GNU General Public License is available at
# and/or
# .
#############################################################################
#
# contest.R - contrast tests using Satterthwaites or KR ddf
# ------- Contents: --------
#
# --- Generics: ---
#
# contest
# contest1D
# contestMD
#
# --- methods: ---
#
# contest.lmerModLmerTest
# contest1D.lmerModLmerTest
# contestMD.lmerModLmerTest
# contest.lmerMod
# contest1D.lmerMod
# contestMD.lmerMod
#
# --- other exported function: ---
#
# calcSatterth
#
# --- utility functions: ---
#
# get_KR1D
# get_Fstat_ddf
##############################################
######## Generics for contest, contest1D and contestMD
##############################################
#' Generic Contrast Test Functions
#'
#' Generic functions for tests contrasts.
#'
#' @param L a contrast vector or matrix.
#' @param model a model object.
#' @param ... additional arguments passed to methods.
#'
#' @export
#' @author Rune Haubo B. Christensen
#' @seealso contest methods for \code{\link{lmer}} objects:
#' \code{\link[=contest.lmerModLmerTest]{contest}},
#' \code{\link[=contest1D.lmerModLmerTest]{contest1D}}, and
#' \code{\link[=contestMD.lmerModLmerTest]{contestMD}}.
#' @keywords internal
contest <- function(model, L, ...) UseMethod("contest")
#' @rdname contest
#' @export
contest1D <- function(model, L, ...) UseMethod("contest1D")
#' @rdname contest
#' @export
contestMD <- function(model, L, ...) UseMethod("contestMD")
##############################################
######## contest()
##############################################
#' Test of Contrasts
#'
#' Tests of vector or matrix contrasts for \code{\link{lmer}} model fits.
#'
#' If the design matrix is rank deficient, \code{lmer} drops columns for the
#' aliased coefficients from the design matrix and excludes the corresponding
#' aliased coefficients from \code{fixef(model)}. When estimability is checked
#' the original rank-deficient design matrix is recontructed and therefore
#' \code{L} contrast vectors need to include elements for the aliased
#' coefficients. Similarly when \code{L} is a matrix, its number of columns
#' needs to match that of the reconstructed rank-deficient design matrix.
#'
#' @param L a contrast vector or matrix or a list of these.
#' The \code{length}/\code{ncol} of each contrasts should equal
#' \code{length(fixef(model))}.
#' @param model a model object fitted with \code{lmer} from package
#' \pkg{lmerTest}, i.e., an object of class \code{\link{lmerModLmerTest}}.
#' @param rhs right-hand-side of the statistical test, i.e. the hypothesized
#' value (a numeric scalar).
#' @param ddf the method for computing the denominator degrees of freedom.
#' \code{ddf="Kenward-Roger"} uses Kenward-Roger's method.
#' @param confint include columns for lower and upper confidence limits? Applies
#' when \code{joint} is \code{FALSE}.
#' @param level confidence level.
#' @param joint make an F-test of potentially several contrast vectors? If
#' \code{FALSE} single DF t-tests are applied to each vector or each row of
#' contrasts matrices.
#' @param collect collect list of tests in a matrix?
#' @param check_estimability check estimability of contrasts? Only single DF
#' contrasts are checked for estimability thus requiring \code{joint = FALSE} to
#' take effect. See details section for necessary adjustments to \code{L} when
#' estimability is checked with rank deficient design matrices.
#' @param ... passed to \code{\link{contestMD}}.
#'
#' @return a \code{data.frame} or a list of \code{data.frame}s.
#' @export
#' @seealso \code{\link[=contestMD.lmerModLmerTest]{contestMD}} for multi
#' degree-of-freedom contrast tests,
#' and \code{\link[=contest1D.lmerModLmerTest]{contest1D}} for tests of
#' 1-dimensional contrasts.
#' @author Rune Haubo B. Christensen
#' @importFrom stats coef model.matrix setNames
#'
#' @examples
#'
#' data("sleepstudy", package="lme4")
#' fm <- lmer(Reaction ~ Days + I(Days^2) + (1|Subject) + (0+Days|Subject),
#' sleepstudy)
#' # F-test of third coeffcients - I(Days^2):
#' contest(fm, c(0, 0, 1))
#' # Equivalent t-test:
#' contest(fm, L=c(0, 0, 1), joint=FALSE)
#' # Test of 'Days + I(Days^2)':
#' contest(fm, L=diag(3)[2:3, ])
#' # Other options:
#' contest(fm, L=diag(3)[2:3, ], joint=FALSE)
#' contest(fm, L=diag(3)[2:3, ], joint=FALSE, collect=FALSE)
#'
#' # Illustrate a list argument:
#' L <- list("First"=diag(3)[3, ], "Second"=diag(3)[-1, ])
#' contest(fm, L)
#' contest(fm, L, collect = FALSE)
#' contest(fm, L, joint=FALSE, confint = FALSE)
#' contest(fm, L, joint=FALSE, collect = FALSE, level=0.99)
#'
#' # Illustrate testing of estimability:
#' # Consider the 'cake' dataset with a missing cell:
#' data("cake", package="lme4")
#' cake$temperature <- factor(cake$temperature, ordered=FALSE)
#' cake <- droplevels(subset(cake, temperature %in% levels(cake$temperature)[1:2] &
#' !(recipe == "C" & temperature == "185")))
#' with(cake, table(recipe, temperature))
#' fm <- lmer(angle ~ recipe * temperature + (1|recipe:replicate), cake)
#' fixef(fm)
#' # The coefficient for recipeC:temperature185 is dropped:
#' attr(model.matrix(fm), "col.dropped")
#' # so any contrast involving this coefficient is not estimable:
#' Lmat <- diag(6)
#' contest(fm, Lmat, joint=FALSE, check_estimability = TRUE)
#'
contest.lmerModLmerTest <- function(model, L, rhs=0, joint=TRUE, collect=TRUE, confint=TRUE,
level=0.95, check_estimability=FALSE,
ddf=c("Satterthwaite", "Kenward-Roger", "lme4"), ...) {
ddf <- match.arg(ddf)
if(!(is_list <- is.list(L))) L <- list(L)
if(joint) {
res <- lapply(L, function(l) contestMD(model, l, ddf=ddf, rhs=rhs, ...))
} else { # joint is FALSE:
if(check_estimability) {
coef_nm <- if(inherits(model, "lmerMod")) colnames(model.matrix(model)) else
names(coef(model))[!is.na(coef(model))]
XX <- get_model_matrix(model, type="remake", contrasts="restore")
keep_coef <- match(coef_nm, colnames(XX), 0L)
nullspaceX <- nullspace(XX)
}
res <- lapply(L, function(l) {
if(!is.matrix(l)) l <- matrix(l, ncol=length(l))
if(check_estimability) {
if(ncol(l) != ncol(XX))
stop(sprintf("Contrast has length/ncol %i, expecting length/ncol %i when checking estimability.",
ncol(l), ncol(XX)))
estim <- is_estimable(l, nullspace = nullspaceX)
l[!estim, ] <- NA_real_ # set unestimable contrasts to NA
l <- l[, keep_coef, drop=FALSE] # drop aliased coefs
}
l <- lapply(setNames(1:nrow(l), rownames(l)), function(i) l[i, ])
rbindall(lapply(l, function(ll)
contest1D(model, ll, rhs=rhs, ddf=ddf, confint=confint,
level=level)))
})
}
if(collect) rbindall(res) else res
}
##############################################
######## contest1D()
##############################################
#' Contrast Tests in 1D
#'
#' Compute the test of a one-dimensional (vector) contrast in a
#' linear mixed model fitted with lmer from package \pkg{lmerTest}.
#' The contrast should specify a linear function of the
#' mean-value parameters, beta. The Satterthwaite or Kenward-Roger method is
#' used to compute the (denominator) df for the t-test.
#'
#' The t-value and associated p-value is for the hypothesis
#' \eqn{L' \beta = \mathrm{rhs}}{L' \beta = rhs} in which rhs may be non-zero
#' and \eqn{\beta} is \code{fixef(model)}.
#' The estimated value (\code{"Estimate"}) is \eqn{L' \beta} with associated
#' standard error and (optionally) confidence interval.
#'
#' @param L a numeric (contrast) vector of the same length as
#' \code{fixef(model)}.
#' @param model a model object fitted with \code{lmer} from package
#' \pkg{lmerTest}, i.e., an object of class \code{\link{lmerModLmerTest}}.
#' @param rhs right-hand-side of the statistical test, i.e. the hypothesized
#' value (a numeric scalar).
#' @param ddf the method for computing the denominator degrees of freedom.
#' \code{ddf="Kenward-Roger"} uses Kenward-Roger's method.
#' @param confint include columns for lower and upper confidence limits?
#' @param level confidence level.
#' @param ... currently not used.
#'
#' @return A \code{data.frame} with one row and columns with \code{"Estimate"},
#' \code{"Std. Error"}, \code{"t value"}, \code{"df"}, and \code{"Pr(>|t|)"}
#' (p-value). If \code{confint = TRUE} \code{"lower"} and \code{"upper"} columns
#' are included before the p-value column.
#' @export
#' @seealso \code{\link[=contest.lmerModLmerTest]{contest}} for a flexible
#' and general interface to tests of contrasts among fixed-effect parameters.
#' \code{\link[=contestMD.lmerModLmerTest]{contestMD}} is also available as a
#' direct interface for tests of multi degree-of-freedom contrast.
#' @author Rune Haubo B. Christensen
#' @importFrom stats pt
#'
#' @examples
#'
#' # Fit model using lmer with data from the lme4-package:
#' data("sleepstudy", package="lme4")
#' fm <- lmer(Reaction ~ Days + (1 + Days|Subject), sleepstudy)
#'
#' # Tests and CI of model coefficients are obtained with:
#' contest1D(fm, c(1, 0), confint=TRUE) # Test for Intercept
#' contest1D(fm, c(0, 1), confint=TRUE) # Test for Days
#'
#' # Tests of coefficients are also part of:
#' summary(fm)
#'
#' # Illustrate use of rhs argument:
#' contest1D(fm, c(0, 1), confint=TRUE, rhs=10) # Test for Days-coef == 10
#'
#'
contest1D.lmerModLmerTest <- function(model, L, rhs=0,
ddf=c("Satterthwaite", "Kenward-Roger"),
confint=FALSE, level = 0.95, ...) {
mk_ttable <- function(estimate, se, ddf) {
tstat <- (estimate - rhs)/se
pvalue <- 2 * pt(abs(tstat), df = ddf, lower.tail = FALSE)
if(confint) {
ci <- waldCI(estimate, se, ddf, level=level)
data.frame("Estimate"=estimate, "Std. Error"=se, "df"=ddf,
"t value"=tstat,
lower=unname(ci[, "lower"]), upper=unname(ci[, "upper"]),
"Pr(>|t|)"=pvalue, check.names=FALSE)
} else
data.frame("Estimate"=estimate, "Std. Error"=se, "df"=ddf,
"t value"=tstat, "Pr(>|t|)"=pvalue, check.names=FALSE)
}
method <- match.arg(ddf)
if(is.matrix(L)) L <- drop(L)
stopifnot(is.numeric(L), length(L) == length(model@beta),
is.numeric(rhs), length(rhs) == 1L)
if(length(L) == 0L) {
o <- numeric(0L)
return(mk_ttable(o, o, o))
}
if(any(is.na(L))) return(mk_ttable(NA_real_, NA_real_, NA_real_))
estimate <- sum(L * model@beta) # contrast estimate
if(method == "Kenward-Roger") { # Handle KR method:
ans <- get_KR1D(model, L) # get var(contrast) and ddf
if(!ans$error) {
return(mk_ttable(estimate=estimate, se=sqrt(ans$var_con), ddf=ans$ddf))
} else {
warning("Unable to compute Kenward-Roger t-test: using Satterthwaite instead",
call.=FALSE)
if(!inherits(model, "lmerModLmerTest")) model <- as_lmerModLmerTest(model)
}
} # method == "Satterthwaite" proceeds:
var_con <- qform(L, model@vcov_beta) # variance of contrast
# Compute denominator DF:
grad_var_con <-
vapply(model@Jac_list, function(x) qform(L, x), numeric(1L)) # = {L' Jac L}_i
satt_denom <- qform(grad_var_con, model@vcov_varpar) # g'Ag
ddf <- drop(2 * var_con^2 / satt_denom) # denominator DF
# return t-table:
mk_ttable(estimate, sqrt(var_con), ddf)
}
get_KR1D <- function(model, L) {
# Compute var(contrast) and ddf using KR-method via the pbkrtest package
if(!getME(model, "is_REML"))
stop("Kenward-Roger's method is only available for REML model fits",
call.=FALSE)
if(!requireNamespace("pbkrtest", quietly = TRUE))
stop("pbkrtest package required for Kenward-Roger's method",
call.=FALSE)
## Add warning as faulty results have been seen with R version 3.3.2 cf https://github.com/hojsgaard/pbkrtest/issues/1
## It may also be related to the Matrix version: an unstated dependency in pbkrtest.
if(getRversion() < "3.3.2")
warning("Kenward-Roger may give faulty results with R <= 3.3.2")
vcov_beta_adj <- try(pbkrtest::vcovAdj(model), silent=TRUE) # Adjusted vcov(beta)
if(inherits(vcov_beta_adj, "try-error")) return(list(error=TRUE))
var_con_adj <- qform(L, as.matrix(vcov_beta_adj)) # variance of contrast
ddf <- try(pbkrtest::Lb_ddf(L=L, V0=vcov(model),
Vadj=vcov_beta_adj), silent=TRUE) # vcov_beta_adj need to be dgeMatrix!
if(inherits(ddf, "try-error")) return(list(error=TRUE))
list(var_con=var_con_adj, ddf=ddf, error=FALSE)
}
##############################################
######## contestMD()
##############################################
#' Multiple Degrees-of-Freedom Contrast Tests
#'
#' Compute the multi degrees-of-freedom test in a linear mixed model fitted
#' by \code{\link{lmer}}. The contrast (L) specifies a linear function of the
#' mean-value parameters, beta. Satterthwaite's method is used to compute the
#' denominator df for the F-test.
#'
#' The F-value and associated p-value is for the hypothesis
#' \eqn{L \beta = \mathrm{rhs}}{L \beta = rhs} in which rhs may be non-zero
#' and \eqn{\beta} is \code{fixef(model)}.
#'
#' Note: NumDF = row-rank(L) is determined automatically so row rank-deficient L
#' are allowed. One-dimensional contrasts are also allowed (L has 1 row).
#'
#' @param L a contrast matrix with nrow >= 1 and ncol ==
#' \code{length(fixef(model))}.
#' @param model a model object fitted with \code{lmer} from package
#' \pkg{lmerTest}, i.e., an object of class \code{\link{lmerModLmerTest}}.
#' @param rhs right-hand-side of the statistical test, i.e. the hypothesized
#' value. A numeric vector of length \code{nrow(L)} or a numeric scalar.
#' @param ddf the method for computing the denominator degrees of freedom and
#' F-statistics. \code{ddf="Kenward-Roger"} uses Kenward-Roger's method.
#' @param eps tolerance on eigenvalues to determine if an eigenvalue is
#' positive. The number of positive eigenvalues determine the rank of
#' L and the numerator df of the F-test.
#' @param ... currently not used.
#'
#' @return a \code{data.frame} with one row and columns with \code{"Sum Sq"},
#' \code{"Mean Sq"}, \code{"F value"}, \code{"NumDF"} (numerator df),
#' \code{"DenDF"} (denominator df) and \code{"Pr(>F)"} (p-value).
#' @export
#' @seealso \code{\link[=contest.lmerModLmerTest]{contest}} for a flexible and
#' general interface to tests of contrasts among fixed-effect parameters.
#' \code{\link[=contest1D.lmerModLmerTest]{contest1D}} is a direct interface for
#' tests of 1-dimensional contrasts.
#' @author Rune Haubo B. Christensen
#' @importFrom stats pf
#' @importFrom MASS ginv
#'
#' @examples
#'
#' data("sleepstudy", package="lme4")
#' fm <- lmer(Reaction ~ Days + I(Days^2) + (1|Subject) + (0+Days|Subject),
#' sleepstudy)
#'
#' # Define 2-df contrast - since L has 2 (linearly independent) rows
#' # the F-test is on 2 (numerator) df:
#' L <- rbind(c(0, 1, 0), # Note: ncol(L) == length(fixef(fm))
#' c(0, 0, 1))
#'
#' # Make the 2-df F-test of any effect of Days:
#' contestMD(fm, L)
#'
#' # Illustrate rhs argument:
#' contestMD(fm, L, rhs=c(5, .1))
#'
#' # Make the 1-df F-test of the effect of Days^2:
#' contestMD(fm, L[2, , drop=FALSE])
#' # Same test, but now as a t-test instead:
#' contest1D(fm, L[2, , drop=TRUE])
#'
contestMD.lmerModLmerTest <- function(model, L, rhs=0,
ddf=c("Satterthwaite", "Kenward-Roger"),
eps=sqrt(.Machine$double.eps), ...) {
mk_Ftable <- function(Fvalue, ndf, ddf, sigma, Fscale=1) {
MS <- Fvalue * sigma^2
Fvalue <- Fvalue * Fscale
pvalue <- pf(q=Fvalue, df1=ndf, df2=ddf, lower.tail=FALSE)
data.frame("Sum Sq"=MS*ndf, "Mean Sq"=MS, "NumDF"=ndf, "DenDF"=ddf,
"F value"=Fvalue, "Pr(>F)"=pvalue, check.names = FALSE)
}
if(!is.matrix(L)) L <- matrix(L, ncol=length(L))
stopifnot(is.matrix(L), is.numeric(L),
ncol(L) == length(model@beta))
if(length(rhs) == 1L) rhs <- rep(rhs, nrow(L))
stopifnot(is.numeric(rhs), length(rhs) == nrow(L))
method <- match.arg(ddf)
if(nrow(L) == 0L) { # May happen if there are no fixed effects
x <- numeric(0L)
return(mk_Ftable(x, x, x, x))
}
if(any(is.na(L))) return(mk_Ftable(NA_real_, NA_real_, NA_real_, NA_real_))
if(method == "Kenward-Roger") {
if(!getME(model, "is_REML"))
stop("Kenward-Roger's method is only available for REML model fits",
call.=FALSE)
if(!requireNamespace("pbkrtest", quietly = TRUE))
stop("pbkrtest package required for Kenward-Roger's method",
call.=FALSE)
if(getRversion() < "3.3.2") # See comments above.
warning("Kenward-Roger may give faulty results with R <= 3.3.2")
if(qr(L)$rank < nrow(L) && !all(rhs == 0))
warning("Contrast is rank deficient and test may be affected")
betaH <- if(all(rhs == 0)) 0 else drop(MASS::ginv(L) %*% rhs)
x <- try(pbkrtest::KRmodcomp(model, L, betaH=betaH)$test, silent = TRUE)
if(inherits(x, "try-error")) { # Handle try-error
warning("Unable to compute Kenward-Roger F-test: using Satterthwaite instead",
call.=FALSE)
if(!inherits(model, "lmerModLmerTest")) model <- as_lmerModLmerTest(model)
} else { # return F-table if we can compute the KR F-test:
return(mk_Ftable(Fvalue=x["FtestU", "stat"], ndf=x[1L, "ndf"],
ddf=x[1L, "ddf"], sigma=sigma(model),
Fscale=x["Ftest", "F.scaling"]))
}
# NOTE on the KR method:
# It seems there is no easy way to calculate the scaling of the F-value,
# so we will have to resort to "KRmodcomp(model, L)" for each of the k terms in
# the anova table. This is highly ineffective since the same vcovAdj(model)
# has to be compute k times.
} # method == "Satterthwaite" proceeds:
if(nrow(L) == 1L) { # 1D case:
res <- contest1D(model, drop(L), rhs=rhs, confint=FALSE)
return(mk_Ftable(Fvalue=res[["t value"]]^2, ndf=1L, ddf=res$df,
sigma=model@sigma))
} # multi-D case proceeds:
beta <- model@beta
# Adjust beta for rhs:
if(!all(rhs == 0)) beta <- beta - drop(MASS::ginv(L) %*% rhs)
# Compute Var(L beta) and eigen-decompose:
VLbeta <- L %*% model@vcov_beta %*% t(L) # Var(contrast) = Var(Lbeta)
eig_VLbeta <- eigen(VLbeta)
P <- eig_VLbeta$vectors
d <- eig_VLbeta$values
tol <- max(eps * d[1], 0)
pos <- d > tol
q <- sum(pos) # rank(VLbeta)
if(q < nrow(L) && !all(rhs == 0))
warning("Contrast is rank deficient and test may be affected")
if(q <= 0) { # shouldn't happen if L is a proper contrast
x <- numeric(0L)
return(mk_Ftable(x, x, x, x))
}
PtL <- crossprod(P, L)[1:q, ]
if(q == 1) { # 1D case:
res <- contest1D(model, PtL, rhs=rhs[1L], confint=FALSE)
return(mk_Ftable(Fvalue=res[["t value"]]^2, ndf=q, ddf=res$df,
sigma=model@sigma))
} # multi-D case proceeds:
# Compute t-squared values and F-value:
t2 <- drop(PtL %*% beta)^2 / d[1:q]
Fvalue <- sum(t2) / q
# Compute q-list of gradients of (PtL)' cov(beta) (PtL) wrt. varpar vector:
grad_PLcov <- lapply(1:q, function(m) {
vapply(model@Jac_list, function(J) qform(PtL[m, ], J), numeric(1L))
})
# Compute degrees of freedom for the q t-statistics:
nu_m <- vapply(1:q, function(m) {
2*(d[m])^2 / qform(grad_PLcov[[m]], model@vcov_varpar) }, numeric(1L)) # 2D_m^2 / g'Ag
# Compute ddf for the F-value:
ddf <- get_Fstat_ddf(nu_m, tol=1e-8)
mk_Ftable(Fvalue, ndf=q, ddf=ddf, sigma=model@sigma)
}
##############################################
######## get_Fstat_ddf()
##############################################
#' Compute denominator df for F-test
#'
#' From a vector of denominator df from independent t-statistics (\code{nu}),
#' the denominator df for the corresponding F-test is computed.
#'
#' Note that if any \code{nu <= 2} then \code{2} is returned. Also, if all nu
#' are within tol of each other the simple average of the nu-vector is returned.
#' This is to avoid downward bias.
#'
#' @param nu vector of denominator df for the t-statistics
#' @param tol tolerance on the consequtive differences between elements of nu to
# determine if mean(nu) should be returned
#'
#' @author Rune Haubo B. Christensen
#'
#' @return the denominator df; a numerical scalar
#' @noRd
#' @keywords internal
get_Fstat_ddf <- function(nu, tol=1e-8) {
# Computes denominator df for an F-statistic that is derived from a sum of
# squared t-statistics each with nu_m degrees of freedom.
#
# nu : vector of denominator df for the t-statistics
# tol: tolerance on the consequtive differences between elements of nu to
# determine if mean(nu) should be returned.
#
# Result: a numeric scalar
#
# Returns nu if length(nu) == 1. Returns mean(nu) if all(abs(diff(nu)) < tol;
# otherwise ddf appears to be downward biased.
fun <- function(nu) {
if(any(nu <= 2)) 2 else {
E <- sum(nu / (nu - 2))
2 * E / (E - (length(nu))) # q = length(nu) : number of t-statistics
}
}
stopifnot(length(nu) >= 1,
# all(nu > 0), # returns 2 if any(nu < 2)
all(sapply(nu, is.numeric)))
if(length(nu) == 1L) return(nu)
if(all(abs(diff(nu)) < tol)) return(mean(nu))
if(!is.list(nu)) fun(nu) else vapply(nu, fun, numeric(1L))
}
##############################################
######## calcSatterth()
##############################################
#' @rdname contestMD.lmerModLmerTest
#' @export
calcSatterth <- function(model, L) {
stopifnot(inherits(model, "lmerMod"))
if(!inherits(model, "lmerModLmerTest")) {
message("Coercing model to class 'lmerModLmerTest'")
model <- as_lmerModLmerTest(model)
if(!inherits(model, "lmerModLmerTest"))
stop("Failed to coerce model to class 'lmerModLmerTest'")
}
x <- contestMD(model, L)
list("denom"=x[["DenDF"]], "Fstat"=as.matrix(x[["F value"]]),
"pvalue"=as.matrix(x[["Pr(>F)"]]), "ndf"=x[["NumDF"]])
}
# m <- lmer(Reaction ~ Days + (1 + Days|Subject), sleepstudy)
# L <- cbind(0,1) ## specify contrast vector
# contestMD(m, L)
# calcSatterth(m, L)
##############################################
######## lmerMod methods for contest, contest1D and contestMD
##############################################
#' @rdname contest.lmerModLmerTest
#' @export
contest.lmerMod <- function(model, L, rhs=0, joint=TRUE, collect=TRUE, confint=TRUE,
level=0.95, check_estimability=FALSE,
ddf=c("Satterthwaite", "Kenward-Roger", "lme4"), ...) {
ddf <- match.arg(ddf)
# For Satterthwaite we need to compute stuff - not for K-R:
if(ddf == "Satterthwaite") model <- as_lmerModLmerTest(model)
# Use lmerModLmerTest method:
eval.parent(contest.lmerModLmerTest(model, L=L, joint=joint, collect=collect,
confint=confint, level=level,
check_estimability=check_estimability,
ddf=ddf, rhs=rhs, ...))
}
#' @rdname contest1D.lmerModLmerTest
#' @export
contest1D.lmerMod <- function(model, L, rhs=0,
ddf=c("Satterthwaite", "Kenward-Roger"),
confint=FALSE, level = 0.95, ...) {
ddf <- match.arg(ddf)
# For Satterthwaite we need to compute stuff - not for K-R:
if(ddf == "Satterthwaite") model <- as_lmerModLmerTest(model)
# Use lmerModLmerTest method:
eval.parent(contest1D.lmerModLmerTest(model, L=L, rhs=rhs, ddf=ddf,
confint=confint, level=level))
}
#' @rdname contestMD.lmerModLmerTest
#' @export
contestMD.lmerMod <- function(model, L, rhs=0,
ddf=c("Satterthwaite", "Kenward-Roger"),
eps=sqrt(.Machine$double.eps), ...) {
ddf <- match.arg(ddf)
# For Satterthwaite we need to compute stuff - not for K-R:
if(ddf == "Satterthwaite") model <- as_lmerModLmerTest(model)
# Use lmerModLmerTest method:
eval.parent(contestMD.lmerModLmerTest(model, L=L, rhs=rhs, ddf=ddf, eps=eps))
}
lmerTest/R/lmer_summary.R 0000644 0001762 0000144 00000013264 15131137167 015124 0 ustar ligges users #############################################################################
# Copyright (c) 2013-2026 Alexandra Kuznetsova, Per Bruun Brockhoff, and
# Rune Haubo Bojesen Christensen
#
# This file is part of the lmerTest package for R (*lmerTest*)
#
# *lmerTest* is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# *lmerTest* is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# A copy of the GNU General Public License is available at
# and/or
# .
#############################################################################
#
# lmer_summary.R - summary method for lmerModLmerTest objects
# ------- Contents: --------
#
# summary.lmerModLmerTest
#
# --- utility functions: ---
#
# get_coefmat
#
#' @include lmer.R
NULL
##############################################
######## summary method for lmerModLmerTest
##############################################
#' Summary Method for Linear Mixed Models
#'
#' Summaries of Linear Mixed Models with coefficient tables including t-tests
#' and p-values using Satterthwaites's or Kenward-Roger's methods for
#' degrees-of-freedom and t-statistics.
#'
#' The returned object is of class
#' \code{c("summary.lmerModLmerTest", "summary.merMod")} utilizing \code{print},
#' \code{coef} and other methods defined for \code{summary.merMod} objects.
#' The \code{"Kenward-Roger"} method use methods from the \pkg{pbkrtest} package internally
#' to compute t-statistics and associated degrees-of-freedom.
#'
#' @param object an lmerModLmerTest object.
#' @param ddf the method for computing the degrees of freedom and
#' t-statistics. \code{ddf="Satterthwaite"} (default) uses Satterthwaite's method;
#' \code{ddf="Kenward-Roger"} uses Kenward-Roger's method,
#' \code{ddf = "lme4"} returns the lme4-summary i.e., using the summary
#' method for \code{lmerMod} objects as defined in the \pkg{lme4}-package and
#' ignores the \code{type} argument. Partial matching is allowed.
#' @param ... additional arguments passed on to \code{lme4::summary.merMod}
#'
#' @return A summary object with a coefficient table (a \code{matrix}) including
#' t-values and p-values. The coefficient table can be extracted with
#' \code{coef(summary())}.
#'
#' @seealso \code{\link{contest1D}} for one degree-of-freedom contrast tests
#' and \code{\link[pbkrtest]{KRmodcomp}} for Kenward-Roger F-tests.
#' @author Rune Haubo B. Christensen and Alexandra Kuznetsova
#' @export
#' @importFrom methods as signature
#'
#' @examples
#'
#' # Fit example model:
#' data("sleepstudy", package="lme4")
#' fm <- lmer(Reaction ~ Days + (1|Subject) + (0+Days|Subject), sleepstudy)
#'
#' # Get model summary:
#' summary(fm) # Satterthwaite df and t-tests
#'
#' # Extract coefficient table:
#' coef(summary(fm))
#'
#' # Use the Kenward-Roger method
#' if(requireNamespace("pbkrtest", quietly = TRUE))
#' summary(fm, ddf="Kenward-Roger")
#'
#' # The lme4-summary table:
#' summary(fm, ddf="lme4") # same as summary(as(fm, "lmerMod"))
#'
#' \dontshow{
#' # Check that summaries are as expected:
#' summ_fm <- coef(summary(fm))
#' summ_fm_lme4 <- coef(summary(fm, ddf="lme4"))
#' stopifnot(
#' all(colnames(summ_fm) == c("Estimate", "Std. Error", "df", "t value", "Pr(>|t|)")),
#' all(colnames(summ_fm_lme4) == c("Estimate", "Std. Error", "t value")),
#' all(!(is.na(summ_fm))),
#' all(!(is.na(summ_fm_lme4)))
#' )
#' if(requireNamespace("pbkrtest", quietly = TRUE) && getRversion() >= "3.3.3") {
#' summ_fm_kr <- coef(summary(fm, ddf="Kenward-Roger"))
#' stopifnot(
#' all(colnames(summ_fm_kr) == c("Estimate", "Std. Error", "df", "t value", "Pr(>|t|)")),
#' all(!(is.na(summ_fm_kr)))
#' )
#' }
#' }
summary.lmerModLmerTest <- function(object, ...,
ddf=c("Satterthwaite", "Kenward-Roger", "lme4")) {
ddf <- match.arg(ddf)
if(!inherits(object, "lmerModLmerTest") && !inherits(object, "lmerMod")) {
stop("Cannot compute summary for objects of class: ",
paste(class(object), collapse = ", "))
}
if(!inherits(object, "lmerModLmerTest") && inherits(object, "lmerMod")) {
message("Coercing object to class 'lmerModLmerTest'")
object <- as_lmerModLmerTest(object)
if(!inherits(object, "lmerModLmerTest")) {
warning("Failed to coerce object to class 'lmerModLmerTest'")
return(summary(object))
}
}
summ <- summary(forceNewMerMod(as(object, "lmerMod"), object), ...)
if(ddf == "lme4") return(summ)
summ$coefficients <- get_coefmat(object, ddf=ddf)
ddf_nm <- switch(ddf, "Satterthwaite" = "Satterthwaite's",
"Kenward-Roger" = "Kenward-Roger's")
summ$objClass <- class(object) # Used by lme4:::print.summary.lmerMod
summ$methTitle <- paste0(summ$methTitle, ". t-tests use ", ddf_nm, " method")
class(summ) <- c("summary.lmerModLmerTest", class(summ))
summ
}
##############################################
######## get_coefmat
##############################################
#' @importFrom lme4 fixef
get_coefmat <- function(model, ddf=c("Satterthwaite", "Kenward-Roger")) {
ddf <- match.arg(ddf)
p <- length(fixef(model))
if(p < 1)
return(as.matrix(contest1D(model, numeric(0L), ddf=ddf)))
Lmat <- diag(p)
tab <- rbindall(lapply(1:p, function(i) contest1D(model, Lmat[i, ], ddf=ddf)))
rownames(tab) <- names(fixef(model))
as.matrix(tab)
}
lmerTest/R/zzz.R 0000644 0001762 0000144 00000002340 15131226542 013232 0 ustar ligges users #############################################################################
# Copyright (c) 2013-2026 Alexandra Kuznetsova, Per Bruun Brockhoff, and
# Rune Haubo Bojesen Christensen
#
# This file is part of the lmerTest package for R (*lmerTest*)
#
# *lmerTest* is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# *lmerTest* is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# A copy of the GNU General Public License is available at
# and/or
# .
#############################################################################
#
# zzz.R - .onLoad
.onLoad <- function(libname, pkgname) {
ns <- parent.env(environment())
if (packageVersion("lme4") < "2.0-0")
assign("forceNewMerMod", envir = ns, inherits = FALSE,
function(object, reference) object)
}
lmerTest/R/estimability.R 0000644 0001762 0000144 00000011751 15131137167 015106 0 ustar ligges users #############################################################################
# Copyright (c) 2013-2026 Alexandra Kuznetsova, Per Bruun Brockhoff, and
# Rune Haubo Bojesen Christensen
#
# This file is part of the lmerTest package for R (*lmerTest*)
#
# *lmerTest* is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# *lmerTest* is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# A copy of the GNU General Public License is available at
# and/or
# .
#############################################################################
#
# estimability.R - functions for assessing model estimability
# ------- Contents: --------
#
# is_estimable
# nullspace
#
##############################################
######## is_estimable
##############################################
#' Estimability of Contrasts
#'
#' Computes the estimability of a vector or matrix of contrasts (i.e. linear
#' functions of the coefficients) from the nullspace of a design matrix or
#' potentially directly from the design matrix.
#'
#' @param contrast a numeric matrix where each row is a contrast vector for
#' which estimability is computed. The matrix should have as many columns as
#' there are columns in the design matrix (which equals the number of
#' coefficients). If \code{contrast} is a vector it is coerced to a matrix.
#' @param nullspace the nullspace of the design matrix.
#' @param X design matrix.
#' @param tol tolerance for determining if a contrast is orthogonal to the
# nullspace.
#'
#' @return a logical vector of length \code{nrow(contrast)} determining if each
#' contrast is estimable
#' @importFrom stats setNames
#' @keywords internal
#' @seealso \code{\link{nullspace}}
#'
#' @author Rune Haubo B. Christensen
#' @keywords internal
#' @noRd
#' @examples
#'
#' # FIXME: We need some examples here
#'
is_estimable <- function(contrast, nullspace=NULL, X=NULL,
tol=sqrt(.Machine$double.eps)) {
if(!is.matrix(contrast)) contrast <- matrix(contrast, ncol=length(contrast))
N <- if(!is.null(nullspace)) { # get nullspace
nullspace
} else if(!is.null(X)) {
nullspace(X)
} else {
stop("Need non-null 'nullspace' or 'X' to compute estimability")
}
if(ncol(contrast) != nrow(N))
stop(sprintf("'contrast' has %i columns: expecting %i columns",
ncol(contrast), nrow(N)))
# Determine estimability:
res <- if(length(N) == 0) rep(TRUE, nrow(contrast)) else
c(abs(rowSums(contrast %*% N)) < tol)
setNames(res, rownames(contrast))
}
#
# XX <- model.matrix(terms(model), data=model.frame(model))
# nullspaceX <- nullspace(XX)
# is_estimable(Llist$DAY, nullspaceX)
# is_estimable(c(Llist$DAY[1, ]), nullspaceX)
# is_estimable(Llist$DAY, X=XX)
# NCOL(0:1)
#
# X <- model.matrix(model)
# str(Llist$DAY[, -9] %*% nullspace(X))
# is_estimable(Llist$DAY[, -9], X=X)
# is_estimable(0:1, X=X)
# contrast <- 0:1
# nrow(matrix(0:1, ncol=2))
# rep(TRUE, 1)
#
# length(Llist$DAY[, -9] %*% nullspace(X))
# apply(Llist$DAY[, -9] %*% nullspace(X), 1, length)
# length(nullspace(X))
##############################################
######## nullspace
##############################################
#' Nullspace
#'
#' Compute the (right or left) nullspace of matrix using a (semi-complete)
#' Singular Value Decomposition.
#'
#' This implementation is fastest on matrices with more rows
#' than columns such as a typical design matrix for a linear model.
#'
#' @param A a numeric matrix.
#' @param type \code{"right"} (default) gives is the standard nullspace,
#' \code{"left"} gives left nullspace of \code{A}.
#' @param tol tolerance multiple of the first singular value to determine if
#' subsequent singular values are (sufficiently) positive to be determined
#' greater than zero.
#'
#' @return a matrix with as many rows as there are columns in \code{A}. The
#' number of columns (which may be zero) determine the dimensionality of the
#' nullspace of \code{A}.
#' @author Rune Haubo B. Christensen
#'
#' @keywords internal
#' @noRd
#' @examples
#'
#' # FIXME: We need some examples here
#'
nullspace <- function(A, type = c("right", "left"),
tol=sqrt(.Machine$double.eps)) {
# Compute the right (standard and default) or left null space of a matrix A.
# using SVD.
type <- match.arg(type)
if(type == "left") return(nullspace(t(A), type="right", tol=tol))
if(length(A) == 0L) return(matrix(numeric(0L))) # length(A) == 0 if any(dim(A) == 0)
svdA <- svd(A, nv = ncol(A))
tol <- 1e-8
positive <- svdA$d > max(tol * svdA$d[1L], 0)
rank <- sum(positive)
set <- if(rank == 0) 1:ncol(A) else -(1:rank)
svdA$v[, set, drop=FALSE]
}
lmerTest/R/ls_means.R 0000644 0001762 0000144 00000040712 15131137167 014207 0 ustar ligges users #############################################################################
# Copyright (c) 2013-2026 Alexandra Kuznetsova, Per Bruun Brockhoff, and
# Rune Haubo Bojesen Christensen
#
# This file is part of the lmerTest package for R (*lmerTest*)
#
# *lmerTest* is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# *lmerTest* is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# A copy of the GNU General Public License is available at
# and/or
# .
#############################################################################
#
# lsmeans.R - lsmeans methods for lmerTest::lmer model fits
# ------- Contents: --------
#
# --- Generics: ---
#
# ls_means
# difflsmeans
# lsmeansLT
#
# --- methods: ---
#
# ls_means.lmerModLmerTest
# difflsmeans.lmerModLmerTest
# lsmeansLT.lmerModLmerTest
# print.ls_means
# plot.ls_means
# as.data.frame.ls_means
#
# show_tests.ls_means
#
# --- other exported function: ---
#
# show_contrasts
#
# --- utility functions: ---
#
# lsmeans_contrasts
#
##############################################
######## ls_means()
##############################################
#' LS-means for lmerTest Model Fits
#'
#' Computes LS-means or pairwise differences of LS-mean for all factors in a
#' linear mixed model. \code{lsmeansLT} is provided as an alias for
#' \code{ls_means} for backward compatibility.
#'
#' Confidence intervals and p-values are based on the t-distribution using
#' degrees of freedom based on Satterthwaites or Kenward-Roger methods.
#'
#' LS-means is SAS terminology for predicted/estimated marginal means, i.e. means
#' for levels of factors which are averaged over the levels of other factors in
#' the model. A flat (i.e. unweighted) average is taken which gives equal weight
#' to all levels of each of the other factors. Numeric/continuous variables are
#' set at their mean values. See \pkg{emmeans} package
#' for more options and greater flexibility.
#'
#' LS-means contrasts are checked for estimability and unestimable contrasts appear
#' as \code{NA}s in the resulting table.
#'
#' LS-means objects (of class \code{"ls_means"} have a print method).
#'
#' @param model a model object fitted with \code{\link{lmer}} (of class
#' \code{"lmerModLmerTest"}).
#' @param which optional character vector naming factors for which LS-means should
#' be computed. If \code{NULL} (default) LS-means for all factors are computed.
#' @param level confidence level.
#' @param ddf method for computation of denominator degrees of freedom.
#' @param pairwise compute pairwise differences of LS-means instead?
#' @param ... currently not used.
#'
#' @return An LS-means table in the form of a \code{data.frame}. Formally an object
#' of class \code{c("ls_means", "data.frame")} with a number of attributes set.
#' @author Rune Haubo B. Christensen and Alexandra Kuznetsova
#' @seealso \code{\link[=show_tests.ls_means]{show_tests}} for display of the
#' underlying LS-means contrasts.
#' @export
#'
#' @examples
#'
#' # Get data and fit model:
#' data("cake", package="lme4")
#' model <- lmer(angle ~ recipe * temp + (1|recipe:replicate), cake)
#'
#' # Compute LS-means:
#' ls_means(model)
#'
#' # Get LS-means contrasts:
#' show_tests(ls_means(model))
#'
#' # Compute pairwise differences of LS-means for each factor:
#' ls_means(model, pairwise=TRUE)
#' difflsmeans(model) # Equivalent.
#'
ls_means.lmerModLmerTest <- function(model, which=NULL, level=0.95,
ddf=c("Satterthwaite", "Kenward-Roger"),
pairwise=FALSE, ...) {
ddf <- match.arg(ddf)
Llist <- lsmeans_contrasts(model, which=which)
coef_nm <- if(inherits(model, "lmerMod")) colnames(model.matrix(model)) else
names(coef(model))[!is.na(coef(model))]
# Need nullspace of _remade_ model matrix to check estimability:
XX <- get_model_matrix(model, type="remake", contrasts="restore")
nullspaceX <- nullspace(XX)
# Pairwise differences:
if(pairwise == TRUE) # Adjust contrasts to compute pairwise diffs:
Llist <- lapply(Llist, function(L)
crossprod(as.matrix(get_pairs(rownames(L))), L))
# Compute LS-means:
if(length(Llist) == 0) {
means <- contest1D(model, rep(NA_real_, length(coef_nm)), ddf=ddf,
confint=TRUE, level=level)[0L, , drop=FALSE]
} else
means <- rbindall(lapply(names(Llist), function(var) {
L <- Llist[[var]]
# Check estimability before computing the contrast:
estim <- is_estimable(L, nullspace = nullspaceX)
L[!estim, ] <- NA_real_ # set unestimable contrasts to NA
L <- L[, coef_nm, drop=FALSE] # drop aliased coefs
# Evaluate contrasts:
tab <- rbindall(lapply(1:nrow(L), function(i)
contest1D(model, L[i, ], ddf=ddf, confint=TRUE, level=level)))
rownames(tab) <- rownames(L)
tab
}))
attr(means, "response") <- deparse(formula(model)[[2]])
attr(means, "confidence_level") <- level
attr(means, "ddf") <- ddf
attr(means, "hypotheses") <- Llist
attr(means, "heading") <- "Least Squares Means table:\n"
class(means) <- c("ls_means", "data.frame")
means
}
##############################################
######## ls_means()
##############################################
#' LS-means Generic Function
#'
#' @param model a model object.
#' @param ... parsed on to methods.
#'
#' @export
#' @author Rune Haubo B. Christensen
#' @seealso \code{\link{ls_means.lmerModLmerTest}}
#' @keywords internal
ls_means <- function(model, ...) UseMethod("ls_means")
##############################################
######## difflsmeans()
##############################################
#' @rdname ls_means
#' @export
#' @seealso \code{\link{difflsmeans.lmerModLmerTest}}
#' @keywords internal
difflsmeans <- function(model, ...) UseMethod("difflsmeans")
##############################################
######## lsmeansLT()
##############################################
#' @rdname ls_means
#' @export
#' @seealso \code{\link{lsmeansLT.lmerModLmerTest}}
#' @keywords internal
lsmeansLT <- function(model, ...) UseMethod("lsmeansLT")
##############################################
######## lsmeansLT.lmerModLmerTest()
##############################################
#' @rdname ls_means.lmerModLmerTest
#' @export
lsmeansLT.lmerModLmerTest <- ls_means.lmerModLmerTest
##############################################
######## difflsmeans.lmerModLmerTest()
##############################################
#' @rdname ls_means.lmerModLmerTest
#' @export
difflsmeans.lmerModLmerTest <- function(model, which=NULL, level=0.95,
ddf=c("Satterthwaite", "Kenward-Roger"), ...) {
ls_means(model, which=which, level=level, ddf=ddf, pairwise = TRUE)
}
##############################################
######## lsmeans_contrasts()
##############################################
#' @importFrom reformulas nobars
lsmeans_contrasts <- function(model, which=NULL) {
stopifnot(inherits(model, "lmerModLmerTest"))
factor_terms <- attr(terms(model), "term.labels")[!numeric_terms(model)]
if(is.null(which)) which <- factor_terms
stopifnot(is.character(which), all(which %in% factor_terms))
which <- setNames(as.list(which), which)
# Get minimal 'unique rows' design matrix:
grid <- get_min_data(model)
form <- formula(model)[-2]
if(inherits(model, "lmerMod")) form <- nobars(form)
Contr <- attr(model.matrix(model), "contrasts")
uX <- model.matrix(form, data=grid, contrasts.arg=Contr)
# Get utilities needed to compute the LS-means contrasts:
var_names <- names(get_var_list(model))
factor_mat <- attr(terms(model), "factors")
Contrasts <- .getXlevels(terms(model), grid)
Contrasts[] <- "contr.treatment"
# Compute LS-means contrast:
Llist <- lapply(which, function(term) {
vars_in_term <- factor_mat[var_names, term] == 1
Lt <- model.matrix(formula(paste0("~ 0 + ", term)), data=grid,
contrasts.arg=Contrasts[vars_in_term])
wts <- 1/colSums(Lt)
# Lt * c(Lt %*% wts)
# L <- diag(wts) %*% t(Lt)
L <- t(sweep(Lt, 2, wts, "*"))
L %*% uX
})
Llist
}
##############################################
######## print.ls_means
##############################################
#' @importFrom stats printCoefmat
#' @export
print.ls_means <- function(x, digits = max(getOption("digits") - 2L, 3L),
signif.stars = getOption("show.signif.stars"),
...) {
if(!is.null(heading <- attr(x, "heading")))
cat(heading, sep = "\n")
if(nrow(x) > 0) {
dig.df <- 1
x[, "df"] <- round(x[, "df"], dig.df)
}
printCoefmat(x, digits=digits, signif.stars = signif.stars,
has.Pvalue = TRUE, cs.ind=c(1:2, 5:6), tst.ind=4)
if(!is.null(ci_level <- attr(x, "confidence_level")))
cat(paste0("\n Confidence level: ", format(100*ci_level, digits=2), "%\n"))
if(!is.null(ddf <- attr(x, "ddf")))
cat(" Degrees of freedom method:", ddf, "\n")
invisible(x)
}
##############################################
######## show_tests.ls_means
##############################################
#' Show LS-means Hypothesis Tests and Contrasts
#'
#' Extracts the contrasts which defines the LS-mean hypothesis tests.
#'
#' @param object an \code{ls_means} object.
#' @param fractions display contrasts as fractions rather than decimal numbers?
#' @param names include row and column names of the contrasts matrices?
#' @param ... currently not used.
#'
#' @return a list of contrast matrices; one matrix for each model term.
#' @export
#' @author Rune Haubo B. Christensen
#' @importFrom MASS fractions
#' @seealso \code{\link[=ls_means.lmerModLmerTest]{ls_means}} for computation of
#' LS-means and \code{\link[=show_tests.anova]{show_tests}} for \code{anova}
#' objects.
#'
#' @examples
#'
#' data("cake", package="lme4")
#' model <- lmer(angle ~ recipe * temp + (1|recipe:replicate), cake)
#'
#' # LS-means:
#' (lsm <- ls_means(model))
#'
#' # Contrasts for LS-means estimates and hypothesis tests:
#' show_tests(lsm)
#'
show_tests.ls_means <- function(object, fractions=FALSE, names=TRUE, ...)
NextMethod() # use default method
##############################################
######## plot.ls_means
##############################################
#' Bar Plots of LS-Means
#'
#' Bar plots of LS-means using the \pkg{ggplot2} package.
#'
#' @param x an \code{\link{ls_means}} object.
#' @param y not used and ignored with a warning.
#' @param which optional character vector naming factors for which LS-means should
#' be plotted. If \code{NULL} (default) plots for all LS-means are generated.
#' @param mult if \code{TRUE} and there is more than one term for which to plot
#' LS-means the plots are organized in panels with \code{facet_wrap}.
#' @param ... currently not used.
#'
#' @return generates the desired plots and invisibly returns the plot objects.
#' @author Rune Haubo B. Christensen
#' @seealso \code{\link{ls_means.lmerModLmerTest}}
#' @export
#' @importFrom graphics plot
#' @importFrom ggplot2 ggplot aes geom_bar geom_errorbar theme element_text
#' @importFrom ggplot2 scale_fill_manual xlab ylab facet_wrap rel
#' @keywords internal
#'
#' @examples
#'
#' # Fit example model with 2 factors:
#' data("cake", package="lme4")
#' cake$Temp <- factor(cake$temperature, ordered = FALSE)
#' model <- lmer(angle ~ recipe * Temp + (1|recipe:replicate), cake)
#'
#' # Extract LS-means:
#' (lsm <- ls_means(model))
#'
#' # Multi-frame plot of the LS-means
#' plot(lsm)
#'
#' # Compute list of 'single frame' plots:
#' res <- plot(lsm, mult=FALSE)
#'
#' # Display each plot separately:
#' plot(res[[1]])
#' plot(res[[2]])
#'
#' # Example with pairwise differences of LS-means:
#' (lsm <- ls_means(model, pairwise = TRUE))
#' plot(lsm, which="Temp")
#'
plot.ls_means <- function(x, y=NULL, which=NULL, mult=TRUE, ...) {
Estimate <- col.bars <- lower <- term <- upper <- NULL # so that r cmd check can see them
get_plot <- function(d, response="") { # basic plot function
ggplot(d, aes(x=levels, y = Estimate, fill = col.bars)) +
geom_bar(position = "dodge", stat = "identity") +
geom_errorbar(aes(ymin = lower, ymax = upper), colour="black", width=.1) +
theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.4),
axis.title.y = element_text(size = rel(1.4)),
axis.text = element_text(size = rel(1)),
legend.text = element_text(size = rel(1)),
legend.title = element_text(size = rel(1))) +
scale_fill_manual(
values=c("NS" = "grey", "p-value < 0.01" = "orange",
"p-value < 0.05" = "yellow", "p-value < 0.001" = "red"),
name="Significance") + ylab(response)
}
get_color_values <- function(x) {
if(x<0.001) return("p-value < 0.001")
if(x<0.01) return("p-value < 0.01")
if(x<0.05) return("p-value < 0.05")
return("NS")
}
# Check for and warn about deprecated arguments:
dots <- list(...)
ignored <- c("main", "cex")
for(nm in ignored) if(any(pmatch(names(dots), nm, nomatch = 0)))
warning(paste0("Argument '", nm, "' is deprecated and ignored."))
if(any(pmatch(names(dots), "effs", nomatch = 0)))
warning("Argument 'effs' is deprecated: use 'which' instead.")
if(!is.null(y)) warning("Argument 'y' is defunct and ignored.")
# Get data for plotting:
plotdata <- as.data.frame(x, add_levels = TRUE)
plotdata <- # Add significance information for colors:
cbind(plotdata, col.bars=sapply(plotdata[, "Pr(>|t|)"], get_color_values))
# Subset plotdata for terms
if(!is.null(which)) {
stopifnot(is.character(which), length(which) >= 1L,
all(sapply(which, length) > 0L))
term_names <- unique(as.character(plotdata[["term"]]))
valid <- which %in% term_names
if(!all(valid)) {
warning(sprintf("The following terms are invalid and ignored: %s.",
paste(which[!valid], collapse = ", ")))
}
plotdata <- subset(plotdata, term %in% which[valid])
}
if(nrow(plotdata) == 0L) stop("No LS-means to plot.")
# Generate plots:
if(mult && length(unique(as.character(plotdata[["term"]]))) > 1L) {
res <- get_plot(plotdata, response=attr(x, "response")) + xlab("") +
facet_wrap( ~ term, scales="free")
print(res)
} else {
plotdata <- split(plotdata, plotdata$term)
res <- lapply(1:length(plotdata), function(i)
get_plot(plotdata[[i]], response=attr(x, "response")) +
xlab(names(plotdata)[i])
)
names(res) <- names(plotdata)
for(obj in res) print(obj)
}
invisible(res)
}
##############################################
######## as.data.frame.ls_means
##############################################
#' Coerce \code{ls_means} Objects to \code{data.frame}s
#'
#' @param x an \code{\link{ls_means}} object.
#' @param add_levels add \code{term} and \code{levels} columns to returned
#' \code{data.frame}?
#' @param ... currently not used.
#'
#' @export
#' @author Rune Haubo B. Christensen
#' @seealso \code{\link{ls_means.lmerModLmerTest}}
#' @keywords internal
#' @examples
#'
#' # Fit example model:
#' data("cake", package="lme4")
#' cake$Temp <- factor(cake$temperature, ordered = FALSE)
#' model <- lmer(angle ~ recipe + Temp + (1|recipe:replicate), cake)
#'
#' # Extract LS-means:
#' head(lsm <- ls_means(model))
#'
#' # Coerce LS-means objects to data.frames:
#' head(as.data.frame(lsm))
#' head(as.data.frame(lsm, add_levels=FALSE))
#'
as.data.frame.ls_means <- function(x, ..., add_levels=TRUE) {
# Function to compute levels of terms including interaction:terms
get_levels <- function(term, levels) {
fun <- function(term, levels) { # workhorse
strng <- paste(paste0("^", unlist(strsplit(term, ":"))), collapse = "|")
sapply(strsplit(levels, ":"), function(txt)
paste(gsub(strng, "", txt), collapse = ":"))
}
if(all(grepl(" - ", levels))) # pairwise contrasts
sapply(strsplit(levels, " - "), function(lev)
paste(fun(term, lev), collapse = " - ")) else fun(term, levels)
}
if(!add_levels) return(structure(x, class="data.frame"))
contrasts <- attr(x, "hypotheses")
term_names <- names(contrasts)
lsm_levels <- lapply(1:length(term_names), function(i)
get_levels(term_names[i], rownames(contrasts[[i]]))
)
class(x) <- "data.frame"
cbind(term = rep(term_names, sapply(lsm_levels, length)),
levels=unlist(lsm_levels), x, stringsAsFactors=FALSE)
}
lmerTest/R/utils.R 0000644 0001762 0000144 00000006367 15131137167 013556 0 ustar ligges users #############################################################################
# Copyright (c) 2013-2026 Alexandra Kuznetsova, Per Bruun Brockhoff, and
# Rune Haubo Bojesen Christensen
#
# This file is part of the lmerTest package for R (*lmerTest*)
#
# *lmerTest* is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# *lmerTest* is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# A copy of the GNU General Public License is available at
# and/or
# .
#############################################################################
#
# utils.R - Utility functions
# ------- Contents: --------
#
# --- utility functions: ---
#
# qform
# rbindall
# cond
# safeDeparse, deparse2
# waldCI
#
##############################################
######## qform
##############################################
#' Compute Quadratic Form
#'
#' Efficiently computes \eqn{x' A x} - or in R-notation:
#'
#' Length of \code{x} should equal the number of rows and columns of \code{A}.
#'
#' @param x a numeric vector
#' @param A a symmetric numeric matrix
#'
#' @return a numerical scalar
#' @noRd
#' @keywords internal
qform <- function(x, A) {
sum(x * (A %*% x)) # quadratic form: x'Ax
}
##############################################
######## rbindall
##############################################
#' \code{rbind} Multiple Objects
#'
#' @param ... objects to be \code{rbind}'ed - typically matrices or vectors
#'
#' @keywords internal
#' @noRd
rbindall <- function(...) do.call(rbind, ...)
cbindall <- function(...) do.call(cbind, ...)
##############################################
######## cond
##############################################
cond <- function(X) with(eigen(X, only.values=TRUE), max(values) / min(values))
##############################################
######## safeDeparse
##############################################
safeDeparse <- function(expr, width.cutoff=500L, backtick = mode(expr) %in%
c("call", "expression", "(", "function"),
control = c("keepInteger","showAttributes", "keepNA"),
nlines = -1L) {
deparse(expr=expr, width.cutoff=width.cutoff, backtick=backtick,
control=control, nlines=nlines)
}
deparse2 <- function(x) paste(safeDeparse(x), collapse = " ")
##############################################
######## waldCI
##############################################
#' @importFrom stats qt
waldCI <- function(estimate, se, df=Inf, level=0.95) {
stopifnot(length(level) == 1,
is.numeric(level),
level > 0, level < 1)
# all(se > 0))
alpha <- (1 - level)/2
fac <- qt(alpha, df=df, lower.tail = FALSE)
res <- cbind(lower = estimate - se * fac,
upper = estimate + se * fac)
if(!is.null(names(estimate))) rownames(res) <- names(estimate)
res
}
# waldCI(setNames(1, "est"), .2)
lmerTest/R/lmer.R 0000644 0001762 0000144 00000036244 15131226632 013346 0 ustar ligges users #############################################################################
# Copyright (c) 2013-2026 Alexandra Kuznetsova, Per Bruun Brockhoff, and
# Rune Haubo Bojesen Christensen
#
# This file is part of the lmerTest package for R (*lmerTest*)
#
# *lmerTest* is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# *lmerTest* is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# A copy of the GNU General Public License is available at
# and/or
# .
#############################################################################
#
# lmer.R - implements lmerTest::lmer incl. class def etc.
# ------- Contents: --------
#
# lmerModLmerTest class definition (S4)
# lmerTest::lmer
# as_lmerModLmerTest
#
# --- Generics: ---
#
# sigma - only for R < 3.3 to support older versions of R
#
# --- methods: ---
#
# sigma.merMod - only for R < 3.3 to support older versions of R
# update.lmerModLmerTest - added in lmerTest version 3.0-1.9002
#
# --- utility functions: ---
#
# as_lmerModLT
# devfun_vp
# get_covbeta
#
##############################################
######## lmerModLmerTest class
##############################################
#' Represent Linear Mixed-Effects Models
#'
#' The \code{lmerModLmerTest} class extends \code{lmerMod} (which extends
#' \code{merMod}) from the \pkg{lme4}-package.
#'
#' @slot vcov_varpar a numeric matrix holding the asymptotic variance-covariance
#' matrix of the variance parameters (including sigma).
#' @slot Jac_list a list of gradient matrices (Jacobians) for the gradient of
#' the variance-covariance of beta with respect to the variance parameters,
#' where beta are the mean-value parameters available in \code{fixef(object)}.
#' @slot vcov_beta a numeric matrix holding the asymptotic variance-covariance
#' matrix of the fixed-effect regression parameters (beta).
#' @slot sigma the residual standard deviation.
#'
#' @seealso \code{\link[lme4]{lmer}} and \code{\link[lme4]{merMod}}
#' @export
#' @author Rune Haubo B. Christensen
#' @importClassesFrom lme4 lmerMod
#'
#' @return An object of class \code{lmerModLmerTest} with slots as in
#' \code{lmerMod} objects (see \code{\link[lme4]{merMod}}) and a few
#' additional slots as described in the slots section.
lmerModLmerTest <-
setClass("lmerModLmerTest",
contains = c("lmerMod"),
representation = representation(vcov_varpar = "matrix",
Jac_list = "list",
vcov_beta = "matrix",
sigma = "numeric"))
##############################################
######## lmer()
##############################################
#' Fit Linear Mixed-Effects Models
#'
#' This function overloads \code{\link[lme4]{lmer}} from the \pkg{lme4}-package
#' (\code{lme4::lmer}) and adds a couple of slots needed for the computation of
#' Satterthwaite denominator degrees of freedom. All arguments are the same as
#' for \code{lme4::lmer} and all the usual \code{lmer}-methods work.
#'
#' For details about \code{lmer} see \code{\link[lme4]{lmer}}
#' (\code{help(lme4::lmer)}). The description of all arguments below is taken
#' verbatim and unedited from the \pkg{lme4}-package.
#'
#' In cases when a valid \code{lmer}-object
#' (\code{lmerMod}) is produced, but when the computations needed for
#' Satterthwaite df fails, the \code{lmerMod} object is returned - not an
#' \code{lmerModLmerTest} object.
#'
#' @inheritParams lme4::lmer
#'
#' @return an S4 object of class \code{"lmerModLmerTest"}
#' @export
#' @importFrom lme4 lmerControl
#' @importFrom methods as new
#' @seealso \code{\link[lme4]{lmer}} and \code{\link{lmerModLmerTest}}
#' @author Rune Haubo B. Christensen and Alexandra Kuznetsova for the overload
#' in \pkg{lmerTest} -- \pkg{lme4}-authors for the underlying implementation
#' in \pkg{lme4}.
#'
#' @examples
#'
#' data("sleepstudy", package="lme4")
#' m <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy)
#' class(m) # lmerModLmerTest
#'
lmer <- function(formula, data = NULL, REML = TRUE,
control = lmerControl(), start = NULL, verbose = 0L,
subset, weights, na.action, offset, contrasts = NULL,
devFunOnly = FALSE) {
orig_call <- mc <- match.call()
mc[[1L]] <- quote(lme4::lmer)
model <- eval.parent(mc)
if(devFunOnly) return(model)
# Make an lmerModLmerTest object:
args <- as.list(mc)
args$devFunOnly <- TRUE
# args <- c(as.list(mc), devFunOnly=TRUE)
# if 'control' is not set we suppress potential message about rank deficient X
# when evaluating devfun:
if(!"control" %in% names(as.list(mc)))
args$control <- lme4::lmerControl(check.rankX = "silent.drop.cols")
Call <- as.call(c(list(quote(lme4::lmer)), args[-1]))
devfun <- eval.parent(Call)
res <- as_lmerModLT(model, devfun)
# Restore the right 'call' in model:
res@call <- orig_call
return(res)
}
#' @rawNamespace
#' if(getRversion() >= "3.3.0") {
#' importFrom("stats", sigma)
#' } else {
#' export(sigma)
#' }
#'
if(getRversion() < "3.3") {
sigma <- function(object, ...) UseMethod("sigma")
sigma.merMod <- function (object, ...)
{
dc <- object@devcomp
dd <- dc$dims
if (dd[["useSc"]])
dc$cmp[[if (dd[["REML"]])
"sigmaREML"
else "sigmaML"]]
else 1
}
}
#' @importFrom utils packageVersion
#' @rawNamespace
#' if (utils::packageVersion("lme4") >= "2.0-0")
#' importFrom(lme4, forceNewMerMod)
# if (utils::packageVersion("lme4") < "2.0-0")
# forceNewMerMod <- function(object, reference) object
##############################################
######## as_lmerModLT()
##############################################
as_lmerModLT <- function(model, devfun, tol=1e-8) {
is_reml <- getME(model, "is_REML")
# Coerce 'lme4-model' to 'lmerModLmerTest':
res <- as(model, "lmerModLmerTest")
# Set relevant slots of the new model object:
res@sigma <- sigma(model)
res@vcov_beta <- as.matrix(vcov(model))
# Compute Hessian:
varpar_opt <- getVarPar(model)
h <- numDeriv::hessian(func=devfun_vp, x=varpar_opt, devfun=devfun,
reml=is_reml)
# Eigen decompose the Hessian:
eig_h <- eigen(h, symmetric=TRUE)
evals <- eig_h$values
neg <- evals < -tol
pos <- evals > tol
zero <- evals > -tol & evals < tol
if(sum(neg) > 0) { # negative eigenvalues
eval_chr <- if(sum(neg) > 1) "eigenvalues" else "eigenvalue"
evals_num <- paste(sprintf("%1.1e", evals[neg]), collapse = " ")
warning(sprintf("Model failed to converge with %d negative %s: %s",
sum(neg), eval_chr, evals_num), call.=FALSE)
}
# Note: we warn about negative AND zero eigenvalues:
if(sum(zero) > 0) { # some eigenvalues are zero
eval_chr <- if(sum(zero) > 1) "eigenvalues" else "eigenvalue"
evals_num <- paste(sprintf("%1.1e", evals[zero]), collapse = " ")
warning(sprintf("Model may not have converged with %d %s close to zero: %s",
sum(zero), eval_chr, evals_num))
}
# Compute vcov(varpar):
pos <- eig_h$values > tol
q <- sum(pos)
# Using the Moore-Penrose generalized inverse for h:
h_inv <- with(eig_h, {
vectors[, pos, drop=FALSE] %*% diag(1/values[pos], nrow=q) %*%
t(vectors[, pos, drop=FALSE]) })
res@vcov_varpar <- 2 * h_inv # vcov(varpar)
# Compute Jacobian of cov(beta) for each varpar and save in list:
Jac <- numDeriv::jacobian(func=get_covbeta, x=varpar_opt, devfun=devfun)
res@Jac_list <- lapply(1:ncol(Jac), function(i)
array(Jac[, i], dim=rep(length(res@beta), 2))) # k-list of Jacobian matrices
# Ensure that the reCovs and upper attributes are set on the model object
# that are required by the >= 2.0-0 version lme4:
res <- forceNewMerMod(res, reference = model)
res
}
#' @importFrom utils packageVersion
#' @importFrom lme4 getME
getOptPar <- function(object) {
if(packageVersion("lme4") >= "2.0.0") unname(getME(object, "par")) else
unname(getME(object, "theta"))
}
getVarPar <- function(object) {
unname(c(getOptPar(object), sigma(object)))
}
##############################################
######## as_lmerModLmerTest()
##############################################
#' Coerce lmerMod Objects to lmerModLmerTest
#'
#' Coercing an lme4::lmer model-object (of class 'lmerMod') to a model-object
#' of class 'lmerModLmerTest' involves computing the covariance
#' matrix of the variance parameters and the gradient (Jacobian) of cov(beta)
#' with respect to the variance parameters.
#'
#' @param model and lmer model-object (of class 'lmerMod') -- the result of a
#' call to \code{lme4::lmer()}
#' @param tol tolerance for determining of eigenvalues are negative, zero or
#' positive
#'
#' @return an object of class \code{'lmerModLmerTest'} which sets the following
#' slots:
#' \item{vcov_varpar}{the asymptotic covariance matrix of the variance parameters
#' (theta, sigma).}
#' \item{Jac_list}{list of Jacobian matrices; gradients of vcov(beta) with
#' respect to the variance parameters.}
#' \item{vcov_beta}{the asymptotic covariance matrix of the fixed-effect
#' regression parameters (beta; vcov(beta)).}
#' \item{sigma}{the residual standard deviation.}
#'
#' @seealso the class definition in \code{\link{lmerModLmerTest}}) and
#' \code{\link{lmer}}
#'
#' @importFrom numDeriv hessian jacobian
#' @importFrom stats vcov update
#' @importFrom lme4 getME
#'
#' @author Rune Haubo B. Christensen
#' @export
#'
#' @examples
#' m <- lme4::lmer(Reaction ~ Days + (Days | Subject), sleepstudy)
#' bm <- as_lmerModLmerTest(m)
#' slotNames(bm)
#'
as_lmerModLmerTest <- function(model, tol=1e-8) {
if(!inherits(model, "lmerMod"))
stop("model not of class 'lmerMod': cannot coerce to class 'lmerModLmerTest")
# Get devfun:
# 'Tricks' to ensure that we get the data to construct devfun even when
# lmerTest is not attached or called inside a function:
mc <- getCall(model)
args <- c(as.list(mc), devFunOnly=TRUE)
# if 'control' is not set we suppress potential message about rank deficient X
# when evaluating devfun:
if(!"control" %in% names(as.list(mc)))
args$control <- lme4::lmerControl(check.rankX = "silent.drop.cols")
Call <- as.call(c(list(quote(lme4::lmer)), args[-1]))
ff <- environment(formula(model))
pf <- parent.frame() ## save parent frame in case we need it
sf <- sys.frames()[[1]]
ff2 <- environment(model)
devfun <- tryCatch(eval(Call, envir=pf),
error=function(e) {
tryCatch(eval(Call, envir=ff),
error=function(e) {
tryCatch(eval(Call, envir=ff2),
error=function(e) {
tryCatch(eval(Call, envir=sf),
error=function(e) {
"error" })})})})
if((is.character(devfun) && devfun == "error") ||
!is.function(devfun))
# !is.function(devfun) || names(formals(devfun)[1]) != "theta")
stop("Unable to extract deviance function from model fit")
as_lmerModLT(model, devfun, tol=tol)
}
##############################################
######## devfun_vp()
##############################################
#' Compute Deviance of an LMM as a Function of Variance Parameters
#'
#' This function is used for extracting the asymptotic variance-covariance matrix
#' of the variance parameters.
#'
#' @param varpar variance parameters; \code{varpar = c(theta, sigma)}.
#' @param devfun deviance function as a function of theta only.
#' @param reml if \code{TRUE} the REML deviance is computed;
#' if \code{FALSE}, the ML deviance is computed.
#'
#' @return the REML or ML deviance.
#' @author Rune Haubo B. Christensen
#' @noRd
#' @keywords internal
devfun_vp <- function(varpar, devfun, reml) {
nvarpar <- length(varpar)
sigma2 <- varpar[nvarpar]^2
theta <- varpar[-nvarpar]
df_envir <- environment(devfun)
devfun(theta) # Evaluate deviance function at varpar
n <- nrow(df_envir$pp$V)
# Compute deviance for ML:
dev <- df_envir$pp$ldL2() + (df_envir$resp$wrss() + df_envir$pp$sqrL(1))/sigma2 +
n * log(2 * pi * sigma2)
if(!reml) return(dev)
# Adjust if REML is used:
RX <- df_envir$pp$RX() # X'V^{-1}X ~ crossprod(RX^{-1}) = cov(beta)^{-1} / sigma^2
dev + 2*c(determinant(RX)$modulus) - ncol(RX) * log(2 * pi * sigma2)
}
##############################################
######## get_covbeta()
##############################################
#' Compute cov(beta) as a Function of varpar of an LMM
#'
#' At the optimum cov(beta) is available as vcov(lmer-model). This function
#' computes cov(beta) at non (RE)ML estimates of \code{varpar}.
#'
#' @inheritParams devfun_vp
#'
#' @return cov(beta) at supplied varpar values.
#' @author Rune Haubo B. Christensen
#' @noRd
#' @keywords internal
get_covbeta <- function(varpar, devfun) {
nvarpar <- length(varpar)
sigma <- varpar[nvarpar] # residual std.dev.
theta <- varpar[-nvarpar] # ranef var-par
devfun(theta) # evaluate REML or ML deviance 'criterion'
df_envir <- environment(devfun) # extract model environment
sigma^2 * tcrossprod(df_envir$pp$RXi()) # vcov(beta)
}
##############################################
######## update.lmerModLmerTest()
##############################################
## We need our own update method for lmerModLmerTest objects because relying on
## lme4::update.merMod will sometimes return an object of class "lmerMod"
## instead of "lmerModLmerTest". This for instance happened if formula was a
## character vector, e.g.:
## form <- "Informed.liking ~ Product+Information+
## (1|Consumer) + (1|Product:Consumer) + (1|Information:Consumer)"
## m <- lmer(form, data=ham)
## class(m) # "lmerModLmerTest"
## class(update(m, ~.- Product)) # "lmerMod"
## in versions < 3.0-1.9002.
##
#' @importFrom stats getCall update.formula
#' @export
#' @keywords internal
update.lmerModLmerTest <- function(object, formula., ..., evaluate = TRUE) {
if(is.null(call <- getCall(object)))
stop("object should contain a 'call' component")
extras <- match.call(expand.dots = FALSE)$...
if(!missing(formula.))
call$formula <- update.formula(formula(object), formula.)
if(length(extras) > 0) {
existing <- !is.na(match(names(extras), names(call)))
for(a in names(extras)[existing]) call[[a]] <- extras[[a]]
if(any(!existing)) {
call <- c(as.list(call), extras[!existing])
call <- as.call(call)
}
}
if(evaluate) {
ff <- environment(formula(object))
pf <- parent.frame()
sf <- sys.frames()[[1]]
res <- tryCatch(eval(call, envir = ff), error = function(e) {
tryCatch(eval(call, envir = sf), error = function(e) {
eval(call, pf)
})
})
# 'res' may be "lmerMod" instead of "lmerModLmerTest" in which case we
# coerce to "lmerModLmerTest":
if(inherits(res, "lmerMod") && !inherits(res, "lmerModLmerTest"))
as_lmerModLmerTest(res) else res
} else call
}
lmerTest/R/lmer_anova.R 0000644 0001762 0000144 00000024555 15131137167 014540 0 ustar ligges users #############################################################################
# Copyright (c) 2013-2026 Alexandra Kuznetsova, Per Bruun Brockhoff, and
# Rune Haubo Bojesen Christensen
#
# This file is part of the lmerTest package for R (*lmerTest*)
#
# *lmerTest* is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# *lmerTest* is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# A copy of the GNU General Public License is available at
# and/or
# .
#############################################################################
#
# lmer_anova.R - anova method for lmerModLmerTest objects
# ------- Contents: --------
#
# --- Generics: ---
#
# show_tests
#
# --- methods: ---
#
# anova.lmerModLmerTest
#
# show_tests.default
# show_tests.anova
#
# --- other exported function: ---
#
# show_contrasts
#
# --- utility functions: ---
#
# single_anova
#
#' @include lmer.R
NULL
##############################################
######## anova method for lmerModLmerTest
##############################################
#' ANOVA Tables for Linear Mixed Models
#'
#' ANOVA table with F-tests and p-values using Satterthwaite's or
#' Kenward-Roger's method for denominator degrees-of-freedom and F-statistic.
#' Models should be fitted with
#' \code{\link{lmer}} from the \pkg{lmerTest}-package.
#'
#' The \code{"Kenward-Roger"} method calls \code{pbkrtest::KRmodcomp} internally and
#' reports scaled F-statistics and associated denominator degrees-of-freedom.
#'
#' @param object an \code{lmerModLmerTest} object; the result of \code{lmer()}
#' after loading the \pkg{lmerTest}-package.
#' @param ... potentially additional \code{lmer} or \code{lm} model objects for
#' comparison of models in which case \code{type} and \code{ddf} arguments are
#' ignored.
#' @param type the type of ANOVA table requested (using SAS terminology)
#' with Type I being the familiar sequential ANOVA table.
#' @param ddf the method for computing the denominator degrees of freedom and
#' F-statistics. \code{ddf="Satterthwaite"} (default) uses Satterthwaite's method;
#' \code{ddf="Kenward-Roger"} uses Kenward-Roger's method,
#' \code{ddf = "lme4"} returns the lme4-anova table, i.e., using the anova
#' method for \code{lmerMod} objects as defined in the \pkg{lme4}-package and
#' ignores the \code{type} argument. Partial matching is allowed.
#'
#' @return an ANOVA table
#' @seealso \code{\link{contestMD}} for multi degree-of-freedom contrast tests
#' and \code{\link[pbkrtest]{KRmodcomp}} for the \code{"Kenward-Roger"} method.
#' @author Rune Haubo B. Christensen and Alexandra Kuznetsova
#' @importFrom methods is callNextMethod
#' @importFrom stats anova
#' @export
#'
#' @examples
#'
#' data("sleepstudy", package="lme4")
#' m <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy)
#' anova(m) # with p-values from F-tests using Satterthwaite's denominator df
#' anova(m, ddf="lme4") # no p-values
#'
#' # Use the Kenward-Roger method
#' if(requireNamespace("pbkrtest", quietly = TRUE))
#' anova(m, ddf="Kenward-Roger")
#'
#' \dontshow{
#' an1 <- anova(m) # with p-values from F-tests using Satterthwaite's denominator df
#' an2 <- anova(m, ddf="lme4")
#' stopifnot(
#' all(colnames(an1) == c("Sum Sq", "Mean Sq", "NumDF", "DenDF", "F value", "Pr(>F)")),
#' !"Pr(>F)" %in% colnames(an2),
#' all(!is.na(an1)),
#' all(!is.na(an2))
#' )
#' }
anova.lmerModLmerTest <- function(object, ..., type = c("III", "II", "I", "3", "2", "1"),
ddf=c("Satterthwaite", "Kenward-Roger", "lme4")) {
if(!inherits(object, "lmerModLmerTest") && !inherits(object, "lmerMod")) {
stop("'object' of class: ", paste(class(object), collapse = ", "),
". Expecting object of class 'lmerModLmerTest'")
}
if(!inherits(object, "lmerModLmerTest") && inherits(object, "lmerMod")) {
message("Coercing object to class 'lmerModLmerTest'")
object <- as_lmerModLmerTest(object)
if(!inherits(object, "lmerModLmerTest")) {
warning("Failed to coerce object to class 'lmerModLmerTest'")
return(NextMethod())
}
}
dots <- list(...)
models <- if(length(dots))
sapply(dots, is, "lmerModLmerTest") | sapply(dots, is, "merMod") |
sapply(dots, is, "lm") else logical(0)
if(any(models)) return(NextMethod())
# Note: Need 'NextMethod' here to get printing from anova.merMod right.
ddf <- match.arg(ddf)
if(ddf=="lme4") return(anova(forceNewMerMod(as(object, "lmerMod"), object), ...))
# FIXME: Warn that 'type' is ignored when ddf="lme4"?
single_anova(object=object, type=type, ddf=ddf)
}
# #' @export
# #' @keywords internal
# anova <- function(object, ...) UseMethod("anova")
##############################################
######## single_anova()
##############################################
#' ANOVA Tables for Linear Mixed Models
#'
#' @param object an \code{lmerModLmerTest} object; the result of \code{lmer()}
#' after loading the \pkg{lmerTest}-package.
#' @param type the type of ANOVA table requested (using the SAS terminology for
#' these) with Type I being the familiar sequential ANOVA table.
#' @param ddf method for computing denominator degrees of freedom.
#'
#' @return an ANOVA table
#' @importFrom utils as.roman
#' @importFrom stats model.matrix terms formula
#' @author Rune Haubo B. Christensen
#'
#' @noRd
#' @keywords internal
single_anova <- function(object,
type = c("III", "II", "I", "3", "2", "1", "yates", "marginal", "2b"),
ddf=c("Satterthwaite", "Kenward-Roger")) {
if(!inherits(object, "lmerModLmerTest"))
warning("calling single_anova() ...")
type <- type[1L]
if(!is.character(type)) type <- as.character(type)
type <- match.arg(type)
if(type %in% c("I", "II", "III"))
type <- as.character(as.integer(as.roman(type)))
ddf <- match.arg(ddf)
# Get list of contrast matrices (L) - one for each model term:
L_list <- if(type == "1") {
get_contrasts_type1(object)
} else if(type == "2") {
get_contrasts_type2_unfolded(object)
} else if(type == "2b") {
get_contrasts_type2(object)
} else if(type == "3") {
get_contrasts_type3(object)
} else if(type == "yates") {
get_contrasts_yates(object)
} else if(type == "marginal") {
get_contrasts_marginal(object)
} else {
stop("'type' not recognized")
}
# Get F-test for each term and collect in table:
table <- rbindall(lapply(L_list, function(L) contestMD(object, L, ddf=ddf)))
# Format ANOVA table and return:
if(length(nm <- setdiff(names(L_list), rownames(table)))) {
tab <- array(NA_real_, dim=c(length(nm), 6L),
dimnames = list(nm, colnames(table)))
table <- rbind(table, tab)
}
method <- switch(ddf, "Satterthwaite" = "Satterthwaite's",
"Kenward-Roger" = "Kenward-Roger's")
# Format 'type':
type <- if(type == "marginal") {
"Marginal"
} else if (type == "yates" || type == "3b") {
"Yates"
} else if(grepl("b|c", type)) {
alph <- gsub("[0-9]", "", type)
paste0("Type ", as.roman(as.integer(gsub("b|c", "", type))), alph)
} else paste("Type", as.roman(as.integer(type)))
attr(table, "heading") <-
paste(type, "Analysis of Variance Table", "with", method, "method")
attr(table, "hypotheses") <- L_list
class(table) <- c("anova", "data.frame")
table
}
##############################################
######## show_tests.anova()
##############################################
#' Show Hypothesis Tests in ANOVA Tables
#'
#' Extracts hypothesis matrices for terms in ANOVA tables detailing exactly which
#' functions of the parameters are being tested in anova tables.
#'
#' @param object an anova table with a \code{"hypotheses"} attribute.
#' @param fractions display entries in the hypothesis matrices as fractions?
#' @param names if \code{FALSE} column and row names of the hypothesis matrices
#' are suppressed.
#' @param ... currently not used.
#'
#' @return a list of hypothesis matrices.
#' @importFrom MASS fractions
#' @author Rune Haubo B. Christensen
#' @seealso \code{\link[=show_tests.ls_means]{show_tests}} for \code{ls_means}
#' objects.
#' @export
#'
#' @examples
#'
#' # Fit basic model to the 'cake' data:
#' data("cake", package="lme4")
#' fm1 <- lmer(angle ~ recipe * temp + (1|recipe:replicate), cake)
#'
#' # Type 3 anova table:
#' (an <- anova(fm1, type="3"))
#'
#' # Display tests/hypotheses for type 1, 2, and 3 ANOVA tables:
#' # (and illustrate effects of 'fractions' and 'names' arguments)
#' show_tests(anova(fm1, type="1"))
#' show_tests(anova(fm1, type="2"), fractions=TRUE, names=FALSE)
#' show_tests(an, fractions=TRUE)
#'
show_tests.anova <- function(object, fractions=FALSE, names=TRUE, ...)
NextMethod() # use default method
##############################################
######## show_tests()
##############################################
#' Show Tests Generic Function and Default Method
#'
#' @param object a suitable object with an \code{"hypotheses"} attribute, e.g. an
#' anova table or an \code{ls_means} table as defined in \pkg{lmerTest}.
#' @param ... parsed on to methods; currently not used in the default method.
#'
#' @export
#' @author Rune Haubo B. Christensen
#' @seealso \code{\link{show_tests.anova}} and \code{\link{show_tests.ls_means}}
#' @keywords internal
show_tests <- function(object, ...) UseMethod("show_tests")
##############################################
######## show_tests.default()
##############################################
#' @rdname show_tests
#'
#' @param fractions display entries in the hypothesis matrices as fractions?
#' @param names if \code{FALSE} column and row names of the hypothesis matrices
#' are suppressed.
#' @export
#' @author Rune Haubo B. Christensen
#' @keywords internal
show_tests.default <- function(object, fractions=FALSE, names=TRUE, ...) {
tests <- attr(object, "hypotheses")
# FIXME: Maybe this should be a generic with a method for anova objects?
if(is.null(tests))
stop("'object' does not have an 'hypotheses' attribute")
if(fractions) tests <- lapply(tests, MASS::fractions)
if(names) tests else lapply(tests, unname)
}
lmerTest/R/data_documentation.R 0000644 0001762 0000144 00000016120 15131137167 016244 0 ustar ligges users #############################################################################
# Copyright (c) 2013-2026 Alexandra Kuznetsova, Per Bruun Brockhoff, and
# Rune Haubo Bojesen Christensen
#
# This file is part of the lmerTest package for R (*lmerTest*)
#
# *lmerTest* is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# *lmerTest* is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# A copy of the GNU General Public License is available at
# and/or
# .
#############################################################################
#
# data_documentation.R - roxygen2 documentation for datasets.
# Datasets documented in this file:
#
# - carrots
# - ham
# - TVbo
##############################################
######## carrots
##############################################
#' Consumer Preference Mapping of Carrots
#'
#' In a consumer study 103 consumers scored their preference of 12 danish
#' carrot types on a scale from 1 to 7. Moreover the consumers scored the
#' degree of sweetness, bitterness and crispiness in the products.
#'
#' The carrots were harvested in autumn 1996 and tested in march 1997. In
#' addition to the consumer survey, the carrot products were evaluated by
#' a trained panel of tasters, the sensory panel, with respect to a
#' number of sensory (taste, odour and texture) properties. Since usually
#' a high number of (correlated) properties (variables) are used, in this
#' case 14, it is a common procedure to use a few, often 2, combined
#' variables that contain as much of the information in the sensory
#' variables as possible. This is achieved by extracting the first two
#' principal components in a principal components analysis (PCA) on the
#' product-by-property panel average data matrix. In this data set the
#' variables for the first two principal components are named
#' (\code{sens1} and \code{sens2}).
#'
#' @docType data
#'
#' @usage data(carrots)
#'
#' @format
#' \describe{
#' \item{Consumer}{factor with 103 levels: numbering identifying consumers.}
#' \item{Frequency}{factor with 5 levels; "How often do you eat carrots?"
#' 1: once a week or more, 2: once
#' every two weeks, 3: once every three weeks, 4: at least once month,
#' 5: less than once a month.}
#' \item{Gender}{factor with 2 levels. 1: male, 2:female.}
#' \item{Age}{factor with 4 levels. 1: less than 25 years, 2: 26-40 years,
#' 3: 41-60 years, 4 more than 61 years.}
#' \item{Homesize}{factor with two levels. Number of persons in the household.
#' 1: 1 or 2 persons, 2: 3 or more persons.}
#' \item{Work}{factor with 7 levels. different types of employment.
#' 1: unskilled worker(no education),
#' 2: skilled worker(with education), 3: office worker, 4: housewife (or man),
#' 5: independent
#' businessman/ self-employment, 6: student, 7: retired}
#' \item{Income}{factor with 4 levels. 1: <150000, 2: 150000-300000,
#' 3: 300000-500000, 4: >500000}
#' \item{Preference}{consumer score on a seven-point scale.}
#' \item{Sweetness}{consumer score on a seven-point scale.}
#' \item{Bitterness}{consumer score on a seven-point scale.}
#' \item{Crispness}{consumer score on a seven-point scale.}
#' \item{sens1}{first sensory variable derived from a PCA.}
#' \item{sens2}{second sensory variable derived from a PCA.}
#' \item{Product}{factor on 12 levels.}
#' }
#'
#' @keywords datasets
#' @source Per Bruun Brockhoff, The Royal Veterinary and Agricultural University,
#' Denmark.
#'
#' @examples
#'
#' fm <- lmer(Preference ~ sens2 + Homesize + (1 + sens2 | Consumer), data=carrots)
#' anova(fm)
#'
"carrots"
##############################################
######## ham
##############################################
#' Conjoint Study of Dry Cured Ham
#'
#' One of the purposes of the study was to investigate the effect of
#' information given to the consumers measured in hedonic liking for the
#' hams. Two of the hams were Spanish and two were Norwegian, each origin
#' representing different salt levels and different aging time. The
#' information about origin was given in such way that both true and
#' false information was given. Essentially a 4x2 design with 4 samples
#' and 2 information levels. A total of 81 Consumers participated in the
#' study.
#'
#' @docType data
#'
#' @usage data(ham)
#'
#' @format
#' \describe{
#' \item{Consumer}{factor with 81 levels: numbering identifying consumers.}
#' \item{Product}{factor with four levels.}
#' \item{Informed.liking}{numeric: hedonic liking for the products.}
#' \item{Information}{factor with two levels.}
#' \item{Gender}{factor with two levels.}
#' \item{Age}{numeric: age of Consumer.}
#' }
#'
#' @keywords datasets
#'
#' @references
#' T. Næs, V. Lengard, S. Bølling Johansen, M. Hersleth (2010)
#' Alternative methods for combining design variables and consumer preference
#' with information about attitudes and demographics in conjoint analysis,
#' \emph{Food Quality and Preference}, 10-4, 368-378, ISSN 0950-3293,
#' \doi{10.1016/j.foodqual.2009.09.004}.
#'
#' @examples
#'
#' # Simple model for the ham data:
#' fm <- lmer(Informed.liking ~ Product*Information + (1|Consumer) , data=ham)
#'
#' # Anova table for the fixed effects:
#' anova(fm)
#'
#' \dontrun{
#' # Fit 'big' model:
#' fm <- lmer(Informed.liking ~ Product*Information*Gender*Age +
#' + (1|Consumer) + (1|Consumer:Product) +
#' (1|Consumer:Information),
#' data=ham)
#' step_fm <- step(fm)
#' step_fm # Display elimination results
#' final_fm <- get_model(step_fm)
#' }
#'
"ham"
##############################################
######## TVbo
##############################################
#' Sensory Assesment of B&O TVs
#'
#' The TVbo dataset has kindly been made available by the Danish high-end
#' consumer electronics company
#' \href{https://www.bang-olufsen.com}{Bang & Olufsen}.
#' The main purpose was to assess 12 different TV sets (products) specified by
#' the two attributes Picture and TVset.
#' 15 different response variables (characteristics of the
#' product) were assessed by a trained panel with 8 assessors.
#'
#' @format
#' \describe{
#' \item{Assessor}{factor with 8 levels assessors.}
#' \item{TVset}{product factor with 3 levels.}
#' \item{Picture}{product factor with 4 levels.}
#' }
#' In addition the following 15 numeric (response) variables are the
#' characteristics on which the TV sets (products) are assessed:
#'
#' Coloursaturation, Colourbalance, Noise, Depth, Sharpness, Lightlevel,
#' Contrast, Sharpnessofmovement, Flickeringstationary, Flickeringmovement,
#' Distortion, Dimglasseffect, Cutting, Flossyedges, Elasticeffect.
#'
#' @docType data
#'
#' @usage data(TVbo)
#'
#' @examples
#'
#' fm <- lmer(Coloursaturation ~ TVset + Picture + (1|Assessor:TVset) +
#' (1|Assessor), data=TVbo)
#' ranova(fm)
#' anova(fm)
#'
"TVbo"
lmerTest/R/ranova.R 0000644 0001762 0000144 00000036173 15131142407 013673 0 ustar ligges users #############################################################################
# Copyright (c) 2013-2026 Alexandra Kuznetsova, Per Bruun Brockhoff, and
# Rune Haubo Bojesen Christensen
#
# This file is part of the lmerTest package for R (*lmerTest*)
#
# *lmerTest* is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# *lmerTest* is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# A copy of the GNU General Public License is available at
# and/or
# .
#############################################################################
#
# ranova.R - random effects ANOVA table
# ------- Contents: --------
#
# --- exported function: ---
#
# ranova
# rand
#
# --- utility functions: ---
#
# rm_complete_terms
# get_lm_call
# get_newforms
# get_logLik
# mk_LRtab
# has_ranef
# has_terms
# get_lhs
# get_rhs
#
##############################################
######## ranova(); rand()
##############################################
#' ANOVA-Like Table for Random-Effects
#'
#' Compute an ANOVA-like table with tests of random-effect terms in the model.
#' Each random-effect term is reduced or removed and likelihood ratio tests of
#' model reductions are presented in a form similar to that of
#' \code{\link[=drop1.lmerModLmerTest]{drop1}}.
#' \code{rand} is an alias for \code{ranova}.
#'
#' If the model is fitted with REML the tests are REML-likelihood ratio tests.
#'
#' A random-effect term of the form \code{(f1 + f2 | gr)} is reduced to
#' terms of the form \code{(f2 | gr)} and \code{(f1 | gr)} and these reduced
#' models are compared to the original model.
#' If \code{reduce.terms} is \code{FALSE} \code{(f1 + f2 | gr)} is removed
#' instead.
#'
#' A random-effect term of the form \code{(f1 | gr)} is reduced to \code{(1 | gr)}
#' (unless \code{reduce.terms} is \code{FALSE}).
#'
#' A random-effect term of the form \code{(1 | gr)} is not reduced but
#' simply removed.
#'
#' A random-effect term of the form \code{(0 + f1 | gr)} or \code{(-1 + f1 | gr)}
#' is reduced (if \code{reduce.terms = TRUE}) to \code{(1 | gr)}.
#'
#' In this exposition it is immaterial whether \code{f1} and \code{f2} are
#' factors or continuous variables.
#'
#' A random-effect term of the form \code{(1 | gr1/gr2)} is automatically
#' expanded to two terms: \code{(1 | gr2:gr1)} and \code{(1 | gr1)} using
#' \code{\link[reformulas]{findbars_x}}.
#'
#' If the model contains structured covariance matrices
#' (introduced with \pkg{lme4} version 2.0-0, cf. \code{help(Covariance-class}))
#' other than \code{us} (eg. terms such as
#' \code{diag(0 + gr1 | gr2)}, \code{cs(gr1 | gr2)} etc.) \code{ranova} behaves
#' as if \code{reduce.terms = FALSE}, ie. terms are removed rather than reduced.
#'
#' @note Note that \code{anova} can be used to compare two models and will often
#' be able to produce the same tests as \code{ranova}. This is, however, not always the
#' case as illustrated in the examples.
#'
#' @section Warning:
#' In certain cases tests of non-nested models may be generated. An example
#' is when \code{(0 + poly(x, 2) | gr)} is reduced (the default) to \code{(1 | gr)}.
#' To our best knowledge non-nested model comparisons are only generated in
#' cases which are statistical nonsense anyway (such as in this example where
#' the random intercept is suppressed).
#'
#'
#' @param model a linear mixed effect model fitted with \code{lmer()}
#' (inheriting from class \code{lmerMod}).
#' @param reduce.terms if \code{TRUE} (default) random-effect terms are
#' reduced (if possible). If \code{FALSE} random-effect terms are simply
#' removed.
#' @param ... currently ignored
#'
#' @return an ANOVA-like table with single term deletions of random-effects
#' inheriting from class \code{anova} and \code{data.frame} with the columns:
#' \item{npar}{number of model parameters.}
#' \item{logLik}{the log-likelihood for the model. Note that this is the
#' REML-logLik if the model is fitted with REML.}
#' \item{AIC}{the AIC for the model evaluated as \code{-2*(logLik - npar)}.
#' Smaller is better.}
#' \item{LRT}{the likelihood ratio test statistic; twice the difference in
#' log-likelihood, which is asymptotically chi-square distributed.}
#' \item{Df}{degrees of freedom for the likelihood ratio test: the difference in
#' number of model parameters.}
#' \item{Pr(>Chisq)}{the p-value.}
#' @export
#' @author Rune Haubo B. Christensen and Alexandra Kuznetsova
#'
#' @seealso \code{\link[=drop1.lmerModLmerTest]{drop1}} for tests of marginal
#' fixed-effect terms and
#' \code{\link{anova}} for usual anova tables for fixed-effect terms.
#' @importFrom stats formula nobs update as.formula
#' @importFrom lme4 getME
#' @importFrom reformulas nobars splitForm findbars_x
#'
#' @examples
#'
#' # Test reduction of (Days | Subject) to (1 | Subject):
#' fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy)
#' ranova(fm1) # 2 df test
#'
#' # This test can also be achieved with anova():
#' fm2 <- lmer(Reaction ~ Days + (1|Subject), sleepstudy)
#' anova(fm1, fm2, refit=FALSE)
#'
#' # Illustrate reduce.test argument:
#' # Test removal of (Days | Subject):
#' ranova(fm1, reduce.terms = FALSE) # 3 df test
#'
#' # The likelihood ratio test statistic is in this case:
#' fm3 <- lm(Reaction ~ Days, sleepstudy)
#' 2*c(logLik(fm1, REML=TRUE) - logLik(fm3, REML=TRUE)) # LRT
#'
#' # anova() is not always able to perform the same tests as ranova(),
#' # for example:
#' anova(fm1, fm3, refit=FALSE) # compares REML with ML and should not be used
#' anova(fm1, fm3, refit=TRUE) # is a test of ML fits and not what we seek
#'
#' # Also note that the lmer-fit needs to come first - not an lm-fit:
#' # anova(fm3, fm1) # does not work and gives an error
#'
#' # ranova() may not generate all relevant test:
#' # For the following model ranova() indicates that we should not reduce
#' # (TVset | Assessor):
#' fm <- lmer(Coloursaturation ~ TVset * Picture + (TVset | Assessor), data=TVbo)
#' ranova(fm)
#' # However, a more appropriate model is:
#' fm2 <- lmer(Coloursaturation ~ TVset * Picture + (1 | TVset:Assessor), data=TVbo)
#' anova(fm, fm2, refit=FALSE)
#' # fm and fm2 has essentially the same fit to data but fm uses 5 parameters
#' # more than fm2.
#'
ranova <- function(model, reduce.terms=TRUE, ...) {
if(!inherits(model, "lmerMod"))
stop("'model' should be an lmer-fit: \"inherits(model, 'lmerMod')\" is not TRUE")
isREML <- getME(model, "is_REML")
nobs_model <- nobs(model)
ll <- get_logLik(model) # store df and logLik
orig_form <- formula(model)
orig_rhs <- orig_form[[length(orig_form)]]
if(!has_ranef(orig_rhs))
stop("Model should have at least one random-effects term")
# Reconstruct formula:
orig_lhs <- orig_form[[2]]
fe_rhs <- deparse2(nobars(orig_rhs))
reforms <- findbars_x(orig_rhs, default.special = NULL,
specials = .known_specials,
expand_doublevert_method = "split")
specials <- vapply(reforms, function(ref) splitForm(ref)$reTrmClasses,
character(1L))
has_specials <- any(!specials %in% c("", "us"))
reforms_chr <- lapply(seq_along(reforms), function(i) { # i <- 1
## Coerce RE formula expressions to character and ensure that they either
## have a 'special' (eg. 'diag(g | f)') or parentheses '(g | f)' rather
## than being naked, 'g | f', and remove the 'us'-special:
res <- deparse2(reforms[[i]])
res <- gsub("^us\\(", "\\(", res) # remove us special if present
if(specials[i] %in% c("us", "") && !grepl("^\\(", res))
res <- paste0("(", res)
if(specials[i] %in% c("us", "") && !grepl("\\)$", res))
res <- paste0(res, ")")
res
})
full_rhs <- paste(c(list(fe_rhs), reforms_chr), collapse=" + ")
full_form <- as.formula(paste0(orig_lhs, "~", full_rhs))
new_forms <- if(!reduce.terms || has_specials) { # || has_double_bar) {
## Remove each of the RE terms in turn:
lapply(setNames(seq_along(reforms_chr), unlist(reforms_chr)), function(i) {
new_rhs <- paste(c(list(fe_rhs), reforms_chr[-i]), collapse=" + ")
new_form <- as.formula(paste0(orig_lhs, "~", new_rhs))
environment(new_form) <- environment(orig_form)
new_form
})
} else { ## Reduce each of the RE terms in turn:
unlist(lapply(reforms_chr, get_newforms, full_formula=full_form))
}
for(nform in new_forms) { # For each new formula. nform <- new_forms[[1]]
newfit <- if(!has_ranef(nform)) { # If no random effects: fit with lm
lm_call <- as.call(get_lm_call(model, nform))
## Evaluate linear model trying various environments:
ff <- environment(formula(model))
pf <- parent.frame() ## save parent frame in case we need it
sf <- sys.frames()[[1]]
ff2 <- environment(model)
res <- tryCatch(eval(lm_call, envir=pf),
error=function(e) {
tryCatch(eval(lm_call, envir=ff),
error=function(e) {
tryCatch(eval(lm_call, envir=ff2),
error=function(e) {
tryCatch(eval(lm_call, envir=sf),
error=function(e) {
"error" })})})})
if(is.character(res) && res == "res")
stop("Unable to evaluate model without random effects using 'lm'")
res
} else eval.parent(update(model, formula=nform))
# Check that models were fit to the same number of observations:
nobs_newfit <- nobs(newfit)
if(all(is.finite(c(nobs_model, nobs_newfit))) && nobs_newfit != nobs_model)
stop("number of rows in use has changed: remove missing values?")
ll <- rbind(ll, get_logLik(newfit, REML=isREML)) # store df and logLik
}
# Collect information in ANOVA table and return:
aov <- mk_LRtab(ll)
rownames(aov) <- c("", names(new_forms))
head <- c("ANOVA-like table for random-effects: Single term deletions",
"\nModel:", deparse2(full_form))
attr(aov, "formulae") <- new_forms
structure(aov, heading = head, class = c("anova", "data.frame"))
}
#' @rdname ranova
#' @export
rand <- ranova
##############################################
######## ranova utility functions below
##############################################
.known_specials <- c("us", "cs", "diag", "ar1")
#' Remove Terms from Formula
#'
#' Remove fixef or ranef terms from formula, return a list of modified formulae
#' with environment restored to that of the original formula.
#'
#' @param terms character vector (or list) of terms to remove from
#' \code{full_formula}
#' @param full_formula formula
#'
#' @importFrom stats update.formula
#' @noRd
#' @keywords internal
rm_complete_terms <- function(terms, full_formula) {
# Remove random-effect formula terms from original model formula (full_formula)
forms <- lapply(terms, function(reform) {
form <- update.formula(full_formula, paste0("~.- ", reform))
environment(form) <- environment(full_formula)
form
})
names(forms) <- terms
forms
}
#' @importFrom stats getCall
get_lm_call <- function(object, formula) {
# object: lmerMod object
# formula: model formula without random effects
Call <- as.list(getCall(object))
notkeep <- c("control", "start", "verbose", "devFunOnly", "REML")
Call <- Call[!names(Call) %in% notkeep]
Call$formula <- formula
Call[[1]] <- as.name("lm")
Call
}
#' @importFrom stats update.formula drop.scope
get_newforms <- function(form, full_formula) {
# Update full_formula by reducing the random-effect structure of 'form'
#
# form: a deparse'd random-effect formula term
# full_formula: the original model formula with lhs, fixed and random terms
#
form <- gsub("^\\(|\\)$", "", trimws(form))
rhs <- get_rhs(form) # rhs of random term: (lhs | rhs)
lhs <- get_lhs(form) # lhs of random term: (lhs | rhs)
scope <- drop.scope(lhs) # Determine terms to drop from lhs
# Determine list of updates to 'form'
update_forms <- if(!has_terms(lhs) || length(scope) == 0L) {# length(scope) >= 1
# Remove entire re-term if lhs is '1':
setNames(list(paste0("~.- (", form, ")")), paste0("(", form, ")"))
} else {
# Drop terms from lhs of random term:
ll <- lapply(scope, function(scp) { # scp <- scope
# If there are no other terms in lhs than scp set new_lhs to just ~1:
new_lhs <- if(setequal(attr(terms(lhs), "term.labels"), scp)) "1" else {
tmp <- deparse2(update.formula(lhs, paste("~.-", scp)))
gsub("~", "", tmp, fixed=TRUE)
}
new_form <- paste0("(", new_lhs, " | ", rhs, ")")
paste0("~.- (", form, ")", " + ", new_form)
})
names(ll) <- paste(scope, paste0("in (", form, ")"))
ll
}
# Update original formula 'full_formula' with update_forms and return:
lapply(update_forms, function(upd) {
form <- update.formula(full_formula, upd)
environment(form) <- environment(full_formula)
form
})
}
#' @importFrom stats logLik
get_logLik <- function(object, ...) {
# Extract data.frame with "df" and "logLik" values from object.
ll <- logLik(object, ...)
data.frame("Df"=attr(ll, "df"), "logLik"=c(ll))
}
#' @importFrom stats pchisq
mk_LRtab <- function(x) {
# Compute drop1-table with LR-tests
# x: a 2-col data.frame with "Df" and "logLik"; 1st row is the full model
chisq_pval <- function(q, df, ...) pchisq(q=q, ifelse(df > 0, df, NA_real_), ...)
stopifnot(is.data.frame(x), colnames(x) == c("Df", "logLik"))
res <- data.frame("npar" = x[, "Df"],
"logLik" = x[, "logLik"],
"AIC" = -2*x[, "logLik"] + 2*x[, "Df"],
"LRT" = NA_real_,
"Df" = NA_real_,
"Pr(>Chisq)" = NA_real_, check.names = FALSE)
if(nrow(x) >= 2) {
res[-1, "LRT"] <- 2*(x[1, "logLik"] - x[-1, "logLik"])
res[-1, "Df"] <- x[1, "Df"] - x[-1, "Df"]
res[-1, "Pr(>Chisq)"] <-
chisq_pval(res[-1, "LRT"], res[-1, "Df"], lower.tail=FALSE)
}
rownames(res) <- rownames(x)
res
}
has_ranef <- function(form) {
# Determine if formula 'form' contain random effect terms.
if(is.character(form)) form <- deparse2(form)
length(grep("|", form, fixed=TRUE)) > 0
}
has_terms <- function(form) {
# Determine if formula 'form' contain any terms beyond intercept.
length(attr(terms(form), "term.labels")) > 0
}
get_lhs <- function(ranef_term) {
# Extract lhs in (lhs | rhs)
if(!is.character(ranef_term)) ranef_term <- deparse2(ranef_term)
lhs <- trimws(gsub("\\|.*$", "", ranef_term))
form <- as.formula(paste0("~", lhs))
form
## Add "1" for intercept if is suppressed:
# FIXME: Only if there no other terms in lhs?
# if(attr(terms(form), "intercept") == 1) form else
# as.formula(paste0("~1 + ", lhs))
}
get_rhs <- function(ranef_term) {
# Extract rhs in (lhs | rhs)
if(!is.character(ranef_term)) ranef_term <- deparse2(ranef_term)
trimws(gsub("^.*\\|", "", ranef_term))
}
lmerTest/data/ 0000755 0001762 0000144 00000000000 15125475223 012770 5 ustar ligges users lmerTest/data/TVbo.rda 0000644 0001762 0000144 00000011402 15125475223 014330 0 ustar ligges users numRD)R,QH"%gVa7GEQSFٲʢA rH&NР]gB* z7fZfo㟽h43hf㥙u7\ӟF+Gf o5;Kk{W^7a#s/ƿ 88T=[w>\~b$=g{Gq 7|+|l63ߌN-Rf?g ?Yi
Ũ7o
'L$ThtB[kctv|]?? UN==}ɿ}ɿ7|X?{U^7σ*7êUnVj5Zй |M=ơQ^=[|W ̷UtnWf߬\[z~|[jܻփOU}yəѭ8{ сzpr@?V*oVi x> kZ~w [Nn 8} vu[^w'[/ϮێkvRtߌ=GaG
=}WZg-uW_cEg+t=0 KM>\TRn^]%\
}'WxzgLY
v^/' x ? z֟!7E^ / 'A/ˎ/*H\Ѿ Vơ*v
r& r oǃqoǏr\ z_OuߎyWc :8:?"zx?
>2 wѵ'5ܴ?'7C W'
ggN؛8+?~[_@ 3)# O:yckП ?aƋa4} OX}i Zϭ:'Ny>C8N>Pzn ;Cykwb $϶Xw߄]Ű/r73 vZ_y<$pm=w輘 xsr l9F|:O/վNc ?*L٪?u+7EN8~_/yLۄ3lEڭ`/ iz3_~_=t7z&ijxĞbchIkvQ<Z &ma W= V;Eb>a\ r GӘW;}c['
|3Hn'~j ?-Fs7C- 0/}^y[ggr xs(!> yG >7cpʞ7;F' ~pzx?]r8~;;"/t|ٿ89ż5gU s <
wS[1.;#}ktAw??%1? Y/\4?5G'x{_ Z ug~M^stn5LwDo=_Ezi 8}|[ov~I>Uu:5VqK/Uw~Q}Ru l9|?:#+o}fUnYs1zb}ay)~2sWMxr1??J='ݎy׳u3 t>／yY{B
5? }s!Wz SΉi1G}Ng? k}W.Ⱥ :ϑk<{|_w/1{QG^=7OǪ˃{G f{s r=h(p^%{sSaOǁГq On#q`3?sHoʼW ۱|_7}v {ЫR{( PV[;L\{OsodGv>97fxL| ss' N=}R˧ӋF~s_i~9G>ש+UW6+9Stߎ:;J߃5}.X| ?}ѷnz *ItC^!7zw?p|r*5NGק.O|5ݘg0]#ZOe;2Iӧ{Ϋ=2? C:giG~*g Cx{Mɿy2i~O='o_J5Ŏs(W'w0 }T;oJi8 %{׆/gޗ P)VV+'e ź ⇝f>>4}&S{f*=s{~O*L]3UVǁR _~}7?
G[CVs6y~j|YJoG~!o_6_Rѿ1G$~5:x?I/L}g=ߣ3^ܰ>qIyw$ޒ#.~_⏧ֹޭF`(oЍBC0n+q_c 9UzOU鯗yqƱ ~~A _3IP7&{xCv6um L~4+$ o7qI9>ϴ
ᖽ_w>*ŧz_eҾei@'x/O}*/N rg;O r_s ~.>'7NjO/ıA\^9/r iFs8_qwmko;r=~]
=9xU.//Nrkc[r!]y{-k_W;
Uʒ>*Kٵsz[Ke%; <'?/ ٿB5Igj/ ={W=ߏ=*{2gc j G7CNZmz~?}Gտw}(!_jԺhy/r} ~%o H^C;~@>̎'7we < (1?J9zR+%|_ ֱ_t=7~ K瓸;7' =tA: O}8!n#ہ~Sc}R{aa~;^L)=PdH=O$gee8^?ɹ ~|O.Ąy)\оp3IMW 3tτh/8~ 7gI-i1ER9>I pV~?Ve/U6 kљww^ ] ~pt,Mۭ觿:
~yy |fpn+>gXC\k$ ~Oʾgկ{y<%^JhW>'o%j *y`t3+x '?T}OƇUڕ}vK j`mpwe_;mt/{]xUw|9> 7,g [_rG7bٿw_~vpxٳq/>;_? ?k |{ 1ѠgM(`~W?۟曧!Ý >?2: D6 j lmerTest/data/carrots.rda 0000644 0001762 0000144 00000011262 15125475223 015137 0 ustar ligges users ]kU>}tP)(RE-;3{KrZ[.rSpN)8m F3M 1ޢQӍ_Fb1^"R9sy=o:|s=y| 7[w4KM6H<7h,,-^<=9!:J*)SRQI%%EI#JUV%MIoPJڮ tި7)b%YI(i.U[t.W[6%]IW( JzTһtޭ(j%WISN%]]Jzv+iLI%UTSҸ&4)%M+Z%}@I T҇a%QҌS^%]tnRJEI*#JMI+i+J:JCIw*.%ݭ) %ݫt PǕ %=I%*a%)鐒J:GtԱV:R?V?hv i]M&tpr Va ;pЉt"vC'mIrҦ)'mIrҦ)'mډv"i'bډv"i'b-{; swXu5w8';rNژ6植9icNژ6植9icNژVq*Y18ǡ Uo[u"NDՉ:}NZI:i5'DԜQs"jND͉954;iNڸ6;Ä6MiN 0sJN:.+.+.+.+.+.+.+ qqqǝPT;2hOgͣW@HI7P7k
`y;ih:_CCćs;~i쓷~,Mz_yZ)t,^ۆKNbk`w
vϮ` vw069{o
zڄNa tMa˗A?o|gæϠ7o獢}1~_1kԱmv9+-im zw 6ʛCK hwBڞ͎Uhwo4x跾 Ƴͮ/^߹fx7 l}9z7}Bϰg|؛F> %]h
æ36[JO7KZ[B"ĆнQw:Z
JꝖBc /m| [ʛ>6~Bs]C
mO-? {s
}IZ(L#77in܃w
я`+gq|2. X#0$,ȓjrp?=36|1= &0g= 8H8* XoX^e;`_s鞔OR~Iyk:LSK yþ~OK:!ᳯ.5 }_S6Cb
A~ea> g'UưxF8)n@|rJ12w玢W^uKFsK= Uư )9.أIuM=|xX*0 {v/&n$_H W9>%G9Sz+R7 ^_0xF[\{ƻ xb i3K0߬IOpJeؗa k/W7c%>p5%o0ZQ!1 rKQ'be>#q?el[)XS.[uyB_SmFoe! 'a{$/ŸvfܓV]68/Np#frrb w8v8VH}ڇㆯK|E xZ9 %E_ sq}X뜣zt)s }_B|^덄U?b*"`:%<c'% ҚՓ}/]g;$8Nvh<9'Z8 vᜯ5 v ľ :cFǼ 汄o}7
$882u)s 6Kd? pX۸fC Y75ee8ƚk}y'~|5Ok RӉǾ@_>g Dv_K{vE5m [uA%㷃;hC IRx>[?H~ૻ[`_!c6Yo)N Xc^w֓1L냘kϲp X{R]P
/R0
{l3!.[9b(cI ǹ9p U#^qQ!|q"\'c܇mlKi}^w7w{чW? ǘ#{| _,}:yoL/)-x6[Lν"CZ}\hl/X Rl_y'1rQG]"Z߸Ļ > _^tvW ?LyqcZW;lg{q}clF]q<6hW$RUO,^Z,tB bAJ|6p}""'_NK6CQo1`uź8\2y"O\'^/6~fต|n`OkzkC==
1.9_ {}=g;c `V 8}1 +99 hs7b6cߕKq=N& T81tH28ny${a}kϵS: v^/c Pf5}ɔl1k5>ȏc\gٿb'^6vp9#] ۸w> G= Y]S!-Ryetm*}' s$ܷa1%:sø< gגtMDžGk\cƜ .p^u3?pˇMl%my̥~哟kfoOܳS'N4_x{g
c:_͘oמ7K+ {T/87>/?Orɩ+;F8G G G G G G G G G G~r b}y;_ܲyrK'N'~rW+6k{sfv<}_>q/uϩ:T6rgpz?3`o ._ G G G G G G G G G 'cRyG&4iI[t^ q| q| q| q| 969<`<[ezcyyۭfکe¼:oϾha'uھ{`ruv ٹFյ;닭۬*// }hԨh}~Cu[ =YhaOcxR8X8ttn9X8ˮBcӧ_1٥])kf3 %*> lmerTest/data/ham.rda 0000644 0001762 0000144 00000002607 15125475223 014232 0 ustar ligges users s6!R$-Iڦ m Si^IS[}?ݸHfuF3O b )R/7 sδٶW~J:%\
ty߳g|BBBDX"t˄S gg /^"L8Gx*57o"Mx.=yE% WW >&|BJ%bBBH !' s/ _&|CNANIppppp=? <-d3}wfG[k%H&L&\2dz6xk]ͭi.\TsriN5bՈU#VX5bՈU#VX%j/Q{K^D}ND5RHU#UT5RHU#UT5RHU#SL52T#SL52T#SL5rU#W\5rU#W\5rUPB5
\B-jP˅Z.rO-rOF/5'9 ܓoe[|kjʛ)oʛ)oWJM$'I _\ݧOysyns),C^6=Iz0m 7 [.(GJߤ}>}7偫r
f"P'mw1Ne@{O!'.yvy6^;!زq 28>=!Աm_e\b}1
ۧvv(cC; v\1Dۆkvq&}..탖CK] @}{jQM]r >+^}"q1Դl~/y<ox y S\G$"(-w8}qb~EY|s )H_a\a\5pQk&m&m&m&m&GRgwʬq?n?nNz,o/NE;7u~<{M}\t 7lCLH lEiJ`{X=9 ۓƏawg^ٞ.gwOS
9b?=
/ 6~t l}a{t}NV,~ٞUl|X|v ؞>>3.]ή?l|X}F>`̻'ouSϰ;sJy>= gGǣ? nƻ՝߶fOMG١`fF3 *.L_WqpϟO]We7}/L= "2.0-0")
importFrom(lme4, forceNewMerMod)
if(getRversion() >= "3.3.0") {
importFrom("stats", sigma)
} else {
export(sigma)
}
S3method(anova,lmerModLmerTest)
S3method(anova,merModLmerTest)
S3method(as.data.frame,ls_means)
S3method(contest,lmerMod)
S3method(contest,lmerModLmerTest)
S3method(contest1D,lmerMod)
S3method(contest1D,lmerModLmerTest)
S3method(contestMD,lmerMod)
S3method(contestMD,lmerModLmerTest)
S3method(difflsmeans,lmerModLmerTest)
S3method(difflsmeans,merModLmerTest)
S3method(drop1,lmerModLmerTest)
S3method(drop1,merModLmerTest)
S3method(get_model,step_list)
S3method(ls_means,lmerModLmerTest)
S3method(ls_means,merModLmerTest)
S3method(lsmeansLT,lmerModLmerTest)
S3method(lsmeansLT,merModLmerTest)
S3method(plot,ls_means)
S3method(plot,step_list)
S3method(print,ls_means)
S3method(print,step_list)
S3method(show_tests,anova)
S3method(show_tests,default)
S3method(show_tests,ls_means)
S3method(step,default)
S3method(step,lmerModLmerTest)
S3method(step,merModLmerTest)
S3method(summary,lmerModLmerTest)
S3method(summary,merModLmerTest)
S3method(update,lmerModLmerTest)
export(as_lmerModLmerTest)
export(calcSatterth)
export(contest)
export(contest1D)
export(contestMD)
export(difflsmeans)
export(get_model)
export(lmer)
export(lmerModLmerTest)
export(ls_means)
export(lsmeansLT)
export(merModLmerTest)
export(rand)
export(ranova)
export(show_tests)
export(step)
exportClasses(lmerModLmerTest)
exportClasses(merModLmerTest)
importClassesFrom(lme4,lmerMod)
importFrom(MASS,fractions)
importFrom(MASS,ginv)
importFrom(ggplot2,aes)
importFrom(ggplot2,element_text)
importFrom(ggplot2,facet_wrap)
importFrom(ggplot2,geom_bar)
importFrom(ggplot2,geom_errorbar)
importFrom(ggplot2,ggplot)
importFrom(ggplot2,rel)
importFrom(ggplot2,scale_fill_manual)
importFrom(ggplot2,theme)
importFrom(ggplot2,xlab)
importFrom(ggplot2,ylab)
importFrom(graphics,plot)
importFrom(lme4,fixef)
importFrom(lme4,getME)
importFrom(lme4,lmerControl)
importFrom(methods,as)
importFrom(methods,callNextMethod)
importFrom(methods,is)
importFrom(methods,new)
importFrom(methods,signature)
importFrom(numDeriv,hessian)
importFrom(numDeriv,jacobian)
importFrom(reformulas,findbars_x)
importFrom(reformulas,nobars)
importFrom(reformulas,splitForm)
importFrom(stats,.getXlevels)
importFrom(stats,.lm.fit)
importFrom(stats,anova)
importFrom(stats,as.formula)
importFrom(stats,coef)
importFrom(stats,delete.response)
importFrom(stats,drop.scope)
importFrom(stats,drop1)
importFrom(stats,formula)
importFrom(stats,getCall)
importFrom(stats,lm.fit)
importFrom(stats,logLik)
importFrom(stats,model.frame)
importFrom(stats,model.matrix)
importFrom(stats,nobs)
importFrom(stats,pchisq)
importFrom(stats,pf)
importFrom(stats,printCoefmat)
importFrom(stats,pt)
importFrom(stats,qt)
importFrom(stats,resid)
importFrom(stats,setNames)
importFrom(stats,terms)
importFrom(stats,update)
importFrom(stats,update.formula)
importFrom(stats,vcov)
importFrom(utils,as.roman)
importFrom(utils,combn)
importFrom(utils,packageVersion)
lmerTest/NEWS.md 0000644 0001762 0000144 00000011175 15127267445 013171 0 ustar ligges users lmerTest 3.2-0 (January 2026)
------------------
- Update lmerTest to accommodate the new lme4-2.0.0
- Fixed scoping issue reported by Uwe Ligges.
lmerTest 3.1-3 (October 2020)
------------------
- Update a test to accommodate `lme4::anova` reporting `NA` instead of `1` for p-value when df=0.
- No longer print message about missing cells with mean centered covariates for type III anova tables (issue #19)
- Fix step such that fixed effects are reduced even if all random effects are reduced away (issue #23).
lmerTest 3.1-2 (April 2020)
------------------
- Remove argument "..." to accommodate new version of `lme4` (from version `1.1-22`)
- Minor fix to tests to accommodate new version of `lme4` (from version `1.1-22`)
lmerTest 3.1-1
------------------
- Sofie P Jensen is taking over as maintainer replacing Per B Brockhoff.
- Fixing "noLD" CRAN issue (a check that ensures the package works on systems without long doubles). This was caused by an over sensitive test.
lmerTest 3.1-0
------------------
- Adding support for legacy model fits, i.e. `merModLmerTest` objects generated with lmerTest version `< 3.0-0`. This includes defining the `merModLmerTest` class and `anova`, `summary`, `drop1`, `ls_means`, `lsmeansLT` and `difflsmeans` methods. The usual `lme4` methods also work with objects of class `merModLmerTest`.
lmerTest 3.0-1
------------------
- over-sensitive tests (failing on Solaris) have reduced tolerance
- `sigma` and `sigma.merMod` defined and exported for `R <= 3.3.0`
- Warn if Kenward-Roger is used with `R <= 3.3.0` since it may give incorrect results
- Add `lme4 (>= 1.1-10)` and `R (>= 3.2.5)` to `Depends` (last available version where `lmerTest` checks out)
- `pbkrtest` package loaded conditional on availability in tests
lmerTest 3.0-0
------------------
* The new and completely re-written lmerTest package. Details of changes are
available in [pdf](https://github.com/runehaubo/lmerTestR/blob/master/pkg_notes/new_lmerTest.pdf) or [html](http://htmlpreview.github.io/?https://github.com/runehaubo/lmerTestR/blob/master/pkg_notes/new_lmerTest.html)
lmerTest < 3.0-0
------------------
* Signficant news and changes for the 2.0-xx release series is provided below.
2.0-34
- included citation info for JSS
2.0-33
- lsmeans and difflsmeans are now deprecated functions. Changed the names to lsmeansLT and dlsmeansLT
- changed the maintainer field
2.0-32
- changed the message of identifiability to the more appropriate one
2.0-31
- removed lmerTestFunctions.R and restructured the package. added calcSatterth(model, L) for calculating Satterthwaite's approximation for a specified L matrix
2.0-30
- envir.R failed with the newest version of lme4. Changed the code to pass the check. TODO: remove updating the model
2.0-28
- changes in general summary function. callNextMethod changed to as(model, "lmerMod)
2.0-25
- updated according to comments from CRAN
2.0-24 changes:
- cleaned the code
2.0-23 changes:
- hessian and grad changed to mygrad and myhess (deriv.R functions of Rune)
- plots use ggplot2
- look for previous changes in R-Forge
2.0-11 changes:
- elimRandEffs deleted. now the rand table contains all the information
2.0-9 changes:
- fixed.calc option is added to step function
- elimRand effs changed: random effects that are 1 approx to 1e-6 are eliminated
- las=2 in barplots: verical axis names
contrast with the name "l" changed to "l.lmerTest.private.contrasts"
2.0-8 changes:
- throws error for lsmeans, difflsmeans, rand and step functions if the model does not inherit lmerMod class
2.0-7 changes:
- in utils calcSatterth changed: solve of 0 dim matrix now catches in tryCatch - example MAMex.R in tests is added to check the bug
- messages are printed if some computational errors occur in anova or summary and the ones from lme4 are returned (bugSummary.R for testing)
2.0.6 changes:
- added a number of tests in the tests folder and inst/datasets for the testing data sets - will not be included in the R-forge nor CRAN (for a moment)
- model is not updated automatically to REML (tests for random effects are ML!)
- man functions updated
2.0.5 changes:
- fixed bug from Ben - summary(model, "lme4") changed to summary(model, ddf="lme4")
- fixed bug for summary from Cyrus
- added in manual notes regarding random coefficient models simplification
- Rune changed solve to chol2inv in lmerTestFunctions.R
- changed updateModel function so that the bugs with the environments are solved
2.0.4 new:
- rewritten rand table elimination
- added elimrand.R
Modifications in lmerTest 2.0.1
- The elim.num column now has KEEP instead of 0
- X'X deficiency was fixed by Rune, lmerTest was fixed accordingly
lmerTest/inst/ 0000755 0001762 0000144 00000000000 15125475223 013034 5 ustar ligges users lmerTest/inst/CITATION 0000644 0001762 0000144 00000001476 15125475223 014201 0 ustar ligges users bibentry(bibtype = "Article",
title = "{lmerTest} Package: Tests in Linear Mixed Effects Models",
author = c(person(given = "Alexandra",
family = "Kuznetsova",
email = "alku@dtu.dk"),
person(given = c("Per", "B."),
family = "Brockhoff",
email = "perbb@dtu.dk"),
person(given = c("Rune", "H.", "B."),
family = "Christensen",
email = "Rune@ChristensenStatistics.dk")),
journal = "Journal of Statistical Software",
year = "2017",
volume = "82",
number = "13",
pages = "1--26",
doi = "10.18637/jss.v082.i13",
header = "To cite lmerTest in publications use:"
)
lmerTest/inst/testdata/ 0000755 0001762 0000144 00000000000 15125475223 014645 5 ustar ligges users lmerTest/inst/testdata/test_paper_objects.RData 0000644 0001762 0000144 00000004364 15125475223 021450 0 ustar ligges users pݏ܅H~!b]դ47o0)Ij$MBtp]&blT;چ-CfJK -bi?N:`8U#$ݽv.`
z}ik|_` \npWS`?(! RQ/]2-gvT t~˖-timgs|QЯ\fMLfa"Q]gyaD⯇tgwngJ-x珵1%{牭7o*zj?+O|$vdzq()/%I/Nwd0xc3 4B^ xlb)bU}s51,Q'uaQ V.$XT ` P4'Ŧ 2니ʬ7
0w!n ;z B5ll@$JPȱ|R 99J E9r2]P
au= igiNL
7oC|->m=:i0Iv WHKM HY._uG!"/jՇ`\1_ay#:G 9R &Jڋ v
#V9 |$ߎϧ:7RΨW*|){Hug4L.?l{eqtew!˖o}jiU̓D\HPML'w,HX[̐ S" cjo]PoİڗsCͿ_q7c
^ޫߡ^F˿ >7H(hSnAK09Y=ʢ3&A5mB$ړ6emfT.!o ;teΐ'E\^q
c6ݠc6jO4>f}M 3&>1>c?6úٿ-r[=ijןN
17¾t=V asnQV -;;_o\z.c{X k<1k9Feuy[G8 GmYz6 [ S Y||ś#gVnȽ;}|dkQLnj 3Fnj>n/K'&0T~0`j;A@EOP\zqL8.GKkOh&؏۵'rK^H%Gޯܚ bܟ5yvn,OΈ b,L]\ ?"Z9|MzN8ee<>;6 tmr-|a
XxX8YY
DWY0ySfEz5N0ϰ{%|lFBdHi/Ґ{qio/n yfvSڢ,^agm=_2 SWv6ĸn,QE6)@s|RҰ81(s|F+Lm ֹ0N(YL 1 lmerTest/inst/testdata/legacy_fits.RData 0000644 0001762 0000144 00000306707 15125475223 020070 0 ustar ligges users =x ճ.ٲܻ}{{eqmmtZIg+E5'B
!!B $ @HB
鄐B
!
;ovs<;3ｙy͛6[\"UʐB*I Vw-"JXunFFo2ʹz5Rƻ.Rz=#:cBTU4 I M鹴Z6'zbdKKdxJ]Z$% H+2)җvK8Z4!-t\Ӻәl[KTKko8m[ uWM.uKힻ%}OVuJ͌;W= j_?m5jo7|}[M5_ѶG^U/E+wvz'qj#W'IjlSW ?5<{+9== uWl^ҟ?ծ~vT;s1kyGkzkߢ__;S=xˇ'?TzUjպ3I{&bojf'5hʉW< zUZCOV=W ww\lS]]$5=7SԞc} |z}O==/_LjF
GM-W̳#}FMR{W{jWyڅDh +o{Igo B+NioR0g>'z.= oTSc~}'G\ vk+j/۾|\6?ߠf߰ݫ}jGY=ͨvqwzh#wU?ҩO] ꎾpjBW҂Sc~F5ǨCy
Zjb^&~{_{f'W;_MVM|oϮ]|ԮS5jׇ7X =-?ZeSn=?CR_A=U4ש6 ^~筹YO~ ']PvRlv _\]= /RAVr7SkJSڵ璏jjwßj"q{gڣvWl;B53V~j>^h|m7?V~L='?ɝ?uܐ:guQ1=tNu|kkqj^/Iz}k./c>!mԃ7˝z5h[9-|}Z R2 pߢagο=כ{/]'Tn~QG =W*5h}..iGSR:#w];M]zڤ_A NUטmz־S/ٟ{{Wލf~FKC5#?CjF{M=t~RzB=E3|GjR#Kz}z{UV{G_W̍j8.W
GjPt.BYЋw|
#%۩f~G6I_1?0Ԓϛ
j-Mp CL22222⫠S" >'TjPj}BO
>aO}aDVǵ -ΦØ`UE KE%ϥeϥ6e6e6e6vvv2ށPݮn>fP`W8dTWšQI"qvTci7׀y]81ˠ
T)-El'OrIj$Cad ɓejڂ(y2fX:֝njSZ;Hk4,vLѴqw6]hH=bqBQj.-?ZOэdEؠ"7$-Z;g|c =iuwyѥ/-^+ʫ{Ggo VWTבOwf6>/[},|(c}o7g䄄: GrÌm;qq
[SO*ٗ:W ѹc xxƍ=:eF>rtڔ
Kͷ|eyjø< ~:{ԙk .oG}.<:tϸ
K+:~
uwaF-g"7ie_M]jTnВ2]]}[-DUz8I{8pzٮ9YPq$FR7 qY@) H$pCDWKJ߬O5EHֱM^}VʐoSU:hƪdR'B[UUk`ctGLwkZw&墱k"}JX"EKz>K8ն^h7zhZ]āM 4 0 G.@8`lq N Xpa)<n71;G%UrT9QB5@i3!
:*p0L Qo f0[~ tX @}3t.5:AaEMpg@=dԩtg[st8Wt@tد%:PZA@-:PciH3Ձں-rWpppf n:ܦ[uxo :Kw :|Pp :|ROӻG=} ×uxHu_:<:|K'tI ~ÏuO+ ~t:UguxNtxI ^_:C1낣8>P(WtP耭ˆˆˆ+ EW*zRtPtPtPtPt٠(9:ӡE:財財財財財Z pueCeCeCeCeC١N v4"y&n'4bړM;!1:뒐BJRZ범
b~mr/a,)RV
+`VX+*XE__K_K_ˬ_˭_+_+_
KBH,1
Y%dHhERRRRRRRRR%!KB,
-h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,hX" # k XEB,']BH})
^.vAvq>n{tT xa.Ac9-Ⴊ2J@ۍD4ϝf %6uL;֞Hf\"uqm1LDcw#-,]VGdʍl"vȸC P%hGIv Rshukƚ&25* ukH*#z=8($' T3Q ;_ãV=ǺFRi=XK=*T =o ۞G}n @}#Q* Tz` ȟ=]Ӕ
**WdB6 =( I5<3rC 5*Z犟 0h:|L,U(kh"uSS
pؘ۸ WC*qXX[镞-cܶ] !Oi[ohq#@`M#?Y.v}'GgG
Yt<`gtv'_~Yxo )[V>?OpqsL/Xҫ8
Du㈪yRY[Sl, ϦB~)m.Ͷ/YP|8kH"Ωbe6ڍX /nw, Y[ $_t+rkma㑉6?d?æaNw ԛkL:#:M-ilgXZa6
ߌءe%
`qo!
Zgܴ& w0P)t[Q[g ¾ `9
(V7qtKQa9,=llۻj 22222s8'%k;o( rX!c*<ΘSWWW=M{_{4?4=M{H>4j^5ښh֝
*7E`SLh?I
fEm@73~_bې
Š~ȸJk/6x+
~-[UJn,oH -9ua@yGzm9h:Q}sgJkܶhTY}4Ct>CTEwjGr6$2ᄼمĩ3$3}T\ {D,3b]ܽ/R5Y:."7DYtIBt3QYkF끢h :f .6_z sif0N#iumiB24 _)+|* O x~PSzk x@ Ci-IA'x^w
ԫWȻ-bTcKZlvu $!*T*#lLhz
#; y &pwJKޖޚh,P7`Rum X^r0 T_A P; h!HYh2
l%%~RVUz7lސAz+^Y ֺf3UnAT2kX:)\Kl(eK{ y>▢:wIsvqp v(++].SߣlQVZeIrۼ.(w5#eMQVQ4YRl
RW
H(?^ Q Y
`
lF Qq>?HWd4չd
[`=N c 5+履b^5E㊦#y'5#R q .O1\66 Sn*1~"}$>^y FX=FG zivu'gU
.j)7 rV?-*eՂ
5#mn//KX?\)
G'ƍ(d7S[Tux/Rt9ց<5pCOzk7X{ b-)ջ;=.&I[J]^tuba U wi. 1{wS 7BB:sA JS/#uUcToJmX.sNU邢ȓ:jGXA_)Cz!}5a,R:;nǕ5Ue/Ou]Pdm^[
(<"4=df M|_V7],hR,yi[*_'jyyI?M$J&&)A.SwxvHzeee^RVvCEV*j1B͆(+, *RWg б>{
~7T>K
xKW7
O@Y G{n)+^fwS^I*]PY{ҫ^4(!nMQVsW/BcP-6idWƃ|Ga9c&o3}FB
Z8<ڛjxO^hKv
1aˆzRPYf5 :_8h nO%dfW.sIh,KZ[E |L6
"|) wPQyg cεWVeg~}PW* \f=
N\#]FCv*5Z2T" tjn-ՕDѢd*ܮJwGRi-3/h"UN
vA: z@V PX)0-]s^ηahz%{Tg`I{6_ko' օ&JKI~b_Ϫ6H%yx Wfct_r
ˎg2B$nHt^;
DQ- Mti1 y!(Xw(Dt,.@nX"eT)v(%&'dO$s
ĻM.]J٘D̞S dBww%v ;NRjj^8FE2 -w$G )t9nS
n*7zJggSHMֳ"ަUU:UfHgB8Li{cCA8bw̔ + ̩A 8Nt0ulsoFKE#qͤ]c58gꄩ0ڰ
{3)cb fTtG zXG'5ڲxPޯa1[i? d P- mW)Է?u 5 {3aC٥oGҲ^%s$٠%z$EP!1 %-Z B.7ڮ⚡f@[*dmN\:Bezxdɻ(1,$&]H`x a(Zz:}9PePM!Ah>&) )4H7%]=J7ұ6 x7y碼-4@Oϋ%.A.
Րv%)P7ktxY iC=@TȻ潄
oy yPC.Vltc+?
x>CA3!vw@mV;!<ZLh<]:ge9/{-%(<ߣ.C] i. b߆[ MtgMj(3t3*I% ޑ ~p22i-ROflw=wE2N-M[#p^ e &YfJϚ^e \*>B{sѯ&?3^)cxf}A&ãR0Ҩ % x" ̖X%7sJټ_H'#Ջ;ۭ-eB? AD*I̞'^l0/(F9inB YxpIcdKjP
p L
? SKlD*Qb+ģi۹^q֑|֑2~r*얈fS)i^%zX} 3hCjp,+q|b>" QTXL$n%A2Iv i'zv8 ׄ\D-cp1
OOc)'0:ָe:a3 KimΙ6N`:}v6шwUa,Xh0직ljɮHl u
L7׀QƝѫL%Ҏ G}<'Ga&p9a& ? 0vFRhFOq7{~H
*di,3
ofXWiYp8ݙꚲUH ܺJLgR&r
̅Nkb-ҙsJ6, h8 V6VLgXApPVB_dkXgo:/1!.*I I I2 t`<2ɩ,׃\l-oK .`K( a<|~=7B8|op.~<=4Wh/T={t(QǗo\ѥxI}T dA
_ )1?g* \t'Հg Ui
+@PP 0kI7I6~ݯ>09>^dx; :70Һ : DbХo"S HIH1d=ccKvFP$
+eO;|o1R|3!֎G:㷦VhOfC8¹ /{
XWAy{
QVo'ʳo.Imޏ~A/A#Y=ٝA;΄vd{%CM롨~?$ab_sD}u(Z-Mi?k?ϲ pH;ҎpI;ZH;
Ҏ!zyExH7(dHF6F~hK̆4 {:B݆ P!xwy
g
SKO da{g.{] @?wcgyX|(MB}
ͭ1D eGZJknZ1ZǒD-]+=9']S}ڃ }:>̓>_
п\+TA
DuҶqGrJu@PףtS@Գo| < x
1>f6bٷ2RwvwZwe1ǕwϾ} /@i 'XA"ߏH|`:6 i+mW"?1BH.z|!"=a?x,=k"Yg_'HG.rtQd qWT˘fX"SL {E..So"S12zrzsDzCt&7'&" EzCq7ٔ&[7O9HO؛-\F"~a䎰I WC?9
E+l>$P;6VNb$>>Mg 0SE ce3 +=b4>W61S |X;c t1 ao 2MʃD*3u+l6vȌQ!3Fa'R2BǪt.sk/?.$v\ED.]y,
VO-2"@YA蒠}yoG_ŃUD*3Wue"5D.3kI¯̬#rY? J;̜*!3xHeJn7l"rL2j+i ߕ s:i`<[]v˙D.ۈ]~ʙ/>y"b=El"]er&Wzl=D Wu^"os=8 /R&ZK#> /L / bgXϞȬol
V=
(.C [ \z5|fxpa YX~ 9ɞG!oŶ %uH8b㪆0ae e I u2i+/
7O$
b_e.mpGeA^8k,nD
'uP >
y + Q^Ǽ]Np[L>dMn4O'eN
7@̿Vw鷳gC³
b΅p/@x { ̷ ! OsK l5fQu
G5˥B6]vAA]J6# ŋِbav9}:V ėL^J&qt|r0p ; B3ts >n,E9b~Vh"hpӆ<Չ qniY.,A71u"4[4ދ~ÕE@o8 ЇR <"`d2 $:
Geq^F: \`z X
.p m>6@N x1Yp`i+ |h$ 7>rw e*Ou9ٜ-JK(iMÙdتYÑ x &dW8Hf:T,QVc@X^iQKS4/18Dw_|-H2p6Sz|9S{Ͷ?|L#D/2DΙaWL͆0)<&kg,lhtOJY4 aųA\.S#T֘7ntl" -Nv:9+ bpY*ۅhUDz뉤bDT Mas3^}{6o? "zyT@s?/bT"((7 19@ޟW5 Qmְሠ?؎=Z sr1'aa
<3?_a NXes7k2O$DqY_8`A Ů ==!J:P \ to+&:⽲嶚<=T<ˋO2,0|`؊`!a8G ic5=C_6%}B30B.*JR:w?.5аX[Ld!Q]et=
3Zw=2M,bYsM6wQ&ۃX;yׁ=lyl%Vo.ݽ %l nG7ciZSZH7ṆO-qQ/1Es}V˦
Wzb>Wbn"M!F!!6<ҍ9b N!B 1 #T%yA1]*#q m-ҕ6x2wh2RGRVǺ|V:BsI#eKL/%OqcqlJ|)鳠qK}; 'TÌt \r_~oDiB pF@a\i^k` @9f`2q4u 4hɀg
0 @u ag?6 >{vK8Gdfʦ34E2 t Z8MWZZdLͬd>a'Q[Ƶp_2 ](dJJl 広Ty}%].-\.?a/x_@5h\ wUSDQ@ZC_.u`>Kb|# /*J^!cGbmz Ƣ79|0"6R7
P~
"p7igxHL?O/ Eo]"$P{ܕ( WKD¥#x\&O&c^T Pz.Su(M2UHJ$>er#V<^Ǘ|KE,fl
7d5 <Mo ?B?ӟCP t·*D.8mRYc8Q7\kY_m|Lє(p]/kW;''̱k} ng{/N_nV)GA߯|E _ ş%$=`Rd| {nD5I;l9=5_Xia<=i>_A;t f
hY\yFp8}tR!a0q?c WE9j> 6?SZSYbx g-]Ž hA|qa!&ƺ ;h70 {Sw3@0Cl ,`O *
>Aഀ ¶ ?g& K Lyn*cKeSYow^Q`oziTXo`[iV6ʮ3 0N-ΎNWN{ss,st9 }k M'X4FD4~6-5|ϢMhN ݪ/k߽J
] /zJ)l
2
Cyy_C@ҦV愜N+N%$*}X#OEɦiWWI2{H'{tc|[xcg2@YLXoKL9Mk
Z~2og/IaG'Jt*vՌ͎Pr+=Z*t+Y\h`;bpOKR {lO']3JwI4,{m
Hst\yzP4ć"G5E}S=1Ξb&ь^8;tAiI+
Ff|M ZK*HSC YG= 5kDC!(Pb7
#Ǜ),4oy 7tdM2ʚ!;&u58dgo&2Ӂ/Zvo%~9tH?i>T>mNjG1
(K)r+>y7W,BeD:7T)}1
u"x s7Ȯ) x WQ n2-+`"mS"WKo6 D6 Pz YG f}8}t<<Cb%Є`paF
0
X>a*9 k`.q,([8rgۯ҇Rsvo>KZ#I}مQ cl&Mxw@^@A|Jf}RKy*ewF3o)+I Z*IJa~{koA4hm@] ]JV@I/hOrEQސ9@ѩyjD9O6{6#vߢ@\ 2jPlW C -5ʩ2 6A~Jf bľxTX\Y' 1P.g"=a!$3;N~g Lh^i>N97¯(0q W؊
ñ,p Y hAt5综p += "=aIJkѬ;Bx$ v3}fnY7uºʹ>hۅrY5!*vRÑP^}Qa(} /5+M?wκd*m4BD-UPFy0PӖl W גf4pyXOc،[4}_O\o'd <_ыǮ,, Y 0`;Z}=Ӂy(4 p`~bG_P?_nH'{7 r3Ñ^I;IE:T l~04A
;|a=%e׳ৼuRgq/Ǫ)zMOow⣆𮝭sw6vx+D'0h}M*!'4h j|u ōA_Vgc¶]7m7b7pGx @77_^2>CYЈ)@\s0& ||B3i9`&)(95 b=QXY?8ebxRm'[h+4KR B>Bx}KWK~9`z
w ]~7߃w#=nB{$=
M'՛Gؒ8ǠtIp<@ BnnJ҄I {8SLsߩ1E2Epw
X.y"T0R7
zBxRx>KxHx^,3] bTP6IosHل% ޚT,H/A1g5Os@x [6x~v3Ƴm&%Y$<~}ROERmH_x2/.D~WqvK}D$LGuIiڒƷj\(c9HKQid81Nâ7k^3{I+$ zź4 ^RSEOe-(ĺhjnzʶHW< (筁fu0.*/(d{m|.
+)nUºc:xsıU3E9Ds/QC;&J+̯ҲŇn3 ~uŠjϰ {*=6Yٱ[WC.P^C=
eJ[ eDۯ7T^ ׯM݈~?lv-)) o}nygMDEɶP6 xfu$3H}@,?Nt.óGvo0!B66zg&n#|Q>AE0.Ly_: Gbmy~Kt ?7?6M*,L=?2(䔐W!5D&}xH\̳ϕ0IL,nxkg017aM&*x&>Sys5
-|T:cy9?K?mCўtZ 3ɕRM-SKifuBygʫz7g,iaBEJ)}/v?DFɖ@Y7Ot'
)׆hd(N'tLc۠W J}6l4 F1;@G\vDZ6cg ɱ|DZKeզf;:Z#B[cBkK8e`s6 rgͶLۤ;= >LfmtՔK\R5C̉>|֛(Q1ad
G# $5= $dMKQf EƒqRY[3nNhͳl,g:#zoA4˪oO\O<0sLŚinـJYJVDkl9 +Jh9S q0Tƻ}*Z w;fsJB?kpr q+sPALFgTݝ ()MP>pF=
A^&vԳ}ڮW)ͱ 6D3vͮb iN!'BTbdʿ0`: tñ+X=b`z~U! O&շ1v
%Zc۲TpDKD8rOs"Lm YzY T2;z_3$3}ݱ(2X],KS)69Ĥm> q Oz[UsԔ&ȅ'ZK:K\J'!6t/Lm +:`x5c|)e0-:i3Oj,KEj.O,w#>K!ntX?+C&M< fQqo\n eU^0W h7@-aHo@ ow LF!`p:B6 =GH~O>ڡiS]gj7NqlCo ` ~tw Q>
V :T @㍆Nj5"k ~50[}W@-6/~E[ ֭qƹ=q`:G(ԙL f
X3\s
va>:
ضv
?p&Xc|`rhv>@_=g-x2
7^p/J&>4H1IuM 6Ld"_Ebt]
Uvk) Zp& hRK.
+kFL*S'+އ+\TiЙw+Ư#3{a:c2c *jyJM FۄAI
b|*7E%di_u%Ahx[ix[q8 D` ȲOBTYan ] վۮ6vg@!b5|NO ըe| >"f^6|}xiy?,Fڋ)!]6G ws2g#PJ_QjS~'RyP!hQ!}( RG'\MegB Lߎ:b>jn\śVI:E&)j˳j͙c3Y,~g8O3X?t˳<{-^5n[<5A`ZnvJ 2G{4a .܁w QJ%"qz D8g68`fX<K^-rPWԬZ2ߖ&&L"T$8iUVV
( .6mz*6˪
kHC]}ETzG]Ḃ:'jbmî.H+.w%Hu-wɤٞ8Uºhg$k[v/a& 4xw{ZS:f6 n¯y̯: ҍM&8U v= FrĴk6r}fmIY/:握qLvvԢ4>l.i!px
# ^Tv
-!v{ f@ w nK1. qIdbw?HbM!a4Qľ vVb."t}\ .tth> CY EB~n1m:uT/vr *yu22|
/[{zW=}=Bv F7AS!ffT/[uxcYg1BXuBy tIb&.VfR YGϳr|q/Y ez[Pxw91/9
P\+&|
pNs9\yGCzҼҼEOoB7P]V
A z QƋ.6 N
Il9 ʳx
ihҾ~ ~!k3|؛>=ԽL/0Z I|k>y? K>B64:g?HyWE4@O9d~ yz /yV AKx3}MLc#i Fb?~¯~li 4߀=i 5[ Hm ԕ A#ok]1?3~HqB~q`y>?E<g)ޞye O/OC?/' /[PG:{w 1e kx#:Cg/z"^?BS,\5a<UĒB]AB9R4_vi+xC̊i&
e4RV
ֵHNID۱@O/k_AF@LP ՓPer4hiS1R6M`}|Q@8*7ĵ1/Q~σvyPt]&ABr!Ȼ .
z(+ nuE]*=;#=Bz]W
Z,* j2P\ o}~ʧ[C4uPW!^vPC0/φ<{A{ʟ{!>σtlib͉7ݞV.Ȟʷ~ l:~6 iOй:ѱ 0ݙH-ji/v{ڴH6J'$et5 tedfGpq\ j#x n˶q r_Gfn&vwz7jW8BOҡjFLJz>UnuqdY% { o1djվDPNiI>*4L&asBuO
w0 ۟6ՕMgz"H:eTY^E]&-PKJėq\|C<!GÈhC۟bcUl|xp5_ L~ I]nr}o4 GV>Bs^5ֆ{
Hՙ7Wh|`jp'=2&&Bc:CحA2A4x+'?H%UF_fKa z 四|$sjR/-z!LmX]cB[㺄{#XDMt騧%rjk"i%>XKR.(1uC4ablۻOfnsu"Bw6/(l-Vr~CLJ>^4\
uAo5 0N㥦5=^"c|
6^1Z>}>2we/G&^δ}GRFT"o
D>fm$꤆nL8>K\(k^ώi{ltX[x%Lc <#sS mx1G'=\,x 9`h%o 0WZwKE:RS- QP.AB9:ED*m WazK!Нtq'sZTG.K²ô]T#L*͈֚Ӣn:wQ 3*y&Z W9Wywy$݊Lj2@APvy a'xA|n}^eXEЏ`G뼰m _)P6ҍHtF2tMv9ZPZǭS
e[Myoyo4-rK]K]//uX8q+t &r#ҕeE_*_h)
1?o)r=f}~ ~\!:x\7eI0+y[J^/p TK~Wx E ձLFZ=6!zOk;KZ - ZfYGdvO
D
<ѹ
Rҍ\ztK_{dr+}Vee[[7v3 _O^H% ABdJ.[^6!뛈ҟ{֛ߚ
opoEeZx>[x22Z`;)?ɣU'ܪS>Y Ԣ=VD>M.>.D~%[t<|NZ\>=Jذ|/ aّ|L}|ʿ͞b,[d"ox%.0!m<7z_. /z9/]w$P=ȧwr>!c ָ$ S$?KqI
bO$
϶Vxh J#4D=6ʫ>N Q>^t #DMo$EHO۾uD´4 ޙ4zOl(]l2:?g2z_һZ6۳1ΚM"=X[8Jf~T>OV[A`BܔWcqiMڄۿIÐh-J7R|ߒrٮrm"2O Sz
:=);]*">!|h>]%?wX?(Jbh#ymâ #Jg?QS?)`Myujm[%
#(Ltw2FᴤV E1[ԣ~#xRg^v). u8?xOp=XM4;d>4/;o/TO:j6/NjA@Wrfͧ
s JaMf-^7e.`/?.(?PBԀs:/&ϟy:._T<\?'3z곆j0oxd-#gy~ x N<\& 9x0K (7wC"zEQxdՙTWHw"dIwj[8Ĵ*Spwc(/A(}ɪ|L/a c cWۜgX+a^P| 1>HU@D`.2 Rxtw5`ml47 lLo C
裠qB݆bХAXkiD|
"|Gi&L&T!c'WIJ0Kb\}|Ԓ`TB>14P}=i P xDdv=1
i}ۄXAqP_iY]6a>ך8ᔕ_ينë (AOgcB} k>Ǟ&C{fB!
P8|ɛ>x9'k&xwZw!afܛBǽ^$n&t%lR{,zDZh}LUv/^ U1ŠeQ4gA8Άp> by?ʞ[g=/W(N 뻽t)E.5`@|/$,U!\
WCXkn1 VL5ǰuf@X5fYp {5$QQ7Cb]7. D>q6Op3)xK' 4
I~"{z[Pc&dm%_+m%ec Y np.ҝEYK0w1g}M$ ˲;`.pvAx?>,9C2e $c\g!Cn /hH0{!< fnb#{j> bϗ@Hě`U wɂrƂRyXGA,
o1xC4nxk8qds*bi(oĕ3]BE@.i"U[ I(&-˼cc,3+˼;`>ߊ\y=ȝgk'W1 )cxX d`_' vL'{:q|/bMt "=d\ϏHǽ5,/[ nKe LCC
z:6Pӛ(Bt ѱX.%mtKKIY^yftWBHY y SP Uf/2%8}& tQWldd"5^oaFooDzʧ|n`{=o2 fo6ۯ37[L~V7}KŠ[l@Œ v)$b V MğQ8ڋT7vo#F, >eђ;HY %(`B=VcI9}' 4ULw^5Uiʍti !|.{=8e-i
e6 }~ )#{ r^>2. )}ϧ>>>>>{C~|Rw 1LjphY!}
~ ?VdQ213/d=})? ~ w'q_"_g "_s~a)4nCD2:壘 & .`[1s~¯@U>U>t^7J>
#& W2> s.V|ol^| oAT`2c;}A}|T!| l.gu z;V! !?[^.`^ :lAA$_ |(`y%q*}~#Vz*T{@ 0aF@S`tҎG0''DVJ`a@hAp-E0` +} %}:N [lO؊şL zu;;Xv!ؓEp >g \3^.F.ۙBD m! A' ]`S9 Ѓ' 9}9/"OyZA̵ [*@ (6~EGr< ]ߓ s#~ ~4 32~p 3? `?K/W&{?!`i3Kq3z'N/ 5F%x9 DZ2 4(!FPP !GP XZC E k>aHm#wF`\`"$ LDMF0p୨G?U"0fS)3m̓ s f!0 %` Fc!E>au> lV#X `,>KϞ!XJ`=
ލ 8-` `'6g= ,9\XZ_'
@>Eh^+O]:cH" ADuW$ f*T*'䭎Ʒhf"\U
Wݜi
P2ָV,+")"!"1vWA) z#v#ءXd^
a>9TEiF㦛Bl|,k%(竕c;iCŖ*֒b\=RQ{H)+]99^eR_8x} "H[⤳cg$Sc'e kMER}[U:sZV-er T 'yiQO:E):Kim%YBE!ƦZn7R,cE+۴Zd۪V-]X5ri 9-n5k9:ym8GTf).c|_EF^
:2 [Լe^p褱-8¼D3(0|n:2oaAs[:X법w+E^{Q=p=FXzXlᙑd-<=<;f~'j3w:_poty2 3cYFyawϮs6g48g,*P\ՠ3EMK^rꚥ?A%YkLBm7ЕBNN,]].7ù;NU$+c PzA.Oj%:EXlu~ ؟5KR*$i16{[
/*%էUㇶsKQ|
|($V1x?'1ꊤ6il"Emŗ3\~'@'+u jUa!{́[Lɕ lBUܴIc.8Lҿ=|{^,p@BNMY 4 UNq-Վ)8-X$FT+ p,yiQO\#уmk=Yڅc^8^/1> \j:Z$,qbYV*er -y)N|O*e
1YaeRV+c*E0 'r1wmDK}/ŦZ)o W)yIfQ:8@v[2hm`['^ nm>hڒ%>܊ܺk i=n%+"l!%H'Kʣp Cz
gKh
-@X*X]8BE Dxo( " 4<`{Oc$ͨGZ]vgQAyb6 6HT/|TF
S9#Zx7pN%JQ['" C8xGB@ AuxI~12EL_БNEB6Ij0"YƎ0P
g{0" YW|3eŪn9)|U2Kޮ&eqG Eb 2+/,gl\1,Tm ![^9uePo. u6 \R4Vy ݺvVu}HbZe>Ϧϴ
6Oo
Z&Hj
X> Agl~X_j 5VVf5 0,X:?6Tw͖S}d]ZjgJk5Kig>qʇiHzӴG:٨iGMj_̄c&#sX(<}~B D-nx7
фПcfa@B8#3
*@q
SYRʖnlIxxs%ly"[YNzNcLNb}Q.OaSD¢M
,PƿLS|gNKX$%a.V!5
֙14ר1L#L/p[iZBKŢ!w3 A<[P9;!e/ !Q`\ρxedt&hڬ i;ӎcjsƳRdF$Q ?dS\ɡhO %pY~" @ `lZ.X5-6}($_X |zFdO i _˧\y|)>t7zzs +WCDlQͼDG> NǓuz#n ޘpMk- FŲIܢDQ
Q=.u&'8`{*~PH<6?:
ϣb=%EjL{6
pJdS - qX""m =kec)=5K 3cGVdw<9(׳yaJIR.&|gޮ&"3@?}2fih)'KKsAӇԊ^K@ ?y+$=+~!g߯ίoC
{ 4GC'&} JQh2?bpxgo
C5.o!7@`3|=ubZV և*8bף[Uʠ| !6!4˴^"g0IiSlk" TՀg[\&OafyO0R89bxj/~>Ϗ -f" Lײ2.crAxΛ
ti]+v2Xk| &GgGYR}0x"^l %l]4 ^t'bj"n&|D2VDJ2 :wmMlMvbj|8טfaFL! S$ 0K$3N 貥T? }B 6]? K9tUXSniնi1}@$Jz^\˽ֹfZu$"`Z!8^RS!DUg"-sЎ>ZƎ`+J ZΉ켃&7њ9ֆk1j~Nj^(+ ՄTI5 ee` |}Btjz! wk$1ƋQ8[x ͗-Ifz\ !9~i+,du1BH.º7m} G
S?-8Egaku"mRZ/: t$ L 8 i LJAhd_}P@{Ben'7ߘ~#r3 U@J.}f:a2yzjJ'eku )woCywo%<1u?h!>[*7O7{:9]Fe#]sg;to"Χ|
|
puNm e'ewyzKۿ˥u b 2y
C<zwvyǡx?c | "q#zC# > r|OB9>841h|V]鳐sĩ >bE:Q=y _Р΄/S A B 9^+ <
y !|}
>
y~oǀv& >'m(P(ǘA} c-PIQh@+k~Dl]D;?#~ xX:)DA'~IqW7אBY)Ww-U%rms(7Qsk^1 \p9'k Gwc>Yy>m7m"]~%.nt}鞮Z㬘>Ɨ~O| AM>WvƢBW^ͳ\.VdVktF|U~s3'?l˹GnŭrO21eȺ|Ȫ\ox%@% Q[7q@g.Lzȧ ӄTe M"r>qc
o8@AEk`h֧`GݗSxaQO#"II2V<d!L"J"7'+Ƙrs?rQC2,&Ko0\//NBXne G=-ͳzEr?#k_gq~ ̗ߥš }W;>#Bw{-Q;,kW9xVJ/)؎ Ļ}W(ji NW>qw Hd{ e斨/)_i=q ~U>Q6mUT>xe
oQx|Wo9[/ziDN'ҁϵ 2*gǀwvϔ^HAX)@1kOq w; /=-I$p6'YWwmI- yL}tF2f;Kב|CN"7giy1hE91n>\'G!HoS; F2Z npK 6ypqv !u ?'
1|"4T >G`~/$FċtDC"ڦw1K~^U8ե0nD.!rɌpb|+ :1>_#Ʒ}
^=cz,a~p{2e^""- inu* k'Auμ-FdͦX K3{bG-q0<|zтuU,+vG+ ] ϹGV N r߬ҟn
r p( GO4s|bʒYZ=#uNJ >qT/ 7b| _p_Bd4_>iNYօP/n'Fc" S{L1z"ͫ_{]gUŐd: kk΅:T\QaJFŻ"kASpk6 ^! n. k 9KʍQH]'g˺vjуR;$̉#Uƍ|[=
vk\o Ws,B-'LK>Qe/ IZ NZx0W%FuQ/%F[sh`<=ى/vL8nq8=;UyN([\@~f(^*ss} /[F<|~=7|iaľX/D/1y4F8} G=F Vh ľ-\2
4If(SPU6u'M? kj_63fJg*3Mz`g@8|*{? y±& 낺ė̾JfBҥ@,AFgIXr꣐t)f>c,?pQYqLBҥCҤ9+d&ߚq]k Y5 {}'_<.:`9V >+]otnD.UG-#ˆ5Zlu@kgכɞ@&|np ! V^
͆gכ
u;g:?7>>Ac`z6;!
.#on! 0@$3_N5b ]f:k 0i7WsLaχf?D
DK˷^N >ާ!0ⷎa|MLŸa=H{ v߁L^z! K!BxIѿ «m廪|+So}uf| ul |_ )As D^1DW)]O&J Zkk XA丐t)k |H
i! >xc˯ Ey^HGq7+3(1\]?>t~VH:~S o[z
Dpލ.nޫ4 "`=>C >>`6g0 | HKq⾌A qRd>f|hRVrzu
ew$MķQIJ {LH W;E) ScN:ȱ Mc$Wo6cU|
}}'mutEZ҇P=.SaA4:F@[n5bw%ͨ:HCq5F Y2T"
K=foMWt+zr3 M2Ngٲ U$eTLH?T<̼F:P2g ;Xv~w!ƣ12$d,G/ {K%T
QMJHüXܞF +٦ó'Ĵ u]>HF 5T`e<
M
kM)>RM0zٮ܈uV+j ^<
Cbچ,7yF#.JtyCA<#n^Hl8 Bl+Z;^Ĥ:bn{+1my&xgY3h D9't-c?cyFB n [e84o,wn& t,p\肃џ &)P0 tx:H 0LݐtC q0 >H"(7] se1?XxY k < jn s
]Bw-1?h@T ~Aat7 ?x]# ȌR y/)@ZxalE][Nv*>!}$j">G{eSd7~x|ʬ}l:CWYZ4 r7pzș"-/$RFy}
!rqi"3i uy` =SÉV- uL9 2H"mb"6Mm6l, -8RJO1HcX_=&y{L" ~&-g=\a:Sx|,}#6k&6 T"oiDfӉf ~ɜl3Wz, B7,m6(y%6Gm4?X[R6ro_@dA wP0RF".^xcƋWk&VQ(`kgXngϕaG
fG{ËC|ٶ !ݵZϗAs!cZ-4v(Mp2Z1>ؗۨj6*XX~ ! 8GB87D'@6Bͩxq!aLpS! ,!o σp.s lp6 \hij@/lr),6/.
&ܦ^KEh`8F %1αgڦ` aឆLYf噍?5Y_"`x!XALUVYp
Zp*
ny6 `E `3i<*]t] Hg.%u.ѝdҸyl:
Gm &o'Z]Vg JlT
K >fgBJjɎ Rp6Cr̶1َlt'G`Ac ? Q;!B&HǶQ~ bqt^rZ1E21(<G
Q mzgs
|E\WrlM3n4u-3Ff %0k [q&y*x4iGX~^VgV
0< `PB`l0m<nj}4Ky2'dhN M9r24D5r"4d5j24D;;`/UD(bsciXjcWLuE p'GZZ8i B$*VI-z1}Ȕ#IJs2*E9lX6WiSAA2Ő%-K" "џ" "_=BP$f;I #z6~mjb 3͋\jp fu?U nSς)ĞcWC'ǣ`j}Lf":Bp>U7p5ChZ:,|t8ʀ0a< x x bR)4H7%]=J656 x7y碼I͝Ĝ~x^o! aʑյ"~:< 홐f;; -!1Nφ=x*t- ms_B[KL9|Q /uyG]ʻ\q@Ŀ麷~:lbÅoxc"qX^
"lCP r ?
g$/J G},uBotfaÂv_~/]aeJ+<^GC78aWC'2:a>fMKRL $l|\VXTi[$ 4cmᙆq7Ӻamu8Lfu]תeWJ-I?\
ȱ(`&*Z 8}k"~'2
LD^iH'"T'lIYK#: ~mB
Uv0{ b>?ĞYX%bo n f>[+ p<|*{ t?؛}eWh F fDwԉF iHX1_ K
i?mW7PȦeVMM
#MOLXjL`YcL2K6N#$_^>&ϏWz =?lTV`"JNPrLGAꏾeL- &!m.%r"ib iǶ-]Dù /{
XWT x& 08?1Ql%^o^i=g`O&U?{^آU&⽎uĞЄ`x`4 71Lf$0L FC", +nǷ5l b(LApZ8 pV`wss$\ g HJ T
i9 cz~!K]D-.xdw5ڸnB^J,]Fi[q 3ιuHPzU)Dz|W uޫn6B$l/ls\'lWnMV+H& agJsbza+.Ў'7KعsgV #)}ҝWA PzQE& M&=DѸ 0!u5mFTz<ϥR͘ ,X 7|h'BKn.~ {,=[ 6جāM~ AFf(fKҙ>|_`9 *O6+HXN#۩8f-znۃK\ #LG_ILbX9(l_n9 ڔkAyBbwu.>vq
WBW_ˉSlkNCU > yN!Jg3@Lf /V }>V{ % &"x-Co &*?\N/VDJq˦)6/7Ǘs|6P\כc8>}=7Lfnt蕉D Ov<^8Ǘ:9|9;syMp$Xt.? Tq r
[aw4dP~ hn_獎bDV@~byL Wtݗ ? ݿSMl_v 8}v{[li/>k$ԳIs% ǕxK8p7rX'7~L(
5dT\a6O+,ρB
'PZHΧ>\a9 A/xDk^A7,.N#t@8z>R
^)ľp {ffoE9j> vpVDP?,7:$
.R q8!&V.0 -n,KaHa) w3@0Cl K X`, `=`OPukb(Mp瀂6h۳`^>;{iǕ#!AYL{)vl7+Kψv@>B>8VT_\b^+;/ܛћ+ I{SyޞJvV<"ޘmh&B\߹,ott,l*L1my
<
<
"_r[1zf`>~T''5!$Lx ӭWشч~ =(AtlM6IE^i wK TOܯH:bG`Pdb+*bqb>S;J:ȼjQ &
,W#֣%ӠhkGmJv3[Mx4bR^+JM您NB
5+!7}R@t A.|0eb t~4&\BtVHhݩX25-v%۴8/& wǍS 7̪ nߥK}:^V*)nff-fu
b_h+0(2OMwcmY}nvѵlDG55z1wæ7żc=̌$s3#CmA?(̝ib lƏzHc!( +Rpn8>]A4 C!^4~Ӳf2H>5Ozͨ~fbl|r4~+%1Auxº2ax /2k[}%Se9֮Z߰6T"P!BE·w!*/B:6#ljnQ\.W
.3v& C0RQ x/~\X' A+ ۏ:KA'
{N e̩SL :V7"FsܦہÜ'+ C %'CM)Mbz١ ܨ[Oaͩp_Ӎ`%w(3mg*IfcH M}y;a|wqY;lQn2Vǘb+]" O(|cJ<:ϒЭOSɑ7jO/,%-,}5ΧU 0=EkqZ$Ľ5r
"w8ja2uv[1v6L`iY/+ E8X K8bgPKaV{ubN*qO ǜHM$?uΜHb~?j8SySM؊cpͷXJKhIFdaڏ} g*ab 7R>B9u+j\!7qnbL' n Rg3vi*`K o'}u{? ? F {6 .O\wrWshc
l"Į (7"-
4̪YÑ%z"XpXW*d"gj'C|D2ө`*G룬ǀl:>8m{o8A3wT(*t-5RMkvtг^u
Z8ݭEc1]̂¥zlWtP2ҥѭ,Ql"J< #у-L }L [- ]]yC$hSe䯭-FfuaVEvwit:gsxVk {zt2զKNԬcCxN lYZKG˼psBm ֣htFBiu1z|d?|YJVCWc}zۤ1( XCRO_C
M2RLRrxS$R(jT2A?Xw^;تs/5sNC_u>A0 ~\ ql)ͷkwٍ B^hS, ! jÅShSeJ?W6Y w&
LJͅT#Z
M ;
&2-p t}s_PK cUTCW3]':6~[KxZMұu6%2
ٝ?K>}1
+t Bы8ʄ8!) k)< 1*Y)üX -%6߅_O\VgiP?E T ќuۏK_fy\9 B= 8cB!4@ǯ=w` C6xYA%!-YSAbP'Y̆v %!ʟb.d[t?W'%&uF⾹c4ol"XA`-
8B^:qM@ yS5։~Z([d@ [GN2~X
::冮{K1 8qfg0;/?FX1,lUvj)VY@CAǜԋqܞ=%=~`V,QYA!zs)\ >Paj.`.Td6v2T RB~k N?g#DKvΧp˞{~19S@`
pWpycPK2`f/ 3 anx(H}buYn<,݂,XT46=M>($,&6Yk-fv6o
$3 1ߕ83x@#dʖ]}+KeKʾD}}|:|z/O'ڨT})]}Lfta]#)b|m>/ >ؐ?Wj. dj1)cLiIʮ+D]1Xn "w8O.?t~ARflRmxd[ 9Sl}2k'"uC}1} *mRpbR4[Xaq(.] [ξlg}?&xy 7|p.G x3TEkJAl1˛XA#v SH-.ڶ [ 5܆o}ceX CCyR=ҝX6*5fOe?YOV(~2R ?YQRZYƝAd}J~ 1}JLy)Sp)zO)bNt_ DISĔ'\/O )_//e LSȠ|0ثmTX I+nt&6U.^O -k`nWRZxGt:' ǮHe,ΦiFGH&`/
&l5
I%K]]O5w\%goާfz~ڻ~t&pvާ~?߫M~K7#߮ qf =6rzp3}U>/|M=ЍW~`_
T㙝C?xz5?7zCWz];v&wMծ;:[Le竉OЮ&^W;m/a/_{ Zt }55%R9vԻ~ǧ qVw.O|TM]ޠfߩ =Ge6C>87߫ |WSM\x=+US/W6SM H~%CYx9w~yu_R?v6qOY~ox o9KM-W=K؟^xe$5SjQ= jOŲlݣvozGgTߌݭ> j{~?q˚j]g?YY5~ſ 1GvRes3j
uwWx˿P ? 釫Ʃ7Gzf|^~EMގ]W3g짟T3G'd>n_~LM | ݧ&mҵjo6ެ|JkoU{ޟw}?^G˺Ƈ>^+-k]_|(t{u=/g=#4L=4h/>uzK|#}i5WOߩO5/?{ m;;7 {Cb.aaYZ \XF)h){eY(|lJ
%M(PV^,[/Kg>O$ےZϣq\ٿqĸ{ &zI-kgRׄQbBnW5/آƗz>xV E 0Й~_q:mnb|+5G/t8J yEK+/ Z(Yj+*&l b aˈV#VU72eq.P.q㮞ń
E?m鱘1B~ ,uC_ '788 cq'jY?m+= };vRݺ./ZlY (Z|Q=(Zokan,&ЩǘM~ܓSη$E-=w~cx?f&ϧ$ ^9W`0Ny3{N3o Pgߺ.,F~%1s~|ϊ7xY؈a-syNl8۬#bBĄ[9̿v@&m,ӷX(|{/F,Y7pLq ľ&_bBAE_hSj8wIc~W,l؏^ }-VKx`.V_05+m,
r L")T[u=Vb #jˆiZlpVs״$"Lៜ'%I ]]\*f@>b1pڊU& ;u L猸Znh-g!bî>]ؼz; L/L tkhrk5ϩE϶)"F- G:/FukZ&vWa~֊QOn7 ^?*u{ƉbAh~N/_&,qbK ˊiZ;SbL%KNg¢g cb|C{E [scSh-zD˞Aſľ[w!=j5s0uA٢eFa}>Vo|sQ 1!oZ])3 lb7bJ-JU 0QҧC]"&;Z!Xv(lrlh)%z/iݼDKG-z(!ES1XqZy]&}s
C&E^>ǧ='1ݷbr9?ŁI%;|D%Z
]j"brlA-~hω
˶q Ƈ2ImO~VbIGZ<(痹 f`L7>A]C\6+&2UNѺpG@~ x1۫oI1КÃG UT1xg[1vg1Q53mc]-:+&|ua*}ĄYW'h )q\~E %,vq`he +L Xz0AJ_VsAG܅ae/:n Y?=]MBm#rK|}f1]ZA 3B[wk/ƥE Y_PiS* Xݹz߾cRW5\L4yN%㗀XA)iPIbM6}n&S;DklΎk B1n > n?W_/%?H{r:@a{v?b|俎S vO8&GmX/C+i\i` 1ddn41l?6W7L{yx]1q̷Az (`ygb2?կ;X-@f̯žk"|)Pրb.*x,X%
HC9ܜfHm, 7En3MU$oknj+9,)T[C\S,5p'mm8vñ Q2Whܣ1/h: M7٣MT.pP>ʉb%tui tT:a9=
_o8k m25H"n!K'vX.POYV |AuOvH V.gŻLMUXa[uN22!ϖT' 6ݞ'oλ,V>xX,eUail|x]F~XԪG@}2kp{IϛfQ}S"R VO K扶=j+X,[V\4bIɶ&6oNmH$3Ed&ݧ]ۍ#NhڳjF3Q2of1KjUxa2#m& ZtŒ$_u1#h۲%bIAlnJ,ɠlASrz!EZj:_zD.ߜ5OJѵH+:[ozoVٸG(|r/[=签X~g&9-Xjk ŀ_)% + %6a&?ըMݞBW(bU>a$[[EU>LwѴiO:Dv-mPn$%>/4 }־X u~nxXl;V g晧UO_nh ;p'P-Ҽm?| u^tg-J+᳴w-y}?Z 3AԽm͝f-?[On 7/ B;ՕsN.{ ߱jj:8\9GV A4CJ+0S1
PszհzDJkK:
+69Tfh@b~QR
Lo#¬a#-a1fM-y2AѤ V76,z`BTI ,QafC fx:0lhҤ?`hf-^âfoX|%n@Tp8!b6StZ=!2Fi< uk kb a6DFY
=fZ
B!1O ĥL^X bWf\h?{ZL-4HU=_ pΡ)y(ά3ӍϪ W~*9ytDNl9CĄ7<",@.laTTϘ0K
06鯔&m7U4ɮ_K'pպ{DT"D
a'Yp?,::LD$qS:Nt9+ZB*(mrmEiOoGS\<{~o82*c"gjbDOf7WDTvDdUW\9@'g0%j@<8H'<$d,hX"fMnHYTX,cӱE[wL՚-3HvEbz&X#H+~O&W_spy(W:QVAZJD/|㜴ŊtN,%oT&ϥw[ 1C0q9Z
wxp6ɖ+Vۯ_H:{4- 95fTӅ Fˈ6D=-% ˄W>~{B9yLǁ 6&ItU_.]w;jOҁH^O)lQ=ϴr=oY"\;a曫k7=pgG;"$7 ލ[tmو՟
(={~UJo̖ӧ^a$߯\Gz`V}GCتUgZI9 W[옻>_bRICbʗt.h~,ܲ|Hpi\¼_T;,AԃV Vn 5PX82@:ҵUVewj?vɟ'.ݻuNʛ-C: IK lV hpo9*:I°7{I̪u) a%٦
ޭ^ˇ WZU}A;i焚OƇHLsW(%+GN|YKHi~jp"[nl;hacI烄mOTwqI^~-ٺ1pͭ`#a
gNm46 у^it/mS?_M8#ݙduC/ A˅7k0ʦOF \u\ӗ'N}s N vvwkOr-~Fz:=' ;y\uk7~cv' >^]mU
/SGAنlWxrmOjRr#IX7I=KV, \5H)L EI> ΥnH]%EmR:#v&\8|Bm$>6p{ۧnY89Tk"rm.^t}~|ҫ$td>*µo]X硰Z$#[q:ptnv!nJ}y/-o!\!Pu)Z}jo{N'4ҔLP: yk Y3>hK7ZW*M C>Q鉔ߺp_BW ;[F8C~JNjE']& >6A!Sx:'9ͭ\[A)<}.Eq{p7fUG}Pmp`@VHk=[Uم3,8Y)BOָ%^
c?Fvz uiM?; ߒ hңh2M P<> ) ^I* /@S}3> T}AO6X`UjUm
V6XTjSmp
N68TjWm
^6xUjWmUFՆQaTmUFՆQaTmUFՆIaRmT&ՆIaRmT&ՆIaRm6U@Fj#PTm6UA Fj#HRm6TA Fj#XVm6U`Fj#Xb/<ׄZ `kZ `kZ qqqqq5#fؚ[3bkFl͈5#fLؚ [3ak&l̈́5fLZ bkZ bkZ G~yQ
q=
SwH|q+=.^I5PGkFYG> |x!-,E6̡I dVzbh
"̖~oCG_̻%6*
rϷORsc;j'$Wɓp݈d kO *m#N\ O}rBZ!D8FԎZP_ GmSL I
)#J"i
8q6m )OگEE46%6J]4ZM%D^ܔyv|%}~__)y'G[,(9dtWwuWwuWwuWwuWwe7IgչfF`\U::okƇ^?~߷w}?>n. .'{1#d ds.r@.s.@>\ r.P@1(%\ \ v2.Pʹ@y] Tv*.P@u. p.L.A.!.Pj@m .P@}u.@chM] 4w.Z@kh15dWu ' K4 5?σf
X$f _mvF߃W#pNQ0#3י =JPVCCw$,B1#I mnqGЂ /'6
JsV3~7j
N)ͩ;-]2TJ Jg(NmOxٓ-"+Jq؟HK 34 cm+q9U$F;X7Xr⟰3]AJ%k)pkce (w GX)Ciu*4-Cݾ뎰ZP~APz APʠ=dwɠ=ewfu2h/]$z u' uF u.
a : u7ftv] -2 2h22m2\2XI'CݾCɠsPˠP"A畡nYvʠPvɠPedw{dewʠ P#An
@]]D}7a un 2b2/ȠP# An} un!A}7 u. unQtpc22edw#NȠPB8) CݾpJ]Q}5it%h3221geUdwcɠP!AWnߍG .Cݾ/t
2hݷ2 DK2{$2hN}7 OwWeFd&2@7dA27e2idMlMG-)CݾpG]K}7 un=t l2hA}7o(Cݾ"+Cݾ@]O}7 u GG2P 8n!i!i!i!i!i!i!i!i!V;0O?K9~#7@ D ,a%첄]vY.Ke9"}H#9"}H#rqD8.O NWoY_*
^M8F8}<(%WfwtӨ9? -'<^X=hO5ij'ZicoϾ%M(4b'uZς= =;lB>Jx5_)\lQjJx%( ҃>CM3?]xJ=)#̍n(WɿbO)6g {ѫ1"3: gg%}d_*QSg\Ѓ=PSYPiմQ:S]ZiGT ^ Yo6ks5.hr'yNKڗy/҃UFHgn<4S^JˬhpsoDu_챍fǍu[1oTΑ=s. ^_i5oc ^ޫȼ;|aY\$E (Rau%}%tiOݭ_ #=)wq)zPpvavJ:Nk>_gV!gU vUjNmMSjTjhSROx~i/vWߣ#\tSjDtԨڌUJGɷ ɛ|)- kxta /\f48]"L_jPEV%z]qGxFJ5yG>rXpm G+e
mxg=vzķ~jWx p0I5 ~+!pW,hȾOT>spʄSxJ8%bw|)3Nw5\*Sár*ENߍUW/ޕzF; O.^uO%=g5J=H +³~f6,i65}Px>tj=*E+͘nHB!Zs^QΥc#6O1pVP =(}\{]oݔ)ו~S/VS ŚQMES)reEO{^^*G }5r.<^z0[Ι}}tDse Ѷ w|<#am%x7y^ez~?j~6x-OK '%#gji閊Gy&Wr~E^RJ"j,aOtިy%;[j="*&RFs<{~*xEuU TMrv&_; oKo y@92,1Z/*6"*gp}0!1ȸ4c`:AM0 t ̈& "o"D$ jZȭMī%QZ X7pE8b^hr5RhPm[o,
{{jy#S)'blaoPsdp6$W`f4[ ;
qC on&( 'uN!=qMĵ^% Z nȭ$B`~!U>,r[ w(r+#W [OS{VNM?QMVN-֜L}CvӐQDkpli0
"#FYflPW\9@ZGR;EF{9; WÑʀNDҐ$o-F[Kh?7uWwuWwuWwuWwuWwuWwuWwuWwuWwuWwĕq70aC0KTXlZx5ȿ(;io- VD[2Jߚn~[rudi+tue:A:kX v d|[G[jU8%ӭ#a}tM֡Ce#ؗ`n `$ 5]_`WFhY `ZTV )RY91]wy݊މkط"7"m8{5uZթ4q^zm]]]]]݅n`ЏOꮮ =TwuW_~~~~xS]{UwuWwuWwuWwuWwuup]d6 Wfnf˗re5*o[_Mmˑ? Pz?a֮P?YS:}_]S2O8B r5 wnޠP}d]O d,7oзPjJg:+Dߴ|to\Skm|%|My
m C ZЖG qK TD|j;΅hb/-< tY?z6=m;jAmTʭm gV7ڨ͇bkoq קVw._>;+|~M_{?8A/㖶hB[ Z=꠶j[)?mC)Oe렼cbʄ
t ~F,Nː//5] h1[- X͖ذhC| |bi5[¬ "
psBBe`=1k(9nfx[lr q |"zool|.r Y75J_WN-ږbFSh##F[ #0~F
=' ""@HEȁ9JJ;!A2\Vˠ M *B8Z */Bo2hOT>3: *?B$z BO
2h TA^eо2BQddPz#lAgAA胰ECU!a : B 6t.TqXI'*`AADG.#2 E!+*`A)'*K_U[]@U!a B?2B2ɠ ˠ* @]]DUa ~tQT%AȠɠ*#|p@]\Ua0At TU/AAUCpHmAUGpX]JU! aQtT pc22(aqt90 G
ʈ0
ʄ5it%T h322 1geUdPcɠʠB!AWADpA]]U d5dP& \Aˠ |,A .ɠY0 AEpEˠ!|pUmAG $
Ep] (j
t !T2`T#id!2nˠkʠ @#%j0 ,{2:2ˠT 9ˠETK)22V ȠɠZ#Gx(/)Ex9}^ pc9 ]83 >G %'8qPC݆ j,QP
< A5 P !!!G!! )Y`߇aOa_
)o`߀#l+ aº]?a %_`hڶjV<Υ|ΉmQ<5|;%\ η
Λ c\G+)yc9 ]8p c %8% 8@uj3_@z5.O)Yg@ y
9
y9y>(5
\\O5\?9<ù8o95;90¹,9)w¹%?9"¹ 9PpBp4p&pp
p> |8ñ0%pc) /=8 Qp c
OɔPC
uj#?qPǠVA=ujG
%k 9\5 \\o5\7\5\JL} \ }乵} ͅs9 As|hX
[4+R%МȀ6 ,kGsh쯌h,T46hXeBcN;BP iy "zH#iii[ Ӏ4?
OӀ4?
OӀ4?
OӀ4? iiix iii iiii OӀ4?
OӀ4?
OӀ4?
OӀ4?
OӀ4?
OӀ4?
OӀ4?
Op O/\u,\(\su%\;!\u \\u?
OpAp3p%pp
p- pN496Gù29/¹+9(g¹$/9!php Zp>Lp^>p~0p"pp O 4?
OӀ4?
OӀ4?
Oөh g g grȟu`rɛz ? 3 ? 3 ? 3 ? 3 ? 3 ? 3 ? 3 ? 3 ? 3 ? 3 ? 3 ? 3 ? 3 ? 3 ? 3 ? 3 ? 3 ? 3̧p g g g g g g g g g g g )9c{e
}+<| =Y ,rc{MA| '% "]vY.Ke ,a%D >GsD >GsD8\ a']vy.O ;+T#ZWɏҞҦ>㚅 Zϊ]T KkԙuM;Jx%=U(|Yv)Gk8!רϋUlE pZz־|y 4w7B:s㑥qRj^fE~%*Mdgm=5;nڏxrW٘sɿcr=Oۨy3 됮^EMO ˺"ل-jXtFɔ
(+K#}nu^ IKԃ ˴SAvZ+!|z?sȷ^>Nxs*U{wmkRbWM WGӞ %=_dZ?|CNO{r_ rjT['RcFf+ P:JGfLޤK wnᰇ ][
ќ`/cE2e5[bbbH0KPW\9@DiES鱋P:~ .?1 i9R :FOѪqSTag۪u _~_~̶hP͊m_ mS7˰[;mlTj}=]7wt;mm86yk&\59&e$m=a Φ i;h\6slH"YCUɖ ֚D #Z;xR$j.{;|YqHn3ja1=">ƙ.WOWxY sfD~i蟿蟿??`38CG] u}QG1(|X*L*D4mPF Z> Ajmc !GX B !!32W ,GP#tEXs2fo@tCX%þtr!tGX-þSv!~a_vˍa r[ p2KEny"~a_Fvˇ`FX'þĄ !a [dؗ
"B(þlV!
a [aeؗ݊ A"þV!a 2[1m2Khnb$5lq67leؗ }vȰ/aB a_v+K}ۭ a 6 l{dط`C臰W} [ydط`U@ l˰oIv0
n@8 þۭ
`2 ݪ"| ljCɰov0 lIGdطU`# C8*þ- a81n,2[58'dطq`_!afDpJ} k2[CF#a60 l`dط` C8/þۭ&x 2Tj!| l.ʰoov-B l7a"%m1n"$2[f"LF"þۭ wWeط`G 6 lP)eط`5@ lSnʰovk0
ln˰o vk0 v!l3ʰo%vk0 6#l˰oAvk0o(s\Kn!C-OB <䟀 iiin
OӀ4?
OӀ4?
OӀ4?
OӀtw iii i*iii: iii 4?
OӀ4?
OӀ4?
OӀ4?
OӀ4?
OӀ4?
OӀ4?
OӀ4?
̀4\5.\µ*\5'\Wµ#\ 5 \ \5\wpHp :p=,p] p}p ppO7cy4+0y-)y&K"y ?
opapSpEp7p)p.pN
4 OӀ4?
OӀ4?
OӀ4?{ a g g \V 3 ? 3 ? 3 ? 3 ? 3 ? 3 ? 3 ? 3 ? 3 ? 3 ? 3 ? 3 ? 3 ? 3 ? 3 ? 3 ? 3L{* ? 3 ? 3 ? 3 ? 3 ? 3 ? 3 ? 3 ? 3 ? 3 ? 3 ? 3 ? 3 ?\3 %ӿ%ҿ%W_ɕWre\տx^+WJտk_E^+WJտ+{ڽWrWJտ+{^+v\տ+{ޏ+ ȿ?-iDm %kKז-_[DmIkJm%kKז-_[Dm m z2 sO!C?=z 9Dy '% "]vY.Ke ,a%D >GsD >GsD8\ a']vy.O ] 焿L0䷧IQAO% ]Hʼn$BtD{i1 Ik:)uM/%9KtMF$E^s27yI!Gu$|;"|L&Ǧ~t cm J떉x}x@}bz}f7
7jmp2 ivIM/'QgT&pRAoYAN;qP/ȼgooVj M=wmnN[7(N =4}[}! gy}Nw.kk-s[wwhuS[WdᲘ$'SZEhώ31-ljôa~M?8 Dx_i%˒4y}M< dK3}ME)d]:Ndt A hA_?2]"^@ÉںA.a2 9>|5~unxEZ=lV%6,:ު3VQJ%YJI _?Σn #"̪Z;(gͣb#b y~ y5[>QJxJdN JB) y0[D{D%MT= J8ORۯ9~tX@Q4|;6h%.6 kF@VJa05]TҊ.v .ys1r6(*@$ +4od>|5Tˍ=km2 ]=^>Q>Eh5O\&S,U shJեqL1%@ Ty4eϵ9 wZ ,o,~f[IJe( p7 ƴy@Ŝ$6v}`/,i9v;A
8eqCeAGVT.~%ȼz4QOe
_.|}y7
҃a{ 0\ B{#,}UH{LTi*3
BWtª4)*-OF9OGngh tIIi"s J;˧rW{ 8.r|R*j)-U)3-hGi /JMg! (CxcdU +k)Z%>%W%àk5( ~rd
#f $.{0ɉ2pej"N?@D q5t&97jIQ:>~F%K; ےesfh~tfZ|S7#oZooa@EePS>_'!/^G*U 4%kY)<yPxYDzjN}[C okdzeM^P};'lLZ8-}c7jeblգ9W͋
J)zFoڢTAXF)O[3NV¬osc`E]]]]]]]]] :z|= _z|= _z|=:== _z|= _z|= _7NOz|= _z|= _|s\?s\?s\?s\?s\?ϝ顤>w߷}m?vmm =>߇^o{_?w} z}=c.? _h
}~op*&㴟w;/VfD
p
sdXb^TlDTlφY4t?X-~S>Pv<`e>&:D:JX2իu Jp,4?=Nt= _z|= _z|= _7NOz|= _z|= _ߍz|= _z|= _ _|\?s\?s\?s\?s\?sgoz(鼩m} o[}}_?>.mmo{ w߷s_?}B^/
@{U<QO R< Ǫ>NϨL/P>`UjUm
V6X`UjSmp
N68TjSm
^6xUjWm
^aTmUFՆQaTmUFՆQaTmU&ՆIaRmT&ՆIaRmT&ՆITm6U@Fj#PTm6TA Fj#HRm6T`Fj#XVm6U`ņ[?`/ k^bobkZ `kZ `kZ bk,bk,bk,bk,bk,ak ak ak ak ak ckf 56,:jM**ý 'T4
\kLL
q f%X;OsjQ={YX9*
ٶAM H~ȿEZVƭ/SJ[K߸NRVn NFP4v-pHMh](]eP_{YrZ£,v
O>}|Pʂ\ ,i`Q@eEW (_Q1,%/@ŃclZAf/pQ u4q=Pz^ rx'PQ"7 S d??
W~[
TE~p!^u['N҄ {EeC U(Gi5,!;igڊsXUO/=wZTj3tjUqi 5SA]5vq9^=]-54ӊouQ.MfP-߁uePMn2Si7<3հZ=afe. ՃJɠy&%?Q~LvlHPs9D @(J8m1&Gz
[ " ȖGYPř@@gCN Qg J>t$+5|݆y;-Y蟥)Ӕ KvIsٝ&e7M-&1I!le'6rG[}V_VK4b`tOwLnin_f}vݗmy6P-]gV*R V mҷu}}U
9ye6{^ʐ_1ImS
};ҷc혬,iMJߊѷb>Э:掌[0o/KFз_0{hx^@e<,zNIJS-q})SR,]zuX_~ 6b/Z ;C8<<\dW%D
%=R;n )y)ըP15v:^,Cɼ
ŇMl"5}eeDʥ}{[!m`X 5cb̠{ O;~k_;kO?{/ssyĴmkomi/[c%irA?5' ΞpVޥjNu9H4l;t݉b
5
,Ṟ#{F;:_[Z}yƟ?m?omю_ZUi/fUlze.3ms>XƘ%5 \CڿwAW u kkY[uŞz,[$|h\ӖY|%~|h]Ġ9_m9imW-PwZ g4֞?b;& "gh3h\gWΝ颖gXS1h5|u W_8Ϳ~ܙ\gzqi=Ğ:k\;9 gsMxm9\~qVwO&|1M<:bϠq?m3,_邶 Gl=Mϙ~7+}t68os6:P{Z.ʥ_GNmtȠ =w'1yW6v+gzDw mgm>ͣSM8tRS9bQaQ̭'z+ ԼO_ wãd@ٚhM0X{
V%6, U
sOsfi4Ě aTO7L^d&4ak%fk vS[lJ) &ˇ=Wc;ikE$%3N+ϸs{"3No;lrQND+KVGF+ڝ5f w'd("kʋ#?,~t\qA4$&X
=̆xsxTd91jO2YtwfͧS)|:vgحVLLbf)_eK'u,Xmv~FQ8l~e~A~QJx+Ј_q3QboYboPbe`ʻ%2 <*.S!2~yZ-0+/~~~~~~~~~~<_)'OK}ϗ&o?{͈ksf/x(]suOwU:JU {į6>3ay_/,ßcfґ~5水=U[ ҉&Re yfi/\kτaSS#Di\+٤yaaS(Waڄ#'vL S.[8NVل?r%`Pm}[P±mM6+=`*ZetM6Oo_@ )CV/"]U n2 rv% ~Y}[KKn,_¥+i/]tuSIwv|gϬY潽ʼ'1 b~1yQ_:eJ '$ϳdOK' ޢ %\rSkɲr0T=xtH_~Zw=_ M)r斱M6 ;VUJyEj8R6ﭭ Ҿ\I;M̿(\]x7ska 7:7mS Im) -/2Nv9ь 9OuX*Tx6>ϾUKni3c[p}бf8,,/xwyǔ)_{'i'lO $=H\1A G;ΏX&]Z +Z]\rHJzr &'\ {[$k'WJ5͢tQϳ'=XqKuJ
$J:P_9Go3MQt;/9qrރw0Cm{sxVmIj
Qzo;l_ZTԅm"%mZ}Qȡya#?6Җ9~&K*]ty®Y^~; Jxmu|v0~hOHs0G`Ү}>5}pܹ=.I'qF꧃~\ rNpg ֎ҝ:}Xόǟ] *Pfi"U 3w"Fv!Yx\_ﳹ7Uե~\}>wat)Ե ѥ fU2Exvsŝmݥ}^];ZII {H>8i>km-9Z_ڤo-wʗk_;~ 7vxt+EedE6aئ
ggTp/Z^J^㌒R9yt?_ U?G AG:݅;' ,]epO(O3QhӉIB
~{S8<Ĕws+E1ǰ7 Wr~_l7^1_2] pnL^ox`t̷?v 7n}ӷ~!((6*:lIBj|;#,\]7Ik] D:rln{@{W:O/U*V9 ~m'=P+)ژZm &= .^fw!)WN|eiOs?5r]W7 ''
3gzwi婩7WJ.lyt7HnCkc
)Gçz/(Pң g^ kYI7)Ov3+n=/>7I:lS
f-$>}qΔpΓwxӵ{:<}6pߎ\z9RLNmeӶiFn͒
cf$J_]Z8єyYS}'].TsE][ͯ% F i0ae+eZ%vK~6^y.2
w 5A' `s&2 Eޔe_{I¥#]O
ؤ͟w`%?mw9joVV?N}/M'.Wv \:} c 9lv$u{݅'̻{ kam}Q^tI[vM!0?A/(rlpXir.&: Kmn/][hB?s|7]?57F[VVW2wmbRͮV|Z#J?bdKz]DQ~QC? G:srJŪk wKcW=to<{4)euE 9`SfK0V4Xl0](a8&>AH1s## IzI"]xXr녷9 ?$rk&\Y¹'>iЮ?w\?\faڨ]J|DA?a~I m*1F?M}݅y@JJ%@0xt(;MhW~.z9g,}%BAUܩiv ?
V>~F_7^'6h9R[dȃG/g>@9 á_7c8,[ ~ya#BA;~9N<30OMY%xH!I~r)@^TPn㟅sS.>,?l|~ 5vk$_;zT`C+S3|YhsT^ք Ƈ/ Uk$+=+mw K)['[ G[]nzÍ_>Ajfxã- o3xUİhCBb!.Ґ71 !ZD>]
8FNDioN:InIO[:, v~=8,jHq^ neYo~y皤s P膠tF9N߯ +Zk t OUgYMlckVnxD/L,-[)K/78b{*= hv} O=Z&Ƅ6TNBͱW¢J*-4$(pSE$[5Ąٕod Sgaq~"¬a#-a1EL]mKՍ
m0KTXl>G^74ib02څYfW( o%g 2j0"'".&< uk kb bE
QVCZ
:^!1O ƥL^ DbkF5M:Z8VD˙E~?y*Nzuv @Q\?sқ% wN>غV%MUќU9:m'6v"bB! MiCT0S?3&Lc?ERCf_k P*){' iJ]GtKUY{)%
.\>!927jޢo j̯[j="*FqٟM[T]ѳ
t5 Q:/g>T;Zհ IH}8qK[߽`xKȭk$ *7EuyZUl8ެ;o$p_]L 益*ݱ7M^p#{>k :ԶLv)貟%4+rN+1RsN7)x I(}KwZ9^pXN9>'
?g&AAvZ(5̪rJ Zlp\7iX˺jx(' N2[:AxIt^&/ u )p}WhEY``;hl[W\9@'qaVKԀ4v ?D*N>q%0
$c1Gk Ee͚y^vc× |Z3At2tz\l-_![^gx=m4Sf:Jg* sL:ҋi͡<'X,^]^@R| p̍;^RBB Lť~7O'ژ &_Q}юSKb){~r[;m ?hVoI /ܩ>W#3ZZY\Vr +P7&gIa^Σ_
JH}5__ݛ
vq p #M^l`ǝ=w_ _,)9 pԻsj# ظbܭ ⩙w̶")hTX{֕cIO)٢m
ybmp1^oݷm_K=zi &}}foҝ &aҩҦOlxt*yVq雭9/ Zgݓ| %tФsK鏽}U Ծ!_ ,]<Dž ]pDR N>ۼa ?S/]_}u}p|֭/^A*K\rh Y^[#m[pknLs*,=VBŭڹ7.uu?%ݒ
Fҁϛ3e 9W#E叜*lo m*u̯=' "iC sa?ܸpíxxaՀ
k֟YmR{gQҵܣh["ʜ5qG6[IXƵppzǔ
-3[#p:ų>^z~\w?{46pܸܓ.y4oqڿ6uTQҊٟr>yst; WH ?ث/W,m Ӣc'm9(;;Js?&~
wJ
^թqY56:/~wl°mFo7Zؕ˫ ¥+|%,S-]6[;K)훟D
ҥ&morI?aQ!\&m.1!rooh#ܟIf=o;o'6*ES7$GM̫oV) /gqfC^nH9wc_X$t RJ9//9`+A]zC߸tUd]kmrq+8;cHNgΡpyyUNk:,Ա#Un'pwdנJrϬywp%f
ijBpw
{Ol#ZVsHRb?R?N6j [ս{}tQu_j/K/ }IjIOuݐu^ BEktڱ,9ɳ,=<6uA?^otB ҥB-LӰm/sC,:p=1]kUN}T:QiawtϚiwc
|.][8˃^^1Sb
3s30N]~ou
νfpjL2[y\~vp'g] `CO0xW/CfNk]jo-/k#]^xwJ `'q} VrOda+c{~Cӽ~Zs4yt*s#OH7f 徧&ܺneӻ Ռ {ĭkªQk [!҆-kBJ+\NAXFޛ+f_Z5t9L= C#6piz+6Tw4йҚr5tz$͏z/K:4 sk;̟-='Hy7 GJm5@G>ߴpbQmҍڵC6}'<=Qx$~S&sKFppI¥ՖnK;YkZ8pi+'l3K; yLtYY k?6M *$xI?u%xɔO=gV ֟w}bXK*rpg^eH+o\mYXB8wz~HcL տ;i\J[)ƞ>%=f6f&]yT7\Xj9E\.7F~"%?-S_l=ࠕ6zSiEw>rAVe Y]L3MXӈ: 9BY Af v8 :ފ5fZS4N8x!KADeG0P| a{=}wߏf:7;55_~Q?O~Gfύþ{SouM 3l}?f/n\ȷ/Ȟ]_:母?۞_5o [n^irA'/F_iK9''dC?ueW}ن9S;y%[y]'/méuUxbr0wgMv
m+ hmǍx|kW7^/Ngϻﵯ xx;.?|<s f?/ _wKϞOGo|i#wΞ0!s/tƤlWOiq7Nս ?t 'V_yhj/yz=IMeYo ;j˿?8m/Gdw(CqRKSKSC*r1TZ|(_:%RLd1yL)rL!ѐhH4$
DC!ѐhh44
FChh44
EâaѰhX4,
Gãhx4<
GãQF9hQF9hQF9hTQF%hTQF%hTQF5hTQF5hTQFh(r
cQ11+JJJJJJJJJJԄPjBM 5&ԄPSjJM)5ԔRSjJͨ5fԌQ3jFͨ5ԜSsjNͩ95D-QKD-QKDLLLLLLLLLLBBBBBBBBBBJJJJJJJJJ
KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K K$,IX$aI% K$,IX$aI% K$,IX$aI% K$,IX$aI% K$,IX$aI% K$,IX$aI% K^K#V۰.3zf\|A-h}`?]8Zw7?uw-=:c{>l] >jV_]vzyZwC !/:֓7 q⃧~
Ov9tK:%m=zcW{o,V_+6Z_w{Vqnj>&,6JR{f̙U::{b|k} ;__kmfmn8F░ݳz=3g3
G}_kUӭ1q~mF ZWq-6ncf}ⰴ;3{V]8wn68p Mj lmerTest/inst/testdata/potdata.RData 0000644 0001762 0000144 00000005630 15125475223 017222 0 ustar ligges users V 4k eI,DkYk
cK
Z(;#Y'Cc_BLl0\>.sn{{}~XLƌ P {J܃ c Bō0X4noO4z3EXDMJ
krFK1'̶t9IxZȊm/Ҝ$P:sm Ad"}" /28vIܻ6os1Ԕ|(0 `8Q٥ 0wMؑpXNAKp>uouSfXBS[H'0!uOq5>e o T H.zP1ٟ}MѺR5k9{_ ÷?x^(b)֗eKa>!&A ٶIvna#Ɍ*;VǚITs ='"D-MSM˧3Kgb O TnR`[aڪ
6 mIE!5u@W=
x;Z"Ig
&! ) }Pj˶b&+WW.hmHS#Vg_cj Qtm>i~mY)֊ҡIίؙ-~S$۬G1zI oQ>Y(dQ6 RhfVxi@ޫ$mgܔMw !B^C6QiB,,8},S~b>[g]T7m( gt8KiC#%dX0Du3{
jA.iD.qHy8,D.B d"9?ҿNXOזEJ= FnJbq71gw@GJ<1j-H2PK0B+ue5Bpvl9OY(ГEu\&xTn p!,D^]eP0}L( cH 5Dtsꉉ[I
,ЀEL(ʻxcVv2#Z6DvmOh-#+k /Tʞ.qQՐ1(83mҬ^щMȰ>_/HOrsIE@B[ NW! <z2kEDSs;〩 9;ϬPOd; 2M ϫgS@)+$OTA!Ӟ#d+M 6:2]f#T
i.vf{rWLswA^O8y+[hX gia\==69יKu ࣓I) [ ",wd2Ȃ|Ņ bKՓUQ-9Hx-zRn.#[4K2Zw2_GcH~bɮ4R%okyMj@GkUԅ̂#\͓D(Aw (VI$,)bLsSx'H0pTpɣ[ P{6Je(.fca> ӫE?`_玫s%YϨfl"^wۼ'$}&.y^l5bw$剎ǶH7: aXL5'<\A_D|BQOW<E8i ODoP3B:G}5BkӪs|+=v^Y Y @9po ;w'.ho v1=e A/9`[kQaU?
ohZiw <RG@ 䀎r7?S#@} &K2\z~_A}f*rh9 Ɲ=<_ЯtXGm܋G_}ԄG qըl ]mО[ m0_> Ss/! Bowwww7
lmerTest/man/ 0000755 0001762 0000144 00000000000 15125507603 012630 5 ustar ligges users lmerTest/man/drop1.lmerModLmerTest.Rd 0000644 0001762 0000144 00000006416 15125475223 017233 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/drop1.R
\name{drop1.lmerModLmerTest}
\alias{drop1.lmerModLmerTest}
\title{Drop Marginal Terms from Model}
\usage{
\method{drop1}{lmerModLmerTest}(
object,
scope,
ddf = c("Satterthwaite", "Kenward-Roger", "lme4"),
force_get_contrasts = FALSE,
...
)
}
\arguments{
\item{object}{an \code{\link{lmer}} model fit (of class
\code{"lmerModLmerTest"}.)}
\item{scope}{optional character vector naming terms to be dropped from the
model. Note that only marginal terms can be dropped. To see which terms are
marginal, use \code{drop.scope(terms(object))}.}
\item{ddf}{the method for computing the denominator degrees of freedom and
F-statistics. \code{ddf="Satterthwaite"} (default) uses Satterthwaite's method;
\code{ddf="Kenward-Roger"} uses Kenward-Roger's method.
\code{ddf = "lme4"} returns the \code{drop1} table for \code{merMod} objects
as defined in package \pkg{lme4}.}
\item{force_get_contrasts}{enforce computation of contrast matrices by a
method in which the design matrices for full and restricted models are
compared.}
\item{...}{currently not used.}
}
\value{
An anova-like table with F-tests of marginal terms.
}
\description{
Computes the F-test for all marginal terms, i.e. terms that can be dropped
from the model while respecting the hierarchy of terms in the model.
}
\details{
Simple marginal contrasts are used for all marginal terms unless the design
matrix is rank deficient. In that case (and if \code{force_get_contrasts} is
\code{TRUE}) the contrasts (i.e. restriction matrices on the design matrix
of the full model) are computed by comparison of the design matrices
for full and restricted models. The set of marginal terms considered for
dropping are computed using \code{drop.scope(terms(object))}.
Since all tests are based on tests of contrasts in the full model, no
models are being (re)fitted.
}
\examples{
# Basic usage:
fm <- lmer(angle ~ recipe + temp + (1|recipe:replicate), cake)
drop1(fm) # Using Satterthwaite degrees of freedom
if(requireNamespace("pbkrtest", quietly = TRUE))
drop1(fm, ddf="Kenward-Roger") # Alternative DenDF and F-test method
drop1(fm, ddf="lme4", test="Chi") # Asymptotic Likelihood ratio tests
# Consider a rank-deficient design matrix:
fm <- lmer(angle ~ recipe + temp + temperature + (1|recipe:replicate), cake)
# Here temp accounts for the linear effect of temperature, and
# temperature is an (ordered) factor that accounts for the remaining
# variation between temperatures (4 df).
drop1(fm)
# While temperature is in the model, we cannot test the effect of dropping
# temp. After removing temperature we can test the effect of dropping temp:
drop1(lmer(angle ~ recipe + temp + (1|recipe:replicate), cake))
# Polynomials:
# Note that linear terms should usually not be dropped before squared terms.
# Therefore 'Days' should not be dropped before 'I(Days^2)' despite it being
# tested here:
fm <- lmer(Reaction ~ Days + I(Days^2) + (Days|Subject), sleepstudy)
drop1(fm)
# Using poly() provides a test of the whole polynomial structure - not a
# separate test for the highest order (squared) term:
fm <- lmer(Reaction ~ poly(Days, 2) + (Days|Subject), sleepstudy)
drop1(fm)
}
\seealso{
\code{\link{ranova}} for tests of marginal random terms.
}
\author{
Rune Haubo B. Christensen
}
lmerTest/man/get_model.Rd 0000644 0001762 0000144 00000000553 15125475223 015063 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/step.R
\name{get_model}
\alias{get_model}
\title{Extract Model from an Object}
\usage{
get_model(x, ...)
}
\arguments{
\item{x}{an object.}
\item{...}{currently not used.}
}
\description{
Extract Model from an Object
}
\seealso{
\code{\link{get_model.step_list}}
}
\keyword{internal}
lmerTest/man/anova.lmerModLmerTest.Rd 0000644 0001762 0000144 00000004673 15125475223 017315 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/lmer_anova.R
\name{anova.lmerModLmerTest}
\alias{anova.lmerModLmerTest}
\title{ANOVA Tables for Linear Mixed Models}
\usage{
\method{anova}{lmerModLmerTest}(
object,
...,
type = c("III", "II", "I", "3", "2", "1"),
ddf = c("Satterthwaite", "Kenward-Roger", "lme4")
)
}
\arguments{
\item{object}{an \code{lmerModLmerTest} object; the result of \code{lmer()}
after loading the \pkg{lmerTest}-package.}
\item{...}{potentially additional \code{lmer} or \code{lm} model objects for
comparison of models in which case \code{type} and \code{ddf} arguments are
ignored.}
\item{type}{the type of ANOVA table requested (using SAS terminology)
with Type I being the familiar sequential ANOVA table.}
\item{ddf}{the method for computing the denominator degrees of freedom and
F-statistics. \code{ddf="Satterthwaite"} (default) uses Satterthwaite's method;
\code{ddf="Kenward-Roger"} uses Kenward-Roger's method,
\code{ddf = "lme4"} returns the lme4-anova table, i.e., using the anova
method for \code{lmerMod} objects as defined in the \pkg{lme4}-package and
ignores the \code{type} argument. Partial matching is allowed.}
}
\value{
an ANOVA table
}
\description{
ANOVA table with F-tests and p-values using Satterthwaite's or
Kenward-Roger's method for denominator degrees-of-freedom and F-statistic.
Models should be fitted with
\code{\link{lmer}} from the \pkg{lmerTest}-package.
}
\details{
The \code{"Kenward-Roger"} method calls \code{pbkrtest::KRmodcomp} internally and
reports scaled F-statistics and associated denominator degrees-of-freedom.
}
\examples{
data("sleepstudy", package="lme4")
m <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy)
anova(m) # with p-values from F-tests using Satterthwaite's denominator df
anova(m, ddf="lme4") # no p-values
# Use the Kenward-Roger method
if(requireNamespace("pbkrtest", quietly = TRUE))
anova(m, ddf="Kenward-Roger")
\dontshow{
an1 <- anova(m) # with p-values from F-tests using Satterthwaite's denominator df
an2 <- anova(m, ddf="lme4")
stopifnot(
all(colnames(an1) == c("Sum Sq", "Mean Sq", "NumDF", "DenDF", "F value", "Pr(>F)")),
!"Pr(>F)" \%in\% colnames(an2),
all(!is.na(an1)),
all(!is.na(an2))
)
}
}
\seealso{
\code{\link{contestMD}} for multi degree-of-freedom contrast tests
and \code{\link[pbkrtest]{KRmodcomp}} for the \code{"Kenward-Roger"} method.
}
\author{
Rune Haubo B. Christensen and Alexandra Kuznetsova
}
lmerTest/man/summary.lmerModLmerTest.Rd 0000644 0001762 0000144 00000005521 15125475223 017677 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/lmer_summary.R
\name{summary.lmerModLmerTest}
\alias{summary.lmerModLmerTest}
\title{Summary Method for Linear Mixed Models}
\usage{
\method{summary}{lmerModLmerTest}(object, ..., ddf = c("Satterthwaite", "Kenward-Roger", "lme4"))
}
\arguments{
\item{object}{an lmerModLmerTest object.}
\item{...}{additional arguments passed on to \code{lme4::summary.merMod}}
\item{ddf}{the method for computing the degrees of freedom and
t-statistics. \code{ddf="Satterthwaite"} (default) uses Satterthwaite's method;
\code{ddf="Kenward-Roger"} uses Kenward-Roger's method,
\code{ddf = "lme4"} returns the lme4-summary i.e., using the summary
method for \code{lmerMod} objects as defined in the \pkg{lme4}-package and
ignores the \code{type} argument. Partial matching is allowed.}
}
\value{
A summary object with a coefficient table (a \code{matrix}) including
t-values and p-values. The coefficient table can be extracted with
\code{coef(summary())}.
}
\description{
Summaries of Linear Mixed Models with coefficient tables including t-tests
and p-values using Satterthwaites's or Kenward-Roger's methods for
degrees-of-freedom and t-statistics.
}
\details{
The returned object is of class
\code{c("summary.lmerModLmerTest", "summary.merMod")} utilizing \code{print},
\code{coef} and other methods defined for \code{summary.merMod} objects.
The \code{"Kenward-Roger"} method use methods from the \pkg{pbkrtest} package internally
to compute t-statistics and associated degrees-of-freedom.
}
\examples{
# Fit example model:
data("sleepstudy", package="lme4")
fm <- lmer(Reaction ~ Days + (1|Subject) + (0+Days|Subject), sleepstudy)
# Get model summary:
summary(fm) # Satterthwaite df and t-tests
# Extract coefficient table:
coef(summary(fm))
# Use the Kenward-Roger method
if(requireNamespace("pbkrtest", quietly = TRUE))
summary(fm, ddf="Kenward-Roger")
# The lme4-summary table:
summary(fm, ddf="lme4") # same as summary(as(fm, "lmerMod"))
\dontshow{
# Check that summaries are as expected:
summ_fm <- coef(summary(fm))
summ_fm_lme4 <- coef(summary(fm, ddf="lme4"))
stopifnot(
all(colnames(summ_fm) == c("Estimate", "Std. Error", "df", "t value", "Pr(>|t|)")),
all(colnames(summ_fm_lme4) == c("Estimate", "Std. Error", "t value")),
all(!(is.na(summ_fm))),
all(!(is.na(summ_fm_lme4)))
)
if(requireNamespace("pbkrtest", quietly = TRUE) && getRversion() >= "3.3.3") {
summ_fm_kr <- coef(summary(fm, ddf="Kenward-Roger"))
stopifnot(
all(colnames(summ_fm_kr) == c("Estimate", "Std. Error", "df", "t value", "Pr(>|t|)")),
all(!(is.na(summ_fm_kr)))
)
}
}
}
\seealso{
\code{\link{contest1D}} for one degree-of-freedom contrast tests
and \code{\link[pbkrtest]{KRmodcomp}} for Kenward-Roger F-tests.
}
\author{
Rune Haubo B. Christensen and Alexandra Kuznetsova
}
lmerTest/man/plot.ls_means.Rd 0000644 0001762 0000144 00000002711 15125475223 015700 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/ls_means.R
\name{plot.ls_means}
\alias{plot.ls_means}
\title{Bar Plots of LS-Means}
\usage{
\method{plot}{ls_means}(x, y = NULL, which = NULL, mult = TRUE, ...)
}
\arguments{
\item{x}{an \code{\link{ls_means}} object.}
\item{y}{not used and ignored with a warning.}
\item{which}{optional character vector naming factors for which LS-means should
be plotted. If \code{NULL} (default) plots for all LS-means are generated.}
\item{mult}{if \code{TRUE} and there is more than one term for which to plot
LS-means the plots are organized in panels with \code{facet_wrap}.}
\item{...}{currently not used.}
}
\value{
generates the desired plots and invisibly returns the plot objects.
}
\description{
Bar plots of LS-means using the \pkg{ggplot2} package.
}
\examples{
# Fit example model with 2 factors:
data("cake", package="lme4")
cake$Temp <- factor(cake$temperature, ordered = FALSE)
model <- lmer(angle ~ recipe * Temp + (1|recipe:replicate), cake)
# Extract LS-means:
(lsm <- ls_means(model))
# Multi-frame plot of the LS-means
plot(lsm)
# Compute list of 'single frame' plots:
res <- plot(lsm, mult=FALSE)
# Display each plot separately:
plot(res[[1]])
plot(res[[2]])
# Example with pairwise differences of LS-means:
(lsm <- ls_means(model, pairwise = TRUE))
plot(lsm, which="Temp")
}
\seealso{
\code{\link{ls_means.lmerModLmerTest}}
}
\author{
Rune Haubo B. Christensen
}
\keyword{internal}
lmerTest/man/lmerTest-package.Rd 0000644 0001762 0000144 00000014407 15125477557 016333 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/lmerTest.R
\docType{package}
\name{lmerTest-package}
\alias{lmerTest-package}
\alias{lmerTest}
\title{lmerTest: Tests in Linear Mixed Effects Models}
\description{
The \pkg{lmerTest} package provides p-values in type I, II or III
\code{anova} and \code{summary}
tables for linear mixed models (\code{\link{lmer}} model fits cf. \pkg{lme4})
via Satterthwaite's degrees of freedom method; a Kenward-Roger method is also
available via the \pkg{pbkrtest} package.
Model selection and assessment methods include \code{\link{step}},
\code{\link{drop1}}, anova-like tables for random effects (\code{\link{ranova}}),
least-square means (LS-means; \code{\link{ls_means}})
and tests of linear contrasts of fixed effects (\code{\link{contest}}).
}
\section{Key Functions and Methods}{
\describe{
\item{lmer}{overloads \code{lme4::lmer} and produced an object of class
\code{lmerModLmerTest} which inherits from \code{lmerMod}. In addition to
computing the model (using \code{lme4::lmer}), \code{lmerTest::lmer}
computes a couple of components needed for the evaluation of Satterthwaite's
denominator degrees of freedom.}
\item{anova}{anova method for \code{\link{lmer}} model fits produces
type I, II, and III anova tables for fixed-effect terms with
Satterthwaite and Kenward-Roger methods for denominator degrees of freedom
for F-tests.}
\item{summary}{summary method for \code{\link{lmer}} model fits adds
denominator degrees of freedom and p-values to the coefficient table.}
\item{ranova}{anova-like table of random effects via likelihood ratio tests
with methods for both \code{lmerMod} and \code{lmerModLmerTest} objects.
\code{ranova} can either test reduction of random-effect terms to simpler
structures or it can test removal of entire random-effect terms.}
\item{drop1}{F-tests of fixed-effect terms using Satterthwaite or
Kenward-Roger methods for denominator degrees of freedom. These 'single term
deletion' tables are useful for model selection and tests of marginal terms.
Compared to the likelihood ratio tests of \code{lme4::drop1} the F-tests and
p-values of \code{lmerTest::drop1} are more accurate and considerably faster
since no additional model fitting is required.}
\item{contest}{tests of contrasts, i.e. tests of linear functions of the
fixed-effect coefficients. A user-friendly interface for tests of contrasts
with outputs either as a summary-like table of t-tests or an anova-like table
of F-tests (or a list of either). Contrasts can optionally be tested for
estimability. Contrasts are allowed to be rank-deficient as the rank is
automatically detected and appropriate adjustments made. Methods for
\code{lmerModLmerTest} as well as \code{lmerMod} objects -- the latter avoids
the Satterthwaite specific computations when the Kenward-Roger method is used.}
\item{show_test}{a function which operates on anova tables and LS-means tables
makes it possible to see exactly which
functions of the coefficients are being tested. This is helpful when
differences between type I, II and III anova tables are being considered and
discussed.}
\item{ls_means}{computes the so-called least-squares means (classical Yates
contrasts) as well as pairwise differences of these.}
\item{step}{performs automatic backward model selection of fixed and random
parts of the linear mixed model.}
\item{as_lmerModLmerTest}{an explicit coerce function from class
\code{lmerMod} to \code{lmerModLmerTest}.}
}
}
\section{Details}{
The computational approach is to let \code{lmerTest::lmer} compute the
Hessian and derivatives needed for evaluation of degrees of freedom and
t- and F-tests and to store these in the model object. The
Hessian and derivatives are therefore computed only once per model fit
and reused with each call to \code{anova}, \code{summary}, etc. Evaluation of
t and F-tests does not involve model re-fitting.
\code{lmerTest::lmer} roughly amounts to calling \code{lme4::lmer} followed by
\code{lmerTest::as_lmerModLmerTest}, so for computationally intensive model
fits it can make sense to use \code{lme4::lmer} rather than \code{lmerTest::lmer}
if computational time is an issue and summary tables and anova tables will
not be needed.
}
\examples{
## load lmerTest package
library(lmerTest)
## Fit linear mixed model to the ham data:
fm <- lmer(Informed.liking ~ Gender + Information * Product + (1 | Consumer) +
(1 | Consumer:Product), data=ham)
## Summary including coefficient table with p-values for t-statistics using
## Satterthwaite's method for denominator degrees of freedom:
summary(fm)
## Type III anova table with p-values for F-tests based on Satterthwaite's
## method:
(aov <- anova(fm))
## Inspect the contrast matrix for the Type III test of Product:
show_tests(aov, fractions = TRUE)$Product
## Choose type II anova table with Kenward-Roger method for the F-test:
\dontrun{
if(requireNamespace("pbkrtest", quietly = TRUE))
anova(fm, type=2, ddf="Kenward-Roger")
}
## Anova-like table of random-effect terms using likelihood ratio tests:
ranova(fm)
## F-tests of 'single term deletions' for all marginal terms:
drop1(fm)
## Least-Square means and pairwise differences:
(lsm <- ls_means(fm))
ls_means(fm, which = "Product", pairwise = TRUE)
## ls_means also have plot and as.data.frame methods:
\dontrun{
plot(lsm, which=c("Product", "Information"))
as.data.frame(lsm)
## Inspect the LS-means contrasts:
show_tests(lsm, fractions=TRUE)$Product
}
## Contrast test (contest) using a custom contrast:
## Here we make the 2-df joint test of the main effects of Gender and Information
(L <- diag(length(fixef(fm)))[2:3, ])
contest(fm, L = L)
## backward elimination of non-significant effects:
step_result <- step(fm)
## Elimination tables for random- and fixed-effect terms:
step_result
# Extract the model that step found:
final_model <- get_model(step_result)
}
\references{
Alexandra Kuznetsova, Per B. Brockhoff and Rune H. B. Christensen (2017)
lmerTest Package: Tests in Linear Mixed Effects Models.
\emph{Journal of Statistical Software}, 82(13), 1--26. doi:10.18637/jss.v082.i13
}
\seealso{
Useful links:
\itemize{
\item \url{https://github.com/runehaubo/lmerTestR}
\item Report bugs at \url{https://github.com/runehaubo/lmerTestR/issues}
}
}
\author{
Alexandra Kuznetsova, Per Bruun Brockhoff, Rune Haubo Bojesen Christensen
}
\keyword{internal}
lmerTest/man/ham.Rd 0000644 0001762 0000144 00000003456 15125501775 013700 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/data_documentation.R
\docType{data}
\name{ham}
\alias{ham}
\title{Conjoint Study of Dry Cured Ham}
\format{
\describe{
\item{Consumer}{factor with 81 levels: numbering identifying consumers.}
\item{Product}{factor with four levels.}
\item{Informed.liking}{numeric: hedonic liking for the products.}
\item{Information}{factor with two levels.}
\item{Gender}{factor with two levels.}
\item{Age}{numeric: age of Consumer.}
}
}
\usage{
data(ham)
}
\description{
One of the purposes of the study was to investigate the effect of
information given to the consumers measured in hedonic liking for the
hams. Two of the hams were Spanish and two were Norwegian, each origin
representing different salt levels and different aging time. The
information about origin was given in such way that both true and
false information was given. Essentially a 4x2 design with 4 samples
and 2 information levels. A total of 81 Consumers participated in the
study.
}
\examples{
# Simple model for the ham data:
fm <- lmer(Informed.liking ~ Product*Information + (1|Consumer) , data=ham)
# Anova table for the fixed effects:
anova(fm)
\dontrun{
# Fit 'big' model:
fm <- lmer(Informed.liking ~ Product*Information*Gender*Age +
+ (1|Consumer) + (1|Consumer:Product) +
(1|Consumer:Information),
data=ham)
step_fm <- step(fm)
step_fm # Display elimination results
final_fm <- get_model(step_fm)
}
}
\references{
T. Næs, V. Lengard, S. Bølling Johansen, M. Hersleth (2010)
Alternative methods for combining design variables and consumer preference
with information about attitudes and demographics in conjoint analysis,
\emph{Food Quality and Preference}, 10-4, 368-378, ISSN 0950-3293,
\doi{10.1016/j.foodqual.2009.09.004}.
}
\keyword{datasets}
lmerTest/man/as.data.frame.ls_means.Rd 0000644 0001762 0000144 00000001734 15125475223 017332 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/ls_means.R
\name{as.data.frame.ls_means}
\alias{as.data.frame.ls_means}
\title{Coerce \code{ls_means} Objects to \code{data.frame}s}
\usage{
\method{as.data.frame}{ls_means}(x, ..., add_levels = TRUE)
}
\arguments{
\item{x}{an \code{\link{ls_means}} object.}
\item{...}{currently not used.}
\item{add_levels}{add \code{term} and \code{levels} columns to returned
\code{data.frame}?}
}
\description{
Coerce \code{ls_means} Objects to \code{data.frame}s
}
\examples{
# Fit example model:
data("cake", package="lme4")
cake$Temp <- factor(cake$temperature, ordered = FALSE)
model <- lmer(angle ~ recipe + Temp + (1|recipe:replicate), cake)
# Extract LS-means:
head(lsm <- ls_means(model))
# Coerce LS-means objects to data.frames:
head(as.data.frame(lsm))
head(as.data.frame(lsm, add_levels=FALSE))
}
\seealso{
\code{\link{ls_means.lmerModLmerTest}}
}
\author{
Rune Haubo B. Christensen
}
\keyword{internal}
lmerTest/man/as_lmerModLmerTest.Rd 0000644 0001762 0000144 00000002576 15125475223 016675 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/lmer.R
\name{as_lmerModLmerTest}
\alias{as_lmerModLmerTest}
\title{Coerce lmerMod Objects to lmerModLmerTest}
\usage{
as_lmerModLmerTest(model, tol = 1e-08)
}
\arguments{
\item{model}{and lmer model-object (of class 'lmerMod') -- the result of a
call to \code{lme4::lmer()}}
\item{tol}{tolerance for determining of eigenvalues are negative, zero or
positive}
}
\value{
an object of class \code{'lmerModLmerTest'} which sets the following
slots:
\item{vcov_varpar}{the asymptotic covariance matrix of the variance parameters
(theta, sigma).}
\item{Jac_list}{list of Jacobian matrices; gradients of vcov(beta) with
respect to the variance parameters.}
\item{vcov_beta}{the asymptotic covariance matrix of the fixed-effect
regression parameters (beta; vcov(beta)).}
\item{sigma}{the residual standard deviation.}
}
\description{
Coercing an lme4::lmer model-object (of class 'lmerMod') to a model-object
of class 'lmerModLmerTest' involves computing the covariance
matrix of the variance parameters and the gradient (Jacobian) of cov(beta)
with respect to the variance parameters.
}
\examples{
m <- lme4::lmer(Reaction ~ Days + (Days | Subject), sleepstudy)
bm <- as_lmerModLmerTest(m)
slotNames(bm)
}
\seealso{
the class definition in \code{\link{lmerModLmerTest}}) and
\code{\link{lmer}}
}
\author{
Rune Haubo B. Christensen
}
lmerTest/man/merModLmerTest-class.Rd 0000644 0001762 0000144 00000000667 15125475223 017140 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/legacy.R
\docType{class}
\name{merModLmerTest-class}
\alias{merModLmerTest-class}
\alias{merModLmerTest}
\title{Legacy lmerTest representation of Linear Mixed-Effects Models}
\description{
The \code{merModLmerTest} class extends \code{lmerMod} (which extends
\code{merMod}) from the \pkg{lme4}-package.
}
\author{
Rune Haubo B. Christensen
}
\keyword{internal}
lmerTest/man/ls_means.Rd 0000644 0001762 0000144 00000001111 15125475223 014714 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/ls_means.R
\name{ls_means}
\alias{ls_means}
\alias{difflsmeans}
\alias{lsmeansLT}
\title{LS-means Generic Function}
\usage{
ls_means(model, ...)
difflsmeans(model, ...)
lsmeansLT(model, ...)
}
\arguments{
\item{model}{a model object.}
\item{...}{parsed on to methods.}
}
\description{
LS-means Generic Function
}
\seealso{
\code{\link{ls_means.lmerModLmerTest}}
\code{\link{difflsmeans.lmerModLmerTest}}
\code{\link{lsmeansLT.lmerModLmerTest}}
}
\author{
Rune Haubo B. Christensen
}
\keyword{internal}
lmerTest/man/lmerModLmerTest-class.Rd 0000644 0001762 0000144 00000002352 15125475223 017305 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/lmer.R
\docType{class}
\name{lmerModLmerTest-class}
\alias{lmerModLmerTest-class}
\alias{lmerModLmerTest}
\title{Represent Linear Mixed-Effects Models}
\value{
An object of class \code{lmerModLmerTest} with slots as in
\code{lmerMod} objects (see \code{\link[lme4]{merMod}}) and a few
additional slots as described in the slots section.
}
\description{
The \code{lmerModLmerTest} class extends \code{lmerMod} (which extends
\code{merMod}) from the \pkg{lme4}-package.
}
\section{Slots}{
\describe{
\item{\code{vcov_varpar}}{a numeric matrix holding the asymptotic variance-covariance
matrix of the variance parameters (including sigma).}
\item{\code{Jac_list}}{a list of gradient matrices (Jacobians) for the gradient of
the variance-covariance of beta with respect to the variance parameters,
where beta are the mean-value parameters available in \code{fixef(object)}.}
\item{\code{vcov_beta}}{a numeric matrix holding the asymptotic variance-covariance
matrix of the fixed-effect regression parameters (beta).}
\item{\code{sigma}}{the residual standard deviation.}
}}
\seealso{
\code{\link[lme4]{lmer}} and \code{\link[lme4]{merMod}}
}
\author{
Rune Haubo B. Christensen
}
lmerTest/man/lmer.Rd 0000644 0001762 0000144 00000016324 15131227671 014065 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/lmer.R
\name{lmer}
\alias{lmer}
\title{Fit Linear Mixed-Effects Models}
\usage{
lmer(
formula,
data = NULL,
REML = TRUE,
control = lmerControl(),
start = NULL,
verbose = 0L,
subset,
weights,
na.action,
offset,
contrasts = NULL,
devFunOnly = FALSE
)
}
\arguments{
\item{formula}{a two-sided linear formula object describing both the
fixed-effects and random-effects part of the model, with the
response on the left of a \code{~} operator and the terms, separated
by \code{+} operators, on the right. Random-effects terms are
distinguished by vertical bars (\code{|}) separating expressions
for design matrices from grouping factors. By default, non-scalar
random effects (where the design matrix has more than one column,
e.g. \code{(1+x|f)}) are fitted with \emph{unstructured} (general
positive semidefinite) covariance matrices.
\itemize{
\item Two vertical bars
(\code{||}) can be used to specify multiple uncorrelated random
effects for the same grouping variable. %----------
With default settings, the \code{||}-syntax \emph{works
only for design matrices containing numeric (continuous) predictors};
to fit models with independent categorical effects, use
\code{diag(f|g)} or set \code{options(lme4.doublevert.default = "diag_special")} (see
\code{help(getDoublevertDefault)} in \pkg{lme4} version \code{2.0-0} or higher).
\item Tags preceding a random effect term specify covariance
structure:
\itemize{
\item \code{us} (default: \code{us(f|g)} is equivalent to \code{(f|g)}):
unstructured, positive semi-definite
\item \code{diag}: diagonal (all correlations set to zero).
Specify \code{diag(f|g, hom = TRUE)}
to fit a homogeneous diagonal covariance matrix
\item \code{cs}: compound symmetric (all pairwise correlations
set identical). Specify \code{cs(f|g, hom = TRUE)} for homogeneous
variances.
\item \code{ar1}: autoregressive order 1. Note that AR1 models
are homogeneous by default; specify \code{ar1(f|g, hom = FALSE)}
for heterogeneous variances.
} % itemize (cov struct types)
} % itemize (cov struct info)
}
\item{data}{an optional data frame containing the variables named in
\code{formula}. By default the variables are taken from the
environment from which \code{lmer} is called. While \code{data} is
optional, the package authors \emph{strongly} recommend its use,
especially when later applying methods such as \code{update} and
\code{drop1} to the fitted model (\emph{such methods are not
guaranteed to work properly if \code{data} is omitted}). If
\code{data} is omitted, variables will be taken from the environment
of \code{formula} (if specified as a formula) or from the parent
frame (if specified as a character vector).}
\item{REML}{logical scalar - Should the estimates be chosen to
optimize the REML criterion (as opposed to the log-likelihood)?}
\item{control}{a list (of correct class, resulting from
\code{\link[lme4]{lmerControl}()} or \code{\link[lme4]{glmerControl}()}
respectively) containing control parameters, including the nonlinear
optimizer to be used and parameters to be passed through to the
nonlinear optimizer, see the \code{*lmerControl} documentation for
details.}
\item{start}{a numeric vector or a named \link{list} with one optional
component named \code{par} or \code{theta}, giving starting values
for covariance parameters. Numeric \code{start} is equivalent to
\code{list(par = start)}. Parameters corresponding to unstructured
covariance matrices are on the scale of the Cholesky factor of the
relative covariance matrix. By default, all relative covariance
matrices are identity matrices.}
\item{verbose}{integer scalar. If \code{> 0} verbose output is
generated during the optimization of the parameter estimates. If
\code{> 1} verbose output is generated during the individual
penalized iteratively reweighted least squares (PIRLS) steps.}
\item{subset}{an optional expression indicating the subset of the rows
of \code{data} that should be used in the fit. This can be a logical
vector, or a numeric vector indicating which observation numbers are
to be included, or a character vector of the row names to be
included. All observations are included by default.}
\item{weights}{an optional vector of \sQuote{prior weights} to be used
in the fitting process. Should be \code{NULL} or a numeric vector.
Prior \code{weights} are \emph{not} normalized or standardized in
any way. In particular, the diagonal of the residual covariance
matrix is the squared residual standard deviation parameter
\code{\link[lme4]{sigma}} times the vector of inverse \code{weights}.
Therefore, if the \code{weights} have relatively large magnitudes,
then in order to compensate, the \code{\link[lme4]{sigma}} parameter will
also need to have a relatively large magnitude.}
\item{na.action}{a function that indicates what should happen when the
data contain \code{NA}s. The default action (\code{na.omit},
inherited from the 'factory fresh' value of
\code{getOption("na.action")}) strips any observations with any
missing values in any variables.}
\item{offset}{this can be used to specify an \emph{a priori} known
component to be included in the linear predictor during
fitting. This should be \code{NULL} or a numeric vector of length
equal to the number of cases. One or more \code{\link{offset}}
terms can be included in the formula instead or as well, and if more
than one is specified their sum is used. See
\code{\link{model.offset}}.}
\item{contrasts}{an optional list. See the \code{contrasts.arg} of
\code{model.matrix.default}.}
\item{devFunOnly}{logical - return only the deviance evaluation
function. Note that because the deviance function operates on
variables stored in its environment, it may not return
\emph{exactly} the same values on subsequent calls (but the results
should always be within machine tolerance).}
}
\value{
an S4 object of class \code{"lmerModLmerTest"}
}
\description{
This function overloads \code{\link[lme4]{lmer}} from the \pkg{lme4}-package
(\code{lme4::lmer}) and adds a couple of slots needed for the computation of
Satterthwaite denominator degrees of freedom. All arguments are the same as
for \code{lme4::lmer} and all the usual \code{lmer}-methods work.
}
\details{
For details about \code{lmer} see \code{\link[lme4]{lmer}}
(\code{help(lme4::lmer)}). The description of all arguments below is taken
verbatim and unedited from the \pkg{lme4}-package.
In cases when a valid \code{lmer}-object
(\code{lmerMod}) is produced, but when the computations needed for
Satterthwaite df fails, the \code{lmerMod} object is returned - not an
\code{lmerModLmerTest} object.
}
\examples{
data("sleepstudy", package="lme4")
m <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy)
class(m) # lmerModLmerTest
}
\seealso{
\code{\link[lme4]{lmer}} and \code{\link{lmerModLmerTest}}
}
\author{
Rune Haubo B. Christensen and Alexandra Kuznetsova for the overload
in \pkg{lmerTest} -- \pkg{lme4}-authors for the underlying implementation
in \pkg{lme4}.
}
lmerTest/man/show_tests.anova.Rd 0000644 0001762 0000144 00000002461 15125475223 016431 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/lmer_anova.R
\name{show_tests.anova}
\alias{show_tests.anova}
\title{Show Hypothesis Tests in ANOVA Tables}
\usage{
\method{show_tests}{anova}(object, fractions = FALSE, names = TRUE, ...)
}
\arguments{
\item{object}{an anova table with a \code{"hypotheses"} attribute.}
\item{fractions}{display entries in the hypothesis matrices as fractions?}
\item{names}{if \code{FALSE} column and row names of the hypothesis matrices
are suppressed.}
\item{...}{currently not used.}
}
\value{
a list of hypothesis matrices.
}
\description{
Extracts hypothesis matrices for terms in ANOVA tables detailing exactly which
functions of the parameters are being tested in anova tables.
}
\examples{
# Fit basic model to the 'cake' data:
data("cake", package="lme4")
fm1 <- lmer(angle ~ recipe * temp + (1|recipe:replicate), cake)
# Type 3 anova table:
(an <- anova(fm1, type="3"))
# Display tests/hypotheses for type 1, 2, and 3 ANOVA tables:
# (and illustrate effects of 'fractions' and 'names' arguments)
show_tests(anova(fm1, type="1"))
show_tests(anova(fm1, type="2"), fractions=TRUE, names=FALSE)
show_tests(an, fractions=TRUE)
}
\seealso{
\code{\link[=show_tests.ls_means]{show_tests}} for \code{ls_means}
objects.
}
\author{
Rune Haubo B. Christensen
}
lmerTest/man/legacy.Rd 0000644 0001762 0000144 00000010361 15125475223 014366 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/legacy.R
\name{anova.merModLmerTest}
\alias{anova.merModLmerTest}
\alias{legacy}
\alias{summary.merModLmerTest}
\alias{ls_means.merModLmerTest}
\alias{lsmeansLT.merModLmerTest}
\alias{difflsmeans.merModLmerTest}
\alias{drop1.merModLmerTest}
\alias{step.merModLmerTest}
\title{Methods for Legacy lmerTest Objects}
\usage{
\method{anova}{merModLmerTest}(
object,
...,
type = c("III", "II", "I", "3", "2", "1"),
ddf = c("Satterthwaite", "Kenward-Roger", "lme4")
)
\method{summary}{merModLmerTest}(object, ..., ddf = c("Satterthwaite", "Kenward-Roger", "lme4"))
\method{ls_means}{merModLmerTest}(
model,
which = NULL,
level = 0.95,
ddf = c("Satterthwaite", "Kenward-Roger"),
pairwise = FALSE,
...
)
\method{lsmeansLT}{merModLmerTest}(
model,
which = NULL,
level = 0.95,
ddf = c("Satterthwaite", "Kenward-Roger"),
pairwise = FALSE,
...
)
\method{difflsmeans}{merModLmerTest}(
model,
which = NULL,
level = 0.95,
ddf = c("Satterthwaite", "Kenward-Roger"),
...
)
\method{drop1}{merModLmerTest}(
object,
scope,
ddf = c("Satterthwaite", "Kenward-Roger", "lme4"),
force_get_contrasts = FALSE,
...
)
\method{step}{merModLmerTest}(
object,
ddf = c("Satterthwaite", "Kenward-Roger"),
alpha.random = 0.1,
alpha.fixed = 0.05,
reduce.fixed = TRUE,
reduce.random = TRUE,
keep,
...
)
}
\arguments{
\item{object}{an \code{lmerModLmerTest} object; the result of \code{lmer()}
after loading the \pkg{lmerTest}-package.}
\item{...}{for the anova method optionally additional models; for other
methods see the corresponding \code{lmerModLmerTest} methods for details.}
\item{type}{the type of ANOVA table requested (using SAS terminology)
with Type I being the familiar sequential ANOVA table.}
\item{ddf}{the method for computing the denominator degrees of freedom and
F-statistics. \code{ddf="Satterthwaite"} (default) uses Satterthwaite's method;
\code{ddf="Kenward-Roger"} uses Kenward-Roger's method,
\code{ddf = "lme4"} returns the lme4-anova table, i.e., using the anova
method for \code{lmerMod} objects as defined in the \pkg{lme4}-package and
ignores the \code{type} argument. Partial matching is allowed.}
\item{model}{a model object fitted with \code{\link{lmer}} (of class
\code{"lmerModLmerTest"}).}
\item{which}{optional character vector naming factors for which LS-means should
be computed. If \code{NULL} (default) LS-means for all factors are computed.}
\item{level}{confidence level.}
\item{pairwise}{compute pairwise differences of LS-means instead?}
\item{scope}{optional character vector naming terms to be dropped from the
model. Note that only marginal terms can be dropped. To see which terms are
marginal, use \code{drop.scope(terms(object))}.}
\item{force_get_contrasts}{enforce computation of contrast matrices by a
method in which the design matrices for full and restricted models are
compared.}
\item{alpha.random}{alpha for random effects elimination}
\item{alpha.fixed}{alpha for fixed effects elimination}
\item{reduce.fixed}{reduce fixed effect structure? \code{TRUE} by default.}
\item{reduce.random}{reduce random effect structure? \code{TRUE} by default.}
\item{keep}{an optional character vector of fixed effect terms which should
not be considered for eliminated. Valid terms are given by
\code{attr(terms(object), "term.labels")}. Terms that are marginal to terms
in keep will also not be considered for eliminations.}
}
\description{
Methods are defined for legacy lmerTest objects of class
\code{merModLmerTest} generated with \pkg{lmerTest} version \code{< 3.0-0}.
These methods are defined by interfacing code for \code{lmerModLmerTest}
methods and therefore behaves like these methods do (which may differ from
the behavior of \pkg{lmerTest} version \code{< 3.0-0}.)
}
\examples{
# Load model fits fm1 and fm2 generated with lmerTest version 2.3-37:
load(system.file("testdata","legacy_fits.RData", package="lmerTest"))
# Apply some methods defined by lmerTest:
anova(fm1)
summary(fm1)
contest(fm1, c(0, 1))
contest(fm1, c(0, 1), joint=FALSE)
drop1(fm1)
ranova(fm1)
# lme4-methods also work:
fixef(fm1)
# Ditto for second model fit:
anova(fm2)
summary(fm2)
ls_means(fm2)
difflsmeans(fm2)
}
\author{
Rune Haubo B. Christensen
}
\keyword{internal}
lmerTest/man/show_tests.Rd 0000644 0001762 0000144 00000001644 15125475422 015331 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/lmer_anova.R
\name{show_tests}
\alias{show_tests}
\alias{show_tests.default}
\title{Show Tests Generic Function and Default Method}
\usage{
show_tests(object, ...)
\method{show_tests}{default}(object, fractions = FALSE, names = TRUE, ...)
}
\arguments{
\item{object}{a suitable object with an \code{"hypotheses"} attribute, e.g. an
anova table or an \code{ls_means} table as defined in \pkg{lmerTest}.}
\item{...}{parsed on to methods; currently not used in the default method.}
\item{fractions}{display entries in the hypothesis matrices as fractions?}
\item{names}{if \code{FALSE} column and row names of the hypothesis matrices
are suppressed.}
}
\description{
Show Tests Generic Function and Default Method
}
\seealso{
\code{\link{show_tests.anova}} and \code{\link{show_tests.ls_means}}
}
\author{
Rune Haubo B. Christensen
}
\keyword{internal}
lmerTest/man/step.lmerModLmerTest.Rd 0000644 0001762 0000144 00000006420 15125475223 017154 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/step.R
\name{step.lmerModLmerTest}
\alias{step.lmerModLmerTest}
\alias{get_model.step_list}
\title{Backward Elimination for Linear Mixed Models}
\usage{
\method{step}{lmerModLmerTest}(
object,
ddf = c("Satterthwaite", "Kenward-Roger"),
alpha.random = 0.1,
alpha.fixed = 0.05,
reduce.fixed = TRUE,
reduce.random = TRUE,
keep,
...
)
\method{get_model}{step_list}(x, ...)
}
\arguments{
\item{object}{a fitted model object. For the \code{lmerModLmerTest} method
an \code{\link{lmer}} model fit (of class \code{"lmerModLmerTest"}.)}
\item{ddf}{the method for computing the denominator degrees of freedom and
F-statistics. \code{ddf="Satterthwaite"} (default) uses Satterthwaite's method;
\code{ddf="Kenward-Roger"} uses Kenward-Roger's method.}
\item{alpha.random}{alpha for random effects elimination}
\item{alpha.fixed}{alpha for fixed effects elimination}
\item{reduce.fixed}{reduce fixed effect structure? \code{TRUE} by default.}
\item{reduce.random}{reduce random effect structure? \code{TRUE} by default.}
\item{keep}{an optional character vector of fixed effect terms which should
not be considered for eliminated. Valid terms are given by
\code{attr(terms(object), "term.labels")}. Terms that are marginal to terms
in keep will also not be considered for eliminations.}
\item{...}{currently not used.}
\item{x}{a step object.}
}
\value{
\code{step} returns a list with elements \code{"random"} and
\code{"fixed"} each
containing anova-like elimination tables. The \code{"fixed"} table is
based on \code{drop1} and the \code{"random"} table is
based on \code{ranova} (a \code{drop1}-like table for random effects). Both
tables have a column \code{"Eliminated"} indicating the order in which terms
are eliminated from the model with zero (\code{0}) indicating that the term
is not eliminated from the model.
The \code{step} object also contains the final model as an attribute which
is extractable with \code{get_model()}.
}
\description{
Backward elimination of random-effect terms followed by backward elimination
of fixed-effect terms in linear mixed models.
}
\details{
Tests of random-effects are performed using \code{\link{ranova}} (using
\code{reduce.terms = TRUE}) and tests of fixed-effects are performed using
\code{\link[=drop1.lmerModLmerTest]{drop1}}.
The step method for \code{\link{lmer}} fits has a print method.
}
\examples{
# Fit a model to the ham dataset:
fm <- lmer(Informed.liking ~ Product*Information+
(1|Consumer) + (1|Product:Consumer)
+ (1|Information:Consumer), data=ham)
# Backward elimination using terms with default alpha-levels:
(step_res <- step(fm))
final <- get_model(step_res)
anova(final)
\dontrun{
# Fit 'big' model:
fm <- lmer(Informed.liking ~ Product*Information*Gender*Age +
+ (1|Consumer) + (1|Consumer:Product) +
(1|Consumer:Information), data=ham)
step_fm <- step(fm)
step_fm # Display elimination results
final_fm <- get_model(step_fm)
}
}
\seealso{
\code{\link[=drop1.lmerModLmerTest]{drop1}} for tests of marginal
fixed-effect terms and \code{\link{ranova}} for a
\code{\link[=drop1.lmerModLmerTest]{drop1}}-like table of reduction of
random-effect terms.
}
\author{
Rune Haubo B. Christensen and Alexandra Kuznetsova
}
lmerTest/man/contestMD.lmerModLmerTest.Rd 0000644 0001762 0000144 00000005742 15125475223 020107 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/contest.R
\name{contestMD.lmerModLmerTest}
\alias{contestMD.lmerModLmerTest}
\alias{calcSatterth}
\alias{contestMD.lmerMod}
\title{Multiple Degrees-of-Freedom Contrast Tests}
\usage{
\method{contestMD}{lmerModLmerTest}(
model,
L,
rhs = 0,
ddf = c("Satterthwaite", "Kenward-Roger"),
eps = sqrt(.Machine$double.eps),
...
)
calcSatterth(model, L)
\method{contestMD}{lmerMod}(
model,
L,
rhs = 0,
ddf = c("Satterthwaite", "Kenward-Roger"),
eps = sqrt(.Machine$double.eps),
...
)
}
\arguments{
\item{model}{a model object fitted with \code{lmer} from package
\pkg{lmerTest}, i.e., an object of class \code{\link{lmerModLmerTest}}.}
\item{L}{a contrast matrix with nrow >= 1 and ncol ==
\code{length(fixef(model))}.}
\item{rhs}{right-hand-side of the statistical test, i.e. the hypothesized
value. A numeric vector of length \code{nrow(L)} or a numeric scalar.}
\item{ddf}{the method for computing the denominator degrees of freedom and
F-statistics. \code{ddf="Kenward-Roger"} uses Kenward-Roger's method.}
\item{eps}{tolerance on eigenvalues to determine if an eigenvalue is
positive. The number of positive eigenvalues determine the rank of
L and the numerator df of the F-test.}
\item{...}{currently not used.}
}
\value{
a \code{data.frame} with one row and columns with \code{"Sum Sq"},
\code{"Mean Sq"}, \code{"F value"}, \code{"NumDF"} (numerator df),
\code{"DenDF"} (denominator df) and \code{"Pr(>F)"} (p-value).
}
\description{
Compute the multi degrees-of-freedom test in a linear mixed model fitted
by \code{\link{lmer}}. The contrast (L) specifies a linear function of the
mean-value parameters, beta. Satterthwaite's method is used to compute the
denominator df for the F-test.
}
\details{
The F-value and associated p-value is for the hypothesis
\eqn{L \beta = \mathrm{rhs}}{L \beta = rhs} in which rhs may be non-zero
and \eqn{\beta} is \code{fixef(model)}.
Note: NumDF = row-rank(L) is determined automatically so row rank-deficient L
are allowed. One-dimensional contrasts are also allowed (L has 1 row).
}
\examples{
data("sleepstudy", package="lme4")
fm <- lmer(Reaction ~ Days + I(Days^2) + (1|Subject) + (0+Days|Subject),
sleepstudy)
# Define 2-df contrast - since L has 2 (linearly independent) rows
# the F-test is on 2 (numerator) df:
L <- rbind(c(0, 1, 0), # Note: ncol(L) == length(fixef(fm))
c(0, 0, 1))
# Make the 2-df F-test of any effect of Days:
contestMD(fm, L)
# Illustrate rhs argument:
contestMD(fm, L, rhs=c(5, .1))
# Make the 1-df F-test of the effect of Days^2:
contestMD(fm, L[2, , drop=FALSE])
# Same test, but now as a t-test instead:
contest1D(fm, L[2, , drop=TRUE])
}
\seealso{
\code{\link[=contest.lmerModLmerTest]{contest}} for a flexible and
general interface to tests of contrasts among fixed-effect parameters.
\code{\link[=contest1D.lmerModLmerTest]{contest1D}} is a direct interface for
tests of 1-dimensional contrasts.
}
\author{
Rune Haubo B. Christensen
}
lmerTest/man/plot.step_list.Rd 0000644 0001762 0000144 00000003613 15125475223 016107 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/step.R
\name{plot.step_list}
\alias{plot.step_list}
\title{Plot LS-means for Backward Reduced Model}
\usage{
\method{plot}{step_list}(
x,
y = NULL,
which = NULL,
pairwise = FALSE,
mult = TRUE,
level = 0.95,
ddf = c("Satterthwaite", "Kenward-Roger"),
...
)
}
\arguments{
\item{x}{a \code{step_list} object; the result of running
\code{\link[=step.lmerModLmerTest]{step}}.}
\item{y}{not used and ignored with a warning.}
\item{which}{optional character vector naming factors for which LS-means should
be plotted. If \code{NULL} (default) plots for all LS-means are generated.}
\item{pairwise}{pairwise differences of LS-means?}
\item{mult}{if \code{TRUE} and there is more than one term for which to plot
LS-means the plots are organized in panels with \code{facet_wrap}.}
\item{level}{confidence level.}
\item{ddf}{denominator degree of freedom method.}
\item{...}{currently not used.}
}
\description{
Computes the LS-means for the final backward reduced model and passes these
to \code{\link{plot.ls_means}}.
}
\details{
Error bars are confidence intervals - the default is 95% CI but the confidence
level can be changed.
}
\examples{
\dontrun{
# Fit example model:
tv <- lmer(Sharpnessofmovement ~ TVset * Picture +
(1 | Assessor:TVset) + (1 | Assessor:Picture) +
(1 | Assessor:Picture:TVset) + (1 | Repeat) + (1 | Repeat:Picture) +
(1 | Repeat:TVset) + (1 | Repeat:TVset:Picture) + (1 | Assessor),
data = TVbo)
# Backward reduce the model:
(st <- step(tv)) # takes ~10 sec to run
# Pairwise comparisons of LS-means for Picture and TVset:
plot(st, which=c("Picture", "TVset"), pairwise = TRUE)
}
}
\seealso{
\code{\link[=ls_means.lmerModLmerTest]{ls_means}} and
\code{\link{plot.ls_means}}
}
\author{
Rune Haubo B. Christensen and Alexandra Kuznetsova
}
\keyword{internal}
lmerTest/man/show_tests.ls_means.Rd 0000644 0001762 0000144 00000002113 15125475223 017120 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/ls_means.R
\name{show_tests.ls_means}
\alias{show_tests.ls_means}
\title{Show LS-means Hypothesis Tests and Contrasts}
\usage{
\method{show_tests}{ls_means}(object, fractions = FALSE, names = TRUE, ...)
}
\arguments{
\item{object}{an \code{ls_means} object.}
\item{fractions}{display contrasts as fractions rather than decimal numbers?}
\item{names}{include row and column names of the contrasts matrices?}
\item{...}{currently not used.}
}
\value{
a list of contrast matrices; one matrix for each model term.
}
\description{
Extracts the contrasts which defines the LS-mean hypothesis tests.
}
\examples{
data("cake", package="lme4")
model <- lmer(angle ~ recipe * temp + (1|recipe:replicate), cake)
# LS-means:
(lsm <- ls_means(model))
# Contrasts for LS-means estimates and hypothesis tests:
show_tests(lsm)
}
\seealso{
\code{\link[=ls_means.lmerModLmerTest]{ls_means}} for computation of
LS-means and \code{\link[=show_tests.anova]{show_tests}} for \code{anova}
objects.
}
\author{
Rune Haubo B. Christensen
}
lmerTest/man/contest.Rd 0000644 0001762 0000144 00000001353 15125475223 014602 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/contest.R
\name{contest}
\alias{contest}
\alias{contest1D}
\alias{contestMD}
\title{Generic Contrast Test Functions}
\usage{
contest(model, L, ...)
contest1D(model, L, ...)
contestMD(model, L, ...)
}
\arguments{
\item{model}{a model object.}
\item{L}{a contrast vector or matrix.}
\item{...}{additional arguments passed to methods.}
}
\description{
Generic functions for tests contrasts.
}
\seealso{
contest methods for \code{\link{lmer}} objects:
\code{\link[=contest.lmerModLmerTest]{contest}},
\code{\link[=contest1D.lmerModLmerTest]{contest1D}}, and
\code{\link[=contestMD.lmerModLmerTest]{contestMD}}.
}
\author{
Rune Haubo B. Christensen
}
\keyword{internal}
lmerTest/man/contest1D.lmerModLmerTest.Rd 0000644 0001762 0000144 00000005435 15125475223 020052 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/contest.R
\name{contest1D.lmerModLmerTest}
\alias{contest1D.lmerModLmerTest}
\alias{contest1D.lmerMod}
\title{Contrast Tests in 1D}
\usage{
\method{contest1D}{lmerModLmerTest}(
model,
L,
rhs = 0,
ddf = c("Satterthwaite", "Kenward-Roger"),
confint = FALSE,
level = 0.95,
...
)
\method{contest1D}{lmerMod}(
model,
L,
rhs = 0,
ddf = c("Satterthwaite", "Kenward-Roger"),
confint = FALSE,
level = 0.95,
...
)
}
\arguments{
\item{model}{a model object fitted with \code{lmer} from package
\pkg{lmerTest}, i.e., an object of class \code{\link{lmerModLmerTest}}.}
\item{L}{a numeric (contrast) vector of the same length as
\code{fixef(model)}.}
\item{rhs}{right-hand-side of the statistical test, i.e. the hypothesized
value (a numeric scalar).}
\item{ddf}{the method for computing the denominator degrees of freedom.
\code{ddf="Kenward-Roger"} uses Kenward-Roger's method.}
\item{confint}{include columns for lower and upper confidence limits?}
\item{level}{confidence level.}
\item{...}{currently not used.}
}
\value{
A \code{data.frame} with one row and columns with \code{"Estimate"},
\code{"Std. Error"}, \code{"t value"}, \code{"df"}, and \code{"Pr(>|t|)"}
(p-value). If \code{confint = TRUE} \code{"lower"} and \code{"upper"} columns
are included before the p-value column.
}
\description{
Compute the test of a one-dimensional (vector) contrast in a
linear mixed model fitted with lmer from package \pkg{lmerTest}.
The contrast should specify a linear function of the
mean-value parameters, beta. The Satterthwaite or Kenward-Roger method is
used to compute the (denominator) df for the t-test.
}
\details{
The t-value and associated p-value is for the hypothesis
\eqn{L' \beta = \mathrm{rhs}}{L' \beta = rhs} in which rhs may be non-zero
and \eqn{\beta} is \code{fixef(model)}.
The estimated value (\code{"Estimate"}) is \eqn{L' \beta} with associated
standard error and (optionally) confidence interval.
}
\examples{
# Fit model using lmer with data from the lme4-package:
data("sleepstudy", package="lme4")
fm <- lmer(Reaction ~ Days + (1 + Days|Subject), sleepstudy)
# Tests and CI of model coefficients are obtained with:
contest1D(fm, c(1, 0), confint=TRUE) # Test for Intercept
contest1D(fm, c(0, 1), confint=TRUE) # Test for Days
# Tests of coefficients are also part of:
summary(fm)
# Illustrate use of rhs argument:
contest1D(fm, c(0, 1), confint=TRUE, rhs=10) # Test for Days-coef == 10
}
\seealso{
\code{\link[=contest.lmerModLmerTest]{contest}} for a flexible
and general interface to tests of contrasts among fixed-effect parameters.
\code{\link[=contestMD.lmerModLmerTest]{contestMD}} is also available as a
direct interface for tests of multi degree-of-freedom contrast.
}
\author{
Rune Haubo B. Christensen
}
lmerTest/man/contest.lmerModLmerTest.Rd 0000644 0001762 0000144 00000010100 15125475223 017646 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/contest.R
\name{contest.lmerModLmerTest}
\alias{contest.lmerModLmerTest}
\alias{contest.lmerMod}
\title{Test of Contrasts}
\usage{
\method{contest}{lmerModLmerTest}(
model,
L,
rhs = 0,
joint = TRUE,
collect = TRUE,
confint = TRUE,
level = 0.95,
check_estimability = FALSE,
ddf = c("Satterthwaite", "Kenward-Roger", "lme4"),
...
)
\method{contest}{lmerMod}(
model,
L,
rhs = 0,
joint = TRUE,
collect = TRUE,
confint = TRUE,
level = 0.95,
check_estimability = FALSE,
ddf = c("Satterthwaite", "Kenward-Roger", "lme4"),
...
)
}
\arguments{
\item{model}{a model object fitted with \code{lmer} from package
\pkg{lmerTest}, i.e., an object of class \code{\link{lmerModLmerTest}}.}
\item{L}{a contrast vector or matrix or a list of these.
The \code{length}/\code{ncol} of each contrasts should equal
\code{length(fixef(model))}.}
\item{rhs}{right-hand-side of the statistical test, i.e. the hypothesized
value (a numeric scalar).}
\item{joint}{make an F-test of potentially several contrast vectors? If
\code{FALSE} single DF t-tests are applied to each vector or each row of
contrasts matrices.}
\item{collect}{collect list of tests in a matrix?}
\item{confint}{include columns for lower and upper confidence limits? Applies
when \code{joint} is \code{FALSE}.}
\item{level}{confidence level.}
\item{check_estimability}{check estimability of contrasts? Only single DF
contrasts are checked for estimability thus requiring \code{joint = FALSE} to
take effect. See details section for necessary adjustments to \code{L} when
estimability is checked with rank deficient design matrices.}
\item{ddf}{the method for computing the denominator degrees of freedom.
\code{ddf="Kenward-Roger"} uses Kenward-Roger's method.}
\item{...}{passed to \code{\link{contestMD}}.}
}
\value{
a \code{data.frame} or a list of \code{data.frame}s.
}
\description{
Tests of vector or matrix contrasts for \code{\link{lmer}} model fits.
}
\details{
If the design matrix is rank deficient, \code{lmer} drops columns for the
aliased coefficients from the design matrix and excludes the corresponding
aliased coefficients from \code{fixef(model)}. When estimability is checked
the original rank-deficient design matrix is recontructed and therefore
\code{L} contrast vectors need to include elements for the aliased
coefficients. Similarly when \code{L} is a matrix, its number of columns
needs to match that of the reconstructed rank-deficient design matrix.
}
\examples{
data("sleepstudy", package="lme4")
fm <- lmer(Reaction ~ Days + I(Days^2) + (1|Subject) + (0+Days|Subject),
sleepstudy)
# F-test of third coeffcients - I(Days^2):
contest(fm, c(0, 0, 1))
# Equivalent t-test:
contest(fm, L=c(0, 0, 1), joint=FALSE)
# Test of 'Days + I(Days^2)':
contest(fm, L=diag(3)[2:3, ])
# Other options:
contest(fm, L=diag(3)[2:3, ], joint=FALSE)
contest(fm, L=diag(3)[2:3, ], joint=FALSE, collect=FALSE)
# Illustrate a list argument:
L <- list("First"=diag(3)[3, ], "Second"=diag(3)[-1, ])
contest(fm, L)
contest(fm, L, collect = FALSE)
contest(fm, L, joint=FALSE, confint = FALSE)
contest(fm, L, joint=FALSE, collect = FALSE, level=0.99)
# Illustrate testing of estimability:
# Consider the 'cake' dataset with a missing cell:
data("cake", package="lme4")
cake$temperature <- factor(cake$temperature, ordered=FALSE)
cake <- droplevels(subset(cake, temperature \%in\% levels(cake$temperature)[1:2] &
!(recipe == "C" & temperature == "185")))
with(cake, table(recipe, temperature))
fm <- lmer(angle ~ recipe * temperature + (1|recipe:replicate), cake)
fixef(fm)
# The coefficient for recipeC:temperature185 is dropped:
attr(model.matrix(fm), "col.dropped")
# so any contrast involving this coefficient is not estimable:
Lmat <- diag(6)
contest(fm, Lmat, joint=FALSE, check_estimability = TRUE)
}
\seealso{
\code{\link[=contestMD.lmerModLmerTest]{contestMD}} for multi
degree-of-freedom contrast tests,
and \code{\link[=contest1D.lmerModLmerTest]{contest1D}} for tests of
1-dimensional contrasts.
}
\author{
Rune Haubo B. Christensen
}
lmerTest/man/carrots.Rd 0000644 0001762 0000144 00000005274 15125475223 014606 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/data_documentation.R
\docType{data}
\name{carrots}
\alias{carrots}
\title{Consumer Preference Mapping of Carrots}
\format{
\describe{
\item{Consumer}{factor with 103 levels: numbering identifying consumers.}
\item{Frequency}{factor with 5 levels; "How often do you eat carrots?"
1: once a week or more, 2: once
every two weeks, 3: once every three weeks, 4: at least once month,
5: less than once a month.}
\item{Gender}{factor with 2 levels. 1: male, 2:female.}
\item{Age}{factor with 4 levels. 1: less than 25 years, 2: 26-40 years,
3: 41-60 years, 4 more than 61 years.}
\item{Homesize}{factor with two levels. Number of persons in the household.
1: 1 or 2 persons, 2: 3 or more persons.}
\item{Work}{factor with 7 levels. different types of employment.
1: unskilled worker(no education),
2: skilled worker(with education), 3: office worker, 4: housewife (or man),
5: independent
businessman/ self-employment, 6: student, 7: retired}
\item{Income}{factor with 4 levels. 1: <150000, 2: 150000-300000,
3: 300000-500000, 4: >500000}
\item{Preference}{consumer score on a seven-point scale.}
\item{Sweetness}{consumer score on a seven-point scale.}
\item{Bitterness}{consumer score on a seven-point scale.}
\item{Crispness}{consumer score on a seven-point scale.}
\item{sens1}{first sensory variable derived from a PCA.}
\item{sens2}{second sensory variable derived from a PCA.}
\item{Product}{factor on 12 levels.}
}
}
\source{
Per Bruun Brockhoff, The Royal Veterinary and Agricultural University,
Denmark.
}
\usage{
data(carrots)
}
\description{
In a consumer study 103 consumers scored their preference of 12 danish
carrot types on a scale from 1 to 7. Moreover the consumers scored the
degree of sweetness, bitterness and crispiness in the products.
}
\details{
The carrots were harvested in autumn 1996 and tested in march 1997. In
addition to the consumer survey, the carrot products were evaluated by
a trained panel of tasters, the sensory panel, with respect to a
number of sensory (taste, odour and texture) properties. Since usually
a high number of (correlated) properties (variables) are used, in this
case 14, it is a common procedure to use a few, often 2, combined
variables that contain as much of the information in the sensory
variables as possible. This is achieved by extracting the first two
principal components in a principal components analysis (PCA) on the
product-by-property panel average data matrix. In this data set the
variables for the first two principal components are named
(\code{sens1} and \code{sens2}).
}
\examples{
fm <- lmer(Preference ~ sens2 + Homesize + (1 + sens2 | Consumer), data=carrots)
anova(fm)
}
\keyword{datasets}
lmerTest/man/step.Rd 0000644 0001762 0000144 00000001156 15125475223 014077 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/step.R
\name{step}
\alias{step}
\alias{step.default}
\title{Generic Step Function}
\usage{
step(object, ...)
\method{step}{default}(object, ...)
}
\arguments{
\item{object}{a model object.}
\item{...}{currently not used.}
}
\description{
Generic step function with default method \code{stats::step}. This
construction ensures that \code{stats::step} still works on \code{lm}
objects etc. after loading the \pkg{lmerTest} package.
}
\seealso{
\code{\link[=step.lmerModLmerTest]{step}}
}
\author{
Rune Haubo B. Christensen
}
\keyword{internal}
lmerTest/man/ranova.Rd 0000644 0001762 0000144 00000011710 15130774625 014413 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/ranova.R
\name{ranova}
\alias{ranova}
\alias{rand}
\title{ANOVA-Like Table for Random-Effects}
\usage{
ranova(model, reduce.terms = TRUE, ...)
rand(model, reduce.terms = TRUE, ...)
}
\arguments{
\item{model}{a linear mixed effect model fitted with \code{lmer()}
(inheriting from class \code{lmerMod}).}
\item{reduce.terms}{if \code{TRUE} (default) random-effect terms are
reduced (if possible). If \code{FALSE} random-effect terms are simply
removed.}
\item{...}{currently ignored}
}
\value{
an ANOVA-like table with single term deletions of random-effects
inheriting from class \code{anova} and \code{data.frame} with the columns:
\item{npar}{number of model parameters.}
\item{logLik}{the log-likelihood for the model. Note that this is the
REML-logLik if the model is fitted with REML.}
\item{AIC}{the AIC for the model evaluated as \code{-2*(logLik - npar)}.
Smaller is better.}
\item{LRT}{the likelihood ratio test statistic; twice the difference in
log-likelihood, which is asymptotically chi-square distributed.}
\item{Df}{degrees of freedom for the likelihood ratio test: the difference in
number of model parameters.}
\item{Pr(>Chisq)}{the p-value.}
}
\description{
Compute an ANOVA-like table with tests of random-effect terms in the model.
Each random-effect term is reduced or removed and likelihood ratio tests of
model reductions are presented in a form similar to that of
\code{\link[=drop1.lmerModLmerTest]{drop1}}.
\code{rand} is an alias for \code{ranova}.
}
\details{
If the model is fitted with REML the tests are REML-likelihood ratio tests.
A random-effect term of the form \code{(f1 + f2 | gr)} is reduced to
terms of the form \code{(f2 | gr)} and \code{(f1 | gr)} and these reduced
models are compared to the original model.
If \code{reduce.terms} is \code{FALSE} \code{(f1 + f2 | gr)} is removed
instead.
A random-effect term of the form \code{(f1 | gr)} is reduced to \code{(1 | gr)}
(unless \code{reduce.terms} is \code{FALSE}).
A random-effect term of the form \code{(1 | gr)} is not reduced but
simply removed.
A random-effect term of the form \code{(0 + f1 | gr)} or \code{(-1 + f1 | gr)}
is reduced (if \code{reduce.terms = TRUE}) to \code{(1 | gr)}.
In this exposition it is immaterial whether \code{f1} and \code{f2} are
factors or continuous variables.
A random-effect term of the form \code{(1 | gr1/gr2)} is automatically
expanded to two terms: \code{(1 | gr2:gr1)} and \code{(1 | gr1)} using
\code{\link[reformulas]{findbars_x}}.
If the model contains structured covariance matrices
(introduced with \pkg{lme4} version 2.0-0, cf. \code{help(Covariance-class}))
other than \code{us} (eg. terms such as
\code{diag(0 + gr1 | gr2)}, \code{cs(gr1 | gr2)} etc.) \code{ranova} behaves
as if \code{reduce.terms = FALSE}, ie. terms are removed rather than reduced.
}
\note{
Note that \code{anova} can be used to compare two models and will often
be able to produce the same tests as \code{ranova}. This is, however, not always the
case as illustrated in the examples.
}
\section{Warning}{
In certain cases tests of non-nested models may be generated. An example
is when \code{(0 + poly(x, 2) | gr)} is reduced (the default) to \code{(1 | gr)}.
To our best knowledge non-nested model comparisons are only generated in
cases which are statistical nonsense anyway (such as in this example where
the random intercept is suppressed).
}
\examples{
# Test reduction of (Days | Subject) to (1 | Subject):
fm1 <- lmer(Reaction ~ Days + (Days|Subject), sleepstudy)
ranova(fm1) # 2 df test
# This test can also be achieved with anova():
fm2 <- lmer(Reaction ~ Days + (1|Subject), sleepstudy)
anova(fm1, fm2, refit=FALSE)
# Illustrate reduce.test argument:
# Test removal of (Days | Subject):
ranova(fm1, reduce.terms = FALSE) # 3 df test
# The likelihood ratio test statistic is in this case:
fm3 <- lm(Reaction ~ Days, sleepstudy)
2*c(logLik(fm1, REML=TRUE) - logLik(fm3, REML=TRUE)) # LRT
# anova() is not always able to perform the same tests as ranova(),
# for example:
anova(fm1, fm3, refit=FALSE) # compares REML with ML and should not be used
anova(fm1, fm3, refit=TRUE) # is a test of ML fits and not what we seek
# Also note that the lmer-fit needs to come first - not an lm-fit:
# anova(fm3, fm1) # does not work and gives an error
# ranova() may not generate all relevant test:
# For the following model ranova() indicates that we should not reduce
# (TVset | Assessor):
fm <- lmer(Coloursaturation ~ TVset * Picture + (TVset | Assessor), data=TVbo)
ranova(fm)
# However, a more appropriate model is:
fm2 <- lmer(Coloursaturation ~ TVset * Picture + (1 | TVset:Assessor), data=TVbo)
anova(fm, fm2, refit=FALSE)
# fm and fm2 has essentially the same fit to data but fm uses 5 parameters
# more than fm2.
}
\seealso{
\code{\link[=drop1.lmerModLmerTest]{drop1}} for tests of marginal
fixed-effect terms and
\code{\link{anova}} for usual anova tables for fixed-effect terms.
}
\author{
Rune Haubo B. Christensen and Alexandra Kuznetsova
}
lmerTest/man/ls_means.lmerModLmerTest.Rd 0000644 0001762 0000144 00000005400 15125475223 017777 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/ls_means.R
\name{ls_means.lmerModLmerTest}
\alias{ls_means.lmerModLmerTest}
\alias{lsmeansLT.lmerModLmerTest}
\alias{difflsmeans.lmerModLmerTest}
\title{LS-means for lmerTest Model Fits}
\usage{
\method{ls_means}{lmerModLmerTest}(
model,
which = NULL,
level = 0.95,
ddf = c("Satterthwaite", "Kenward-Roger"),
pairwise = FALSE,
...
)
\method{lsmeansLT}{lmerModLmerTest}(
model,
which = NULL,
level = 0.95,
ddf = c("Satterthwaite", "Kenward-Roger"),
pairwise = FALSE,
...
)
\method{difflsmeans}{lmerModLmerTest}(
model,
which = NULL,
level = 0.95,
ddf = c("Satterthwaite", "Kenward-Roger"),
...
)
}
\arguments{
\item{model}{a model object fitted with \code{\link{lmer}} (of class
\code{"lmerModLmerTest"}).}
\item{which}{optional character vector naming factors for which LS-means should
be computed. If \code{NULL} (default) LS-means for all factors are computed.}
\item{level}{confidence level.}
\item{ddf}{method for computation of denominator degrees of freedom.}
\item{pairwise}{compute pairwise differences of LS-means instead?}
\item{...}{currently not used.}
}
\value{
An LS-means table in the form of a \code{data.frame}. Formally an object
of class \code{c("ls_means", "data.frame")} with a number of attributes set.
}
\description{
Computes LS-means or pairwise differences of LS-mean for all factors in a
linear mixed model. \code{lsmeansLT} is provided as an alias for
\code{ls_means} for backward compatibility.
}
\details{
Confidence intervals and p-values are based on the t-distribution using
degrees of freedom based on Satterthwaites or Kenward-Roger methods.
LS-means is SAS terminology for predicted/estimated marginal means, i.e. means
for levels of factors which are averaged over the levels of other factors in
the model. A flat (i.e. unweighted) average is taken which gives equal weight
to all levels of each of the other factors. Numeric/continuous variables are
set at their mean values. See \pkg{emmeans} package
for more options and greater flexibility.
LS-means contrasts are checked for estimability and unestimable contrasts appear
as \code{NA}s in the resulting table.
LS-means objects (of class \code{"ls_means"} have a print method).
}
\examples{
# Get data and fit model:
data("cake", package="lme4")
model <- lmer(angle ~ recipe * temp + (1|recipe:replicate), cake)
# Compute LS-means:
ls_means(model)
# Get LS-means contrasts:
show_tests(ls_means(model))
# Compute pairwise differences of LS-means for each factor:
ls_means(model, pairwise=TRUE)
difflsmeans(model) # Equivalent.
}
\seealso{
\code{\link[=show_tests.ls_means]{show_tests}} for display of the
underlying LS-means contrasts.
}
\author{
Rune Haubo B. Christensen and Alexandra Kuznetsova
}
lmerTest/man/TVbo.Rd 0000644 0001762 0000144 00000002352 15125475223 013775 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/data_documentation.R
\docType{data}
\name{TVbo}
\alias{TVbo}
\title{Sensory Assesment of B&O TVs}
\format{
\describe{
\item{Assessor}{factor with 8 levels assessors.}
\item{TVset}{product factor with 3 levels.}
\item{Picture}{product factor with 4 levels.}
}
In addition the following 15 numeric (response) variables are the
characteristics on which the TV sets (products) are assessed:
Coloursaturation, Colourbalance, Noise, Depth, Sharpness, Lightlevel,
Contrast, Sharpnessofmovement, Flickeringstationary, Flickeringmovement,
Distortion, Dimglasseffect, Cutting, Flossyedges, Elasticeffect.
}
\usage{
data(TVbo)
}
\description{
The TVbo dataset has kindly been made available by the Danish high-end
consumer electronics company
\href{https://www.bang-olufsen.com}{Bang & Olufsen}.
The main purpose was to assess 12 different TV sets (products) specified by
the two attributes Picture and TVset.
15 different response variables (characteristics of the
product) were assessed by a trained panel with 8 assessors.
}
\examples{
fm <- lmer(Coloursaturation ~ TVset + Picture + (1|Assessor:TVset) +
(1|Assessor), data=TVbo)
ranova(fm)
anova(fm)
}
\keyword{datasets}
lmerTest/DESCRIPTION 0000644 0001762 0000144 00000003622 15131411367 013564 0 ustar ligges users Package: lmerTest
Type: Package
Title: Tests in Linear Mixed Effects Models
Version: 3.2-0
Authors@R: c(person("Alexandra", "Kuznetsova", role = c("aut")),
person("Per", "Bruun Brockhoff", role = c("aut", "ths")),
person("Rune", "Haubo Bojesen Christensen", role = c("aut", "cre"),
email = "Rune.Haubo@gmail.com",
comment = c(ORCID = "0000-0002-4494-3399")),
person("Sofie", "Pødenphant Jensen", role=c("ctb")))
Depends: R (>= 3.2.5), lme4 (>= 1.1-10), stats, methods
Imports: numDeriv, MASS, ggplot2, reformulas
Suggests: pbkrtest (>= 0.4-3), tools
Description: Provides p-values in type I, II or III anova and summary tables
for lmer model fits (cf. lme4) via Satterthwaite's degrees of freedom method. A
Kenward-Roger method is also available via the pbkrtest package. Model selection
methods include step, drop1 and anova-like tables for random effects (ranova).
Methods for Least-Square means (LS-means) and tests of linear contrasts of fixed
effects are also available.
License: GPL (>= 2)
Encoding: UTF-8
LazyData: true
URL: https://github.com/runehaubo/lmerTestR
BugReports: https://github.com/runehaubo/lmerTestR/issues
RoxygenNote: 7.3.3
Collate: 'anova_contrasts.R' 'contest.R' 'contrast_utils.R'
'data_documentation.R' 'drop1.R' 'estimability.R' 'legacy.R'
'lmer.R' 'lmerTest.R' 'lmer_anova.R' 'lmer_summary.R'
'ls_means.R' 'ranova.R' 'step.R' 'terms_utils.R' 'utils.R'
'zzz.R'
NeedsCompilation: no
Packaged: 2026-01-12 18:49:55 UTC; runechristensen
Author: Alexandra Kuznetsova [aut],
Per Bruun Brockhoff [aut, ths],
Rune Haubo Bojesen Christensen [aut, cre] (ORCID:
),
Sofie Pødenphant Jensen [ctb]
Maintainer: Rune Haubo Bojesen Christensen
Repository: CRAN
Date/Publication: 2026-01-13 09:40:07 UTC