lmerTest/0000755000176200001440000000000013574671743012072 5ustar liggesuserslmerTest/NAMESPACE0000644000176200001440000000547513573715730013316 0ustar liggesusers# Generated by roxygen2: do not edit by hand 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(ls_means) export(lsmeansLT) 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,findbars) importFrom(lme4,fixef) importFrom(lme4,getME) importFrom(lme4,lmerControl) importFrom(lme4,nobars) importFrom(methods,as) importFrom(methods,callNextMethod) importFrom(methods,is) importFrom(methods,new) importFrom(methods,signature) importFrom(numDeriv,hessian) importFrom(numDeriv,jacobian) 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) lmerTest/data/0000755000176200001440000000000013573715730012775 5ustar liggesuserslmerTest/data/ham.rda0000644000176200001440000000260713573715730014237 0ustar liggesuserss6!R$-IڦmSi^IS[}?ݸHfuF3O b)R/7sδٶ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_\ݧOy𙻔syns),C^6=Iz0m7 [.(GJߤ}>}7偫r ׽f"P'mw1Ne@{O!'.yvy6^;!زq28>=!Աm_e\b}1 ۧvv(cC; v\1Dۆkvq&}..탖CK]@}{jQM]r>+^}"q1Դl~/y<ox yS\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}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%}@IT҇a%QҌS^%]tnRJEI*#JMI+i+J:JCIw*.%ݭ)%ݫtPǕ %=I%*a%)鐒J:GtԱV:R?V?hvi]M&tprVa;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ڄNatMa˗A?o|gæϠ7o獢}1~_1kԱmv9+-imzw6ʛCK hwBڞ͎Uhwo4x跾Ƴͮ/^߹fx7l}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:LSKyþ~OK:!ᳯ.5}_S6Cb A~ea> g'UưxF8)n@|rJ12w玢W^uKFsK= Uư)9.أIuM=|xX*0 {v/&n$_HW9>%G9Sz+R7^_0xF[\{ƻ xbi3K0߬IOpJeؗa k/W7c%>p5%o0ZQ׹!1rKQ'be>#q?el[)XS.[uyB_SmFoe!'a{$/ŸvfܓV]68/Np#frrb w8v8VH}ڇㆯK|ExZ9%E_sq}X뜣zt)s }_B|^덄U?b*"`:%<c'%ҚՓ}/]g;$8Nvh<9'Z8vᜯ5vľ :cFǼ 汄o}7 $882u)s6Kd? pX۸fCY75ee8ƚk}y'~|5Ok RӉǾ@_>gDv_K{vE5m[uA%㷃;hCIRx>[?H~ૻ[`_!c6Yo)NXc^w֓1L냘kϲpX{R]P /R0 {l3!.[9b(cIǹ9p U#^qQ!|q"\'c܇mlKi}^w7w{чW?ǘ#{|_,}:yoL/)-x6[Lν"CZ}\hl/XRl_y'1rQG]"Z߸Ļ> _^tvW ?LyqcZW;lg{q}clF]q<6hW$RUO,^Z,tBbAJ|6p}""'_NK6CQo1`uź8\2y"O\'^/׸6~fต|n`OkzkC== 1.9_{}=g;c`V8}1 +99hs7b6cߕKq=N&T81tH28ny${a}kϵS: v^/cPf5}ɔ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ɩ+;F8GGGGGGGGGG~rb}y;_ܲyrK'N'~rW+6k{sfv<}_>q/޼uϩ:T6rgpz?3`o._GGGGGGGGG'cRyG&4iI[t^q|q|q|q|969<`<[e‘zcyyۭfکe¼:oϾha'uھ{`ruvٹFյ;닭۬*//}hԨh}~Cu[=YhaOcxR8X8ttn9X8ˮBcӧ_1٥])kf3%*>lmerTest/data/TVbo.rda0000644000176200001440000001140213573715730014335 0ustar liggesusersnumRD)R,QH"%gVa7GEQSFٲʢA rH&NР]gB*z7fZfo㟽h43hf㥙u7\ӟF+Gfo5;Kk{W^7a#s/ƿ88T=[w>\~b$=g{Gq7|+|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*oVix>kZ~w[Nn8}vu[^w'[/ϮێkvRtߌ=GaG =}WZg-uW_cEg+t=0KM>\TRn^]%\ }'WxzgLY v^/'x?z֟!7E^/'A/ˎ/*H\ѾVơ*v r&roǃqoǏr\z_OuߎyWc:8:?"zx? >2wѵ'5ܴ?'7CW' ggN؛8+?~᜾[_@3)#O:yckП?aƋa4} OX}iZϭ:'Ny>C8N>Pzn;Cykwb$϶Xw߄]Ű/r73vZ_y<$pm=w輘xsr l9F|:O/վNc?*L٪?u+7ENŸ8~_/yLۄ3lEڭ`/ iz3_~_=t7z&ijxĞbchIkvQ<Z &maW=V;Eb>a\r򓷴GӘW;}c[' |3Hn'~j?-Fs7C-0/}^y[ggrxs(!> yG >7cpʞ7;F' ~pzx?]r8~;;"/t|ٿ89ż5gU s < wS[1.;#}ktAw??%1?Y/\4?5G'x{_Zug~M^stn5LwDo=_Ezi8}|[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Ǫ˃{Gf{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~*gCx{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_c9UzOU鯗yqƱ ~~A_3IP7&{xCv6umL~4+$o7qI9>ϴ ᖽ_w>*ŧz_eҾei@'x/O}*/N rg;Or_s~.>'7NjO/ıA\^9/r iFs8_qwmko;r=~] =9xU.//Nrkc[r!]y{-k_W; Uʒ>*Kٵsz[Ke%;<'?/ٿB5޾Ig󫢗j/={W=ߏ=*{2gcjG7CNZmz~?}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)\оp3IMW3tτh/8~7gI-i1ER9>IpV~?Ve/U6kљww^]~pt,Mۭ觿: ~yy |fpn+>gXC\k$~Oʾgկ{y<%^JhW>'o%j *y`t3+x'?T}OƇUڕ}vKj`mpwe_;m΋t/{]xUw|9>7,g[_rG7bٿw_~vpxٳq/>;_??k |{1ѠgM(`~W?۟曧!Ý>?2:D6jlmerTest/man/0000755000176200001440000000000013573715730012637 5ustar liggesuserslmerTest/man/ensure_full_rank.Rd0000644000176200001440000000136113573715730016465 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/contrast_utils.R \name{ensure_full_rank} \alias{ensure_full_rank} \title{Ensure a Design Matrix has Full (Column) Rank} \usage{ ensure_full_rank(X, tol = 1e-07, silent = FALSE, test.ans = FALSE) } \arguments{ \item{X}{a design matrix as produced by \code{model.matrix}.} \item{tol}{\code{qr} tolerance.} \item{silent}{throw message if columns are dropped from \code{X}? Default is \code{FALSE}.} \item{test.ans}{Test if the resulting/returned matrix has full rank? Default is \code{FALSE}.} } \value{ A design matrix in which redundant columns are dropped } \description{ Determine and drop redundant columns using the \code{\link{qr}} decomposition. } \keyword{internal} lmerTest/man/anova.lmerModLmerTest.Rd0000644000176200001440000000466313573715730017321 0ustar liggesusers% 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/get_model.Rd0000644000176200001440000000055313573715730015070 0ustar liggesusers% 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/is_estimable.Rd0000644000176200001440000000222413573715730015566 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/estimability.R \name{is_estimable} \alias{is_estimable} \title{Estimability of Contrasts} \usage{ is_estimable(contrast, nullspace = NULL, X = NULL, tol = sqrt(.Machine$double.eps)) } \arguments{ \item{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.} \item{nullspace}{the nullspace of the design matrix.} \item{X}{design matrix.} \item{tol}{tolerance for determining if a contrast is orthogonal to the} } \value{ a logical vector of length \code{nrow(contrast)} determining if each contrast is estimable } \description{ 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. } \examples{ # FIXME: We need some examples here } \seealso{ \code{\link{nullspace}} } \author{ Rune Haubo B. Christensen } \keyword{internal} lmerTest/man/doolittle.Rd0000644000176200001440000000120713573715730015125 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/contrast_utils.R \name{doolittle} \alias{doolittle} \title{Doolittle Decomposition} \usage{ doolittle(x, eps = 1e-06) } \arguments{ \item{x}{a numeric square matrix with at least 2 columns/rows.} \item{eps}{numerical tolerance on the whether to normalize with components in \code{L} with the diagonal elements of \code{U}.} } \value{ 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)} } \description{ Doolittle Decomposition } \keyword{internal} lmerTest/man/plot.step_list.Rd0000644000176200001440000000357513573715730016123 0ustar liggesusers% 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/get_model_matrix.Rd0000644000176200001440000000160613573715730016454 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/terms_utils.R \name{get_model_matrix} \alias{get_model_matrix} \title{Extract or remake model matrix from model} \usage{ get_model_matrix(model, type = c("extract", "remake"), contrasts = "restore") } \arguments{ \item{model}{an \code{lm} or \code{lmerMod} model object.} \item{type}{extract or remake model matrix?} \item{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.} } \value{ the model (or 'design') matrix. } \description{ Extract or remake model matrix from model and potentially change the contrast coding } \author{ Rune Haubo B Christensen } \keyword{internal} lmerTest/man/summary.lmerModLmerTest.Rd0000644000176200001440000000552313573715730017706 0ustar liggesusers% 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/show_tests.anova.Rd0000644000176200001440000000246313573715730016440 0ustar liggesusers% 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/plot.ls_means.Rd0000644000176200001440000000271113573715730015705 0ustar liggesusers% 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/get_contrasts_type1.Rd0000644000176200001440000000076313573715730017135 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/anova_contrasts.R \name{get_contrasts_type1} \alias{get_contrasts_type1} \title{Type I ANOVA table contrasts} \usage{ get_contrasts_type1(model) } \arguments{ \item{model}{a model object with \code{terms} and \code{model.matrix} methods.} } \value{ List of contrast matrices - one contrast matrix for each model term. } \description{ Type I ANOVA table contrasts } \author{ Rune Haubo B. Christensen } \keyword{internal} lmerTest/man/devfun_vp.Rd0000644000176200001440000000127613573715730015130 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/lmer.R \name{devfun_vp} \alias{devfun_vp} \title{Compute Deviance of an LMM as a Function of Variance Parameters} \usage{ devfun_vp(varpar, devfun, reml) } \arguments{ \item{varpar}{variance parameters; \code{varpar = c(theta, sigma)}.} \item{devfun}{deviance function as a function of theta only.} \item{reml}{if \code{TRUE} the REML deviance is computed; if \code{FALSE}, the ML deviance is computed.} } \value{ the REML or ML deviance. } \description{ This function is used for extracting the asymptotic variance-covariance matrix of the variance parameters. } \author{ Rune Haubo B. Christensen } \keyword{internal} lmerTest/man/merModLmerTest-class.Rd0000644000176200001440000000066713573715730017145 0ustar liggesusers% 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.Rd0000644000176200001440000000111113573715730014721 0ustar liggesusers% 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/get_covbeta.Rd0000644000176200001440000000115513573715730015412 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/lmer.R \name{get_covbeta} \alias{get_covbeta} \title{Compute cov(beta) as a Function of varpar of an LMM} \usage{ get_covbeta(varpar, devfun) } \arguments{ \item{varpar}{variance parameters; \code{varpar = c(theta, sigma)}.} \item{devfun}{deviance function as a function of theta only.} } \value{ cov(beta) at supplied varpar values. } \description{ At the optimum cov(beta) is available as vcov(lmer-model). This function computes cov(beta) at non (RE)ML estimates of \code{varpar}. } \author{ Rune Haubo B. Christensen } \keyword{internal} lmerTest/man/carrots.Rd0000644000176200001440000000527213573715730014611 0ustar liggesusers% 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/containment.Rd0000644000176200001440000000105713573715730015450 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/contrast_utils.R \name{containment} \alias{containment} \title{Determine the Containment Structure for All Terms in a Model} \usage{ containment(object) } \arguments{ \item{object}{a model object, e.g. of class \code{lm} or \code{merMod}.} } \value{ 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. } \description{ See \code{\link{term_contain}} for details about containment. } \keyword{internal} lmerTest/man/step.lmerModLmerTest.Rd0000644000176200001440000000640213573715730017161 0ustar liggesusers% 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/contest.lmerModLmerTest.Rd0000644000176200001440000001004013573715730017656 0ustar liggesusers% 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/as.data.frame.ls_means.Rd0000644000176200001440000000173413573715730017337 0ustar liggesusers% 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/contest1D.lmerModLmerTest.Rd0000644000176200001440000000540313573715730020052 0ustar liggesusers% 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/as_lmerModLmerTest.Rd0000644000176200001440000000257613573715730016702 0ustar liggesusers% 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/step.Rd0000644000176200001440000000115613573715730014104 0ustar liggesusers% 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/term_contain.Rd0000644000176200001440000000256213573715730015615 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/contrast_utils.R \name{term_contain} \alias{term_contain} \title{Determine which Terms Contain a Term} \usage{ term_contain(term, factors, dataClasses, term_names) } \arguments{ \item{term}{character; name of a model term and one of \code{term_names}.} \item{factors}{the result of \code{attr(terms_object, "factors")}.} \item{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.} \item{term_names}{the result of \code{attr(terms_object, "term.labels")}.} } \value{ a logical vector indicating for each term in \code{term_names} if it contains \code{term}. } \description{ The definition of \emph{containment} follows from the SAS documentation on "The Four Types of Estimable Functions". } \details{ 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. } \keyword{internal} lmerTest/man/rm_complete_terms.Rd0000644000176200001440000000115613573715730016651 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ranova.R \name{rm_complete_terms} \alias{rm_complete_terms} \title{Remove Terms from Formula} \usage{ rm_complete_terms(terms, full_formula, random = TRUE) } \arguments{ \item{terms}{character vector (or list) of terms to remove from \code{full_formula}} \item{full_formula}{formula} \item{random}{if \code{TRUE} names of the return list have parentheses around them.} } \description{ Remove fixef or ranef terms from formula, return a list of modified formulae with environment restored to that of the original formula. } \keyword{internal} lmerTest/man/lmerModLmerTest-class.Rd0000644000176200001440000000235213573715730017312 0ustar liggesusers% 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/ls_means.lmerModLmerTest.Rd0000644000176200001440000000533613573715730020014 0ustar liggesusers% 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/contest.Rd0000644000176200001440000000135313573715730014607 0ustar liggesusers% 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/get_rdX.Rd0000644000176200001440000000103413573715730014520 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/contrast_utils.R \name{get_rdX} \alias{get_rdX} \title{Compute the 'Full' Rank-Deficient Design Matrix} \usage{ get_rdX(model, do.warn = TRUE) } \arguments{ \item{model}{a model object; lmerMod or lmerModLmerTest.} \item{do.warn}{throw a message if there is no data for some factor combinations.} } \value{ the rank-deficien design matrix } \description{ Compute the 'Full' Rank-Deficient Design Matrix } \author{ Rune Haubo B. Christensen } \keyword{internal} lmerTest/man/lmerTest-package.Rd0000644000176200001440000001411413573715730016317 0ustar liggesusers% 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 } \author{ Alexandra Kuznetsova, Per Bruun Brockhoff, Rune Haubo Bojesen Christensen } lmerTest/man/legacy.Rd0000644000176200001440000001026113573715730014372 0ustar liggesusers% 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/lmer.Rd0000644000176200001440000001404113573715730014065 0ustar liggesusers% 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. Two vertical bars (\code{||}) can be used to specify multiple uncorrelated random effects for the same grouping variable. (Because of the way it is implemented, the \code{||}-syntax \emph{works only for design matrices containing numeric (continuous) predictors}; to fit models with independent categorical effects, see \code{\link{dummy}} or the \code{lmer_alt} function from the \code{afex} package.) } \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{lmerControl}()} or \code{\link{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 named \code{\link{list}} of starting values for the parameters in the model. For \code{lmer} this can be a numeric vector or a list with one component named \code{"theta"}.} \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{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{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).} \item{...}{other potential arguments. A \code{method} argument was used in earlier versions of the package. Its functionality has been replaced by the \code{REML} argument.} } \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 is taken 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/qform.Rd0000644000176200001440000000070313573715730014252 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils.R \name{qform} \alias{qform} \title{Compute Quadratic Form} \usage{ qform(x, A) } \arguments{ \item{x}{a numeric vector} \item{A}{a symmetric numeric matrix} } \value{ a numerical scalar } \description{ Efficiently computes \eqn{x' A x} - or in R-notation: } \details{ Length of \code{x} should equal the number of rows and columns of \code{A}. } \keyword{internal} lmerTest/man/nullspace.Rd0000644000176200001440000000210413573715730015111 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/estimability.R \name{nullspace} \alias{nullspace} \title{Nullspace} \usage{ nullspace(A, type = c("right", "left"), tol = sqrt(.Machine$double.eps)) } \arguments{ \item{A}{a numeric matrix.} \item{type}{\code{"right"} (default) gives is the standard nullspace, \code{"left"} gives left nullspace of \code{A}.} \item{tol}{tolerance multiple of the first singular value to determine if subsequent singular values are (sufficiently) positive to be determined greater than zero.} } \value{ 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}. } \description{ Compute the (right or left) nullspace of matrix using a (semi-complete) Singular Value Decomposition. } \details{ This implementation is fastest on matrices with more rows than columns such as a typical design matrix for a linear model. } \examples{ # FIXME: We need some examples here } \author{ Rune Haubo B. Christensen } \keyword{internal} lmerTest/man/get_Fstat_ddf.Rd0000644000176200001440000000146313573715730015667 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/contest.R \name{get_Fstat_ddf} \alias{get_Fstat_ddf} \title{Compute denominator df for F-test} \usage{ get_Fstat_ddf(nu, tol = 1e-08) } \arguments{ \item{nu}{vector of denominator df for the t-statistics} \item{tol}{tolerance on the consequtive differences between elements of nu to} } \value{ the denominator df; a numerical scalar } \description{ From a vector of denominator df from independent t-statistics (\code{nu}), the denominator df for the corresponding F-test is computed. } \details{ 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. } \author{ Rune Haubo B. Christensen } \keyword{internal} lmerTest/man/show_tests.Rd0000644000176200001440000000170113573715730015327 0ustar liggesusers% 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 Rune Haubo B. Christensen } \keyword{internal} lmerTest/man/drop1.lmerModLmerTest.Rd0000644000176200001440000000640413573715730017235 0ustar liggesusers% 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/single_anova.Rd0000644000176200001440000000143513573715730015576 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/lmer_anova.R \name{single_anova} \alias{single_anova} \title{ANOVA Tables for Linear Mixed Models} \usage{ single_anova(object, type = c("III", "II", "I", "3", "2", "1", "yates", "marginal", "2b"), ddf = c("Satterthwaite", "Kenward-Roger")) } \arguments{ \item{object}{an \code{lmerModLmerTest} object; the result of \code{lmer()} after loading the \pkg{lmerTest}-package.} \item{type}{the type of ANOVA table requested (using the SAS terminology for these) with Type I being the familiar sequential ANOVA table.} \item{ddf}{method for computing denominator degrees of freedom.} } \value{ an ANOVA table } \description{ ANOVA Tables for Linear Mixed Models } \author{ Rune Haubo B. Christensen } \keyword{internal} lmerTest/man/ham.Rd0000644000176200001440000000347413573715730013703 0ustar liggesusers% 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, \url{https://doi.org/10.1016/j.foodqual.2009.09.004}. } \keyword{datasets} lmerTest/man/show_tests.ls_means.Rd0000644000176200001440000000211513573715730017127 0ustar liggesusers% 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/rbindall.Rd0000644000176200001440000000051613573715730014717 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils.R \name{rbindall} \alias{rbindall} \title{\code{rbind} Multiple Objects} \usage{ rbindall(...) } \arguments{ \item{...}{objects to be \code{rbind}'ed - typically matrices or vectors} } \description{ \code{rbind} Multiple Objects } \keyword{internal} lmerTest/man/TVbo.Rd0000644000176200001440000000235013573715730014000 0ustar liggesusers% 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/man/ranova.Rd0000644000176200001440000001116513573715730014420 0ustar liggesusers% 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)}. 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[lme4]{findbars}}. In this exposition it is immaterial whether \code{f1} and \code{f2} are factors or continuous variables. } \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 fm. } \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/get_contrasts_type3.Rd0000644000176200001440000000073413573715730017135 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/anova_contrasts.R \name{get_contrasts_type3} \alias{get_contrasts_type3} \title{Contrasts for Type III Tests} \usage{ get_contrasts_type3(model, which = NULL) } \arguments{ \item{model}{model object.} \item{which}{optional character vector naming terms for which to compute the the contrasts.} } \value{ list of contrast matrices. } \description{ Contrasts for Type III Tests } \keyword{internal} lmerTest/man/contestMD.lmerModLmerTest.Rd0000644000176200001440000000571413573715730020113 0ustar liggesusers% 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/DESCRIPTION0000644000176200001440000000342413574671743013603 0ustar liggesusersPackage: lmerTest Type: Package Title: Tests in Linear Mixed Effects Models Version: 3.1-1 Authors@R: c(person("Alexandra", "Kuznetsova", role = c("aut")), person("Per", "Bruun Brockhoff", role = c("aut", "ths"), email = "perbb@dtu.dk"), person("Rune", "Haubo Bojesen Christensen", role = c("aut"), email = "Rune@ChristensenStatistics.dk"), person("Sofie", "Pødenphant Jensen", role=c("ctb", "cre"), email="sofp@dtu.dk")) Depends: R (>= 3.2.5), lme4 (>= 1.1-10), stats, methods Imports: numDeriv, MASS, ggplot2 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: 6.1.1 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' NeedsCompilation: no Packaged: 2019-12-13 10:17:26 UTC; sofp Author: Alexandra Kuznetsova [aut], Per Bruun Brockhoff [aut, ths], Rune Haubo Bojesen Christensen [aut], Sofie Pødenphant Jensen [ctb, cre] Maintainer: Sofie Pødenphant Jensen Repository: CRAN Date/Publication: 2019-12-13 11:20:03 UTC lmerTest/tests/0000755000176200001440000000000013573715730013226 5ustar liggesuserslmerTest/tests/test_lmerTest_paper.R0000644000176200001440000000527713573715730017411 0ustar liggesusers# 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.R0000644000176200001440000000115213573715730016047 0ustar liggesusers# 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_lmer.R0000644000176200001440000001030213573715730015343 0ustar liggesusers# 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) lmerTest_args <- formals(lmerTest::lmer) stopifnot( all.equal(names(lmer_args), names(lmerTest_args)), all.equal(lmer_args, lmerTest_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_contestMD.R0000644000176200001440000001013613573715730016311 0ustar liggesusers# 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_zerovar.R0000644000176200001440000000217313573715730016103 0ustar liggesusers# 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_ls_means.R0000644000176200001440000001055613573715730016220 0ustar liggesusers# 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_compare_sas.R0000644000176200001440000001264513573715730016714 0ustar liggesusers# 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_drop1.R0000644000176200001440000000526313573715730015443 0ustar liggesusers# 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_summary.R0000644000176200001440000001026013573715730016104 0ustar liggesusers# 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_anova.R0000644000176200001440000003063313573715730015521 0ustar liggesusers# 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/tests/zlmerTest_zeroDenom.R0000644000176200001440000000136613573715730017372 0ustar liggesuserslibrary(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_legacy.R0000644000176200001440000000640213573715730015656 0ustar liggesusers# 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_contest1D.R0000644000176200001440000000647213573715730016265 0ustar liggesusers# 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_ranova_step.R0000644000176200001440000002224713573715730016740 0ustar liggesusers# 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)) stopifnot( all.equal(an1[2, "LRT"], an2[2, "Chisq"], tolerance=TOL), all.equal(an1[2, "Df"], an2[2, "Chi Df"], tolerance=TOL), all.equal(an1[1:2, "logLik"], an2[2:1, "logLik"], tolerance=TOL) ) # 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( an2[2L, "Pr(>Chisq)"] == 1 ) 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)) ) # 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")) lmerTest/R/0000755000176200001440000000000013573715730012265 5ustar liggesuserslmerTest/R/contrast_utils.R0000644000176200001440000003375413573715730015501 0ustar liggesusers############################################################################# # Copyright (c) 2013-2018 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 #' @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 #' @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)} #' #' @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 #' @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 #' @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(colSums(rdX) == 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) # 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.R0000644000176200001440000002251413573715730015620 0ustar liggesusers############################################################################# # Copyright (c) 2013-2018 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 #' @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 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/utils.R0000644000176200001440000000623413573715730013555 0ustar liggesusers############################################################################# # Copyright (c) 2013-2018 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 # 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 #' @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 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) } ############################################## ######## 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/ls_means.R0000644000176200001440000004065113573715730014217 0ustar liggesusers############################################################################# # Copyright (c) 2013-2018 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() ############################################## 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/estimability.R0000644000176200001440000001172713573715730015117 0ustar liggesusers############################################################################# # Copyright (c) 2013-2018 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 #' @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 #' @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/data_documentation.R0000644000176200001440000001614013573715730016254 0ustar liggesusers############################################################################# # Copyright (c) 2013-2018 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, #' \url{https://doi.org/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/lmer_summary.R0000644000176200001440000001323313573715730015126 0ustar liggesusers############################################################################# # Copyright (c) 2013-2018 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(as(object, "lmerMod"), ...) 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/lmer.R0000644000176200001440000003465613573715730013365 0ustar liggesusers############################################################################# # Copyright (c) 2013-2018 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 is taken #' 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 } } ############################################## ######## 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)) varpar_opt <- unname(c(res@theta, res@sigma)) # Compute Hessian: 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 res } ############################################## ######## 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 evaulating 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) || 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 #' @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 #' @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/step.R0000644000176200001440000003514613573715730013374 0ustar liggesusers############################################################################# # Copyright (c) 2013-2018 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, "lmerModLmerTest")) model <- as_lmerModLmerTest(model) 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:", deparse(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:", deparse(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, random = FALSE)[[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.R0000644000176200001440000001616613573715730013447 0ustar liggesusers############################################################################# # Copyright (c) 2013-2018 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 #' @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, random=FALSE), 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:", deparse(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/lmerTest.R0000644000176200001440000001654713573715730014224 0ustar liggesusers############################################################################# # Copyright (c) 2013-2018 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 #' #' #' @docType 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/ranova.R0000644000176200001440000003162613573715730013706 0ustar liggesusers############################################################################# # Copyright (c) 2013-2018 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)}. #' #' 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[lme4]{findbars}}. #' #' In this exposition it is immaterial whether \code{f1} and \code{f2} are #' factors or continuous variables. #' #' @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 #' @importFrom lme4 getME findbars nobars #' #' @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 fm. #' 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) 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 - needed for terms like (1 | g1 / g2): fe_rhs <- safeDeparse(nobars(orig_rhs)) reforms <- lapply(findbars(orig_rhs), safeDeparse) # random-effect forms re_rhs <- lapply(reforms, function(rf) paste0("(", rf, ")")) full_rhs <- paste(c(list(fe_rhs), re_rhs), collapse=" + ") full_form <- update(orig_form, paste0(". ~", full_rhs)) # Compute new model formulae with reduced ranef formulae: new_forms <- if(!reduce.terms) rm_complete_terms(reforms, full_form) else unlist(lapply(reforms, get_newforms, full_formula=full_form)) ll <- get_logLik(model) # store df and logLik 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 <- get_lm_call(model, nform) eval.parent(as.call(lm_call)) } else eval.parent(update(model, formula=nform)) # } 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:", deparse(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 ############################################## #' 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 #' @param random if \code{TRUE} names of the return list have parentheses around #' them. #' #' @importFrom stats update.formula #' @keywords internal rm_complete_terms <- function(terms, full_formula, random=TRUE) { # 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) <- if(!random) terms else sapply(terms, function(form) paste0("(", form, ")")) 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 # rhs <- get_rhs(form) # rhs of random term: (lhs | rhs) lhs <- get_lhs(form) # lhs of random term: (lhs | rhs) scope <- drop.scope(lhs) # Detemine 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 <- safeDeparse(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 <- safeDeparse(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 <- safeDeparse(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 <- safeDeparse(ranef_term) trimws(gsub("^.*\\|", "", ranef_term)) } lmerTest/R/contest.R0000644000176200001440000006074613573715730014104 0ustar liggesusers############################################################################# # Copyright (c) 2013-2018 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 #' @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/terms_utils.R0000644000176200001440000001752113573715730014770 0ustar liggesusers############################################################################# # Copyright (c) 2013-2018 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 #' @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 deparse2 <- function(x) paste(safeDeparse(x), collapse = " ") 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/lmer_anova.R0000644000176200001440000002476413573715730014550 0ustar liggesusers############################################################################# # Copyright (c) 2013-2018 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()) # return(anova(as(object, "lmerMod"), ...)) # Note: Need 'NextMethod' here to get printing from anova.merMod right. ddf <- match.arg(ddf) # Commented since we need to pass 'hidden' type options to single_anova # type <- match.arg(type) if(ddf=="lme4") return(anova(as(object, "lmerMod"), ...)) # return(NextMethod()) # 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 #' #' @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/legacy.R0000644000176200001440000001461013573715730013656 0ustar liggesusers############################################################################# # Copyright (c) 2013-2018 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/NEWS.md0000644000176200001440000000764313573715730013174 0ustar liggesuserslmerTest 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 occurr 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 environmentgs 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 deficiancy was fixed by Rune, lmerTest was fixed accordingly lmerTest/MD50000644000176200001440000001075513574671743012412 0ustar liggesusersce0b4ab7fbce0d0e77f36e00e1988a3b *DESCRIPTION 52b6d9050650f3655b1479abf244f833 *NAMESPACE 144ed50d83c1b0f65a47e32daf5b77bb *NEWS.md 40d6a66234c96d4dd251743eb97b1812 *R/anova_contrasts.R 6af2efa9be0b2e7b2771abd064497b55 *R/contest.R 73c9cb9019cc7d6f4413b1a85b523946 *R/contrast_utils.R 4c4ba173dada5afe0c06c99a4604fca7 *R/data_documentation.R 9c248ff95d29480c5786829442c4ec58 *R/drop1.R a479a3cf9c3ddc821e3a15ef8e70460f *R/estimability.R c1a3f73dc6601fd0eee7f49fec84f368 *R/legacy.R 57ce285083262d32e2cfe581c8bc498f *R/lmer.R 4a5c82d790a24a512c9be88341e2e0b4 *R/lmerTest.R 906d881c32431a50e2b6cf7c1f5549be *R/lmer_anova.R 7207872e001b69f295089e8582074b62 *R/lmer_summary.R a5f142c7659768285f41ea6a1bb70ed0 *R/ls_means.R 2164df352a8ee8dbac90197934f4576d *R/ranova.R e75628fbc2a45e8b403e1e63f00771cc *R/step.R c5cffbdecd3b0dcc799c567b19fdc936 *R/terms_utils.R 30a0b40341f851a5e40c4ec1b40cb323 *R/utils.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 8476f7c3a6dc8ff59ef116cc3ff3abea *man/TVbo.Rd 6fc82972c1cc47e1fd77bd7b302bfd91 *man/anova.lmerModLmerTest.Rd 42290867a073d2dc3955ea2b4acf8b8b *man/as.data.frame.ls_means.Rd d1043abb4725e992da1bf19c5a8fdfdd *man/as_lmerModLmerTest.Rd 6804ced2c3a45b6a478422b69bb0af90 *man/carrots.Rd 40afc7c036b2d03f1dc1c53a63e6734d *man/containment.Rd c6e71f37db047bf40d01f433c5e1c371 *man/contest.Rd 21da78b8b85da916829e11a33a8ef3fc *man/contest.lmerModLmerTest.Rd 2f13180282ab51c17957716433b42d2e *man/contest1D.lmerModLmerTest.Rd b358ffdf43b9428ff5d2c2c0ef428e63 *man/contestMD.lmerModLmerTest.Rd 76f81c800630a2b5f8d30de1c68432af *man/devfun_vp.Rd 313d20d9831a033a3f6dd47e307e3bcf *man/doolittle.Rd e759497a850ad41eee16f6824a20cee8 *man/drop1.lmerModLmerTest.Rd c3c2b834b887b2ebc3acca01fe3e0afa *man/ensure_full_rank.Rd 8f97a0e51588678de4fb1642aed363cc *man/get_Fstat_ddf.Rd 763eb2c2d5c039223bb014cf9eb0633a *man/get_contrasts_type1.Rd 7f2857a8114b0faec132d4a515a1a14d *man/get_contrasts_type3.Rd ba73fff82bd391adfbb2994f7b99777b *man/get_covbeta.Rd 694c357e7338c15a3a9f1e3e82d5ed30 *man/get_model.Rd 108ed1407f04742d00b1698c78a073e0 *man/get_model_matrix.Rd b82e18cdf3f8c1fc491660b9a2b85570 *man/get_rdX.Rd 8b89ae0a29cb3982c5567f54af486fb5 *man/ham.Rd 0dbbc5ae2bfdd0812e17f88ada9a9e3a *man/is_estimable.Rd c670a6595035b435f934905c6e33fc8e *man/legacy.Rd 61592b0f39a00afb1e3eaab0819cc58b *man/lmer.Rd ba1fc9cb9d0d6b06233b2b6c5f7a7d4b *man/lmerModLmerTest-class.Rd eb9b8e6214e32a0e127ac247cb942ce7 *man/lmerTest-package.Rd fcc75d0724e94e9ab93929609e273904 *man/ls_means.Rd c3d0ff861c67ef58cf56a21fa234a1d6 *man/ls_means.lmerModLmerTest.Rd 5ec03c1e9cf15c3044fc986a2ad54512 *man/merModLmerTest-class.Rd 6899bee88d2cb1320c0cbd668a5f640f *man/nullspace.Rd 401db0036840b98ec716380aadb88f5f *man/plot.ls_means.Rd 15842b4bd6020a2b6df0ea2c41529c67 *man/plot.step_list.Rd 112bdf2ace9ff5d9d5de3835bc9a147e *man/qform.Rd 7d1a5680977594817ef0d8cef4d726a4 *man/ranova.Rd bc889bd701e25682cc1e0b13d77d6388 *man/rbindall.Rd 292dd7c645ecea325212165a40505f75 *man/rm_complete_terms.Rd 2aaf66d3a9092bee309d8e86248ba72d *man/show_tests.Rd 29462499c778ebd5dfb4a3b931481ee3 *man/show_tests.anova.Rd cbdf5b05a70dd005ecd87311ea43db46 *man/show_tests.ls_means.Rd 4581ce85177ebadc83b82255de387e2c *man/single_anova.Rd a0f9deb02c62822eb28f92f7b92d8f56 *man/step.Rd 45825e7cdc348ab93df886ba0e1b2920 *man/step.lmerModLmerTest.Rd a8e2a184fa1e9f68ccd6dcabce59c2ae *man/summary.lmerModLmerTest.Rd 041b5fc11da3e72417847c3519029f36 *man/term_contain.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 61b56963b69bb0a918d6f0068a31c960 *tests/test_drop1.R 871dc95c5780e4fe63ddf44d9fb586a6 *tests/test_legacy.R d3d543f80be58ec7797f69ea2528e6a0 *tests/test_lmer.R bc49940e3c950e447dc3a5a8ec7eddab *tests/test_lmerTest_paper.R 26d8f42e8cc43a44bc5355e4f650977e *tests/test_ls_means.R fbd8c681c0dfaa72b5163a1bf7533d50 *tests/test_ranova_step.R d6116771ee3a2c4299ec9d9930790732 *tests/test_summary.R 45baa7c308b815bc2e03a1ff0db52f17 *tests/test_zerovar.R 191c0b12e0277651920d1acb1da6c1d9 *tests/zlmerTest_zeroDenom.R lmerTest/inst/0000755000176200001440000000000013573715730013041 5ustar liggesuserslmerTest/inst/testdata/0000755000176200001440000000000013573715730014652 5ustar liggesuserslmerTest/inst/testdata/potdata.RData0000644000176200001440000000563013573715730017227 0ustar liggesusersV 4k eI,DkYk cK Z(;#Y'Cc_BLl0\>.sn{{}~XLƌP{J܃ cBō0X4noO4z3EXDMJ krFK1'̶t9IxZȊm/Ҝ$P:smAd"}"/28vIܻ6os1Ԕ|(0`8Q٥ 0wMؑpXNAKp>u݋ouSfXBS[H'0!uOq5>eoŸ TH.zP1ٟ}MѺR5k9{_÷?x^(b)֗eKa>!&A ٶIvna#Ɍ*;VǚITs='"D-MSM˧3KgbOTnR`[aڪ 6mIE!5u@W= x;Z"Ig &! )}Pj˶b&+WW.hmHS#Vg_cj Qtm>i~mY)֊ҡIίؙ-~S$۬G1zIoQ>Y(dQ6 RhfVxi@ޫ$mgܔMw !B^C6QiB,,8},S~b>[g]T7m( gt8KiC#%dX0Du3{ jA.iD.qHy8,D.Bd"9?ҿNXOזEJ=FnJbq71gw@GJ<1j-H2PK0B+ue5Bpvl9OY(ГEu\&xTnp!,D^]eP0}L(cH 5Dtsꉉ[I ,ЀEL(ʻxc򦐻Vv2#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 ODoP3B:G}5BkӪs|+=v^YY@9po;w'.ho v1=eA/9`[kQaU? ohZiw<RG@䀎r7?S#@}&K2\z~_A}f*rh9Ɲ=<_ЯtXGm܋G_}ԄGqըl]mО[ m0_> Ss/!Bowwww7 lmerTest/inst/testdata/legacy_fits.RData0000644000176200001440000030670713573715730020075 0ustar liggesusers=xճ.ٲܻ}{{eqmmtZIg+E5'B !!B $@HB 鄐B ! ;ovs<;3ｙy͛6[\"UʐB*IVw-"JXunFFo2ʹz5Rƻ.Rz=#:cBTU4IM鹴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=Www\lS]]$5=7SԞc}|z}O==/_L߻jF GM-W̳#}FMR{W{jWyڅDh +o{IgoB+NioR0g>'z.=oTSc~}'G\vk+j/۾|\6?ߠf߰ݫ}jGY=ͨvqwzh#wU?ҩO]ꎾpjBW҂Sc~F5󅋾ǨCy Zjb^&~{_{f'W;_MVM|oϮ]|ԮS޶5jׇ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ڤ_ANUטmz־S/ٟ{{Wލf~FKC5#?CjF{M=t~RzB=E3|GjR#Kz}z{UV{G_W̍j8.W GjPt.BYЋw| #%۩f~G׫6I׻_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ѥ/-^+ʫ{GgoVWTבOwf6>/[},|(c}o7g䄄:GrÌm;qq ΁[SO*ٗ:Wѹcxxƍ=:eF>rt΃ڔ Kͷ|eyjø< ~:{ԙ׎k.oG}.<:tϸ K+:~ uwaF-g"7ie_M]jTnВ2]]}[-DUz8I{8pzٮ9YPq$FR7qY@)H$pCDWKJ߬O5EHֱM^}VʐoSU:hƪdR'B[UUk`ctGLwkZw&墱k"}JX"EKz>K8ն^h7zhZ]āM40G.@8`lq NXpa)<n71;G%UrT9QB5@i3! :*p0L Qo f0[~ tX@}3t.5:AaEMpg@=dԩtg[st8Wt@tد%:PZA@-:PciH3Ձں-rWpppfn:ܦ[uxo:Kw:|Pp:|ROӻG=}×uxHu_:<:|K'tI~ÏuO+~t:UguxNtxI^_:C1낣8>P(WtP耭ˆˆˆ+EW*zRtPtPtPtPt٠(9:ӡE:財財財財財ZpueCeCeCeCeC١Nv4"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{tTxa.Ac9-Ⴊ2J@ۍD4ϝf%6uL;֞Hf\"uqm1LDcw#-,]VGdʍl"vȸCP%hGIvRshukƚ&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)>?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ۻj22222s8'%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_)+|*Ox~PSzk x@ Ci-IA'x^w ԫWȻ-bTcKZlvu$!*T*#lLhz #;y&pwJKޖޚh,P7`Rum X^r0 T_AP;h!HYh2 l%%~RVUz7lސAz+^Yֺf3UnAT2kX:)\Kl(eK{y>▢‰:wIsvqp v(++].SߣlQVZeIrۼ.(w5#eMQVQ4YRl RW H(?^Q Y ` lFQq>?HWd4չd [`=Nc 5+履b^5E㊦#y'5#R q .O1\66Sn*1~"}$>^yFX=FGzivu'gU .j)7rV?-*eՂ 5#mn//KX?\) G'ƍ(d7S[Tux/Rt9ց<5pCOzk7X{ b-)ջ;=.&׽I[J]^tuba Uwi. 1{wS7BB:sA JS/#uUc򔪔ToJmX.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@YG{n)+^fwS^I*]PY{ҫ^4(!nMQVsW/BcP-6idWƃ|Ga9c&o3}FB Z8<ڛjxO^hKv 1aˆzRPYf5 :_8h nO%dfW.sIh,KZ[E|L6 "|) wPQygcε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̞SdBww%v;NRjj^8FE2 -w$G)t9nS n*7zJggSHMֳ"ަUU:UfHgB8Li{cCA8bw̔+ ̩A8Nt0ulsoFKE#qͤ]c58gꄩ0ڰ {3)cbfTtGzXG'5ڲxPޯa1[i?dP- mW)Է?u 5 {3aC٥oGҲ^%s$٠%z$EP!1 %-ZB.7ڮ⚡f@[*dmN؃\:Bezxdɻ(1,$&]H`xa(Zz:}9PePM!Ah>&))4H7%]=J7ұ6x7y碼-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 pL ?SKlD*Qb+ģi۹^q֑|֑2~r*얈fS)i^%zX}3hCjp,+q|b>"QTXL$n%A2Iv i'zv8ׄ\D-cp1 OOc)'0:ָe:a3KimΙ6N`:}v6шwUa,Xh0직ljɮHlu L7׀QƝѫL%Ҏ G}<'Ga&p9a&? 0vFRhFOq7{~H *di,3 ofXWiYp8ݙꚲUHܺJLgR&r ̅Nkb-ҙsJ6, h8V6VLgXApPVB_dkXgo:/1!.*I I I2t`<2ɩ,׃\l-oK .`K( a<|~=7B8|op.~<=4Wh/T={t(QǗo\ѥxI}T dA _ )1?g* \t'Հg Ui +@PP0kI7I6~ݯ>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.rtQdqWT˘fX"SL {E..SŽo"S12zrzsDzCt&7'&" EzCq7ٔ&[7O9HO؛-\F"~a䎰IWC?9 E+l>$P;6VNb$>>Mg0SEce3+=b4>W61S |X;ct1ao2Mʃ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=DWu^"os=8/R&ZK#>/L /bgXϞȬol V= (.C [ \z5|fxpaYX~ 9ɞG!oŶ%uH8b㪆0ae e Iu2i+/ 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:\`zX .pm>6@Nx1Yp`i+ |h$7>rwe*Ou9ٜ-JK(iMÙdتYÑ x&dW8Hf:T,QVc@X^iQKS4/18Dw_|-H2p6Sz|9S{Ͷ?|L#D/2DΙaWL͆0)<&kg,lhtOJY4aųA\.S#T֘7ntl"-Nv:9+bpY*ۅhUDz뉤bDTMas3^}{6߼o?"zyT@s?/bT"((719@ޟW5Qmְሠ?؎=Zsr1'aa <3?_a NXes7k2O$DqY_8`A Ů==!J:P\to+&:⽲嶚<=܏T<ˋO2,0|`؊`!a8Gic5=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]*#qm-ҕ6x2wh2RGRVǺ|V:BsI#eKL/%OqcqlJ|)鳠qK};'TÌt\r_~oDiBpF@a\i^k` @9f`2q4u 4hɀg 0™@uag?6 >{vK8Gdfʦ34E2 tZ8MWZZdLͬ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^TPz.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&KLyn*cKeSYow^Q`oziTXo`[iV6ʮ3 0N-ΎNWN{ss,st9}kM'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|MZK*HSCYG=5kDC!(Pb7 #Ǜ),4oy7tdM2ʚ!;&u58d׌go&2Ӂ/Zvo%~9tH?i>T>mNjG1 (K)r+>y7W,BeD:7T)}1 u"x s7Ȯ) x WQ n2-+`"mS"WKo6 D6PzYGf}8}t<<Cb%Є`paF 0 X>a*9k`.q,([8rgۯ҇Rsvo>KZ#I}مQcl&Mxw@^@A|Jf}RKy*ewF3o)+IZ*IJa~{koA4hm@] ]JV@I/hOrEQސ9@ѩyjD9O6{6#vߢ@\2jPlWC -5ʩ2 6A~Jf bľxTX\Y'1P.g"=a!$3;N~gLh^i>N97¯(0qW؊ ñ,p Y hAt5综p += "=aIJkѬ;Bx$ v׺3}fnY7uºʹ>hۅrY5!*vRÑP^}Qa(}/5+M?wκd*m4BD-UPFy0PӖlW גf4pyXOc،[4}_O\o'd <_ыǮ,, Y 0`;Z}=Ӂy(4p`~bG_P?_nH'{7 ΂r3Ñ^I;IE:T l~04A ;|a=%e׳ৼuRgq/Ǫ)zMOow⣆𮝭sw6vx+D'0h}M*!'4hj|uōA_Vgc¶]7m7b7pGx@77_^2>CYЈ)@\s0& ||B3i9`&)(95 b=QXY?8ebxRm'[h+4KRB>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۠WJ}6l4F1;@G\vDZ6cg ɱ|DZKeզf;:Z#B[cBkK8e`s6rgͶLۤ;= >LfmtՔK\R5C̉>|֛(Q1ad G# $5=$dMKQfEƒqRY[3nNhͳl,g:#zoA4˪oO\O<0sLŚinـJYJVDkl9+Jh9S q0Tƻ}*Z w;fsJB?kprq+sPALFgTݝ ()MP>pF=  A^&vԳ}ڮW)ͱ6D3vͮbiN!'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 `~twQ> V:T@㍆Nj5"k ~50[}W@-6/~E[ ֭qƹ=q`:G(ԙLf X3\s va>: ضv ?p&Xc|`rhv>@_=g-x2 7^p/J&>4H1IuM6Ld"_Ebt] Uvk)Zp&hRK. +kFL*S'+އ+\TiЙw+Ư#3{a:c﹮2c*jyJMFۄ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 .܁wQJ%"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:f6n¯y̯:ҍM&8U v=FrĴk6r}fmIY/:握qLvvԢ4>l.i!px # ^Tv -!v{ f@wnK1.qIdbw?HbM!a4Qľ׭ vVb."΁t}\.tth> CYEB~n1m:uT/vr*yu22| /[{zW=}=BvF7AS!ffT/[uxcYg1޴BXuBy tIb&.VfR YGϳr|q/Yez[Pxw91/9 P\+&| pNs9\yGCzҼҼEOoB7P]V AzQƋ.6N Il9 ʳx ihҾ~~!k3|؛>=ԽL/0Z I|k>y? K>B64:g?HyWE4@O9d~yz/yV AKx3}MLc#iFb?~¯~li4߀=i5[ HmԕA#ok]1?3~HqB~q`y>?E<g)ޞyeO/OC?/' /[PG:{w1ekx#: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'$et5tedfGpq\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}o4GV>Bs^5ֆ{ Hՙ7Wh|`jp'=2&&Bc:CحA2A4x+'?H%UF_fKaz四|$sjR/-z!LmX]cB[㺄{#XDMt騧%rjk"i%>XKR.(1uC4ablۻOfnsu"Bw6/(l-Vr~CLJ>^4\ uAo50N㥦5=^"c| 6^1Z>}>2we/G&^δ}GRFT"o D>fm$꤆nL8>K\(k^ώi{ltX[x%Lc <#sSmx1G'=\,x9`h%o 0WZwKE:RS- QP.AB9:ED*mWazK!Нtq'sZTG.K²ô]T#L*͈֚Ӣn:wQ3*y&ZW9Wywy$݊Lj2@APvya'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^/pTK~WxE ձ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ʫ>NQ>^t#DMo$EHO۾uD´4 ޙ4zOl(]l2:?g2z_һZ6۳1ΚM"=X[8Jf~T>OV[A`BܔWcqiMڄۿIÐh-J7R|ߒrٮrm"2OSz :=);]*">!|h>]%?wX?(Jbh#ymâ#Jg?QS?)`Myujm[% #(Ltw2FᴤVE1[ԣ~#xRg^v). u8?xOp=XM4;d>4/;o/TO:j6/NjA@Wrfͧ sJaMf-^7e.`/?.(?PBԀs:/&ϟy:._T<\?'3z곆j0oxd-#gy~xN<\& 9x0K (7wC"zEQxdՙTWHw"dIwj[8Ĵ*Spwc(/A(}ɪ|L/accWۜgX+a^P| 1>HU@D`.2 Rxtw5`ml47 lLoC 裠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!\ WCXkn1VL5ǰuf@X5fYp {5$QQ7Cb]7. D>q6Op3)xK'4 I~"{z[Pc&dm%_+m%ecY 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)cxXd`_'vL'{:q|/bMt"=d\ϏHǽ5,/[ nKe LCC z:6Pӛ(BtѱX.%mtKKIY^yftWBHY ySP Uf/2%8}&tQWldd"5^oa﯃FooDzʧ|n`{=o2fo6ۯ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~|Rw1LjphY!} ~?VdQ213/d=})? ~ w'q_"_g "_s~a)4nCD2:壘&.`[1s~¯@U>U>t^7J> #&W2>s.V|ol^|oAT`2c;}A}|T!| l.guz;V!!?[^.`^ :lAA$_ |(`y%q*}~#Vz*T{@0aF@S`tҎG0''DVJ`a@hAp-E0`+}%}:N [lO؊şLzu;;Xv!ؓEp>g \3^.F.ۙBDm!A']`S9 Ѓ' 9}9/"OyZA̵[*@(6~EGr<]ߓs#~~432~p3? `?K/W&{?!`i3Kq3z'N/ 5F%x9DZ24(!FPP!GPXZC E k>aHm#wF`\`"$ LDMF0p୨G?U"0fS)3m̓sf!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'ekMER}[U:sZV-erT 'yiQO:E):Kim%YBE!ƦZn7R,cE+۴Zd۪V-]X5ri9-n5k9:ym8GTf).c|_EF^ :2[Լe^p褱-8¼D3(0|n:2oaAs[:X법w+E^{Q=p=FXzXlᙑd-<=<;f~'j3w:_poty2 3cYFyawϮs6g48g,*P\ՠ3EMK^rꚥ?A%YkLBm7ЕBNN,]].7ù;NU$+cPzA.Oj%:EXlu~ ؟5KR*$i16{[ /*򖝓%էUㇶsKQ| |($V1x?'1ꊤ6il"Emŗ3\~'@'+ujUa!{́[LɕlBUܴIc.8Lҿ=|{^,p@BNMY 4UNq-Վ)8-X$FT+p,yiQO\#уmk=Yڅc^8^/1> \j:Z$,qbYV*er-y)N|O*e 1YaeRV+c*E0 'r1wmDK}/ŦZ)oW)yIfQ:8@v[2hm`['^nm>hڒ%>܊ܺki=n%+"l!%H'KʣpCz 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_j5VVf5 0,X:?6Tw͖S}d]ZjgJk5Kig>qʇiHzӴG:٨iGMj_̄c&#sX(<}~BD-nx7 фПcfa@B8#3 *@q SYRʖnlIxxs%ly"[YNzNcLNb}Q.OaSD¢M ,PƿLS|gNKX$%a.V!5 ֙14ר1L#L/p[iZBKŢ!w3A<[P9;!e/ !Q`\ρxedt&hڬi;ӎcjsƳRdF$Q?dS\ɡhO%pY~"@`lZ.X5-6}($_X |zFdOi_˧\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? }B6]?K9tUXSniնi1}@$Jz^\˽ֹfZu$"`Z!8^RS!DUg"-sЎ>ZƎ`+JZΉ켃&7њ9ֆk1j~Nj^(+ ՄTI5ee`|}Btjz!wk$1ƋQ8[x͗-Ifz\ !9~i+,du1BH.º7m} G S?-8Egaku"mRZ/:t$ L8iLJAhd_}P@{Ben'7ߘ~#r3 U@J.}f:a2yzjJ'eku )woCywo%<1u?h!>[*7O7{:9]Fe#]sg;to"Χ| | puNme'ewyzKۿ˥ub2y C<zwvyǡx?c|"q#zC#>r|OB9>841h|V]鳐sĩ >bE:Q=y_Р΄/SAB 9^+< y!|} > y~oǀv&>'m(P(ǘA}c-PIQh@+k~Dl]D;?#~ xX:)DA'~IqW7אBY)Ww-U%rms(7Qsk^1 \p9'kGwc>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(jiNW>qw Hd{e斨/)_i=q~U>Q6mUT>xe oQx|Wo9[/ziDN'ҁϵ2*gǀwvϔ^HAX)@1kOqw;/=-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ͦXK3{bG-q0<|zтuU,+vG+]ϹGV Nr߬ҟn rp(GO4s|bʒYZ=#uNJ>qT/7b|_p_Bd4_>iNYօP/n'Fc"S{L1z"ͫ_{]gUŐd:kk΅:T\QaJFŻ"kASpk6^!n.k9KʍQH]'g˺vjуR;$̉#Uƍ|[= vk\oWs,B-'LK>Qe/ IZNZx0W%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:k0i7WsLaχf?D DK˷^NŒ>ާ!0ⷎa|MLŸa=H{v߁L^z! K!BxIѿ«m廪|+So}uf| ul |_)AsD^1DW)]O&JZkk XA丐t)k |H i! >xc˯Ey^HGq7+3(1\]?>t~VH:~So[z Dpލ.nޫ4"`=>C>>`6g0|HKq⾌A qRd>f|hRVrzu ew$MķQIJ {LHW;E) ScN:ȱMc$Wo6cU| }}'mutEZ҇P=.SaA4:F@[n5bw%ͨ:HCq5F Y2T" K=foMWt+zr3M2NgٲU$eTLH?T<̼F:P2g ;Xv~w!ƣ12$d,G/{K%T QMJHüXܞF+٦ó'Ĵ u]>HF5T`e< M kM)>RM0zٮ܈uV+j ^< Cbچ,7yF#.JtyCA<#n^Hl8Bl+Z;^Ĥ:bn{+1my&xgY3hD9't-c?cyFBn[e84o,wn&t,p\肃џ&)P0tx:H0LݐtCq0 >H"(7] se1?XxY k< jns ]Bw-1?h@T~Aat7?x]# ȌR y/)@ZxalE][Nv*>!}$j">G{eSd7~x|ʬ}l:CWYZ4r7pzș"-/$RFy} !rqi"3iuy`=SÉV-uL9 2H"mb"6Mm6l, -8RJO1HcX_=&y{L"~&-g=\a:Sx|׋,}#6k&6 T"oiDfӉf ~ɜl3Wz,B7,m6(y%6Gm4?X[R6ro_@dAwP0RF".^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~mjb3͋\jp fu?UnSς)ĞcWC'ǣ`j}Lf":Bp>U7p5ChZ:,|t8ʀ0a<xx bR)4H7%]=J656x7y碼I͝Ĝ~x^o!aʑյ"~:< 홐f;; -!1Nφ=x*t- ms_B[KL9|Q/uyG]ʻ\q@Ŀ麷~:lbÅoxc"qX^ "lCPr ? g$/JG},uBot׫faÂ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%bonf>[+p<|*{t?؛}eWh FfDwԉFiHX1_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(LApZ8pV`wss$\gHJT i9cz~!K]D-.xdw5ڸnB^J,]Fi[q 3ιuHPzU)Dz|W uޫn6B$l/ls\'lWnMV+H&agJsbza+.Ў'7KعsgV#)}ҝWAPzQE&M&=DѸ0!u5mFTz<ϥR͘ ,X7|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蕉DOv<^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Χ>\a9A/xDk^A7,.N#t@8z>R ^)ľp {ffoE9j>vpVDP?,7:$ .Rq8!&V.0-n,KaHa)w3@0Cl K X`, `=`OPukb(Mp瀂6h۳`^>;{iǕ#!AYL{)vl7+Kψv@>B>8VT_\b^+;/ܛћ+I{SyޞJvV<"ޘmh&B\߹,o‡tt,l*L1my < < "_r[1zf`>~T''5!$Lx ӭWشч~ =(AtlM6IE^iwK TOܯH:bG`Pdb+*bqb>S;J:ȼjQ& ,W#֣%ӠhkGmJv3[Mx׬4bR^+JM您NB 5+!7}R@t A.|0ebt~4&\BtVHhݩX25-v%۴8/& wǍS 7̪ nߥK}:^V*)nff-fu b_h+0(2OMwcmY}nvѵlDG55z1wæ7żc=̌$s3#CmA?͸(̝iblƏzHc!(+Rpn8>]A4C!^4~Ӳf2H>5Ozͨ~fbl|r4~+%1Auxº2ax/2k[}%Se9֮Z߰6T"P!BE·w!*/B:6#ljnQ\.W .3v& C0RQx/~\X'A+ۏ:KA' {Ne̩SL:V7"FsܦہÜ'+ C %'CM)Mbz١ ܨ[Oaͩp_Ӎ`%w(—3mg*IfcHM}y;a|wqY;lQn2Vǘb+]" O(|cJ<:ϒЭOSɑ7jO/,%-,}5ΧU 0=EkqZ$Ľ5r "w8ja2uv[1v6L`iY/+ E8XK8bgPKaV{ubN*qOǜHM$?uΜHb~?j8SySM؊cpͷXJKhIFdaڏ}g*ab7R>B9u+j\!7qnbL'n Rg3vi*`Ko'}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ԬcCxNlYZKG˼psBm֣htFBiu1z|d?|YJVCWc}zۤ1( XCRO_C M2RLRrxS$R(jT2A?Xw^;تs/5sNC_u>A0~\ ql)ͷkwٍ B^hS, ! ׊jÅShSeJ?W6Yw& LJͅT#Z M; &2-p t}s_PK cUTCW3]':6~[KxZMұu6%2 ٝ?K>}1 +tBы8ʄ8!)k)<1*Y)üX-%6߅_O\VgiP?ETќuۏK_fy\9B= 8cB!4@ǯ=w`C6xYA%!-YSAbP'Y̆v %!ʟb.d[t?W'%&uF⾹c4ol"XA`- 8B^:qM@ yS5։~Z([d@[GN2~X ::冮{K18qfg0;/?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 $31ߕ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}ceXCCyR=ҝX6*5fOe?YOV(~2R?YQRZYƝAd}J~1}JLy)Sp)zO)bNt_ DISĔ'\/O)_//eLSȠ|0ثmTXI+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/W6SMH~%CYx9w~yu_R?v6qOY~oxo9KM-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>xVE0Й~_q:mnb|+5G/t8J yEK+܏/ Z(Yj+*&l baˈV#VU72eq.P.q㮞ń E?m鱘1B~,uC_'788cq'jY?m+= };vRݺ./ZlY(Z|Q=(Zokan,&ЩǘM~ܓSη$E-=w~cx?f&ϧ$^9W`0Ny3{N3oPgߺ.,F~%1s~|ϊ7xY؈a۝-syNl8۬#bBĄ[9̿v@&m,ӷX(|{/F,Y7pLqľ&_bBAE_hSj8wIc~W,l؏^ }-VKx`.V_05+m, rL")T[u=Vb #jˆiZlpVs״$"Lៜ'%I]]\*f@>b1pڊU& ;uL猸Znh-g!bî>]ؼz;L/Ltkhrk5ϩE϶)"F-G:/FukZ&vWa~֊QOn7^?*u{ƉbAh~N/_&,qbK ˊiZ;SbL%KNg¢gcb|C{E[scSh-zD˞Aſľ[w!=j5s0޾uA٢eFa}>Vo|sQ 1!oZ])3lb7bJ-JU0QҧC]"&;Z!Xv(lrlh)%z/iݼDKG-z(!ES1XqZy]&}s C&E^>ǧ='1ݷbr9?ŁI%;|D%Z ]j"brlA-~hω ˶q Ƈ2ImO~VˆbIGZ<(痹f`L7>A]C\6׸+&2UNѺpG@~x1۫oI1КÃGUT1xg[1vg1Q53mc]-:+&|ua*}ĄYW'h )q\~E%,vq`he +LXz0AJ_VsAG܅ae/:nY?=]MBm#rK|޶}f1]ZA3B[wk/ƥEY_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?6W׺7L{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%tuitT:a9= _o8km25H"n!K'vX.POYV |AuOvH V.gŻLMUXa[uN22!ϖT' 6ݞ'oλ,V>xX,eUail|x]F~XԪG@}2kp{IϛfQ}S"Rѽͫ;4D(l0~$JV*lͷg*'͝J9g)h+7ÆɶrE}w/uf<){ŅUU=u%V} 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-?[On7/B;ՕsN.{ ߱jj:8\9GVA4CJ+0S1 PszհzDJkK: +69Tfh@b~QR Lo#¬a#-a1fM-y2AѤV76,z`BTI,QafCfx:0lhҤ?`hf-^âfoX|%n@Tp8!b6StZ=!2Fi< ukkba6DFY =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 Vn5PX82@:ҵUVewj?v­ɟ'.ݻuNʛ-C:߼IKlVhpo՗9*: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}sN vvwkOr-~Fz:=' ;y\uk7~cv'>^]mU /SGAنlWxrmOjRr#IX7I=KV,\5H)LEI>ΥnH]%EmR:#v&\8|Bm$>6p{ۧnY89Tk׹"rm.^t}~|ҫ$td>*µo]X硰Z$#[q:ptnv!nJ}y/-o!\!Pu)Z}jo{N'4ҔLP:ykY3>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#Xb/<ׄZ`kZ`kZqqqqq5#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_ GmSLI )#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 34cm+q9U$F;X7Xr⟰3]AJ%k)pkce (w GX)Ciu*4-Cݾ뎰ZP~APz APʠ=dwɠ=ewfu2h/]$z u' uF u. a : u7ftv]-22h22m2\2XI'CݾCɠsPˠP"A畡nYvʠPvɠPedw{dewʠ P#An @]]D}7a un2b2/ȠP#An} un!A}7 u. unQtpc22edw#NȠPB8) CݾpJ]Q}5it%h3221geUdwcɠP!AWnߍG .Cݾ/t 2hݷ2DK2{$2hN}7 OwWeFd&2@7dA27e2idMlMG-)CݾpG]K}7 un=tl2hA}7o(Cݾ"+Cݾ@]O}7 u GG2P8n!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 vUjNmMSjTjhSROx~i/vWߣ#\tSjDtԨڌUJGɷ ɛ|)-kxta/\f48]"L_jPEV%z]qGxFJ5yG>rXpm G+e mxg=vzķ~jWxp0I5~+!pW,hȾOT>spʄSxJ8%bw|)3N򁚮w5\*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.<^z԰0[Ι}}tDseѶ w|<#am%x7y^ez~?j~6x-OK'%#gji閊Gy&Wr~E^RJ"j,aOtިy%;[j="*&RFs<{~*xEuUTMrv&_;oKo y@92,1Z/*6"*gp}0!1ȸ4c`:AM0 ẗ& "o"D$ jZȭMī%QZX7pE8b^hr5RhPm[o, {{jy#S)'blaoPsdp6$W`f4[ ; qCon&('uN!=qMĵ^% Znȭ$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:kXvd|[G[jU8%ӭ#a}tM֡Ce#ؗ`n `$5]_`WFhY`ZTV)RY91]wy݊މkط"7"m8{5uZթ4q^zm]]]]]݅n`ЏOꮮ=TwuW_~~~~xS]{UwuWwuWwuWwuWwuup]d6Wfnf˗re5*o[_Mmˑ?Pz?a֮P?YS:}_]S2O8Br5wnޠP}d]Od,7oзPjJg:+Dߴ|to\Skm|%|My mCZЖGqKTD|j;΅hb/-<tY?z6=m;jAmTʭmgV7ڨ͇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 2hTA^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! aQtTpc22(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%'8qPC݆ j,QP <A5 P !!!G!! )Y`߇aOa_ )o`߀#l+aº]?a %_`hڶjV<Υ|ΉmQ<5|;%\ η Λc\G+)yc9 ]8pc%8% 8@uj3_@z5.O)Yg@y 9 y9y>(5 \\O5\?9<ù8o95;90¹,9)w¹%?9"¹9PpBp4p&pp p>|8ñ0%pc)/=8 Qpc OɔPC uj#?qPǠVA=ujG %k9\5\\o5\7\5\JL}\}乵}ͅs9As|hX [4+R%МȀ6,kGsh쯌h,T46hXeBcN;BP iy"zH#iii[Ӏ4? OӀ4? OӀ4? OӀ4?iiixiiiiiiiOӀ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!phpZp>Lp^>p~0p"ppO4? OӀ4? OӀ4? Oөhgggrȟu`rɛz ?3 ?3 ?3 ?3 ?3 ?3 ?3 ?3 ?3 ?3 ?3 ?3 ?3 ?3 ?3 ?3 ?3 ?3̧pggggggggggg)9c{e }+<|=Y,rc{MA| '%  "]vY.Ke ,a%D>GsD>GsD8\a']vy.O ;+T#ZWɏҞҦ>㚅Zϊ]TKkԙuM;Jx%=U(|Yv)Gk8!רϋUlEpZz־|y4w7B:s㑥qRj^fE󇫅~%*Mdgm=5;nڏxrW٘sɿcr=Oۨy3됮^EMO ˺"ل-jXtFɔ (+K#}nu^IKԃ ˴SAvZ+!|z?sȷ^>Nxs*U{wmkRbWMWGӞ%=_dZ?|CNO{r_rjT['RcFf+P:JGfLޤK wnᰇ ][ ќ`񷱬/cE2e5[bbbH0KPW\9@DiES鱋P:~.?1i9R :FOѪqSTag۪u_~_~̶hP͊m_ mS7˰[;mlTj}=]7wt;mm86yk&\59&e$m=a Φ i;h\6slH"YCUɖ ׌֚D #Z;xR$j.{;|YqHn3ja1=">ƙ.WOWxYsfD~i蟿蟿??`38CG]u}QG1(|X*L*D4mPFZ> Ajmc !GXB!!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 6l{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 6lP)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Ӏtwiiii*iii: iii4? OӀ4? OӀ4? OӀ4? OӀ4? OӀ4? OӀ4? OӀ4? ̀4\5.\µ*\5'\Wµ#\5 \\5\wpHp:p=,p]p}pppO7cy4+0y-)y&K"y? opapSpEp7p)p.pN 4OӀ4? OӀ4? OӀ4?{agg\V3 ?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 mz2 sO!C?=z9Dy'%  "]vY.Ke ,a%D>GsD>GsD8\a']vy.O ] 焿L0䷧IQAO%]Hʼn$BtD{i1Ik:)uM/%9KtMF$E^s27yI!Gu$|;"|L&Ǧ~t cmJ떉x}xŸ@}bz}f7 7jmp2ivIM/'QgT&pRAoYAN;qP/ȼgooVjM=wmnN[7(N=4}[}! gy}Nw.kk-s[wwhuS[WdᲘ$'SZEhώ31-ljôa~M?8Dx_i%˒4y}M<dK3}ME)d]:NdtAhA_?2]"^@ÉںA.a2 9>|5~unxEZ=lV%6,:ު3VQJ%YJI_?Σn#"̪Z;(gͣb#by~ y5[>QJxJdN JB) y0[D{D%MT= J8ORۯ9~tX@Q4|;6h%.6kF@VJa05]TҊ.v.ys1r6(*@$ +4od>|5Tˍ=km2]=^>׽Q>Eh5򾙼O\&S,U shJեqL1%@Ty4eϵ9wZ ,o,~f[IJe(p7 ƴy@Ŝ$6Œv}`/,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?@Dq5t&97jIQ:>~F%K; ےesfh~tfZ|S7#oZooa@EePS>_'!/^G*U4%kY)<yPxYDzjN}[C okdzeM^P};'lLZ׷8-}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իuJp,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`kZbk,bk,bk,bk,bk,akakakakakckf56,:jM**ý 'T4 \kLL q f%X;OsjQ={YX9* ٶAMH~ȿEZVƭ/SJ[K߸NRVnNFP4v-pHMh](]eP_{YrZ£,v O>}|Pʂ\,i`Q@eEW(_Q1,%/@ŃclZAf/pQ u4q=Pz^rx'PQ"7Sd?? W‹~[ TE~p!^u['N҄ {EeCU(Gi5,!;igڊsXUO/=wZTj3tjUqi 5SA]5vq9^=]-54ӊouQ.MfP-߁uePMn2Si7<3հZ=afe.ՃJɠy&%?Q~LvlHPs9D @(J8m1&Gz ["ȖGYPř@@gCN QgJ>׵t$+5|݆y;-Y蟥)Ӕ KvIsٝ&e7M-&1I!le'6rG[}V_VK4b`tOwLnin_f}vݗmy6P-]gV*RVmҷu}}U 9ye’6{^ʐ_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`X5cb̠{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 ukkY[uŞz,[޴$|h\ӖY|%~|h]Ġ9_m9imW-PwZg4֞?b;&"gh3h\gWΝ颖gXS1h5|uW_8Ϳ~ܙ\gzqi=Ğ:k\;9 gsMxm9\~qVwO&|1M<:bϠq?m3,_邶Gl=Mϙ~7+}t68os6:P{Z.ʥ_GNmtȠ =w'1yW6v+gzDwmgm>ͣSM8tRS9bQaQ̭'z+ԼO_ wãd@ٚhM0X{ V%6, U sOsfi4Ě aTO7L^d&4ak%fkvS[lJ)&ˇ=Wc;ikE$%3N+ϸs{"3No;lrQND+KVGF+ڝ5fw'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ڄ#'vLS.[8NVل?r%`Pm}[P±mM6+=`*ZetM6Oo_@ )CV/"]U n2 rv%~Y}[KKn,_¥+i/]tuSIwv|gϬY潽ʼ'1b~1yQ_:eJ'$ϳdOK' ޢ %\rSkɲr0T=xtH_~Zw=_ M)r斱M6;VUJyEj8R6ﭭ Ҿ\I;M̿(\]x7ska7:7mS Im) -/2Nv9ь9OuX*Tx6>ϾUKni3c[p}бf8,,/xwyǔ)_{'i'lO$=H\1AG;Ώ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"U3w"Fv!Yx\_ﳹ7Uե~\}>wat)ԵѥfU2Exvsŝmݥ}^];ZII{H>8׎i>km-9Z_ڤo-wʗk_;~ 7vxt+EedE6aئ ggTp/Z^J^㌒R9yt?_U?G AG:݅;',]epO(O3QhӉIB ~{S8<Ĕws+E1ǰ7Wr~_l7^1_2]pnL^ox`t̷?v7n}ӷ~!((6*:lIBj׋|;#,\]7Ik] D:rln{@{W:O/U*V9~m'=P+)ژZm&=.^fw!)WN|eiOs?5r]W7 '' 3gzwi婩7WJ.lyt7HnCkc )Gçz/(Pңg^ kYI7)Ov3+n=/>7I:lS f-$>}qΔpΓwxӵ{:<}6pߎ\z9RLNmeӶiFn͒ cf$J_]Z8єyYS}'].TsE][ͯ%Fi0ae+eZ%vK~6޹^y.2 w5A'`s&2Eޔe_{I¥#]O ؤ͟w`%?mw9joVV?N}/M؄'.Wv \:}c 9׮lv$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~Im*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$+=+mwK)['[G[]nzÍ_>Ajfxã- o3xUİhCBb!.Ґ71 !ZD>] 8FNDioN:InIO[:, v~=8,jHq^neYo~y皤sP膠tF9N߯+Zkt OUgYMlckVnxD/L,-[’)K/7޶8b{*=hv}O=Z&Ƅ6TNBͱW¢J*-4$(pSE$[5Ąٕod Sgaq”~"¬a#-a1EL]mKՍ m0KTXl>G^74ib02څYfW(o%g2j0"'".&< ukkbbE 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)xI(}KwZ9^pXN9>' ?g&AAvZ(5̪rJZlp\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̍;^RBBLť~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ž]pDRN>ۼa ?S/]_}u}p|֭/^A*K\rhY^[#m[pknLs*,=VBŭڹ7.uu?%ݒ Fҁϛ3e 9W#E叜*lom*u̯=' "iC sa?ܸpíxxaՀ k֟׼YmR{gQҵܣh΢["ʜ5֌qG6[IXƵppzǔ -3[#p:ų>^z~‘\w?{46pܸܓ.y4oqڿ6uT­QҊٟ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$tRJ9//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:4sk;̟-='Hy7GJm5@G>ߴpbQmҍڵC6}'<=Qx$~S&sKFppI¥ՖnK;YkZ8pi+'l3K; yLtYYk?׺6M*$xI?u%xɔO=gV֟w}bXK*rpg^eH+o\mYXB8wz~HcLտ;i\J[)ƞ>%=f6f&]yT7\Xj9E\.7F~"%?-S_l=ࠕ6zSiEw>rAVeY]L3MXӈ:9BY Afv8 :ފ5fZS4N8x!KADeG0P|a{=}wߏf:7;55_~Q?O~Gfύþ{SouM3l}?f/n\ȷ/Ȟ]_:母?۞_5o[n^irA'/F_iK9''dC?ueW}ن9S;y%[y]'/méuUxbr0wgMv m+hmǍx|kW7^/Ngϻﵯxx;.?|󢫗<sf?/_wKϞOGo|i#wΞ0!s/tƤlWOiq7Nս ?t 'V_yhj/yz=IMeYo;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 KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK$,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!/:֓7q⃧~ Ov9tK:%m=zcW{o,V_+6Z_w{Vqnj>&,6JR{f̙U::{b|k}޾;__kmfmn8F░ݳz=3g3 G}_kUӭ1q~mFZWq-6ncf}ⰴ;3{V]8wn68pMj lmerTest/inst/testdata/test_paper_objects.RData0000644000176200001440000000436413573715730021455 0ustar liggesuserspݏ܅H~!b]դ47o0)Ij$MBtp]&blT;چ-CfJK-bi?N:`8U#$ݽv.` z}޷ik|_` \npWS`?(!RQ/]2-gvTt~˖-timgs|QЯ\fMLfa"Q]g׿yaD⯇tgwngJ-x珵1%{޿牭7o*zj?+O|$vdzq()/%I/Nwd0xc34B^xlb)bU}s51,Q'uaQV.$XT ` P4'Ŧ 2니ʬ7 0w!n ;z B5ll@$JPȱ|R99J E9r2]P au=igiNL 7oC|->m=:i0Iv WHKM HY._uG!"/jՇ`\1_ay#:G9R&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}M3&>1>c?6úٿ-r[=ijןN 17¾t=V޿ asnQV-;;_o\z.c{Xk<1k9׍Feuy[G8GmYz6 [ SY||ś#gVnȽ;}|dkQLnj3Fnj>n/K'&0T~0`j;A@EOP\zqL8.GKkOh&؏۵'rK^H%Gޯܚ bܟ5yvn,OΈ b,L]\?"Z9|MzN8ee<>;6tmr-|a XxX8YY DWY0ySfEz5N0ϰ{%|lFBdHi/Ґ{qio/n yfvSڢ,^agm=_2 SWv6ĸn,QE6)@s|RҰ81(s|F+Lm ֹ0N(YL 1lmerTest/inst/CITATION0000644000176200001440000000147613573715730014206 0ustar liggesusersbibentry(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:" )