Running ‘classes.R’ [14s/26s]
  Running ‘coxme.R’
  Running ‘gam-smooth-consitency.R’ [6s/13s]
  Running ‘misc-tests.R’
  Running ‘parallel.R’ [14s/28s]
  Running ‘r_squared_glmm.R’ [37s/103s]
Running the tests in ‘tests/r_squared_glmm.R’ failed.
Complete output:
  > if(length(find.package(c("lme4", "nlme"), quiet = TRUE)) == 2) {
  + 
  + library(lme4)
  + library(nlme)
  + library(MuMIn) ## needs  version >= 1.9.22
  + 
  + ## Paul Johnson's code from MEE ms appendix:
  + R2PJ <-
  + function(model) { 
  +   X <- model.matrix(model)
  +   n <- nrow(X)
  +   Beta <- fixef(model)
  +   Sf <- var(X %*% Beta)
  +   Sigma.list <- VarCorr(model)
  +   Sl <- sum(
  +       sapply(Sigma.list, function(Sigma) {
  +           Xstar <- X[,rownames(Sigma)]
  +           sum(diag(Xstar %*% Sigma %*% t(Xstar))) / n
  +         }))
  +   Se <- attr(Sigma.list, "sc")^2
  +   Sd <- 0
  +   total.var <- Sf + Sl + Se + Sd
  +   return(c(R2m = Sf / total.var, R2c = (Sf + Sl) / total.var))
  + }
  + 
  + R2PJpois <-
  + function(model, ovdVarName) { 
  +   X <- model.matrix(model)
  +   n <- nrow(X)
  +   Beta <- fixef(model)
  +   Sf <- var(X %*% Beta)
  +   Sigma.list <- VarCorr(model)
  +   Sl <- sum(sapply(Sigma.list[names(Sigma.list) != ovdVarName], function(Sigma) {
  +           Xstar <-X[,rownames(Sigma)]
  +           sum(diag(Xstar %*% Sigma %*% t(Xstar)))/n
  +         }))
  +   Se <- Sigma.list[[ovdVarName]][1L]
  +   Sd <- log(1 + 1 / exp(mean(X %*% Beta))) ### See footnote ###
  +   (total.var <- c(Sf + Sl + Se + Sd))
  +   return (c(R2m = c(Sf / total.var), R2c = c((Sf + Sl) / total.var)))
  + }
  + 
  + 
  + ### tests:
  + orangemod.ri <- lmer(circumference ~ age +(1 | Tree), data = Orange)
  + orangemod.rs <- lmer(circumference ~ age +(age | Tree), data = Orange)
  + 
  + stopifnot(
  + all.equal(r.squaredGLMM(orangemod.ri), R2PJ(orangemod.ri))
  + )
  + 
  + #r.squaredGLMM(orangemod.rs)
  + #R2PJ(orangemod.rs)
  + 
  + stopifnot(
  + all.equal(r.squaredGLMM(orangemod.rs), R2PJ(orangemod.rs))
  + )
  + 
  + set.seed(1)
  + Orange$rand <- rnorm(nrow(Orange))
  + subs <- 2:31
  + model1 <- lmer(circumference ~ scale(age) + (I(rand + 1) | Tree), data = Orange, subset = subs, REML = TRUE)
  + model1a <- lme(circumference ~ scale(age), ~ I(rand + 1) | Tree, data = Orange, subset = subs, method = "REML")
  + model1b <- lme(circumference ~ scale(age), list(~ I(rand + 1) | Tree), data = Orange, subset = subs, method = "REML")
  + rm(subs)
  + 
  + stopifnot(
  + all.equal(r.squaredGLMM(model1), r.squaredGLMM(model1a), tolerance = .001)
  + )
  + 
  + #fixef(model1)
  + #fixef(model1a)
  + 
  + model.frame(model1a, TRUE)
  + model.matrix(model1a, TRUE)
  + 
  + ###########################
  + 
  + if(require(glmmML)) {
  + 
  + ### tests models evaluated in a strange environment
  + #with(env <- new.env(), {
  + #
  + #	n <- 200
  + #	id <- factor(rep(1:20, rep(5, 20)))
  + #	y <- rbinom(n, prob = rep(runif(20), rep(5, 20)), size = 1)
  + #	x <- rnorm(n)
  + #	dat <- data.frame(y = y, x = x, id = id)
  + #	
  + #	subs <- 1:110
  + #	model2 <- glmmML(y ~ x, data = dat, cluster = id, subset = subs, x = TRUE)
  + #	model2a <- glmer(y ~ x + (1 | id), data = dat, subset = subs, family = family(model2))
  + #
  + #	model2b <- glmer(y ~ x + (1 | id), data = dat, subset = subs, family = binomial("logit"))
  + #	
  + #	
  + #	dat$..obslev <- gl(200, 1)
  + #	
  + #	x <- glmer(formula = y ~ x + (1 | id) + (1 | ..obslev), data = dat, family = binomial("logit"))
  + #	
  + #	model2b <- glmer(y ~ x + (1 | id) + (1 | gl(n, 1)), data = dat,  family = binomial("logit"),
  + #					 subset = subs)
  + #	
  + #	
  + #	model2b <- glmer(y ~ x + (1 | id) + (gl(200, 1), data = dat,  family = binomial("logit"))
  + #
  + #	x <- model2b
  + #
  + #})
  + #
  + #r.squaredGLMM(env$model2a)
  + #r.squaredGLMM(model2)
  + 
  + #stopifnot(
  + #all.equal(r.squaredGLMM(env$model2), r.squaredGLMM(env$model2a), tolerance = 0.005)
  + #)
  + 
  + } ## if(require(glmmML))
  + ### Poisson:
  + 
  + # the value DUMMY=0 and the high counts DUMMY=1:
  + data(grouseticks, package = "lme4")
  + grouseticks <- merge(grouseticks, aggregate(
  + 	list(medianTicks = grouseticks$TICKS), grouseticks['LOCATION'], median))
  + grouseticks$DUMMY <- as.integer(grouseticks$TICKS > grouseticks$medianTicks)
  + grouseticks$medianTicks <- NULL
  + 
  + tickmod.ri  <- glmer(TICKS ~ HEIGHT + DUMMY+YEAR + (1|INDEX) + (1|BROOD) + (1|LOCATION),
  + 	family = poisson, data = grouseticks)
  + 	
  + tickmod.ri0  <- glmer(update(formula(tickmod.ri), .~. -(1|INDEX)),
  + 	family = poisson, data = grouseticks)
  + 
  + #x1  <- glm(TICKS ~ HEIGHT+DUMMY+YEAR, family = quasipoisson, data = grouseticks)
  + #
  + #x2 <- glmer(TICKS~HEIGHT+DUMMY+YEAR + (1|INDEX), family = poisson, data = grouseticks)
  + #
  + #sqrt(VarCorr(x2)[[1]][1])
  + #
  + #(11.47402)^2
  + #
  + #?QAIC
  + #qpf <- quasipoisson()
  + #qpf$aic <- poisson()$aic
  + #qpf$family <- "qp"
  + #
  + #tickmod.ri0q  <- glmer(TICKS~HEIGHT+DUMMY+YEAR + (1|BROOD) + (1|LOCATION),
  + #	family = qpf, data = grouseticks)
  + #tickmod.ri0q
  + 
  + 
  + print(R2PJpois(tickmod.ri, 'INDEX'))
  + print(r.squaredGLMM(tickmod.ri))
  + #print(r.squaredGLMM(tickmod.ri0))
  + 
  + stopifnot(all.equal(R2PJpois(tickmod.ri, 'INDEX'), r.squaredGLMM(tickmod.ri)))
  + 
  + ## results are slightly different depending on the ordering of INDEX
  + ## try with (1 | sample(INDEX))
  + stopifnot(
  + 		  all.equal(r.squaredGLMM(tickmod.ri), r.squaredGLMM(tickmod.ri0), tolerance = 0.001)
  + 		  )
  + 
  + tickmod.rs  <- glmer(TICKS ~ HEIGHT + DUMMY + YEAR + (1|INDEX) + (1|BROOD) + (DUMMY|LOCATION),
  +       family = poisson, data = grouseticks)
  + tickmod.rs0  <-  glmer(TICKS ~ HEIGHT + DUMMY + YEAR + (1|BROOD) + (DUMMY|LOCATION),
  + 						  family = poisson, data = grouseticks)
  + 
  + stopifnot(all.equal(R2PJpois(tickmod.rs, 'INDEX'), r.squaredGLMM(tickmod.rs)))
  + 
  + 
  + #tickmod3 <- glmmML(TICKS ~ HEIGHT + DUMMY + YEAR, cluster = INDEX, family = poisson, data = grouseticks, x = TRUE)
  + #tickmod3a  <- glmer(TICKS ~ HEIGHT + DUMMY + YEAR + (1|INDEX), family = poisson, data = grouseticks)
  + #tickmod4 <- glmmML(TICKS ~ HEIGHT + DUMMY + YEAR, cluster = LOCATION, family = poisson, data = grouseticks, x = TRUE)
  + #r.squaredGLMM(tickmod3)
  + #r.squaredGLMM(tickmod3a)
  + #r.squaredGLMM(tickmod.rs0)
  + }
  Loading required package: Matrix
  
  Attaching package: 'nlme'
  
  The following object is masked from 'package:lme4':
  
      lmList
  
  Loading required package: glmmML
        R2m       R2c 
  0.5864754 0.8202255 
        R2m       R2c 
  0.5864754 0.8202255 
  The result is correct only if all data used by the model has not changed since model was fitted.
  
   *** caught segfault ***
  address 3ba983e6, cause 'memory not mapped'
  
  Traceback:
   1: .Call(glmerLaplace, pp$ptr(), resp$ptr(), nAGQ, tol, as.integer(maxit),     verbose)
   2: pwrssUpdate(pp, resp, tol = tolPwrss, GQmat = GQmat, compDev = compDev,     grpFac = fac, maxit = maxit, verbose = verbose)
   3: fn(nM$xeval())
   4: stopifnot(length(value <- as.numeric(value)) == 1L)
   5: nM$newf(fn(nM$xeval()))
   6: (function (fn, par, lower = rep.int(-Inf, n), upper = rep.int(Inf,     n), control = list()) {    n <- length(par)    if (is.null(xst <- control[["xst"]]))         xst <- rep.int(0.02, n)    if (is.null(xt <- control[["xt"]]))         xt <- xst * 5e-04    control[["xst"]] <- control[["xt"]] <- NULL    if (is.null(verbose <- control[["verbose"]]))         verbose <- 0    control[["verbose"]] <- NULL    if (is.null(control[["iprint"]])) {        control[["iprint"]] <- switch(as.character(min(as.numeric(verbose),             3L)), `0` = 0, `1` = 20, `2` = 10, `3` = 1)    }    stopifnot(is.function(fn), length(formals(fn)) == 1L, (n <- length(par <- as.numeric(par))) ==         length(lower <- as.numeric(lower)), length(upper <- as.numeric(upper)) ==         n, length(xst <- as.numeric(xst)) == n, all(xst != 0),         length(xt <- as.numeric(xt)) == n)    nM <- NelderMead$new(lower = lower, upper = upper, x0 = par,         xst = xst, xt = xt)    cc <- do.call(function(iprint = 0L, maxfun = 10000L, FtolAbs = 1e-05,         FtolRel = 1e-15, XtolRel = 1e-07, MinfMax = -.Machine$double.xmax,         warnOnly = FALSE, ...) {        if (length(list(...)) > 0)             warning("unused control arguments ignored")        list(iprint = iprint, maxfun = maxfun, FtolAbs = FtolAbs,             FtolRel = FtolRel, XtolRel = XtolRel, MinfMax = MinfMax,             warnOnly = warnOnly)    }, control)    nM$setFtolAbs(cc$FtolAbs)    nM$setFtolRel(cc$FtolRel)    nM$setIprint(cc$iprint)    nM$setMaxeval(cc$maxfun)    nM$setMinfMax(cc$MinfMax)    it <- 0    repeat {        it <- it + 1        nMres <- nM$newf(fn(nM$xeval()))        if (nMres != 0L)             break    }    cmsg <- "reached max evaluations"    if (nMres == -4) {        cmsg <- warning(sprintf("failure to converge in %d evaluations",             cc$maxfun))        nMres <- 4    }    msgvec <- c("nm_forced", "cannot generate a feasible simplex",         "initial x is not feasible", "active", "objective function went below allowed minimum",         "objective function values converged to within tolerance",         "parameter values converged to within tolerance", cmsg)    if (nMres < 0) {        (if (cc$warnOnly)             warning        else stop)(msgvec[nMres + 4])    }    list(fval = nM$value(), par = nM$xpos(), convergence = pmin(0,         nMres), NM.result = nMres, message = msgvec[nMres + 4],         control = c(cc, xst = xst, xt = xt), feval = it)})(fn = function (pars) {    resp$setOffset(baseOffset)    resp$updateMu(lp0)    pp$setTheta(as.double(pars[dpars]))    spars <- as.numeric(pars[-dpars])    offset <- if (length(spars) == 0)         baseOffset    else baseOffset + pp$X %*% spars    resp$setOffset(offset)    p <- pwrssUpdate(pp, resp, tol = tolPwrss, GQmat = GQmat,         compDev = compDev, grpFac = fac, maxit = maxit, verbose = verbose)    resp$updateWts()    p}, par = c(0.413433585767537, 1.07698303301472, -0.466769350199216, 0.136850450091159, 7.35801943472411, -0.0159911419847054, 1.4732515814105, 0.638497477673346, -0.59269913700384), lower = c(0, 0, -Inf, 0, -Inf, -Inf, -Inf, -Inf, -Inf), upper = c(Inf, Inf, Inf, Inf, Inf, Inf, Inf, Inf, Inf), control = list(xst = c(0.02, 0.02, 0.02, 0.02, 0.280569077466124, 0.000599804000106246, 0.0200768148258394, 0.0321910539277337, 0.0394122792574391), xt = c(1e-05, 1e-05, 1e-05, 1e-05, 0.000140284538733062, 2.99902000053123e-07, 1.00384074129197e-05, 1.60955269638669e-05, 1.97061396287195e-05), verbose = 0L))
   7: do.call(optfun, arglist)
   8: withCallingHandlers(do.call(optfun, arglist), warning = function(w) {    curWarnings <<- append(curWarnings, list(w$message))})
   9: optwrap(optimizer, devfun, start, rho$lower, control = control,     adj = adj, verbose = verbose, ...)
  10: optimizeGlmer(devfun, optimizer = control$optimizer[[2]], restart_edge = control$restart_edge,     boundary.tol = control$boundary.tol, control = control$optCtrl,     start = start, nAGQ = nAGQ, verbose = verbose, stage = 2,     calc.derivs = control$calc.derivs, use.last.params = control$use.last.params)
  11: glmer(TICKS ~ HEIGHT + DUMMY + YEAR + (1 | BROOD) + (DUMMY |     LOCATION), family = poisson, data = grouseticks)
  An irrecoverable exception occurred. R is aborting now ...