R Under development (unstable) (2026-01-12 r89300 ucrt) -- "Unsuffered Consequences" Copyright (C) 2026 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > # test_contestMD.R > library(lmerTest) Loading required package: lme4 Loading required package: Matrix Attaching package: 'lmerTest' The following object is masked from 'package:lme4': lmer The following object is masked from 'package:stats': step > > # 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) Sum Sq Mean Sq NumDF DenDF F value Pr(>F) 1 990089.3 330029.8 3 42.15441 507.24 4.351211e-33 > > # Tests of ddf arg: > contestMD(fm, L, ddf="Sat") Sum Sq Mean Sq NumDF DenDF F value Pr(>F) 1 990089.3 330029.8 3 42.15441 507.24 4.351211e-33 > if(has_pbkrtest) + contestMD(fm, L, ddf="Kenward-Roger") Sum Sq Mean Sq NumDF DenDF F value Pr(>F) 1 990089.3 330029.8 3 38.84733 490.1937 6.706733e-31 > assertError(contestMD(fm, L, ddf="sat")) # Invalid ddf arg. > > # Tests of simple 2-df test: > (ans <- contestMD(fm, L[2:3, ], ddf="Sat")) Sum Sq Mean Sq NumDF DenDF F value Pr(>F) 1 30399.15 15199.57 2 54.40752 23.36102 4.744897e-08 > 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")) Sum Sq Mean Sq NumDF DenDF F value Pr(>F) 1 1079.503 1079.503 1 144.6311 1.659144 0.1997759 > 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)) Sum Sq Mean Sq NumDF DenDF F value Pr(>F) 1 1079.503 1079.503 1 144.6311 1.659144 0.1997759 > 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)) [1] Sum Sq Mean Sq NumDF DenDF F value Pr(>F) <0 rows> (or 0-length row.names) > stopifnot(nrow(ans) == 0L) > L <- matrix(numeric(0L), ncol=0L) > (ans <- contestMD(fm1, L)) [1] Sum Sq Mean Sq NumDF DenDF F value Pr(>F) <0 rows> (or 0-length row.names) > 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, ]) [,1] [,2] [,3] [,4] [,5] [,6] [1,] 0 1 0 0 0 0 [2,] 0 0 1 0 0 0 > (an <- anova(model, type="marginal")) Marginal Analysis of Variance Table with Satterthwaite's method Sum Sq Mean Sq NumDF DenDF F value Pr(>F) recipe 4.00 2.00 2 254.02 0.0957 0.9088 temp 620.24 620.24 1 222.00 29.6961 1.339e-07 *** recipe:temp 1.74 0.87 2 222.00 0.0417 0.9592 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 > > 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 Sum Sq Mean Sq NumDF DenDF F value Pr(>F) 1 3.996684 1.998342 2 254.0158 0.09567796 0.9087894 > 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)) Sum Sq Mean Sq NumDF DenDF F value Pr(>F) 1 30030.94 30030.94 1 16.99998 45.85296 3.263824e-06 > contestMD(fm, L=cbind(0, 1), rhs=10) Sum Sq Mean Sq NumDF DenDF F value Pr(>F) 1 59.85028 59.85028 1 16.99998 0.09138285 0.7660937 > if(has_pbkrtest) { + contestMD(fm, L=cbind(0, 1), ddf="Kenward-Roger") + contestMD(fm, L=cbind(0, 1), ddf="Kenward-Roger", rhs=10) + } Sum Sq Mean Sq NumDF DenDF F value Pr(>F) 1 59.85028 59.85028 1 17 0.09138285 0.7660937 > > > ## Test 'lmerMod' method: > fm <- lme4::lmer(Reaction ~ Days + (Days|Subject), sleepstudy) > contestMD(fm, L=cbind(0, 1)) Sum Sq Mean Sq NumDF DenDF F value Pr(>F) 1 30030.94 30030.94 1 16.99998 45.85296 3.263824e-06 > contestMD(fm, L=cbind(0, 1), rhs=10) Sum Sq Mean Sq NumDF DenDF F value Pr(>F) 1 59.85028 59.85028 1 16.99998 0.09138285 0.7660937 > if(has_pbkrtest) { + contestMD(fm, L=cbind(0, 1), ddf="Kenward-Roger") + contestMD(fm, L=cbind(0, 1), ddf="Kenward-Roger", rhs=10) + } Sum Sq Mean Sq NumDF DenDF F value Pr(>F) 1 59.85028 59.85028 1 17 0.09138285 0.7660937 > > proc.time() user system elapsed 2.85 0.25 3.09