Skip to content

Commit 201bce9

Browse files
strengejackestrengejacke
committed
add tests
1 parent 146fc2b commit 201bce9

2 files changed

Lines changed: 170 additions & 44 deletions

File tree

‎R/estimate_slopes.R‎

Lines changed: 9 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -142,8 +142,16 @@ estimate_slopes <- function(
142142
backend <- getOption("modelbased_backend", "marginaleffects")
143143
}
144144

145+
trend_missing <- missing(trend)
146+
145147
# handle alias
146-
if (missing(trend)) {
148+
if (!trend_missing && !missing(slope) && !identical(trend, slope)) {
149+
insight::format_warning(
150+
"Both `slope` and `trend` were provided with different values. Please use only `slope` in future code."
151+
)
152+
trend <- slope
153+
}
154+
if (trend_missing) {
147155
trend <- slope
148156
}
149157

‎tests/testthat/test-estimate_slopes.R‎

Lines changed: 161 additions & 43 deletions
Original file line numberDiff line numberDiff line change
@@ -11,47 +11,118 @@ test_that("estimate_slopes", {
1111
expect_identical(dim(estim1), c(1L, 8L))
1212
expect_equal(estim1$Slope, estim2$Slope, tolerance = 1e-4)
1313

14+
# aliases
15+
estim1 <- estimate_slopes(model, slope = "Petal.Length")
16+
estim2 <- estimate_slopes(model, trend = "Petal.Length")
17+
expect_equal(estim1$Slope, estim2$Slope, tolerance = 1e-4)
18+
19+
expect_warning(
20+
{
21+
estim3 <- estimate_slopes(model, slope = "Petal.Length", trend = "Species")
22+
},
23+
regex = "Both `slope` and `trend` were provided",
24+
fixed = TRUE
25+
)
26+
expect_equal(estim1$Slope, estim3$Slope, tolerance = 1e-4)
27+
1428
estim1 <- suppressMessages(estimate_slopes(model, by = "Species", backend = "emmeans"))
15-
estim2 <- suppressMessages(estimate_slopes(model, by = "Species", backend = "marginaleffects"))
29+
estim2 <- suppressMessages(estimate_slopes(
30+
model,
31+
by = "Species",
32+
backend = "marginaleffects"
33+
))
1634
expect_identical(dim(estim1), c(3L, 9L))
1735
expect_equal(estim1$Slope, estim2$Slope, tolerance = 1e-4)
1836

19-
estim1 <- suppressMessages(estimate_slopes(model, by = "Petal.Length", backend = "emmeans"))
20-
estim2 <- suppressMessages(estimate_slopes(model, by = "Petal.Length", backend = "marginaleffects"))
37+
estim1 <- suppressMessages(estimate_slopes(
38+
model,
39+
by = "Petal.Length",
40+
backend = "emmeans"
41+
))
42+
estim2 <- suppressMessages(estimate_slopes(
43+
model,
44+
by = "Petal.Length",
45+
backend = "marginaleffects"
46+
))
2147
expect_identical(dim(estim1), c(10L, 9L))
2248
expect_equal(estim1$Slope, estim2$Slope, tolerance = 0.2)
2349

24-
estim1 <- suppressMessages(estimate_slopes(model, by = c("Species", "Petal.Length"), backend = "emmeans"))
50+
estim1 <- suppressMessages(estimate_slopes(
51+
model,
52+
by = c("Species", "Petal.Length"),
53+
backend = "emmeans"
54+
))
2555
expect_identical(dim(estim1), c(30L, 10L))
2656

27-
estim2 <- suppressMessages(estimate_slopes(model, by = c("Species", "Petal.Length"), preserve_range = FALSE, backend = "marginaleffects"))
57+
estim2 <- suppressMessages(estimate_slopes(
58+
model,
59+
by = c("Species", "Petal.Length"),
60+
preserve_range = FALSE,
61+
backend = "marginaleffects"
62+
))
2863
expect_identical(dim(estim2), c(30L, 9L))
29-
expect_equal(estim1$Slope, estim2$Slope[order(estim2$Petal.Length, estim2$Species)], tolerance = 1e-3)
64+
expect_equal(
65+
estim1$Slope,
66+
estim2$Slope[order(estim2$Petal.Length, estim2$Species)],
67+
tolerance = 1e-3
68+
)
3069

3170
# test different DF
32-
estim1 <- suppressMessages(estimate_slopes(model, by = "Petal.Length", backend = "marginaleffects"))
33-
estim2 <- suppressMessages(estimate_slopes(model, by = "Petal.Length", df = Inf, backend = "marginaleffects"))
71+
estim1 <- suppressMessages(estimate_slopes(
72+
model,
73+
by = "Petal.Length",
74+
backend = "marginaleffects"
75+
))
76+
estim2 <- suppressMessages(estimate_slopes(
77+
model,
78+
by = "Petal.Length",
79+
df = Inf,
80+
backend = "marginaleffects"
81+
))
3482
expect_named(
3583
estim1,
3684
c("Petal.Length", "Slope", "SE", "CI_low", "CI_high", "t", "df", "p")
3785
)
38-
expect_named(
39-
estim2,
40-
c("Petal.Length", "Slope", "SE", "CI_low", "CI_high", "z", "p")
41-
)
86+
expect_named(estim2, c("Petal.Length", "Slope", "SE", "CI_low", "CI_high", "z", "p"))
4287

4388
model <- lm(Petal.Length ~ poly(Sepal.Width, 4), data = iris)
4489

45-
estim1 <- suppressMessages(estimate_slopes(model, by = "Sepal.Width", backend = "emmeans"))
46-
estim2 <- suppressMessages(estimate_slopes(model, by = "Sepal.Width", backend = "marginaleffects"))
90+
estim1 <- suppressMessages(estimate_slopes(
91+
model,
92+
by = "Sepal.Width",
93+
backend = "emmeans"
94+
))
95+
estim2 <- suppressMessages(estimate_slopes(
96+
model,
97+
by = "Sepal.Width",
98+
backend = "marginaleffects"
99+
))
47100
expect_identical(dim(estim1), c(10L, 9L))
48101
expect_equal(estim1$Slope, estim2$Slope, tolerance = 0.2)
49-
estim1 <- suppressMessages(estimate_slopes(model, by = "Sepal.Width", length = 5, backend = "emmeans"))
50-
estim2 <- suppressMessages(estimate_slopes(model, by = "Sepal.Width", length = 5, backend = "marginaleffects"))
102+
estim1 <- suppressMessages(estimate_slopes(
103+
model,
104+
by = "Sepal.Width",
105+
length = 5,
106+
backend = "emmeans"
107+
))
108+
estim2 <- suppressMessages(estimate_slopes(
109+
model,
110+
by = "Sepal.Width",
111+
length = 5,
112+
backend = "marginaleffects"
113+
))
51114
expect_identical(dim(estim1), c(5L, 9L))
52115
expect_equal(estim1$Slope, estim2$Slope, tolerance = 0.2)
53-
estim1 <- suppressMessages(estimate_slopes(model, by = "Sepal.Width = c(1, 2, 3)", backend = "emmeans"))
54-
estim2 <- suppressMessages(estimate_slopes(model, by = "Sepal.Width = c(1, 2, 3)", backend = "marginaleffects"))
116+
estim1 <- suppressMessages(estimate_slopes(
117+
model,
118+
by = "Sepal.Width = c(1, 2, 3)",
119+
backend = "emmeans"
120+
))
121+
estim2 <- suppressMessages(estimate_slopes(
122+
model,
123+
by = "Sepal.Width = c(1, 2, 3)",
124+
backend = "marginaleffects"
125+
))
55126
expect_identical(dim(estim1), c(3L, 9L))
56127
expect_equal(estim1$Slope, estim2$Slope, tolerance = 0.2)
57128
})
@@ -64,35 +135,45 @@ test_that("estimate_slopes, johnson-neyman p-adjust", {
64135
expect_equal(
65136
out$CI_low,
66137
c(
67-
-0.83863, -0.66978, -0.50396, -0.34188, -0.18459, -0.03252,
68-
0.11384, 0.25426, 0.38899, 0.51855
138+
-0.83863,
139+
-0.66978,
140+
-0.50396,
141+
-0.34188,
142+
-0.18459,
143+
-0.03252,
144+
0.11384,
145+
0.25426,
146+
0.38899,
147+
0.51855
69148
),
70149
tolerance = 1e-2
71150
)
72151
expect_equal(
73152
out$p,
74-
c(
75-
0.00664, 0.03956, 0.20019, 0.70529, 0.52501, 0.08553, 0.00496,
76-
0.00013, 0, 0
77-
),
153+
c(0.00664, 0.03956, 0.20019, 0.70529, 0.52501, 0.08553, 0.00496, 0.00013, 0, 0),
78154
tolerance = 1e-2
79155
)
80156

81157
out <- estimate_slopes(model, "Petal.Width", by = "Petal.Length", p_adjust = "esarey")
82158
expect_equal(
83159
out$CI_low,
84160
c(
85-
-0.89944, -0.72628, -0.55667, -0.39145, -0.23184, -0.07835,
86-
0.06843, 0.20825, 0.3414, 0.46848
161+
-0.89944,
162+
-0.72628,
163+
-0.55667,
164+
-0.39145,
165+
-0.23184,
166+
-0.07835,
167+
0.06843,
168+
0.20825,
169+
0.3414,
170+
0.46848
87171
),
88172
tolerance = 1e-2
89173
)
90174
expect_equal(
91175
out$p,
92-
c(
93-
0.03438, 0.14813, 0.50393, 0.83427, 0.24689, 0.03326, 0.00219,
94-
9e-05, 0, 0
95-
),
176+
c(0.03438, 0.14813, 0.50393, 0.83427, 0.24689, 0.03326, 0.00219, 9e-05, 0, 0),
96177
tolerance = 1e-2
97178
)
98179

@@ -102,17 +183,22 @@ test_that("estimate_slopes, johnson-neyman p-adjust", {
102183
expect_equal(
103184
out$CI_low,
104185
c(
105-
-0.90003, -0.72665, -0.55721, -0.39196, -0.23229, -0.07873,
106-
0.06797, 0.20793, 0.34088, 0.468
186+
-0.90003,
187+
-0.72665,
188+
-0.55721,
189+
-0.39196,
190+
-0.23229,
191+
-0.07873,
192+
0.06797,
193+
0.20793,
194+
0.34088,
195+
0.468
107196
),
108197
tolerance = 1e-2
109198
)
110199
expect_equal(
111200
out$p,
112-
c(
113-
0.01765, 0.08691, 0.36222, 0.9097, 0.76792, 0.17275, 0.01369,
114-
5e-04, 1e-05, 0
115-
),
201+
c(0.01765, 0.08691, 0.36222, 0.9097, 0.76792, 0.17275, 0.01369, 5e-04, 1e-05, 0),
116202
tolerance = 1e-2
117203
)
118204
})
@@ -121,7 +207,12 @@ test_that("estimate_slopes, johnson-neyman p-adjust", {
121207
test_that("estimate_slopes, custom comparison", {
122208
data(iris)
123209
m <- lm(Sepal.Width ~ Sepal.Length * Species, data = iris)
124-
out <- estimate_contrasts(m, "Sepal.Length", by = "Species", comparison = "(b1 - b2) = (b1 - b3)")
210+
out <- estimate_contrasts(
211+
m,
212+
"Sepal.Length",
213+
by = "Species",
214+
comparison = "(b1 - b2) = (b1 - b3)"
215+
)
125216
expect_identical(dim(out), c(1L, 8L))
126217
expect_equal(out$Difference, -0.08782885, tolerance = 1e-4)
127218
})
@@ -140,8 +231,18 @@ test_that("estimate_slopes, works with lme4", {
140231
expect_equal(
141232
out$Slope,
142233
c(
143-
0.01847, 0.02553, 0.02322, 0.02119, 0.02458, 0.02548, 0.01366,
144-
0.01519, 0.02286, 0.00541, 0.00632, 0.01085
234+
0.01847,
235+
0.02553,
236+
0.02322,
237+
0.02119,
238+
0.02458,
239+
0.02548,
240+
0.01366,
241+
0.01519,
242+
0.02286,
243+
0.00541,
244+
0.00632,
245+
0.01085
145246
),
146247
tolerance = 1e-3
147248
)
@@ -160,8 +261,18 @@ test_that("estimate_slopes, works with glmmTMB", {
160261
expect_equal(
161262
out$Slope,
162263
c(
163-
0.01847, 0.02553, 0.02322, 0.02119, 0.02458, 0.02548, 0.01366,
164-
0.01519, 0.02286, 0.00541, 0.00632, 0.01085
264+
0.01847,
265+
0.02553,
266+
0.02322,
267+
0.02119,
268+
0.02458,
269+
0.02548,
270+
0.01366,
271+
0.01519,
272+
0.02286,
273+
0.00541,
274+
0.00632,
275+
0.01085
165276
),
166277
tolerance = 1e-3
167278
)
@@ -197,8 +308,15 @@ test_that("estimate_slopes, estimate-argument works", {
197308
skip_if(getRversion() < "4.5.0")
198309
skip_if_not_installed("datawizard")
199310
data(penguins)
200-
penguins$long_bill <- factor(datawizard::categorize(penguins$bill_len), labels = c("short", "long"))
201-
m <- glm(long_bill ~ sex + species + island * bill_dep, data = penguins, family = "binomial")
311+
penguins$long_bill <- factor(
312+
datawizard::categorize(penguins$bill_len),
313+
labels = c("short", "long")
314+
)
315+
m <- glm(
316+
long_bill ~ sex + species + island * bill_dep,
317+
data = penguins,
318+
family = "binomial"
319+
)
202320

203321
out <- estimate_slopes(m, "bill_dep", by = "island")
204322
expect_equal(out$Slope, c(0.00607, 0.04194, 0.00529), tolerance = 1e-4)

0 commit comments

Comments
 (0)