Skip to content

Commit d3db8e8

Browse files
strengejackestrengejacke
committed
Replace snapshot tests
1 parent 6d70fb9 commit d3db8e8

1 file changed

Lines changed: 228 additions & 95 deletions

File tree

‎tests/testthat/test-printing.R‎

Lines changed: 228 additions & 95 deletions
Original file line numberDiff line numberDiff line change
@@ -2,119 +2,252 @@ skip_on_cran()
22
skip_if_not_installed("withr")
33
skip_if(getRversion() < "4.0.0")
44

5-
withr::with_options(
6-
list(parameters_interaction = "*", easystats_table_width = Inf),
7-
{
8-
# Splitting model components ----
9-
test_that("print model with multiple components", {
10-
skip_if_not_installed("glmmTMB")
11-
data("Salamanders", package = "glmmTMB")
12-
model <- glmmTMB::glmmTMB(count ~ spp + mined + (1 | site),
13-
ziformula = ~ spp + mined,
14-
family = glmmTMB::nbinom2(),
15-
data = Salamanders
5+
withr::with_options(list(parameters_interaction = "*", easystats_table_width = Inf), {
6+
# Splitting model components ----
7+
test_that("print model with multiple components", {
8+
skip_if_not_installed("glmmTMB")
9+
data("Salamanders", package = "glmmTMB")
10+
model <- glmmTMB::glmmTMB(
11+
count ~ spp + mined + (1 | site),
12+
ziformula = ~ spp + mined,
13+
family = glmmTMB::nbinom2(),
14+
data = Salamanders
15+
)
16+
out <- model_parameters(model, exponentiate = TRUE)
17+
expect_identical(
18+
capture.output(print(out)),
19+
c(
20+
"# Fixed Effects (Count Model)",
21+
"",
22+
"Parameter | IRR | SE | 95% CI | z | p",
23+
"---------------------------------------------------------",
24+
"(Intercept) | 0.54 | 0.22 | [0.25, 1.20] | -1.51 | 0.132 ",
25+
"spp [PR] | 0.38 | 0.25 | [0.11, 1.35] | -1.50 | 0.134 ",
26+
"spp [DM] | 1.19 | 0.28 | [0.75, 1.88] | 0.73 | 0.468 ",
27+
"spp [EC-A] | 0.68 | 0.23 | [0.35, 1.33] | -1.13 | 0.258 ",
28+
"spp [EC-L] | 1.63 | 0.39 | [1.02, 2.60] | 2.05 | 0.041 ",
29+
"spp [DES-L] | 1.80 | 0.41 | [1.15, 2.82] | 2.59 | 0.010 ",
30+
"spp [DF] | 0.89 | 0.22 | [0.55, 1.44] | -0.46 | 0.642 ",
31+
"mined [no] | 4.18 | 1.53 | [2.04, 8.57] | 3.90 | < .001",
32+
"",
33+
"# Fixed Effects (Zero-Inflation Component)",
34+
"",
35+
"Parameter | Odds Ratio | SE | 95% CI | z | p",
36+
"----------------------------------------------------------------",
37+
"(Intercept) | 2.48 | 1.56 | [0.73, 8.51] | 1.45 | 0.147 ",
38+
"spp [PR] | 3.19 | 4.26 | [0.23, 43.70] | 0.87 | 0.384 ",
39+
"spp [DM] | 0.39 | 0.31 | [0.08, 1.88] | -1.17 | 0.241 ",
40+
"spp [EC-A] | 2.84 | 2.02 | [0.70, 11.49] | 1.46 | 0.144 ",
41+
"spp [EC-L] | 0.57 | 0.41 | [0.14, 2.37] | -0.77 | 0.439 ",
42+
"spp [DES-L] | 0.41 | 0.31 | [0.09, 1.79] | -1.19 | 0.236 ",
43+
"spp [DF] | 0.08 | 0.17 | [0.00, 5.68] | -1.16 | 0.244 ",
44+
"mined [no] | 0.08 | 0.05 | [0.02, 0.25] | -4.24 | < .001",
45+
"",
46+
"# Dispersion",
47+
"",
48+
"Parameter | Coefficient | 95% CI",
49+
"----------------------------------------",
50+
"(Intercept) | 1.51 | [0.93, 2.46]",
51+
"",
52+
"# Random Effects Variances",
53+
"",
54+
"Parameter | Coefficient | 95% CI",
55+
"-------------------------------------------------",
56+
"SD (Intercept: site) | 0.38 | [0.17, 0.87]"
57+
)
58+
)
59+
expect_identical(
60+
capture.output(print(out, split_component = FALSE)),
61+
c(
62+
"# Fixed Effects",
63+
"",
64+
"Parameter | Coefficient | SE | 95% CI | z | p | Effects | Component",
65+
"----------------------------------------------------------------------------------------------------",
66+
"(Intercept) | 0.54 | 0.22 | [0.25, 1.20] | -1.51 | 0.132 | fixed | conditional",
67+
"spp [PR] | 0.38 | 0.25 | [0.11, 1.35] | -1.50 | 0.134 | fixed | conditional",
68+
"spp [DM] | 1.19 | 0.28 | [0.75, 1.88] | 0.73 | 0.468 | fixed | conditional",
69+
"spp [EC-A] | 0.68 | 0.23 | [0.35, 1.33] | -1.13 | 0.258 | fixed | conditional",
70+
"spp [EC-L] | 1.63 | 0.39 | [1.02, 2.60] | 2.05 | 0.041 | fixed | conditional",
71+
"spp [DES-L] | 1.80 | 0.41 | [1.15, 2.82] | 2.59 | 0.010 | fixed | conditional",
72+
"spp [DF] | 0.89 | 0.22 | [0.55, 1.44] | -0.46 | 0.642 | fixed | conditional",
73+
"mined [no] | 4.18 | 1.53 | [2.04, 8.57] | 3.90 | < .001 | fixed | conditional",
74+
"(Intercept) | 2.48 | 1.56 | [0.73, 8.51] | 1.45 | 0.147 | fixed | zero_inflated",
75+
"sppPR | 3.19 | 4.26 | [0.23, 43.70] | 0.87 | 0.384 | fixed | zero_inflated",
76+
"sppDM | 0.39 | 0.31 | [0.08, 1.88] | -1.17 | 0.241 | fixed | zero_inflated",
77+
"sppEC-A | 2.84 | 2.02 | [0.70, 11.49] | 1.46 | 0.144 | fixed | zero_inflated",
78+
"sppEC-L | 0.57 | 0.41 | [0.14, 2.37] | -0.77 | 0.439 | fixed | zero_inflated",
79+
"sppDES-L | 0.41 | 0.31 | [0.09, 1.79] | -1.19 | 0.236 | fixed | zero_inflated",
80+
"sppDF | 0.08 | 0.17 | [0.00, 5.68] | -1.16 | 0.244 | fixed | zero_inflated",
81+
"minedno | 0.08 | 0.05 | [0.02, 0.25] | -4.24 | < .001 | fixed | zero_inflated",
82+
"(Intercept) | 1.51 | | [0.93, 2.46] | | | fixed | dispersion",
83+
"SD (Intercept: site) | 0.38 | | [0.17, 0.87] | | | random | conditional"
1684
)
17-
out <- model_parameters(model, exponentiate = TRUE)
18-
expect_snapshot(print(out))
19-
expect_snapshot(print(out, split_component = FALSE))
20-
})
85+
)
86+
})
2187

22-
# Adding model summaries -----
23-
test_that("adding model summaries", {
24-
# summary doesn't show the R2 if performance is not installed so the
25-
# snapshot breaks between R CMD check "classic" and "strict"
26-
skip_if_not_installed("performance")
27-
model <- lm(Sepal.Length ~ Species * Petal.Length, data = iris)
28-
out <- model_parameters(model, include_info = TRUE)
29-
expect_snapshot(print(out))
30-
})
88+
# Adding model summaries -----
89+
test_that("adding model summaries", {
90+
# summary doesn't show the R2 if performance is not installed so the
91+
# snapshot breaks between R CMD check "classic" and "strict"
92+
skip_if_not_installed("performance")
93+
model <- lm(Sepal.Length ~ Species * Petal.Length, data = iris)
94+
out <- model_parameters(model, include_info = TRUE)
95+
expect_identical(
96+
capture.output(print(out)),
97+
c(
98+
"Parameter | Coefficient | SE | 95% CI | t(144) | p",
99+
"-------------------------------------------------------------------------------------------",
100+
"(Intercept) | 4.21 | 0.41 | [ 3.41, 5.02] | 10.34 | < .001",
101+
"Species [versicolor] | -1.81 | 0.60 | [-2.99, -0.62] | -3.02 | 0.003 ",
102+
"Species [virginica] | -3.15 | 0.63 | [-4.41, -1.90] | -4.97 | < .001",
103+
"Petal Length | 0.54 | 0.28 | [ 0.00, 1.09] | 1.96 | 0.052 ",
104+
"Species [versicolor] * Petal Length | 0.29 | 0.30 | [-0.30, 0.87] | 0.97 | 0.334 ",
105+
"Species [virginica] * Petal Length | 0.45 | 0.29 | [-0.12, 1.03] | 1.56 | 0.120 ",
106+
"",
107+
"Model: Sepal.Length ~ Species * Petal.Length (150 Observations)",
108+
"Sigma: 0.336 (df = 144)",
109+
"RMSE : 0.330",
110+
"R2: 0.840; adjusted R2: 0.835"
111+
)
112+
)
113+
})
31114

32-
# Group parameters ------
33-
test_that("grouped parameters", {
34-
mtcars$cyl <- as.factor(mtcars$cyl)
35-
mtcars$gear <- as.factor(mtcars$gear)
36-
model <- lm(mpg ~ hp + gear * vs + cyl + drat, data = mtcars)
115+
# Group parameters ------
116+
test_that("grouped parameters", {
117+
mtcars$cyl <- as.factor(mtcars$cyl)
118+
mtcars$gear <- as.factor(mtcars$gear)
119+
model <- lm(mpg ~ hp + gear * vs + cyl + drat, data = mtcars)
37120

38-
# don't select "Intercept" parameter
39-
out <- model_parameters(model, drop = "^\\(Intercept")
40-
expect_snapshot(
41-
print(out, groups = list(
121+
# don't select "Intercept" parameter
122+
out <- model_parameters(model, drop = "^\\(Intercept")
123+
expect_identical(
124+
capture.output(print(
125+
out,
126+
groups = list(
42127
Engine = c(5, 6, 4, 1), # c("cyl6", "cyl8", "vs", "hp"),
43128
Interactions = c(8, 9), # c("gear4:vs", "gear5:vs"),
44129
Controls = c(2, 3, 7)
45-
))
130+
)
131+
)),
132+
c(
133+
"Parameter | Coefficient | SE | 95% CI | t(22) | p",
134+
"----------------------------------------------------------------------",
135+
"Engine | | | | | ",
136+
" cyl [6] | -2.47 | 2.21 | [ -7.05, 2.12] | -1.12 | 0.276",
137+
" cyl [8] | 1.97 | 5.11 | [ -8.63, 12.58] | 0.39 | 0.703",
138+
" vs | 3.18 | 3.79 | [ -4.68, 11.04] | 0.84 | 0.410",
139+
" hp | -0.06 | 0.02 | [ -0.11, -0.02] | -2.91 | 0.008",
140+
"Interactions | | | | | ",
141+
" gear [4] * vs | -2.90 | 4.67 | [-12.57, 6.78] | -0.62 | 0.541",
142+
" gear [5] * vs | 2.59 | 4.54 | [ -6.82, 12.00] | 0.57 | 0.574",
143+
"Controls | | | | | ",
144+
" gear [4] | 3.10 | 4.34 | [ -5.90, 12.10] | 0.71 | 0.482",
145+
" gear [5] | 4.80 | 3.48 | [ -2.42, 12.01] | 1.38 | 0.182",
146+
" drat | 2.70 | 2.03 | [ -1.52, 6.91] | 1.33 | 0.198"
46147
)
47-
expect_snapshot(
48-
print(out, groups = list(
148+
)
149+
expect_identical(
150+
capture.output(print(
151+
out,
152+
groups = list(
49153
Engine = c("cyl [6]", "cyl [8]", "vs", "hp"),
50154
Interactions = c("gear [4] * vs", "gear [5] * vs"),
51155
Controls = c(2, 3, 7)
52-
))
53-
)
54-
expect_snapshot(
55-
print(out,
56-
sep = " ",
57-
groups = list(
58-
Engine = c(5, 6, 4, 1),
59-
Interactions = c(8, 9),
60-
Controls = c(2, 3, 7)
61-
)
62156
)
157+
)),
158+
c(
159+
"Parameter | Coefficient | SE | 95% CI | t(22) | p",
160+
"----------------------------------------------------------------------",
161+
"Engine | | | | | ",
162+
" cyl [6] | -2.47 | 2.21 | [ -7.05, 2.12] | -1.12 | 0.276",
163+
" cyl [8] | 1.97 | 5.11 | [ -8.63, 12.58] | 0.39 | 0.703",
164+
" vs | 3.18 | 3.79 | [ -4.68, 11.04] | 0.84 | 0.410",
165+
" hp | -0.06 | 0.02 | [ -0.11, -0.02] | -2.91 | 0.008",
166+
"Interactions | | | | | ",
167+
" gear [4] * vs | -2.90 | 4.67 | [-12.57, 6.78] | -0.62 | 0.541",
168+
" gear [5] * vs | 2.59 | 4.54 | [ -6.82, 12.00] | 0.57 | 0.574",
169+
"Controls | | | | | ",
170+
" gear [4] | 3.10 | 4.34 | [ -5.90, 12.10] | 0.71 | 0.482",
171+
" gear [5] | 4.80 | 3.48 | [ -2.42, 12.01] | 1.38 | 0.182",
172+
" drat | 2.70 | 2.03 | [ -1.52, 6.91] | 1.33 | 0.198"
63173
)
64-
})
65-
66-
67-
# Digits ------
68-
test_that("digits and ci_digits", {
69-
mtcars$cyl <- as.factor(mtcars$cyl)
70-
mtcars$gear <- as.factor(mtcars$gear)
71-
model <- lm(mpg ~ hp + gear + vs + cyl + drat, data = mtcars)
72-
expect_snapshot(model_parameters(model, digits = 4))
73-
expect_snapshot(model_parameters(model, digits = 4, ci_digits = 1))
74-
out <- model_parameters(model)
75-
expect_snapshot(print(out, digits = 4))
76-
expect_snapshot(print(out, digits = 4, ci_digits = 1))
77-
})
78-
79-
80-
# Table templates ------
81-
test_that("select pattern", {
82-
mtcars$cyl <- as.factor(mtcars$cyl)
83-
mtcars$gear <- as.factor(mtcars$gear)
84-
model <- lm(mpg ~ hp + gear * vs + cyl + drat, data = mtcars)
85-
86-
# don't select "Intercept" parameter
87-
out <- model_parameters(model, drop = "^\\(Intercept")
88-
expect_snapshot(
89-
print(out, groups = list(
90-
Engine = c(5, 6, 4, 1),
91-
Interactions = c(8, 9),
92-
Controls = c(2, 3, 7)
93-
))
94-
)
95-
expect_snapshot(print(out, select = "{coef} ({se})"))
96-
expect_snapshot(print(out, select = "{coef}{stars}|[{ci}]"))
97-
expect_snapshot(
98-
print(out, groups = list(
174+
)
175+
expect_identical(
176+
capture.output(print(
177+
out,
178+
sep = " ",
179+
groups = list(
99180
Engine = c(5, 6, 4, 1),
100181
Interactions = c(8, 9),
101182
Controls = c(2, 3, 7)
102-
), select = "{coef}{stars}|[{ci}]")
103-
)
104-
expect_snapshot(
105-
print(out,
106-
sep = " ",
107-
groups = list(
108-
Engine = c(5, 6, 4, 1),
109-
Interactions = c(8, 9),
110-
Controls = c(2, 3, 7)
111-
),
112-
select = "{coef}{stars}|[{ci}]"
113183
)
184+
)),
185+
c(
186+
"Parameter Coefficient SE 95% CI t(22) p",
187+
"-----------------------------------------------------------------",
188+
"Engine ",
189+
" cyl [6] -2.47 2.21 [ -7.05, 2.12] -1.12 0.276",
190+
" cyl [8] 1.97 5.11 [ -8.63, 12.58] 0.39 0.703",
191+
" vs 3.18 3.79 [ -4.68, 11.04] 0.84 0.410",
192+
" hp -0.06 0.02 [ -0.11, -0.02] -2.91 0.008",
193+
"Interactions ",
194+
" gear [4] * vs -2.90 4.67 [-12.57, 6.78] -0.62 0.541",
195+
" gear [5] * vs 2.59 4.54 [ -6.82, 12.00] 0.57 0.574",
196+
"Controls ",
197+
" gear [4] 3.10 4.34 [ -5.90, 12.10] 0.71 0.482",
198+
" gear [5] 4.80 3.48 [ -2.42, 12.01] 1.38 0.182",
199+
" drat 2.70 2.03 [ -1.52, 6.91] 1.33 0.198"
114200
)
115-
})
116-
}
117-
)
201+
)
202+
})
203+
204+
# Digits ------
205+
test_that("digits and ci_digits", {
206+
mtcars$cyl <- as.factor(mtcars$cyl)
207+
mtcars$gear <- as.factor(mtcars$gear)
208+
model <- lm(mpg ~ hp + gear + vs + cyl + drat, data = mtcars)
209+
expect_snapshot(model_parameters(model, digits = 4))
210+
expect_snapshot(model_parameters(model, digits = 4, ci_digits = 1))
211+
out <- model_parameters(model)
212+
expect_snapshot(print(out, digits = 4))
213+
expect_snapshot(print(out, digits = 4, ci_digits = 1))
214+
})
215+
216+
# Table templates ------
217+
test_that("select pattern", {
218+
mtcars$cyl <- as.factor(mtcars$cyl)
219+
mtcars$gear <- as.factor(mtcars$gear)
220+
model <- lm(mpg ~ hp + gear * vs + cyl + drat, data = mtcars)
221+
222+
# don't select "Intercept" parameter
223+
out <- model_parameters(model, drop = "^\\(Intercept")
224+
expect_snapshot(print(
225+
out,
226+
groups = list(Engine = c(5, 6, 4, 1), Interactions = c(8, 9), Controls = c(2, 3, 7))
227+
))
228+
expect_snapshot(print(out, select = "{coef} ({se})"))
229+
expect_snapshot(print(out, select = "{coef}{stars}|[{ci}]"))
230+
expect_snapshot(print(
231+
out,
232+
groups = list(
233+
Engine = c(5, 6, 4, 1),
234+
Interactions = c(8, 9),
235+
Controls = c(2, 3, 7)
236+
),
237+
select = "{coef}{stars}|[{ci}]"
238+
))
239+
expect_snapshot(print(
240+
out,
241+
sep = " ",
242+
groups = list(
243+
Engine = c(5, 6, 4, 1),
244+
Interactions = c(8, 9),
245+
Controls = c(2, 3, 7)
246+
),
247+
select = "{coef}{stars}|[{ci}]"
248+
))
249+
})
250+
})
118251

119252
withr::with_options(
120253
list(parameters_warning_exponentiate = TRUE),

0 commit comments

Comments
 (0)