RLRsim/0000755000176200001440000000000014214405737011431 5ustar liggesusersRLRsim/NAMESPACE0000755000176200001440000000136014212701602012637 0ustar liggesusers# Generated by roxygen2: do not edit by hand if(getRversion() >= "3.3.0") { importFrom("stats", sigma) } else { importFrom("lme4", sigma) } export(LRTSim) export(RLRTSim) export(exactLRT) export(exactRLRT) export(extract.lmeDesign) import(Rcpp) importFrom(lme4,VarCorr) importFrom(lme4,getME) importFrom(mgcv,tensor.prod.model.matrix) importFrom(nlme,getGroups) importFrom(stats,anova) importFrom(stats,coefficients) importFrom(stats,complete.cases) importFrom(stats,cov2cor) importFrom(stats,formula) importFrom(stats,logLik) importFrom(stats,model.frame) importFrom(stats,model.matrix) importFrom(stats,model.response) importFrom(stats,quantile) importFrom(stats,rchisq) importFrom(utils,packageVersion) useDynLib(RLRsim, .registration = TRUE) RLRsim/man/0000755000176200001440000000000014212607702012176 5ustar liggesusersRLRsim/man/exactLRT.Rd0000755000176200001440000000731314212607702014162 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/exactLRT.R \name{exactLRT} \alias{exactLRT} \title{Likelihood Ratio Tests for simple linear mixed models} \usage{ exactLRT( m, m0, seed = NA, nsim = 10000, log.grid.hi = 8, log.grid.lo = -10, gridlength = 200, parallel = c("no", "multicore", "snow"), ncpus = 1L, cl = NULL ) } \arguments{ \item{m}{The fitted model under the alternative; of class \code{lme}, \code{lmerMod} or \code{spm}} \item{m0}{The fitted model under the null hypothesis; of class \code{lm}} \item{seed}{Specify a seed for \code{set.seed}} \item{nsim}{Number of values to simulate} \item{log.grid.hi}{Lower value of the grid on the log scale. See \code{\link{exactLRT}}.} \item{log.grid.lo}{Lower value of the grid on the log scale. See \code{\link{exactLRT}}.} \item{gridlength}{Length of the grid. See \code{\link{LRTSim}}.} \item{parallel}{The type of parallel operation to be used (if any). If missing, the default is "no parallelization").} \item{ncpus}{integer: number of processes to be used in parallel operation: typically one would chose this to the number of available CPUs. Defaults to 1, i.e., no parallelization.} \item{cl}{An optional parallel or snow cluster for use if parallel = "snow". If not supplied, a cluster on the local machine is created for the duration of the call.} } \value{ A list of class \code{htest} containing the following components: \itemize{ \item \code{statistic} the observed likelihood ratio \item \code{p} p-value for the observed test statistic \item \code{method} a character string indicating what type of test was performed and how many values were simulated to determine the critical value \item \code{sample} the samples from the null distribution returned by \code{\link{LRTSim}} } } \description{ This function provides an exact likelihood ratio test based on simulated values from the finite sample distribution for simultaneous testing of the presence of the variance component and some restrictions of the fixed effects in a simple linear mixed model with known correlation structure of the random effect and i.i.d. errors. } \details{ The model under the alternative must be a linear mixed model \eqn{y=X\beta+Zb+\varepsilon}{y=X*beta+Z*b+epsilon} with a \emph{single} random effect \eqn{b} with known correlation structure and error terms that are i.i.d. The hypothesis to be tested must be of the form \deqn{H_0: \beta_{p+1-q}=\beta^0_{p+1-q},\dots,\beta_{p}=\beta^0_{p};\quad }{H0: beta_1=beta0_1,..,beta_q=beta0_q, Var(b)=0}\deqn{Var(b)=0}{H0: beta_1=beta0_1,..,beta_q=beta0_q, Var(b)=0} versus \deqn{H_A:\; \beta_{p+1-q}\neq \beta^0_{p+1-q}\;\mbox{or}\dots }{H0: beta_1 \neq beta0_1,..or..,beta_q \neq beta0_q ot Var(b)>0}\deqn{\mbox{or}\;\beta_{p}\neq \beta^0_{p}\;\;\mbox{or}\;Var(b)>0}{H0: beta_1 \neq beta0_1,..or..,beta_q \neq beta0_q ot Var(b)>0} We use the exact finite sample distribution of the likelihood ratio test statistic as derived by Crainiceanu & Ruppert (2004). } \examples{ library(nlme); data(Orthodont); ##test for Sex:Age interaction and Subject-Intercept mA<-lme(distance ~ Sex * I(age - 11), random = ~ 1| Subject, data = Orthodont, method = "ML") m0<-lm(distance ~ Sex + I(age - 11), data = Orthodont) summary(mA) summary(m0) exactLRT(m = mA, m0 = m0) } \references{ Crainiceanu, C. and Ruppert, D. (2004) Likelihood ratio tests in linear mixed models with one variance component, \emph{Journal of the Royal Statistical Society: Series B},\bold{66},165--185. } \seealso{ \code{\link{LRTSim}} for the underlying simulation algorithm; \code{\link{RLRTSim}} and \code{\link{exactRLRT}} for restricted likelihood based tests } \author{ Fabian Scheipl, updates for \pkg{lme4.0}-compatibility by Ben Bolker } \keyword{htest} RLRsim/man/RLRsim-package.Rd0000755000176200001440000000363014212616726015241 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RLRsim-package.R \docType{package} \name{RLRsim-package} \alias{RLRsim-package} \alias{RLRsim} \title{R package for fast and exact (restricted) likelihood ratio tests for mixed and additive models.} \description{ \code{RLRsim} implements fast simulation-based exact tests for variance components in mixed and additive models for conditionally Gaussian responses -- i.e., tests for questions like: \itemize{ \item is the variance of my random intercept significantly different from 0? \item is this smooth effect significantly nonlinear? \item is this smooth effect significantly different from a constant effect?} The convenience functions \code{\link{exactRLRT}} and \code{\link{exactLRT}} can deal with fitted models from packages \pkg{lme4, nlme, gamm4, SemiPar} and from \pkg{mgcv}'s \code{gamm()}-function. Workhorse functions \code{\link{LRTSim}} and \code{\link{RLRTSim}} accept design matrices as inputs directly and can thus be used more generally to generate exact critical values for the corresponding (restricted) likelihood ratio tests.\cr\cr The theory behind these tests was first developed in:\cr Crainiceanu, C. and Ruppert, D. (2004) \href{https://people.orie.cornell.edu/~davidr/papers/asymptoticpaper2.pdf}{Likelihood ratio tests in linear mixed models with one variance component}, \emph{Journal of the Royal Statistical Society: Series B}, \bold{66}, 165--185.\cr\cr Power analyses and sensitivity studies for \pkg{RLRsim} can be found in:\cr Scheipl, F., Greven, S. and Kuechenhoff, H. (2008) Size and power of tests for a zero random effect variance or polynomial regression in additive and linear mixed models. \emph{Computational Statistics and Data Analysis}, \bold{52}(7), 3283--3299, \doi{10.1016/j.csda.2007.10.022}. } \author{ Fabian Scheipl (\email{fabian.scheipl@stat.uni-muenchen.de}), Ben Bolker } \keyword{package} RLRsim/man/extract.lmeDesign.Rd0000755000176200001440000000235714212607702016057 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/extract.lmeDesign.R \name{extract.lmeDesign} \alias{extract.lmeDesign} \alias{extract.lmerModDesign} \title{Extract the Design of a linear mixed model} \usage{ extract.lmeDesign(m) } \arguments{ \item{m}{a fitted \code{lme}- or \code{merMod}-Object} } \value{ a a list with components \itemize{ \item \code{Vr} estimated covariance of the random effects divided by the estimated variance of the residuals \item \code{X} design of the fixed effects \item \code{Z} design of the random effects \item \code{sigmasq} variance of the residuals \item \code{lambda} ratios of the variances of the random effects and the variance of the residuals \item \code{y} response variable } } \description{ These functions extract various elements of the design of a fitted \code{lme}-, \code{mer} or \code{lmerMod}-Object. They are called by \code{exactRLRT} and \code{exactLRT}. } \examples{ library(nlme) design <- extract.lmeDesign(lme(distance ~ age + Sex, data = Orthodont, random = ~ 1)) str(design) } \author{ Fabian Scheipl, \code{extract.lmerModDesign} by Ben Bolker. Many thanks to Andrzej Galecki and Tomasz Burzykowski for bug fixes. } \keyword{utilities} RLRsim/man/exactRLRT.Rd0000755000176200001440000001231714212607702014304 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/exactRLRT.R \name{exactRLRT} \alias{exactRLRT} \title{Restricted Likelihood Ratio Tests for additive and linear mixed models} \usage{ exactRLRT( m, mA = NULL, m0 = NULL, seed = NA, nsim = 10000, log.grid.hi = 8, log.grid.lo = -10, gridlength = 200, parallel = c("no", "multicore", "snow"), ncpus = 1L, cl = NULL ) } \arguments{ \item{m}{The fitted model under the alternative or, for testing in models with multiple variance components, the reduced model containing only the random effect to be tested (see Details), an \code{lme}, \code{lmerMod} or \code{spm} object} \item{mA}{The full model under the alternative for testing in models with multiple variance components} \item{m0}{The model under the null for testing in models with multiple variance components} \item{seed}{input for \code{set.seed}} \item{nsim}{Number of values to simulate} \item{log.grid.hi}{Lower value of the grid on the log scale. See \code{\link{exactRLRT}}.} \item{log.grid.lo}{Lower value of the grid on the log scale. See \code{\link{exactRLRT}}.} \item{gridlength}{Length of the grid. See \code{\link{exactLRT}}.} \item{parallel}{The type of parallel operation to be used (if any). If missing, the default is "no parallelization").} \item{ncpus}{integer: number of processes to be used in parallel operation: typically one would chose this to the number of available CPUs. Defaults to 1, i.e., no parallelization.} \item{cl}{An optional parallel or snow cluster for use if parallel = "snow". If not supplied, a cluster on the local machine is created for the duration of the call.} } \value{ A list of class \code{htest} containing the following components: A list of class \code{htest} containing the following components: \itemize{ \item \code{statistic} the observed likelihood ratio \item \code{p} p-value for the observed test statistic \item \code{method} a character string indicating what type of test was performed and how many values were simulated to determine the critical value \item \code{sample} the samples from the null distribution returned by \code{\link{RLRTSim}} } } \description{ This function provides an (exact) restricted likelihood ratio test based on simulated values from the finite sample distribution for testing whether the variance of a random effect is 0 in a linear mixed model with known correlation structure of the tested random effect and i.i.d. errors. } \details{ Testing in models with only a single variance component require only the first argument \code{m}. For testing in models with multiple variance components, the fitted model \code{m} must contain \bold{only} the random effect set to zero under the null hypothesis, while \code{mA} and \code{m0} are the models under the alternative and the null, respectively. For models with a single variance component, the simulated distribution is exact if the number of parameters (fixed and random) is smaller than the number of observations. Extensive simulation studies (see second reference below) confirm that the application of the test to models with multiple variance components is safe and the simulated distribution is correct as long as the number of parameters (fixed and random) is smaller than the number of observations and the nuisance variance components are not superfluous or very small. We use the finite sample distribution of the restricted likelihood ratio test statistic as derived by Crainiceanu & Ruppert (2004). No simulation is performed if the observed test statistic is 0. (i.e., if the fit of the model fitted under the alternative is indistinguishable from the model fit under H0), since the p-value is always 1 in this case. } \examples{ data(sleepstudy, package = "lme4") mA <- lme4::lmer(Reaction ~ I(Days-4.5) + (1|Subject) + (0 + I(Days-4.5)|Subject), data = sleepstudy) m0 <- update(mA, . ~ . - (0 + I(Days-4.5)|Subject)) m.slope <- update(mA, . ~ . - (1|Subject)) #test for subject specific slopes: exactRLRT(m.slope, mA, m0) library(mgcv) data(trees) #test quadratic trend vs. smooth alternative m.q<-gamm(I(log(Volume)) ~ Height + s(Girth, m = 3), data = trees, method = "REML")$lme exactRLRT(m.q) #test linear trend vs. smooth alternative m.l<-gamm(I(log(Volume)) ~ Height + s(Girth, m = 2), data = trees, method = "REML")$lme exactRLRT(m.l) } \references{ Crainiceanu, C. and Ruppert, D. (2004) Likelihood ratio tests in linear mixed models with one variance component, \emph{Journal of the Royal Statistical Society: Series B},\bold{66},165--185. Greven, S., Crainiceanu, C., Kuechenhoff, H., and Peters, A. (2008) Restricted Likelihood Ratio Testing for Zero Variance Components in Linear Mixed Models, \emph{Journal of Computational and Graphical Statistics}, \bold{17} (4): 870--891. Scheipl, F., Greven, S. and Kuechenhoff, H. (2008) Size and power of tests for a zero random effect variance or polynomial regression in additive and linear mixed models. \emph{Computational Statistics & Data Analysis}, \bold{52}(7):3283--3299. } \seealso{ \code{\link{RLRTSim}} for the underlying simulation algorithm; \code{\link{exactLRT}} for likelihood based tests } \author{ Fabian Scheipl, bug fixes by Andrzej Galecki, updates for \pkg{lme4}-compatibility by Ben Bolker } \keyword{htest} RLRsim/man/LRTSim.Rd0000755000176200001440000001001714212701602013573 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/LRTSim.R \name{LRTSim} \alias{LRTSim} \alias{RLRTSim} \title{Simulation of the (Restricted) Likelihood Ratio Statistic} \usage{ LRTSim( X, Z, q, sqrt.Sigma, seed = NA, nsim = 10000, log.grid.hi = 8, log.grid.lo = -10, gridlength = 200, parallel = c("no", "multicore", "snow"), ncpus = 1L, cl = NULL ) } \arguments{ \item{X}{The fixed effects design matrix of the model under the alternative} \item{Z}{The random effects design matrix of the model under the alternative} \item{q}{The number of parameters restrictions on the fixed effects (see Details)} \item{sqrt.Sigma}{The upper triangular Cholesky factor of the correlation matrix of the random effect} \item{seed}{Specify a seed for \code{set.seed}} \item{nsim}{Number of values to simulate} \item{log.grid.hi}{Lower value of the grid on the log scale. See \bold{Details}} \item{log.grid.lo}{Lower value of the grid on the log scale. See \bold{Details}} \item{gridlength}{Length of the grid for the grid search over lambda. See \bold{Details}} \item{parallel}{The type of parallel operation to be used (if any). If missing, the default is "no parallelization").} \item{ncpus}{integer: number of processes to be used in parallel operation: typically one would chose this to the number of available CPUs. Defaults to 1, i.e., no parallelization.} \item{cl}{An optional parallel or snow cluster for use if parallel = "snow". If not supplied, a cluster on the local machine is created for the duration of the call.} } \value{ A vector containing the the simulated values of the (R)LRT under the null, with attribute 'lambda' giving \eqn{\arg\min(f(\lambda))} (see Crainiceanu, Ruppert (2004)) for the simulations. } \description{ These functions simulate values from the (exact) finite sample distribution of the (restricted) likelihood ratio statistic for testing the presence of the variance component (and restrictions of the fixed effects) in a simple linear mixed model with known correlation structure of the random effect and i.i.d. errors. They are usually called by \code{exactLRT} or \code{exactRLRT}. } \details{ The model under the alternative must be a linear mixed model \eqn{y=X\beta+Zb+\varepsilon}{y=X*beta+Z*b+epsilon} with a single random effect \eqn{b} with known correlation structure \eqn{Sigma} and i.i.d errors. The simulated distribution of the likelihood ratio statistic was derived by Crainiceanu & Ruppert (2004). The simulation algorithm uses a grid search over a log-regular grid of values of \eqn{\lambda=\frac{Var(b)}{Var(\varepsilon)}}{lambda=Var(b)/Var(epsilon)} to maximize the likelihood under the alternative for \code{nsim} realizations of \eqn{y} drawn under the null hypothesis. \code{log.grid.hi} and \code{log.grid.lo} are the lower and upper limits of this grid on the log scale. \code{gridlength} is the number of points on the grid.\ These are just wrapper functions for the underlying C code. } \examples{ library(lme4) g <- rep(1:10, e = 10) x <- rnorm(100) y <- 0.1 * x + rnorm(100) m <- lmer(y ~ x + (1|g), REML=FALSE) m0 <- lm(y ~ 1) (obs.LRT <- 2*(logLik(m)-logLik(m0))) X <- getME(m,"X") Z <- t(as.matrix(getME(m,"Zt"))) sim.LRT <- LRTSim(X, Z, 1, diag(10)) (pval <- mean(sim.LRT > obs.LRT)) } \references{ Crainiceanu, C. and Ruppert, D. (2004) Likelihood ratio tests in linear mixed models with one variance component, \emph{Journal of the Royal Statistical Society: Series B},\bold{66},165--185. Scheipl, F. (2007) Testing for nonparametric terms and random effects in structured additive regression. Diploma thesis (unpublished). Scheipl, F., Greven, S. and Kuechenhoff, H (2008) Size and power of tests for a zero random effect variance or polynomial regression in additive and linear mixed models, \emph{Computational Statistics & Data Analysis}, \bold{52}(7):3283-3299 } \seealso{ \code{\link{exactLRT}}, \code{\link{exactRLRT}} for tests } \author{ Fabian Scheipl; parallelization code adapted from \code{boot} package } \keyword{datagen} \keyword{distribution} RLRsim/DESCRIPTION0000644000176200001440000000234214214405737013140 0ustar liggesusersPackage: RLRsim Type: Package Title: Exact (Restricted) Likelihood Ratio Tests for Mixed and Additive Models Version: 3.1-8 Authors@R: c(person("Fabian", "Scheipl", role = c("aut", "cre"), email = "fabian.scheipl@stat.uni-muenchen.de", comment=c(ORCID="0000-0001-8172-3603")), person("Ben", "Bolker", role = "ctb", comment=c(ORCID="0000-0002-2127-0443"))) Maintainer: Fabian Scheipl Description: Rapid, simulation-based exact (restricted) likelihood ratio tests for testing the presence of variance components/nonparametric terms for models fit with nlme::lme(),lme4::lmer(), lmeTest::lmer(), gamm4::gamm4(), mgcv::gamm() and SemiPar::spm(). License: GPL URL: https://github.com/fabian-s/RLRsim BugReports: https://github.com/fabian-s/RLRsim/issues SystemRequirements: C++11 Depends: R (>= 2.14.0) Imports: Rcpp (>= 0.11.1), lme4 (>= 1.1), mgcv, nlme LinkingTo: Rcpp Enhances: SemiPar, lmerTest RoxygenNote: 7.1.2 NeedsCompilation: yes Packaged: 2022-03-15 16:21:53 UTC; fabians Author: Fabian Scheipl [aut, cre] (), Ben Bolker [ctb] () Repository: CRAN Date/Publication: 2022-03-16 16:10:07 UTC RLRsim/build/0000755000176200001440000000000014214136440012520 5ustar liggesusersRLRsim/build/partial.rdb0000644000176200001440000001036414214136440014651 0ustar liggesusers]Z@.uݸ[+3@݁MtbC_f+ /_ :ݧl5]ZNUWߍ @yȳ9)5m*&1=/ a*+6\( sU巶(ŵ[[v-S2i1y"]UdW2rWɉu] 0@aKAy v#Qx_? %U,[/Ͽl_kWQjFM\^ߨwY_𲁝0~D,x@ϩĘFިT!9mV (:#v{IޏR#=Y B )m@ 5x Si:,044siO+ x䕉荓A-"C\n ɶ<{`C<+<3xT&:$"Z1|/ &\/rGNGD.B7#=c#w ⑓KV vR3LR-dil"2v>UaĄa^)Y ׉2J4CUNl XCmV2c ^} 3D< V^?Yj8Xc'DEF8ҩP D*:U.xDSu^.^#m@i'뒡l.j<be&,Qʴ\a$rjbUFYHb>uEbX~ -((8њleCciSS =]),dV&`R3YI9[3&r4gL îʬ$mT4%zg4h]-p"ˡesaBSNp闹Eî 7}2ǭ?{yÛ~@uB69 D^Fr &qhVbJ 1lBCzӗPsy/ EO / .#{\ q.,_ 7a%eaqqcHe~|R-†"SQ%6, 9B8Nۼ6BVn˪FKDgP"{_hF4S9y@hp-!D:U0Yd4Nad~79OBYy~+!N"=O!}*ONH܍Os#kL\N[d!.#~~(v $SNc9iABt˟=;ܯWIm=T e;~ɾlWo }0WHOvgiI7+HWrb5uXG|ބ2k 9'H?࿎Ff9^'SXb!ωX+jtñ-"+&``Xdr+`=w6A+_ei6P$⺻d*"@THZާ.9" Yx\7F 1̯!@:04MofQi)!X6džd=~c5Ŵ{Ph Et 1ˈw{()*:˷ZMUѠ]"Odzannq&q^^WHY@c- QZݶjҠFCeTh%TjN/xf!2h5m ~S^ZKZAaxo_cˆW`AUd.8VOcxiwX:hFrF\$ۢ4j/q[:T3|ݠ{q³;-y#}?7c 2$Si*܇>o;:2XEM6T[NCJzRsGʄ6Uo#GS.kd:TShV{sQjte˓7l6k]:gHKHN4=?a)%^ #>DafI yLuPT$n[cruÌTZ!CFʞj}?RMhqo[]/xRױ}߶ڧwhw=qp߶g8#O T& 8B]F_& GW A}czOZ&" l@ߋk4h4I^?j;pWn=pޝukkSjʞcRٹZ ho55 F>ExZ u]8*TjZnY׺:U'ٵBKhk3,Xe+`PHVS7s$^pI)dhVӋa /;p\hNivQ6DMF6$VQ.+5TD;] x?0ačYv"SN AC:>rAgu*̎׫eF[n0c. `-vq!A D(IQd8tB 1LU/䪈ir{,o89igor(s1µ:MX)˔WCy 6#U7ڒULBV3t8"4p5:^s6g"#sv5M8c5|FjG°ްSv+ 7N{!NzǚjC؀llw[GjPI8`ږekSOOCqHF[ [,޻+tMM:eم:98Pj3 v"vSGFp+1>+t _A>ĵm9 w'o@ruw"<ҵY?˂ VṏO! }~|{kjgG WˬXuѤrś3VrtkS7Tѳlr3+ 5oSs m ROGMq~)z)05>„ÇCq\Ez57G\SEgljS)]T Ҫ1֪^5 b .WgfSLj]#T_Bz+Ys't/G/̓$JP9k<--_'ܥъ=gCWuݤo纬5uMr )xqKH1vToUyU>HQp2ۃ{o9mvq0&֐⵿ H C˚v5_BM3DEgs*>Z"[L(#-)^X_; 7L` 0;yς/KnV@ #A?lRLRsim/src/0000755000176200001440000000000014214136440012210 5ustar liggesusersRLRsim/src/init.c0000644000176200001440000000074214212607702013324 0ustar liggesusers#include #include #include // for NULL #include /* .Call calls */ extern SEXP _RLRsim_RLRsimCpp(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); static const R_CallMethodDef CallEntries[] = { {"_RLRsim_RLRsimCpp", (DL_FUNC) &_RLRsim_RLRsimCpp, 11}, {NULL, NULL, 0} }; void R_init_RLRsim(DllInfo *dll) { R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); R_useDynamicSymbols(dll, FALSE); } RLRsim/src/RLRsim.cpp0000755000176200001440000000524314213626474014105 0ustar liggesusers#define USE_FC_LEN_T // [[Rcpp::depends(Rcpp)]] #include using namespace Rcpp ; // [[Rcpp::export]] List RLRsimCpp ( int p, int k, int n, int nsim, int g, int q, Rcpp::NumericVector mu, Rcpp::NumericVector lambda, double lambda0, Rcpp::NumericVector xi, bool REML) { Rcpp::RNGScope scope ; /* allocate: */ Rcpp::NumericMatrix lambdamu(g, k) ; Rcpp::NumericMatrix lambdamuP1(g, k) ; Rcpp::NumericMatrix fN(g, k) ; Rcpp::NumericMatrix fD(g, k) ; Rcpp::NumericVector sumlog1plambdaxi(g) ; Rcpp::NumericVector Chi1(k) ; Rcpp::NumericVector res(nsim) ; Rcpp::IntegerVector lambdaind(nsim) ; int is, ig, ik, dfChiK, n0 ; double LR, N, D, ChiK, ChiSum ; dfChiK = n-p-k; if(dfChiK < 0){ dfChiK = 0; }; if(REML) { n0 = n - p ; for(ik=0; ik < k; ++ik){ xi[ik] = mu[ik] ; } } else { n0 = n ; } /*precompute stuff that stays constant over simulations*/ for(ig = 0; ig < g; ++ig) { sumlog1plambdaxi[ig] = 0 ; for(ik=0 ; ik < k ; ++ik){ lambdamu(ig, ik) = lambda[ig] * mu[ik] ; lambdamuP1(ig, ik) = lambdamu(ig, ik) + 1.0 ; fN(ig, ik) = ((lambda[ig] - lambda0) * mu[ik]) / lambdamuP1(ig, ik) ; fD(ig, ik) = (1 + lambda0 * mu[ik]) / lambdamuP1(ig, ik) ; sumlog1plambdaxi[ig] += log1p(lambda[ig] * xi[ik]) ; } /* end for k*/ } /* end for g*/ for(is = 0; is < nsim; ++is) { /*make random variates, set LR 0*/ LR = 0 ; ChiSum = 0 ; ChiK = rchisq(1, dfChiK)[0] ; Chi1 = rchisq(k, 1) ; if(!REML) { ChiSum = std::accumulate(Chi1.begin(), Chi1.end(), 0.0) ; } for(ig = 0; ig < g; ++ig) { /*loop over lambda-grid*/ N = D = 0 ; for(ik=0 ; ik < k ; ++ik){ /*loop over mu, xi*/ N = N + fN(ig, ik) * Chi1[ik] ; D = D + fD(ig, ik) * Chi1[ik] ; } D = D + ChiK ; LR = n0 * log1p(N/D) - sumlog1plambdaxi[ig] ; if(LR >= res[is]){ /*save if LR is bigger than previous LR*/ res[is] = LR ; lambdaind[is] = ig + 1 ; } else break ; }/*end for g*/ /* add additional term for LR*/ if(!REML){ res[is] = res[is] + n * log1p(rchisq(1, q)[0] / (ChiSum + ChiK)) ; } }/*end for nsim*/ return List::create(Named("res")=res, Named("lambdaind")=lambdaind, Named("lambdamu")=lambdamu, Named("fN")=fN, Named("fD")=fD, Named("sumlog1plambdaxi")=sumlog1plambdaxi, Named("Chi1")=Chi1, Named("ChiK")=ChiK) ; } RLRsim/src/RcppExports.cpp0000644000176200001440000000314014212616517015211 0ustar liggesusers// Generated by using Rcpp::compileAttributes() -> do not edit by hand // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 #include using namespace Rcpp; #ifdef RCPP_USE_GLOBAL_ROSTREAM Rcpp::Rostream& Rcpp::Rcout = Rcpp::Rcpp_cout_get(); Rcpp::Rostream& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get(); #endif // RLRsimCpp List RLRsimCpp(int p, int k, int n, int nsim, int g, int q, Rcpp::NumericVector mu, Rcpp::NumericVector lambda, double lambda0, Rcpp::NumericVector xi, bool REML); RcppExport SEXP _RLRsim_RLRsimCpp(SEXP pSEXP, SEXP kSEXP, SEXP nSEXP, SEXP nsimSEXP, SEXP gSEXP, SEXP qSEXP, SEXP muSEXP, SEXP lambdaSEXP, SEXP lambda0SEXP, SEXP xiSEXP, SEXP REMLSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< int >::type p(pSEXP); Rcpp::traits::input_parameter< int >::type k(kSEXP); Rcpp::traits::input_parameter< int >::type n(nSEXP); Rcpp::traits::input_parameter< int >::type nsim(nsimSEXP); Rcpp::traits::input_parameter< int >::type g(gSEXP); Rcpp::traits::input_parameter< int >::type q(qSEXP); Rcpp::traits::input_parameter< Rcpp::NumericVector >::type mu(muSEXP); Rcpp::traits::input_parameter< Rcpp::NumericVector >::type lambda(lambdaSEXP); Rcpp::traits::input_parameter< double >::type lambda0(lambda0SEXP); Rcpp::traits::input_parameter< Rcpp::NumericVector >::type xi(xiSEXP); Rcpp::traits::input_parameter< bool >::type REML(REMLSEXP); rcpp_result_gen = Rcpp::wrap(RLRsimCpp(p, k, n, nsim, g, q, mu, lambda, lambda0, xi, REML)); return rcpp_result_gen; END_RCPP } RLRsim/NEWS0000755000176200001440000000060314212607702012124 0ustar liggesusers3.1 ------- *** removed bug in LRTSim that led to non-sensical results. * now deals with testing in models where tested variance component is 0 for `m`, but not for `mA`. (Thanks, Christoph Huber-Huber!) * now deals correctly with models returned from lmerTest::lmer (Thanks, twice, Lukas Meier) 3.0 ------- *** now using Rcpp * removed terrible "browser()"-bug in extract.lmeDesign() RLRsim/R/0000755000176200001440000000000014214135325011623 5ustar liggesusersRLRsim/R/exactRLRT.R0000755000176200001440000002163314213625201013562 0ustar liggesusers#' Restricted Likelihood Ratio Tests for additive and linear mixed models #' #' This function provides an (exact) restricted likelihood ratio test based on #' simulated values from the finite sample distribution for testing whether the #' variance of a random effect is 0 in a linear mixed model with known #' correlation structure of the tested random effect and i.i.d. errors. #' #' Testing in models with only a single variance component require only the #' first argument \code{m}. For testing in models with multiple variance #' components, the fitted model \code{m} must contain \bold{only} the random #' effect set to zero under the null hypothesis, while \code{mA} and \code{m0} #' are the models under the alternative and the null, respectively. For models #' with a single variance component, the simulated distribution is exact if the #' number of parameters (fixed and random) is smaller than the number of #' observations. Extensive simulation studies (see second reference below) #' confirm that the application of the test to models with multiple variance #' components is safe and the simulated distribution is correct as long as the #' number of parameters (fixed and random) is smaller than the number of #' observations and the nuisance variance components are not superfluous or #' very small. We use the finite sample distribution of the restricted #' likelihood ratio test statistic as derived by Crainiceanu & Ruppert (2004). #' #' No simulation is performed if the observed test statistic is 0. (i.e., if the #' fit of the model fitted under the alternative is indistinguishable from the #' model fit under H0), since the p-value is always 1 in this case. #' #' @param m The fitted model under the alternative or, for testing in models #' with multiple variance components, the reduced model containing only the #' random effect to be tested (see Details), an \code{lme}, \code{lmerMod} or #' \code{spm} object #' @param mA The full model under the alternative for testing in models with #' multiple variance components #' @param m0 The model under the null for testing in models with multiple #' variance components #' @param seed input for \code{set.seed} #' @param nsim Number of values to simulate #' @param log.grid.hi Lower value of the grid on the log scale. See #' \code{\link{exactRLRT}}. #' @param log.grid.lo Lower value of the grid on the log scale. See #' \code{\link{exactRLRT}}. #' @param gridlength Length of the grid. See \code{\link{exactLRT}}. #' @param parallel The type of parallel operation to be used (if any). If #' missing, the default is "no parallelization"). #' @param ncpus integer: number of processes to be used in parallel operation: #' typically one would chose this to the number of available CPUs. Defaults to #' 1, i.e., no parallelization. #' @param cl An optional parallel or snow cluster for use if parallel = "snow". #' If not supplied, a cluster on the local machine is created for the duration #' of the call. #' @return A list of class \code{htest} containing the following components: #' @return A list of class \code{htest} containing the following components: #' \itemize{ #' \item \code{statistic} the observed likelihood ratio #' \item \code{p} p-value for the observed test statistic #' \item \code{method} a character string indicating what type of test was #' performed and how many values were simulated to determine the critical value #' \item \code{sample} the samples from the null distribution returned by #' \code{\link{RLRTSim}} #' } #' @author Fabian Scheipl, bug fixes by Andrzej Galecki, updates for #' \pkg{lme4}-compatibility by Ben Bolker #' @seealso \code{\link{RLRTSim}} for the underlying simulation algorithm; #' \code{\link{exactLRT}} for likelihood based tests #' @references Crainiceanu, C. and Ruppert, D. (2004) Likelihood ratio tests in #' linear mixed models with one variance component, \emph{Journal of the Royal #' Statistical Society: Series B},\bold{66},165--185. #' #' Greven, S., Crainiceanu, C., Kuechenhoff, H., and Peters, A. (2008) #' Restricted Likelihood Ratio Testing for Zero Variance Components in Linear #' Mixed Models, \emph{Journal of Computational and Graphical Statistics}, #' \bold{17} (4): 870--891. #' #' Scheipl, F., Greven, S. and Kuechenhoff, H. (2008) Size and power of tests #' for a zero random effect variance or polynomial regression in additive and #' linear mixed models. \emph{Computational Statistics & Data Analysis}, #' \bold{52}(7):3283--3299. #' @keywords htest #' @examples #' #' data(sleepstudy, package = "lme4") #' mA <- lme4::lmer(Reaction ~ I(Days-4.5) + (1|Subject) + (0 + I(Days-4.5)|Subject), #' data = sleepstudy) #' m0 <- update(mA, . ~ . - (0 + I(Days-4.5)|Subject)) #' m.slope <- update(mA, . ~ . - (1|Subject)) #' #test for subject specific slopes: #' exactRLRT(m.slope, mA, m0) #' #' library(mgcv) #' data(trees) #' #test quadratic trend vs. smooth alternative #' m.q<-gamm(I(log(Volume)) ~ Height + s(Girth, m = 3), data = trees, #' method = "REML")$lme #' exactRLRT(m.q) #' #test linear trend vs. smooth alternative #' m.l<-gamm(I(log(Volume)) ~ Height + s(Girth, m = 2), data = trees, #' method = "REML")$lme #' exactRLRT(m.l) #' #' @export exactRLRT #' @importFrom stats anova cov2cor logLik quantile #' @importFrom utils packageVersion 'exactRLRT' <- function(m, mA = NULL, m0 = NULL, seed = NA, nsim = 10000, log.grid.hi = 8, log.grid.lo = -10, gridlength = 200, parallel = c("no", "multicore", "snow"), ncpus = 1L, cl = NULL) { if (inherits(m, "spm")) { m <- m$fit class(m) <- "lme" } if (any(class(m) %in% c("amer", "mer"))) stop("Models fit with package or versions of below 1.0 are no longer supported.") c.m <- class(m) if (!any(c.m %in% c("lme", "lmerMod", "merModLmerTest", "lmerModLmerTest"))) stop("Invalid specified. \n") if (any(c.m %in% c("merModLmerTest", "lmerModLmerTest"))) c.m <- "lmerMod" if ("REML" != switch(c.m, lme = m$method, lmerMod = ifelse(lme4::isREML(m), "REML", "ML"))){ message("Using restricted likelihood evaluated at ML estimators.") message("Refit with method=\"REML\" for exact results.") } d <- switch(c.m, lme = extract.lmeDesign(m), lmerMod = extract.lmerModDesign(m)) X <- d$X qrX <- qr(X) Z <- d$Z y <- d$y Vr <- d$Vr if (all(Vr == 0)) { # this only happens if the estimate of the tested variance component is 0. # since we still want chol(cov2cor(Vr)) to work, this does the trick. diag(Vr) <- 1 } K <- ncol(Z) n <- nrow(X) p <- ncol(X) if (is.null(mA) && is.null(m0)) { if (length(d$lambda) != 1 || d$k != 1) stop("multiple random effects in model - exactRLRT needs with only a single random effect.") #2*restricted ProfileLogLik under H0: lambda=0 res <- qr.resid(qrX, y) R <- qr.R(qrX) detXtX <- det(t(R) %*% R) reml.H0 <- -((n - p) * log(2 * pi) + (n - p) * log(sum(res^2)) + log(detXtX) + (n - p) - (n - p) * log(n - p)) #observed value of the test-statistic reml.obs <- 2 * logLik(m, REML = TRUE)[1] rlrt.obs <- max(0, reml.obs - reml.H0) lambda <- d$lambda } else { nonidentfixmsg <- "Fixed effects structures of and not identical. REML-based inference not appropriate." if (c.m == "lme") { if (any(mA$fixDF$terms != m0$fixDF$terms)) stop(nonidentfixmsg) } else { if (c.m == "mer") { if (any(mA@X != m0@X)) stop(nonidentfixmsg) } else { if (c.m == "lmerMod") { if (any(lme4::getME(mA,"X") != lme4::getME(m0,"X"))) stop(nonidentfixmsg) } } } lmer_nm <- if (utils::packageVersion("lme4")<="1.1.21") "Df" else "npar" ## bug fix submitted by Andrzej Galecki 3/10/2009 DFx <- switch(c.m, lme = anova(mA,m0)$df, lmerMod = anova(mA, m0, refit = FALSE)[[lmer_nm]]) if (abs(diff(DFx)) > 1) { stop("Random effects not independent - covariance(s) set to 0 under H0.\n exactRLRT can only test a single variance.\n") } rlrt.obs <- max(0, 2 * (logLik(mA, REML = TRUE)[1] - logLik(m0, REML = TRUE)[1])) } p <- if (rlrt.obs != 0) { sample <- RLRTSim(X, Z, qrX = qrX, sqrt.Sigma = chol(cov2cor(Vr)), lambda0 = 0, seed = seed, nsim = nsim, log.grid.hi = log.grid.hi, log.grid.lo = log.grid.lo, gridlength = gridlength, parallel = match.arg(parallel), ncpus = ncpus, cl = cl) if (quantile(sample, 0.9) == 0) { warning("Null distribution has mass ", mean(sample == 0), " at zero.\n") } mean(rlrt.obs < sample) } else { message("Observed RLRT statistic is 0, no simulation performed.") nsim <- 0 sample <- NULL 1 } RVAL <- list(statistic = c(RLRT = rlrt.obs), p.value = p, method = paste("simulated finite sample distribution of RLRT.\n (p-value based on", nsim, "simulated values)"), sample = sample) class(RVAL) <- "htest" return(RVAL) } RLRsim/R/exactLRT.R0000755000176200001440000001412514213627507013451 0ustar liggesusers#' Likelihood Ratio Tests for simple linear mixed models #' #' This function provides an exact likelihood ratio test based on simulated #' values from the finite sample distribution for simultaneous testing of the #' presence of the variance component and some restrictions of the fixed #' effects in a simple linear mixed model with known correlation structure of #' the random effect and i.i.d. errors. #' #' The model under the alternative must be a linear mixed model #' \eqn{y=X\beta+Zb+\varepsilon}{y=X*beta+Z*b+epsilon} with a \emph{single} #' random effect \eqn{b} with known correlation structure and error terms that #' are i.i.d. The hypothesis to be tested must be of the form \deqn{H_0: #' \beta_{p+1-q}=\beta^0_{p+1-q},\dots,\beta_{p}=\beta^0_{p};\quad }{H0: #' beta_1=beta0_1,..,beta_q=beta0_q, Var(b)=0}\deqn{Var(b)=0}{H0: #' beta_1=beta0_1,..,beta_q=beta0_q, Var(b)=0} versus \deqn{H_A:\; #' \beta_{p+1-q}\neq \beta^0_{p+1-q}\;\mbox{or}\dots }{H0: beta_1 \neq #' beta0_1,..or..,beta_q \neq beta0_q ot #' Var(b)>0}\deqn{\mbox{or}\;\beta_{p}\neq #' \beta^0_{p}\;\;\mbox{or}\;Var(b)>0}{H0: beta_1 \neq beta0_1,..or..,beta_q #' \neq beta0_q ot Var(b)>0} We use the exact finite sample distribution of the #' likelihood ratio test statistic as derived by Crainiceanu & Ruppert (2004). #' #' @param m The fitted model under the alternative; of class \code{lme}, #' \code{lmerMod} or \code{spm} #' @param m0 The fitted model under the null hypothesis; of class \code{lm} #' @param seed Specify a seed for \code{set.seed} #' @param nsim Number of values to simulate #' @param log.grid.hi Lower value of the grid on the log scale. See #' \code{\link{exactLRT}}. #' @param log.grid.lo Lower value of the grid on the log scale. See #' \code{\link{exactLRT}}. #' @param gridlength Length of the grid. See \code{\link{LRTSim}}. #' @param parallel The type of parallel operation to be used (if any). If #' missing, the default is "no parallelization"). #' @param ncpus integer: number of processes to be used in parallel operation: #' typically one would chose this to the number of available CPUs. Defaults to #' 1, i.e., no parallelization. #' @param cl An optional parallel or snow cluster for use if parallel = "snow". #' If not supplied, a cluster on the local machine is created for the duration #' of the call. #' @return A list of class \code{htest} containing the following components: #' \itemize{ #' \item \code{statistic} the observed likelihood ratio #' \item \code{p} p-value for the observed test statistic #' \item \code{method} a character string indicating what type of test was #' performed and how many values were simulated to determine the critical value #' \item \code{sample} the samples from the null distribution returned by #' \code{\link{LRTSim}} #' } #' @author Fabian Scheipl, updates for \pkg{lme4.0}-compatibility by Ben Bolker #' @seealso \code{\link{LRTSim}} for the underlying simulation algorithm; #' \code{\link{RLRTSim}} and \code{\link{exactRLRT}} for restricted likelihood #' based tests #' @references Crainiceanu, C. and Ruppert, D. (2004) Likelihood ratio tests in #' linear mixed models with one variance component, \emph{Journal of the Royal #' Statistical Society: Series B},\bold{66},165--185. #' @keywords htest #' @examples #' #' library(nlme); #' data(Orthodont); #' #' ##test for Sex:Age interaction and Subject-Intercept #' mA<-lme(distance ~ Sex * I(age - 11), random = ~ 1| Subject, #' data = Orthodont, method = "ML") #' m0<-lm(distance ~ Sex + I(age - 11), data = Orthodont) #' summary(mA) #' summary(m0) #' exactLRT(m = mA, m0 = m0) #' #' @export exactLRT #' @importFrom stats coefficients `exactLRT` <- function(m, m0, seed = NA, nsim = 10000, log.grid.hi = 8, log.grid.lo = -10, gridlength = 200, parallel = c("no", "multicore", "snow"), ncpus = 1L, cl = NULL) { if (!inherits(m0, "lm")) stop("m0 not an lm-object. \n") if (inherits(m, "spm")) { m <- m$fit class(m) <- "lme" } if (any(class(m) %in% c("amer", "mer"))) stop("Models fit with package or versions of below 1.0 are no longer supported.") c.m <- class(m) if (!any(c.m %in% c("lme", "lmerMod", "merModLmerTest", "lmerModLmerTest"))) stop("Invalid specified. \n") if (c.m %in% c("merModLmerTest", "lmerModLmerTest")) { c.m <- "lmerMod" } d <- switch(c.m, lme = extract.lmeDesign(m), lmerMod=extract.lmerModDesign(m)) if (length(d$lambda) != 1 || d$k != 1) stop("multiple random effects in model - exactLRT needs with only a single random effect.") X <- d$X Z <- d$Z y <- d$y Vr <- d$Vr K <- NCOL(Z) n <- NROW(X) p <- NCOL(X) q <- p - length(coefficients(m0)[!is.na(coefficients(m0))]) if (n != length(m0$fitted)) stop("different data under the null and alternative. \n") if (q < 0) stop("m0 not nested in m. \n") if (n - p - K < 1) stop("No. of effects greater than no. of observations. Reduce model complexity.\n") if (q == 0) message("No restrictions on fixed effects. REML-based inference preferable.") method <- switch(c.m, lme = m$method, lmerMod=ifelse(lme4::isREML(m), "REML", "ML")) if (method != "ML") { message("Using likelihood evaluated at REML estimators.") message("Please refit model with method=\"ML\" for exact results.") } #observed value of the LRT lrt.obs <- max(0, 2 * logLik(m, REML = FALSE)[1] - 2 * logLik(m0, REML = FALSE)[1]) sample <- LRTSim(X, Z, q, sqrt.Sigma = chol(cov2cor(Vr)), seed = seed, nsim = nsim, log.grid.hi = log.grid.hi, log.grid.lo = log.grid.lo, gridlength = gridlength, parallel = match.arg(parallel), ncpus = ncpus, cl = cl) if (quantile(sample, 0.9) == 0) { warning("Null distribution has mass ", mean(sample == 0), " at zero.\n") } p <- mean(lrt.obs < sample) RVAL <- list(statistic = c(LRT = lrt.obs), p.value = p, method = paste("simulated finite sample distribution of LRT. (p-value based on", nsim, "simulated values)"), sample=sample) class(RVAL) <- "htest" return(RVAL) } RLRsim/R/extract.lmerModDesign.R0000755000176200001440000000222514212607702016155 0ustar liggesusers#' @importFrom stats model.response #' @importFrom lme4 getME VarCorr #' @rawNamespace #' if(getRversion() >= "3.3.0") { #' importFrom("stats", sigma) #' } else { #' importFrom("lme4", sigma) #' } extract.lmerModDesign <- function(m) { X <- getME(m,"X") Z <- as.matrix(getME(m,"Z")) v <- VarCorr(m) resvar <- sigma(m)^2 Sigma.l <- lapply(v,function(x) x/resvar) #Cov(b)/ Var(Error) k <- getME(m,"n_rtrms") #how many grouping factors q <- lapply(Sigma.l,NROW) #how many variance components in each grouping factor ## OR lapply(m@cnms,length) -- but we should have an extractor for this nlevel<-sapply(m@flist, function(x) length(levels(x))) #how many inner blocks in Sigma_i ## works as is -- but we should have an extractor Vr <- matrix(0,NCOL(Z),NCOL(Z)) #Cov(RanEf)/Var(Error) from <- 1 for(i in 1:k) { ii<-nlevel[i] inner.block<-as.matrix(Sigma.l[[i]]) to<-from-1+ii*NCOL(inner.block) Vr[from:to,from:to]<- inner.block %x% diag(ii) from<-to+1 } return(list( Vr=Vr, #Cov(RanEf)/Var(Error) X=X, Z=Z, sigmasq=resvar, lambda=unique(diag(Vr)), y=model.response(model.frame(m)), k=k )) } RLRsim/R/RLRTSim.R0000755000176200001440000001706114212607702013213 0ustar liggesusers#' @export RLRTSim #' @import Rcpp #' @importFrom stats rchisq RLRTSim <- function(X, Z, qrX=qr(X), sqrt.Sigma, lambda0 = NA, seed = NA, nsim = 10000, use.approx = 0, log.grid.hi = 8, log.grid.lo = -10, gridlength = 200, parallel = c("no", "multicore", "snow"), ncpus = 1L, cl = NULL) { if (is.na(lambda0)) { lambda0 <- 0 } #checking args: if (!is.numeric(lambda0) | (lambda0 < 0) | length(lambda0) != 1) { stop("Invalid lambda0 specified. \n") } if (lambda0 > exp(log.grid.hi)) { log.grid.hi <- log(10 * lambda0) warning(paste0("lambda0 smaller than upper end of grid: \n", "Setting log.grid.hi to ln(10*lambda0).\n"), immediate. = TRUE) } if ((lambda0 != 0) && (lambda0 < exp(log.grid.lo))) { log.grid.lo <- log(-10 * lambda0) warning(paste0("lambda0 > 0 and larger than lower end of grid: \n", "Setting log.grid.lo to ln(-10*lambda0).\n"), immediate. = TRUE) } parallel <- match.arg(parallel) have_mc <- have_snow <- FALSE if (parallel != "no" && ncpus > 1L) { if (parallel == "multicore") have_mc <- .Platform$OS.type != "windows" else if (parallel == "snow") have_snow <- TRUE if (!have_mc && !have_snow) ncpus <- 1L } n <- NROW(X) p <- NCOL(X) K <- min(n, NCOL(Z)) if (any(is.na(sqrt.Sigma))) sqrt.Sigma <- diag(NCOL(Z)) mu <- (svd(sqrt.Sigma %*% t(qr.resid(qrX, Z)), nu = 0, nv = 0)$d)^2 #normalize mu <- mu/max(mu) if (!is.na(seed)) set.seed(seed) if (use.approx) { #eigenvalue pattern of balanced ANOVA: mu_s=const for s=1,..,K-1, mu_K approx. 0 if ((length(unique(round(mu, 6))) == 2) & (1000 * mu[K] < mu[1])) { message("using simplified distribution for balanced ANOVA \n") approx.constantmu <- function(nsim, n, p, K, mu) #simplified distribution for balanced ANOVA: #mu_s=const for s=1,..,K-1 and mu_K=0 { w.K <- rchisq(nsim, (K - 1)) w.n <- rchisq(nsim, (n - p - K + 1)) lambda <- pmax(rep(0, nsim), ((((n - p - K +1) / (K - 1)) * w.K/w.n - 1)/mu[1])) rlrt <- rep(0, nsim) rlrt[lambda != 0] = ((n - p) * log((w.K + w.n)/(n -p)) - (n - p - K + 1) * log(w.n/(n - p - K + 1)) - (K - 1) * log(w.K/(K - 1)))[lambda != 0] return(cbind(lambda, rlrt)) } res <- approx.constantmu(nsim, n, p, K, mu) return(res) } #eigenvalue pattern for P-splines: exponential decrease if (mu[1]/sum(mu) > use.approx) { message("using simplified distribution for 1 single dominating eigenvalue \n") approx.scalarmu <- function(nsim, n, p, K, mu) #simplified distribution for B-splines: #mu_1 >>> mu_s for s=2,..,K { mu <- mu[1] w.1 <- rchisq(nsim, 1) w.n <- rchisq(nsim, (n - p - 1)) lambda <- pmax(rep(0, nsim), ((((n - p - 1) * w.1)/w.n) - 1)/mu) rlrt <- rep(0, nsim) rlrt[lambda != 0] <- log(((w.1 + w.n)/(n - p))^(n -p) / (w.1 *(w.n/(n - p - 1)) ^ (n - p - 1)))[lambda != 0] return(cbind(lambda, rlrt)) } res <- approx.scalarmu(nsim, n, p, K, mu) return(res) } #use only first k elements of mu, adapt K<-k accordingly #how many eigenvalues are needed to represent at least approx.ratio of #the sum of all eigenvalues (at least 1, of course) new.K <- max(sum((cumsum(mu)/sum(mu)) < use.approx), 1) if (new.K < K) message(paste("Approximation used:", new.K, "biggest eigenvalues instead of", K, "\n")) mu <- mu[1:new.K] K <- new.K } #generate symmetric grid around lambda0 that is log-equidistant to the right, make.lambdagrid <- function(lambda0, gridlength, log.grid.lo, log.grid.hi) { # return(c(0, exp(seq(log.grid.lo, log.grid.hi, # length = gridlength - 1)))) if (lambda0 == 0) return(c(0, exp(seq(log.grid.lo, log.grid.hi, length = gridlength - 1)))) else { leftratio <- min(max((log(lambda0)/((log.grid.hi) - (log.grid.lo))), 0.2), 0.8) leftlength <- max(round(leftratio * gridlength) - 1, 2) leftdistance <- lambda0 - exp(log.grid.lo) #make sure leftlength doesn't split the left side into too small parts: if (leftdistance < (leftlength * 10 * .Machine$double.eps)) { leftlength <- max(round(leftdistance/(10 * .Machine$double.eps)), 2) } #leftdistance approx. 1 ==> make a regular grid, since # (1 +- epsilon)^((1:n)/n) makes a too concentrated grid if (abs(leftdistance - 1) < 0.3) { leftgrid <- seq(exp(log.grid.lo), lambda0, length = leftlength + 1)[-(leftlength + 1)] } else { leftdiffs <- ifelse(rep(leftdistance > 1, leftlength - 1), leftdistance^((2:leftlength)/leftlength) - leftdistance^(1/leftlength), leftdistance^((leftlength - 1):1) - leftdistance^(leftlength)) leftgrid <- lambda0 - rev(leftdiffs) } rightlength <- gridlength - leftlength rightdistance <- exp(log.grid.hi) - lambda0 rightdiffs <- rightdistance^((2:rightlength)/rightlength) - rightdistance^(1/rightlength) rightgrid <- lambda0 + rightdiffs return(c(0, leftgrid, lambda0, rightgrid)) } } lambda.grid <- make.lambdagrid(lambda0, gridlength, log.grid.lo = log.grid.lo, log.grid.hi = log.grid.hi) res <- if (ncpus > 1L && (have_mc || have_snow)) { nsim. <- as.integer(ceiling(nsim/ncpus)) if (have_mc) { tmp <- parallel::mclapply(seq_len(ncpus), function(i){ RLRsimCpp(p = as.integer(p), k = as.integer(K), n = as.integer(n), nsim = as.integer(nsim.), g = as.integer(gridlength), q = as.integer(0), mu = as.double(mu), lambda = as.double(lambda.grid), lambda0 = as.double(lambda0), xi = as.double(mu), REML = as.logical(TRUE)) }, mc.cores = ncpus) do.call(mapply, c(tmp, FUN=c)) } else { if (have_snow) { if (is.null(cl)) { cl <- parallel::makePSOCKcluster(rep("localhost", ncpus)) if (RNGkind()[1L] == "L'Ecuyer-CMRG") { parallel::clusterSetRNGStream(cl) } tmp <- parallel::parLapply(cl, seq_len(ncpus), function(i){ RLRsimCpp(p = as.integer(p), k = as.integer(K), n = as.integer(n), nsim = as.integer(nsim.), g = as.integer(gridlength), q = as.integer(0), mu = as.double(mu), lambda = as.double(lambda.grid), lambda0 = as.double(lambda0), xi = as.double(mu), REML = as.logical(TRUE)) }) parallel::stopCluster(cl) do.call(mapply, c(tmp, FUN=c)) } else { tmp <- parallel::parLapply(cl, seq_len(ncpus), function(i){ RLRsimCpp(p = as.integer(p), k = as.integer(K), n = as.integer(n), nsim = as.integer(nsim.), g = as.integer(gridlength), q = as.integer(0), mu = as.double(mu), lambda = as.double(lambda.grid), lambda0 = as.double(lambda0), xi = as.double(mu), REML = as.logical(TRUE)) }) do.call(mapply, c(tmp, FUN=c)) } } } } else { RLRsimCpp(p = as.integer(p), k = as.integer(K), n = as.integer(n), nsim = as.integer(nsim), g = as.integer(gridlength), q = as.integer(0), mu = as.double(mu), lambda = as.double(lambda.grid), lambda0 = as.double(lambda0), xi = as.double(mu), REML = as.logical(TRUE)) } ret <- res$res attr(ret, "lambda") <- lambda.grid[res$lambdaind] return(ret) } RLRsim/R/RLRsim-package.R0000755000176200001440000000361214212616721014516 0ustar liggesusers#' R package for fast and exact (restricted) likelihood ratio tests for mixed and additive models. #' #' \code{RLRsim} implements fast simulation-based exact tests for variance components in mixed and additive models for #' conditionally Gaussian responses -- i.e., tests for questions like: #' \itemize{ #' \item is the variance of my random intercept significantly different from 0? #' \item is this smooth effect significantly nonlinear? #' \item is this smooth effect significantly different from a constant effect?} #' The convenience functions \code{\link{exactRLRT}} and \code{\link{exactLRT}} #' can deal with fitted models from packages \pkg{lme4, nlme, gamm4, SemiPar} and #' from \pkg{mgcv}'s \code{gamm()}-function. #' Workhorse functions \code{\link{LRTSim}} and \code{\link{RLRTSim}} #' accept design matrices as inputs directly and can thus be used more generally #' to generate exact critical values for the corresponding #' (restricted) likelihood ratio tests.\cr\cr #' The theory behind these tests was first developed in:\cr #' Crainiceanu, C. and Ruppert, D. (2004) #' \href{https://people.orie.cornell.edu/~davidr/papers/asymptoticpaper2.pdf}{Likelihood ratio tests in #' linear mixed models with one variance component}, \emph{Journal of the Royal #' Statistical Society: Series B}, \bold{66}, 165--185.\cr\cr #' Power analyses and sensitivity studies for \pkg{RLRsim} can be found in:\cr #' Scheipl, F., Greven, S. and Kuechenhoff, H. (2008) #' Size and power of tests #' for a zero random effect variance or polynomial regression in additive and #' linear mixed models. \emph{Computational Statistics and Data Analysis}, #' \bold{52}(7), 3283--3299, \doi{10.1016/j.csda.2007.10.022}. #' #' #' #' @name RLRsim-package #' @aliases RLRsim-package RLRsim #' @docType package #' @author Fabian Scheipl (\email{fabian.scheipl@@stat.uni-muenchen.de}), #' Ben Bolker #' @keywords package NULL RLRsim/R/RcppExports.R0000644000176200001440000000044114214135325014236 0ustar liggesusers# Generated by using Rcpp::compileAttributes() -> do not edit by hand # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 RLRsimCpp <- function(p, k, n, nsim, g, q, mu, lambda, lambda0, xi, REML) { .Call(`_RLRsim_RLRsimCpp`, p, k, n, nsim, g, q, mu, lambda, lambda0, xi, REML) } RLRsim/R/LRTSim.R0000755000176200001440000001613414212701561013067 0ustar liggesusers#' Simulation of the (Restricted) Likelihood Ratio Statistic #' #' These functions simulate values from the (exact) finite sample distribution #' of the (restricted) likelihood ratio statistic for testing the presence of #' the variance component (and restrictions of the fixed effects) in a simple #' linear mixed model with known correlation structure of the random effect and #' i.i.d. errors. They are usually called by \code{exactLRT} or #' \code{exactRLRT}. #' #' The model under the alternative must be a linear mixed model #' \eqn{y=X\beta+Zb+\varepsilon}{y=X*beta+Z*b+epsilon} with a single random #' effect \eqn{b} with known correlation structure \eqn{Sigma} and i.i.d errors. #' The simulated distribution of the likelihood ratio statistic was derived by #' Crainiceanu & Ruppert (2004). The simulation algorithm uses a grid search over #' a log-regular grid of values of #' \eqn{\lambda=\frac{Var(b)}{Var(\varepsilon)}}{lambda=Var(b)/Var(epsilon)} to #' maximize the likelihood under the alternative for \code{nsim} realizations of #' \eqn{y} drawn under the null hypothesis. \code{log.grid.hi} and #' \code{log.grid.lo} are the lower and upper limits of this grid on the log #' scale. \code{gridlength} is the number of points on the grid.\ These are just #' wrapper functions for the underlying C code. #' #' @aliases RLRTSim #' @param X The fixed effects design matrix of the model under the alternative #' @param Z The random effects design matrix of the model under the alternative #' @param q The number of parameters restrictions on the fixed effects (see #' Details) #' @param sqrt.Sigma The upper triangular Cholesky factor of the correlation #' matrix of the random effect #' @param seed Specify a seed for \code{set.seed} #' @param nsim Number of values to simulate #' @param log.grid.hi Lower value of the grid on the log scale. See #' \bold{Details} #' @param log.grid.lo Lower value of the grid on the log scale. See #' \bold{Details} #' @param gridlength Length of the grid for the grid search over lambda. See #' \bold{Details} #' @param parallel The type of parallel operation to be used (if any). If #' missing, the default is "no parallelization"). #' @param ncpus integer: number of processes to be used in parallel operation: #' typically one would chose this to the number of available CPUs. Defaults to #' 1, i.e., no parallelization. #' @param cl An optional parallel or snow cluster for use if parallel = "snow". #' If not supplied, a cluster on the local machine is created for the duration #' of the call. #' @return A vector containing the the simulated values of the (R)LRT under the #' null, with attribute 'lambda' giving \eqn{\arg\min(f(\lambda))} (see #' Crainiceanu, Ruppert (2004)) for the simulations. #' @author Fabian Scheipl; parallelization code adapted from \code{boot} package #' @seealso \code{\link{exactLRT}}, \code{\link{exactRLRT}} for tests #' @references Crainiceanu, C. and Ruppert, D. (2004) Likelihood ratio tests in #' linear mixed models with one variance component, \emph{Journal of the Royal #' Statistical Society: Series B},\bold{66},165--185. #' #' Scheipl, F. (2007) Testing for nonparametric terms and random effects in #' structured additive regression. Diploma thesis (unpublished). #' #' Scheipl, F., Greven, S. and Kuechenhoff, H (2008) Size and power of tests #' for a zero random effect variance or polynomial regression in additive and #' linear mixed models, \emph{Computational Statistics & Data Analysis}, #' \bold{52}(7):3283-3299 #' @keywords datagen distribution #' @examples #' #' library(lme4) #' g <- rep(1:10, e = 10) #' x <- rnorm(100) #' y <- 0.1 * x + rnorm(100) #' m <- lmer(y ~ x + (1|g), REML=FALSE) #' m0 <- lm(y ~ 1) #' #' (obs.LRT <- 2*(logLik(m)-logLik(m0))) #' X <- getME(m,"X") #' Z <- t(as.matrix(getME(m,"Zt"))) #' sim.LRT <- LRTSim(X, Z, 1, diag(10)) #' (pval <- mean(sim.LRT > obs.LRT)) #' #' @export LRTSim #' @useDynLib RLRsim, .registration = TRUE LRTSim <- function(X,Z,q, sqrt.Sigma, seed=NA, nsim=10000, log.grid.hi=8, log.grid.lo=-10, gridlength=200, parallel = c("no", "multicore", "snow"), ncpus = 1L, cl = NULL){ parallel <- match.arg(parallel) have_mc <- have_snow <- FALSE if (parallel != "no" && ncpus > 1L) { if (parallel == "multicore") have_mc <- .Platform$OS.type != "windows" else if (parallel == "snow") have_snow <- TRUE if (!have_mc && !have_snow) ncpus <- 1L } K <- NCOL(Z) # no. of random effects n <- NROW(X) # no. of obs p <- NCOL(X) # no of fixed effects #compute eigenvalues mu <- (svd(sqrt.Sigma %*% t(qr.resid(qr(X), Z)), nu = 0, nv = 0)$d)^2 xi <- (svd(sqrt.Sigma %*% t(Z), nu = 0, nv = 0)$d)^2 #norm eigenvalues mu <- mu / max(mu,xi) xi <- xi / max(mu,xi) lambda.grid <-c(0, exp(seq(log.grid.lo, log.grid.hi, length = gridlength - 1))) if (!is.na(seed)) set.seed(seed) res <- if (ncpus > 1L && (have_mc || have_snow)) { nsim. <- as.integer(ceiling(nsim/ncpus)) if (have_mc) { tmp <- parallel::mclapply(seq_len(ncpus), function(i){ RLRsimCpp(p = as.integer(p), k = as.integer(K), n = as.integer(n), nsim = as.integer(nsim.), g = as.integer(gridlength), q = as.integer(q), mu = as.double(mu), lambda = as.double(lambda.grid), lambda0 = as.double(0), xi = as.double(xi), REML = as.logical(FALSE)) }, mc.cores = ncpus) do.call(mapply, c(tmp, FUN=c)) } else { if (have_snow) { if (is.null(cl)) { cl <- parallel::makePSOCKcluster(rep("localhost", ncpus)) if (RNGkind()[1L] == "L'Ecuyer-CMRG") { parallel::clusterSetRNGStream(cl) } tmp <- parallel::parLapply(cl, seq_len(ncpus), function(i){ RLRsimCpp(p = as.integer(p), k = as.integer(K), n = as.integer(n), nsim = as.integer(nsim.), g = as.integer(gridlength), q = as.integer(q), mu = as.double(mu), lambda = as.double(lambda.grid), lambda0 = as.double(0), xi = as.double(xi), REML = as.logical(FALSE)) }) parallel::stopCluster(cl) do.call(mapply, c(tmp, FUN=c)) } else { tmp <- parallel::parLapply(cl, seq_len(ncpus), function(i){ RLRsimCpp(p = as.integer(p), k = as.integer(K), n = as.integer(n), nsim = as.integer(nsim.), g = as.integer(gridlength), q = as.integer(q), mu = as.double(mu), lambda = as.double(lambda.grid), lambda0 = as.double(0), xi = as.double(xi), REML = as.logical(FALSE)) }) do.call(mapply, c(tmp, FUN=c)) } } } } else { RLRsimCpp(p = as.integer(p), k = as.integer(K), n = as.integer(n), nsim = as.integer(nsim), g = as.integer(gridlength), q = as.integer(q), mu = as.double(mu), lambda = as.double(lambda.grid), lambda0 = as.double(0), xi = as.double(xi), REML = as.logical(FALSE)) } lambda <- lambda.grid[res$lambdaind] ret <- res$res attr(ret, "lambda") <- lambda.grid[res$lambdaind] return(ret) } RLRsim/R/extract.lmeDesign.R0000755000176200001440000000601714214136154015336 0ustar liggesusers#' Extract the Design of a linear mixed model #' #' These functions extract various elements of the design of a fitted #' \code{lme}-, \code{mer} or \code{lmerMod}-Object. They are called by #' \code{exactRLRT} and \code{exactLRT}. #' #' #' @aliases extract.lmerModDesign extract.lmeDesign #' @param m a fitted \code{lme}- or \code{merMod}-Object #' @return a a list with components #' \itemize{ #' \item \code{Vr} estimated covariance of the random effects divided by the #' estimated variance of the residuals #' \item \code{X} design of the fixed effects #' \item \code{Z} design of the random effects #' \item \code{sigmasq} variance of the residuals #' \item \code{lambda} ratios of the variances of the random effects and the #' variance of the residuals #' \item \code{y} response variable #' } #' @author Fabian Scheipl, \code{extract.lmerModDesign} by Ben Bolker. #' Many thanks to Andrzej Galecki and Tomasz Burzykowski for bug fixes. #' @keywords utilities #' @examples #' #' library(nlme) #' design <- extract.lmeDesign(lme(distance ~ age + Sex, data = Orthodont, #' random = ~ 1)) #' str(design) #' #' @export extract.lmeDesign #' @importFrom stats complete.cases formula model.frame model.matrix #' @importFrom nlme getGroups #' @importFrom mgcv tensor.prod.model.matrix extract.lmeDesign <- function(m) { start.level = 1 data <- if(any(!complete.cases(m$data))){ warning("Removing incomplete cases from supplied data.") m$data[complete.cases(m$data),] } else m$data grps <- getGroups(m) n <- length(grps) X <- list() grp.dims <- m$dims$ncol Zt <- model.matrix(m$modelStruct$reStruct, data) cov <- as.matrix(m$modelStruct$reStruct) i.col <- 1 n.levels <- length(m$groups) Z <- matrix(0, n, 0) if (start.level <= n.levels) { for (i in 1:(n.levels - start.level + 1)) { if (length(levels(m$groups[[n.levels - i + 1]])) != 1) { grps <- m$groups[[n.levels - i + 1]] X[[1]] <- model.matrix(~ grps - 1, contrasts.arg = list(grps = "contr.treatment")) } else { X[[1]] <- matrix(1, n, 1) } X[[2]] <- as.matrix(Zt[, i.col:(i.col + grp.dims[i] - 1)]) i.col <- i.col + grp.dims[i] Z <- cbind(tensor.prod.model.matrix(X), Z) } Vr <- matrix(0, ncol(Z), ncol(Z)) start <- 1 for (i in 1:(n.levels - start.level + 1)) { k <- n.levels - i + 1 for (j in 1:m$dims$ngrps[i]) { stop <- start + ncol(cov[[k]]) - 1 Vr[ncol(Z)+1-(stop:start),ncol(Z)+1-(stop:start)] <- cov[[k]] start <- stop + 1 } } } X <- if(class(m$call$fixed) == "name" && !is.null(m$data$X)){ m$data$X } else { model.matrix(formula(eval(m$call$fixed)), data) } y <- as.vector(matrix(m$residuals, ncol=NCOL(m$residuals))[,NCOL(m$residuals)] + matrix(m$fitted, ncol=NCOL(m$fitted))[,NCOL(m$fitted)]) return(list( Vr=Vr, #Cov(RanEf)/Var(Error) X=X, Z=Z, sigmasq=m$sigma^2, lambda=unique(diag(Vr)), y=y, k=n.levels ) ) } RLRsim/MD50000644000176200001440000000202614214405737011741 0ustar liggesusersb362b7228cf1655dde14e00f0d244b84 *DESCRIPTION bb359d9cafe1f40a50e252f86046eb9e *NAMESPACE 278cfca95dbdbfdc1325cd86dbb0a9e6 *NEWS 5740bf5241d2079530b4238dad9bdf51 *R/LRTSim.R c9812f9d5a457246aa3cf63d457ee624 *R/RLRTSim.R aa9bcfe0277fd3bd55f4fc14b33b2f8c *R/RLRsim-package.R 31279272f4ca2ae997884d8ed9d5e97e *R/RcppExports.R eff72d8a1b9a5c143e9d5566b3ed9507 *R/exactLRT.R c9aca2ff43eda601972a5dd9187df263 *R/exactRLRT.R fb0cc4392e8c6fc37e03957608f358ec *R/extract.lmeDesign.R d8687f4928b4251874e98496216f11a6 *R/extract.lmerModDesign.R d1f87aa0e9175b6d7fa250aaab15af17 *build/partial.rdb 41c04c7526ce81f92356558d6fbc6218 *inst/CITATION 2c2fcd67f3ff9d46024e61df34e4f959 *man/LRTSim.Rd 601b918d1afb59ef85c65fa795ca8f6d *man/RLRsim-package.Rd 2d37fb356e2ef76d1413d0f0c495cef4 *man/exactLRT.Rd b988d43348efe06af5da2b21229970f6 *man/exactRLRT.Rd 291d616828fe6a081a13c32942c18aed *man/extract.lmeDesign.Rd eb60faff8813825fbc7b14b296dc22db *src/RLRsim.cpp 5f887f3bd09a8ae776610ffeb1965a94 *src/RcppExports.cpp 4503bd305f9b8747a3e78fa0cdbeeb3f *src/init.c RLRsim/inst/0000755000176200001440000000000014212607702012400 5ustar liggesusersRLRsim/inst/CITATION0000755000176200001440000000170614212607702013544 0ustar liggesusers citHeader("To cite package 'RLRsim' in publications please use:") citEntry(entry="Article", title = "Size and power of tests for a zero random effect variance or polynomial regression in additive and linear mixed models.", author = personList(as.person("Fabian Scheipl"), as.person("Sonja Greven"), as.person("Helmut Kuechenhoff")), year = "2008", journal = "Computational Statistics & Data Analysis", volume = "52", number = "7", pages = "3283--3299", textVersion = paste("Scheipl, F., Greven, S. and Kuechenhoff, H. (2008)", "Size and power of tests for a zero random effect variance or polynomial regression in additive and linear mixed models.", "Computational Statistics & Data Analysis, 52(7):3283--3299."))