RLRsim/0000755000176200001440000000000013007206326011421 5ustar liggesusersRLRsim/inst/0000755000176200001440000000000011567176622012414 5ustar liggesusersRLRsim/inst/CITATION0000744000176200001440000000170611600354440013536 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.")) RLRsim/src/0000755000176200001440000000000013007101136012201 5ustar liggesusersRLRsim/src/RLRsim.cpp0000744000176200001440000000521613007101136014062 0ustar liggesusers// [[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.cpp0000744000176200001440000000267713007101136015213 0ustar liggesusers// Generated by using Rcpp::compileAttributes() -> do not edit by hand // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 #include using namespace Rcpp; // 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/NAMESPACE0000744000176200001440000000127113007076144012645 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) useDynLib(RLRsim) RLRsim/NEWS0000744000176200001440000000057413007075441012131 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, Lukas Meier) 3.0 ------- *** now using Rcpp * removed terrible "browser()"-bug in extract.lmeDesign() RLRsim/R/0000755000176200001440000000000012574046022011625 5ustar liggesusersRLRsim/R/RLRTSim.R0000744000176200001440000001706113007074702013210 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/exactRLRT.R0000744000176200001440000002056613007074635013575 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). #' #' @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 #' #' library(lme4) #' data(sleepstudy) #' mA <- 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 '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 (class(m) == "spm") { m <- m$fit class(m) <- "lme" } if (class(m) %in% c("amer", "mer")) stop("Models fit with package or versions of below 1.0 are no longer supported.") if (!(c.m <- (class(m))) %in% c("lme", "lmerMod", "merModLmerTest")) stop("Invalid specified. \n") if(c.m == "merModLmerTest") 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) } } } ## bug fix submitted by Andrzej Galecki 3/10/2009 DFx <- switch(c.m, lme = anova(mA,m0)$df, lmerMod = anova(mA, m0, refit = FALSE)$Df) 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 { 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/RLRsim-package.R0000744000176200001440000000363412505004674014521 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{http://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) #' \href{http://dx.doi.org/10.1016/j.csda.2007.10.022}{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. #' #' #' #' @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/extract.lmeDesign.R0000744000176200001440000000576012574322276015351 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) { X[[1]] <- model.matrix(~m$groups[[n.levels - i + 1]] - 1, contrasts.arg = c("contr.treatment", "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/R/LRTSim.R0000744000176200001440000001617512573600152013074 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 gridsearch 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 containig 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.\ #' \url{http://www.statistik.lmu.de/~scheipl/downloads/DIPLOM.zip}. #' #' 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 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/RcppExports.R0000744000176200001440000000046413007075165014250 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', PACKAGE = 'RLRsim', p, k, n, nsim, g, q, mu, lambda, lambda0, xi, REML) } RLRsim/R/extract.lmerModDesign.R0000744000176200001440000000222513007076130016147 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/exactLRT.R0000744000176200001440000001401413007074672013443 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 (class(m0) != "lm") stop("m0 not an lm-object. \n") if (class(m) == "spm") { m <- m$fit class(m) <- "lme" } if (class(m) %in% c("amer", "mer")) stop("Models fit with package or versions of below 1.0 are no longer supported.") if (!((c.m <- class(m)) %in% c("lme", "lmerMod", "merModLmerTest"))) stop("Invalid specified. \n") if(c.m == "merModLmerTest") 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/MD50000644000176200001440000000166513007206326011741 0ustar liggesusersa58592abbc7c76fc17a2c08c78466088 *DESCRIPTION 8df01da48a556f2f72ffb5edda94fdb8 *NAMESPACE 8c173ef3ec82166d879e646bf7611ee1 *NEWS 9d6f9230837e8b39c276ffd72630a5fc *R/LRTSim.R c9812f9d5a457246aa3cf63d457ee624 *R/RLRTSim.R 0180fce884de17ffc5b18bf8d02fc96a *R/RLRsim-package.R d4e9d907114069e26e65fc9b7c62d20c *R/RcppExports.R 63ab6786ab123d07bcd084ae769e1b2a *R/exactLRT.R 6c66e21fc66644dd1a9d5b9dcb836cb7 *R/exactRLRT.R 04604eccab97876b89abbb70ee9eb8ad *R/extract.lmeDesign.R d8687f4928b4251874e98496216f11a6 *R/extract.lmerModDesign.R 41c04c7526ce81f92356558d6fbc6218 *inst/CITATION 79d0c7bf592f58314039bd569ad986a2 *man/LRTSim.Rd 3c8ca0a6cf562e51ea17323c883ece40 *man/RLRsim-package.Rd 41c6819d5ed755100da6b382ed8dbd8d *man/exactLRT.Rd a9d14104f94b9b088ec792d8003c02c2 *man/exactRLRT.Rd 778e2669646b62a67bca77683e4c71c4 *man/extract.lmeDesign.Rd 0d863081f160c630e7b5afb615e46f0b *src/RLRsim.cpp 529d8f5566d4dd780713cc4db6b50983 *src/RcppExports.cpp RLRsim/DESCRIPTION0000644000176200001440000000204113007206326013124 0ustar liggesusersPackage: RLRsim Type: Package Title: Exact (Restricted) Likelihood Ratio Tests for Mixed and Additive Models Version: 3.1-3 Date: 2016-11-03 Authors@R: c(person("Fabian", "Scheipl", role = c("aut", "cre"), email = "fabian.scheipl@stat.uni-muenchen.de"), person("Ben", "Bolker", role = "aut")) 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 Depends: R (>= 2.14.0) Imports: Rcpp (>= 0.11.1), lme4 (>= 1.1), mgcv, nlme LinkingTo: Rcpp Enhances: SemiPar, lmerTest RoxygenNote: 5.0.1 NeedsCompilation: yes Packaged: 2016-11-04 12:43:10 UTC; fabians Author: Fabian Scheipl [aut, cre], Ben Bolker [aut] Repository: CRAN Date/Publication: 2016-11-04 23:33:58 RLRsim/man/0000755000176200001440000000000012372351053012176 5ustar liggesusersRLRsim/man/LRTSim.Rd0000744000176200001440000001005613007075165013605 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 containig 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 gridsearch 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)) } \author{ Fabian Scheipl; parallelization code adapted from \code{boot} package } \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.\ \url{http://www.statistik.lmu.de/~scheipl/downloads/DIPLOM.zip}. 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 } \keyword{datagen} \keyword{distribution} RLRsim/man/exactRLRT.Rd0000744000176200001440000001172513007075165014307 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). } \examples{ library(lme4) data(sleepstudy) mA <- 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) } \author{ Fabian Scheipl, bug fixes by Andrzej Galecki, updates for \pkg{lme4}-compatibility by Ben Bolker } \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 } \keyword{htest} RLRsim/man/extract.lmeDesign.Rd0000744000176200001440000000236013007075165016052 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/exactLRT.Rd0000744000176200001440000000727213007075165014167 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) } \author{ Fabian Scheipl, updates for \pkg{lme4.0}-compatibility by Ben Bolker } \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 } \keyword{htest} RLRsim/man/RLRsim-package.Rd0000744000176200001440000000365313007075165015241 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} \alias{RLRsim-package} \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{http://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) \href{http://dx.doi.org/10.1016/j.csda.2007.10.022}{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. } \author{ Fabian Scheipl (\email{fabian.scheipl@stat.uni-muenchen.de}), Ben Bolker } \keyword{package}