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