tests/testthat/test-subboot.R

In merTools: Tools for Analyzing Mixed Effect Regression Models

# test subboot

set.seed(51315)
library(lme4)
# Sleepstudy
lmerSlope1 <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy)


###############################################
# Extract theta----
#context("Extract theta using subBoot")
################################################

test_that("extract theta produces a vector", {
  expect_type(thetaExtract(lmerSlope1), "double")
  expect_equal(length(thetaExtract(lmerSlope1)), 3)
})

test_that("thetaExtract throws errors for non-merMod objects", {
  expect_error(thetaExtract(lmerSlope1@frame))
  m1 <- lm(mpg ~ disp + hp, data = mtcars)
  expect_error(thetaExtract(m1))
})

###############################################
# subBoot----
#context("subBoot")
################################################

test_that("subBoot produces correct output", {
  skip_on_cran()
  # Subbooot returns errors here
  out1 <- subBoot(lmerSlope1, n = 100, FUN = thetaExtract, R = 100)
  expect_s3_class(out1, "data.frame")
  expect_equal(ncol(out1), 4)
  expect_equal(nrow(out1), 101)

  out2 <- subBoot(lmerSlope1, n = 100,
                  FUN = function(x) getME(x, "fixef"),
                  R = 100)
  expect_s3_class(out2, "data.frame")
  expect_equal(ncol(out2), 3)
  expect_equal(nrow(out2), 101)
})

#context("subBoot glmer models")



test_that("subBoot produces correct glmer output", {
  skip_on_cran()
  d <- expand.grid(fac1 = LETTERS[1:5],
                   grp = letters[11:20],
                   obs = 1:50)
  d$y <- simulate(~fac1 + (1 | grp), family = binomial,
                  newdata = d,
                  newparams = list( beta = c(2,-1,3,-2,1.2),
                                    theta = c(.33)),
                  seed =634)[[1]]
  subD <- d[sample(row.names(d), 1200), ]

  g1 <- glmer(y~fac1+(1|grp), data=subD, family = 'binomial')

  out1 <- subBoot(g1, n = 1000, FUN = thetaExtract, R = 10)
  expect_s3_class(out1, "data.frame")
  expect_equal(ncol(out1), 2)
  expect_equal(nrow(out1), 11)
  #
  out2 <- subBoot(g1, n = 500,
                  FUN = function(x) getME(x, "fixef"),
                  R = 10)
  expect_s3_class(out2, "data.frame")
  expect_equal(ncol(out2), 6)
  expect_equal(nrow(out2), 11)

})