1context("emmeans")
2
3skip_on_cran()
4
5skip_if_not_installed("modeltests")
6library(modeltests)
7
8skip_if_not_installed("lsmeans")
9library(lsmeans)
10
11skip_if_not_installed("lme4")
12library(lme4)
13
14fit <- lm(sales1 ~ price1 + price2 + day + store, data = oranges)
15rg <- ref.grid(fit)
16
17marginal <- lsmeans(rg, ~day)
18
19marginal_summary <- summary(marginal, infer = TRUE)
20joint_tests_summary <- joint_tests(fit)
21
22# generate dataset with dashes
23marginal_dashes <- tibble(
24  y = rnorm(100),
25  x = rep(c("Single", "Double-Barrelled"), 50)
26) %>%
27  lm(y ~ x, data = .) %>%
28  lsmeans::lsmeans(., ~x) %>%
29  lsmeans::contrast(., "pairwise")
30
31test_that("lsmeans tidier arguments", {
32  check_arguments(tidy.lsmobj, strict = FALSE)
33  check_arguments(tidy.ref.grid)
34  check_arguments(tidy.emmGrid)
35})
36
37test_that("tidy.lsmobj", {
38  tdm <- tidy(marginal)
39  tdmd <- tidy(marginal_dashes)
40  tdc <- tidy(contrast(marginal, method = "pairwise"))
41
42  check_tidy_output(tdm, strict = FALSE)
43  check_tidy_output(tdmd, strict = FALSE)
44  check_tidy_output(tdc, strict = FALSE)
45
46  check_dims(tdm, 6, 6)
47  check_dims(tdmd, 1, 8)
48  check_dims(tdc, 15, 8)
49
50  tdm <- tidy(marginal, conf.int = TRUE)
51  tdmd <- tidy(marginal_dashes, conf.int = TRUE)
52  tdc <- tidy(contrast(marginal, method = "pairwise"), conf.int = TRUE)
53
54  check_dims(tdm, 6, 8)
55  check_dims(tdmd, 1, 10)
56  check_dims(tdc, 15, 10)
57})
58
59test_that("ref.grid tidiers work", {
60  td <- tidy(rg)
61  check_tidy_output(td, strict = FALSE)
62  check_dims(td, 36, 9)
63
64  td <- tidy(rg, conf.int = TRUE)
65  check_dims(td, 36, 11)
66})
67
68test_that("summary_emm tidiers work", {
69  tdm <- tidy(marginal, conf.int = TRUE)
70  tdms <- tidy(marginal_summary)
71
72  expect_identical(tdm, tdms)
73
74  tdjt <- tidy(joint_tests_summary)
75  check_tidy_output(tdjt)
76  check_dims(tdjt, 4, 5)
77
78
79  glmm <- glmer(
80    cbind(incidence, size - incidence) ~ period + (1 | herd),
81    data = cbpp, family = binomial
82  )
83  emm_glmm <- emmeans(glmm, ~period)
84  tdm <- tidy(emm_glmm, conf.int = TRUE)
85
86  check_tidy_output(tdm[, -1])
87})
88
89test_that("tidy.ref.grid consistency with tidy.TukeyHSD", {
90  amod <- aov(breaks ~ wool + tension, data = warpbreaks)
91  td_hsd <- tidy(TukeyHSD(amod, "tension"))
92
93  td_pairs <- lsmeans(amod, ~tension) %>%
94    pairs(reverse = TRUE) %>%
95    tidy(conf.int = TRUE) %>%
96    dplyr::select(-statistic, -df, -std.error) %>%
97    mutate(contrast = gsub(" ", "", contrast))
98
99  expect_equal(
100    as.data.frame(td_hsd),
101    as.data.frame(td_pairs),
102  )
103})
104
105test_that("tidy.ref.grid consistency with tidy.glht", {
106  pigs.aov <- aov(log(conc) ~ source, data = pigs)
107  pigs.emm.s <- emmeans(pigs.aov, "source")
108
109  pigs.emm_c <- contrast(
110    pigs.emm.s,
111    list(lambda1 = c(1, 2, 0), lambda2 = c(0, 3, -2)),
112    offset = c(-7, 1),
113    adjust = "none"
114  )
115
116  td_emm <- tidy(pigs.emm_c) %>%
117    dplyr::select(-df)
118
119  pigs.aov <- aov(log(conc) ~ 0 + source, data = pigs)
120  K <- rbind(
121    c(1, 2, 0),
122    c(0, 3, -2)
123  )
124  rownames(K) <- c("lambda1", "lambda2")
125  colnames(K) <- names(coef(pigs.aov))
126
127  aov_glht <- multcomp::glht(pigs.aov, linfct = multcomp::mcp(source = K), rhs = c(7, -1))
128  tidy_glht <- tidy(aov_glht, test = multcomp::adjusted("none")) %>%
129    mutate(
130      estimate = estimate - null.value,
131      null.value = -null.value
132    )
133
134  expect_equal(
135    as.data.frame(td_emm),
136    as.data.frame(purrr::map_dfr(tidy_glht, unname)),
137    tolerance = 0.000001
138  )
139})
140
141test_that("tidy.emmGrid for combined contrasts", {
142  noise.lm <- lm(noise ~ size * type * side, data = auto.noise)
143  noise.emm <- emmeans(noise.lm, ~ size * side * type)
144  noise_c.s <- contrast(noise.emm,
145                        method = "consec",
146                        simple = "each",
147                        combine = TRUE,
148                        adjust = "mvt")
149  td_noise <- tidy(noise_c.s)
150
151  # strict = FALSE needed becasue of factor names and "null.value" column
152  check_tidy_output(td_noise, strict = FALSE)
153  check_dims(td_noise, 20, 10)
154})
155