Skip to content

Commit 8e362ee

Browse files
strengejackestrengejacke
authored
include_reference = TRUE erroneously works with datawizard::contr.deviation() (#966)
* `include_reference = TRUE` erroneously works with `datawizard::contr.deviation()` Fixes #962 * add tests * update news
1 parent fcd1e9b commit 8e362ee

File tree

6 files changed

+174
-1
lines changed

6 files changed

+174
-1
lines changed

‎DESCRIPTION‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
Type: Package
22
Package: parameters
33
Title: Processing of Model Parameters
4-
Version: 0.22.2.19
4+
Version: 0.22.2.20
55
Authors@R:
66
c(person(given = "Daniel",
77
family = "Lüdecke",

‎NEWS.md‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -37,6 +37,10 @@
3737
* `print()` for `compare_parameters()` now also puts factor levels into square
3838
brackets, like the `print()` method for `model_parameters()`.
3939

40+
* `include_reference` now only adds the reference category of factors to the
41+
parameters table when those factors have appropriate contrasts (treatment or
42+
SAS contrasts).
43+
4044
## Bug fixes
4145

4246
* Arguments like `digits` etc. were ignored in `model_parameters() for objects

‎R/utils.R‎

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -177,6 +177,29 @@
177177
}
178178

179179

180+
# This functions finds contrasts for those factors in a model, where including
181+
# a reference level makes sense. This is the case when there are contrasts
182+
# that are all zeros, which means that the reference level is not included in
183+
# the model matrix.
184+
.remove_reference_contrasts <- function(model) {
185+
cons <- .safe(model$contrasts)
186+
if (is.null(cons)) {
187+
return(NULL)
188+
}
189+
out <- vapply(cons, function(mat) {
190+
if (is.matrix(mat) && nrow(mat) > 0) {
191+
any(rowSums(mat) == 0)
192+
} else if (is.character(mat)) {
193+
mat %in% c("contr.treatment", "contr.SAS")
194+
} else {
195+
FALSE
196+
}
197+
}, logical(1))
198+
# only return those factors that need to be removed
199+
names(out)[!out]
200+
}
201+
202+
180203
# Almost identical to dynGet(). The difference is that we deparse the expression
181204
# because get0() allows symbol only since R 4.1.0
182205
.dynGet <- function(x,

‎R/utils_format.R‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -389,6 +389,14 @@
389389
return(params)
390390
}
391391
}
392+
# next, check contrasts of factors. including the reference level makes
393+
# only sense if there are contrasts that are all zeros, which means that
394+
# the reference level is not included in the model matrix
395+
remove_contrasts <- .remove_reference_contrasts(model)
396+
# keep only factors with valid contrasts
397+
if (!is.null(remove_contrasts) && length(remove_contrasts)) {
398+
factors <- factors[setdiff(names(factors), remove_contrasts)]
399+
}
392400

393401
# we need some more information about prettified labels etc.
394402
pretty_names <- attributes(params)$pretty_names

‎tests/testthat/_snaps/include_reference.md‎

Lines changed: 91 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -64,3 +64,94 @@
6464
| Observations | 32 | 32 |
6565
+--------------+----------------------+----------------------+
6666

67+
# include_reference, different contrasts
68+
69+
Code
70+
print(out)
71+
Output
72+
Parameter | Coefficient | SE | 95% CI | t(27) | p
73+
-------------------------------------------------------------------
74+
(Intercept) | 19.70 | 1.18 | [ 17.28, 22.11] | 16.71 | < .001
75+
cyl [6] | -6.66 | 1.63 | [-10.00, -3.31] | -4.09 | < .001
76+
cyl [8] | -10.54 | 1.96 | [-14.56, -6.52] | -5.38 | < .001
77+
gear [3] | 0.00 | | | |
78+
gear [4] | 1.32 | 1.93 | [ -2.63, 5.28] | 0.69 | 0.498
79+
gear [5] | 1.50 | 1.85 | [ -2.31, 5.31] | 0.81 | 0.426
80+
Message
81+
82+
Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed
83+
using a Wald t-distribution approximation.
84+
85+
---
86+
87+
Code
88+
print(out)
89+
Output
90+
Parameter | Coefficient | SE | 95% CI | t(27) | p
91+
-------------------------------------------------------------------
92+
(Intercept) | 25.43 | 1.88 | [ 21.57, 29.29] | 13.52 | < .001
93+
cyl [4] | 0.00 | | | |
94+
cyl [6] | -6.66 | 1.63 | [-10.00, -3.31] | -4.09 | < .001
95+
cyl [8] | -10.54 | 1.96 | [-14.56, -6.52] | -5.38 | < .001
96+
gear [3] | 0.00 | | | |
97+
gear [4] | 1.32 | 1.93 | [ -2.63, 5.28] | 0.69 | 0.498
98+
gear [5] | 1.50 | 1.85 | [ -2.31, 5.31] | 0.81 | 0.426
99+
Message
100+
101+
Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed
102+
using a Wald t-distribution approximation.
103+
104+
---
105+
106+
Code
107+
print(out)
108+
Output
109+
Parameter | Coefficient | SE | 95% CI | t(27) | p
110+
-------------------------------------------------------------------
111+
(Intercept) | 20.64 | 0.67 | [ 19.26, 22.01] | 30.76 | < .001
112+
cyl [6] | -6.66 | 1.63 | [-10.00, -3.31] | -4.09 | < .001
113+
cyl [8] | -10.54 | 1.96 | [-14.56, -6.52] | -5.38 | < .001
114+
gear [1] | -0.94 | 1.09 | [ -3.18, 1.30] | -0.86 | 0.396
115+
gear [2] | 0.38 | 1.11 | [ -1.90, 2.67] | 0.34 | 0.734
116+
Message
117+
118+
Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed
119+
using a Wald t-distribution approximation.
120+
121+
---
122+
123+
Code
124+
print(out)
125+
Output
126+
Parameter | Coefficient | SE | 95% CI | t(27) | p
127+
------------------------------------------------------------------
128+
(Intercept) | 15.83 | 1.24 | [13.28, 18.37] | 12.75 | < .001
129+
cyl [8] | 0.00 | | | |
130+
cyl [4] | 10.54 | 1.96 | [ 6.52, 14.56] | 5.38 | < .001
131+
cyl [6] | 3.89 | 1.88 | [ 0.03, 7.75] | 2.07 | 0.049
132+
gear [1] | -0.94 | 1.09 | [-3.18, 1.30] | -0.86 | 0.396
133+
gear [2] | 0.38 | 1.11 | [-1.90, 2.67] | 0.34 | 0.734
134+
Message
135+
136+
Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed
137+
using a Wald t-distribution approximation.
138+
139+
---
140+
141+
Code
142+
print(out)
143+
Output
144+
Parameter | Coefficient | SE | 95% CI | t(27) | p
145+
------------------------------------------------------------------
146+
(Intercept) | 14.89 | 0.92 | [13.00, 16.77] | 16.19 | < .001
147+
cyl [8] | 0.00 | | | |
148+
cyl [4] | 10.54 | 1.96 | [ 6.52, 14.56] | 5.38 | < .001
149+
cyl [6] | 3.89 | 1.88 | [ 0.03, 7.75] | 2.07 | 0.049
150+
gear [3] | 0.00 | | | |
151+
gear [4] | 1.32 | 1.93 | [-2.63, 5.28] | 0.69 | 0.498
152+
gear [5] | 1.50 | 1.85 | [-2.31, 5.31] | 0.81 | 0.426
153+
Message
154+
155+
Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed
156+
using a Wald t-distribution approximation.
157+

‎tests/testthat/test-include_reference.R‎

Lines changed: 47 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -56,3 +56,50 @@ test_that("include_reference, with pretty formatted cut", {
5656
)
5757
)
5858
})
59+
60+
test_that("include_reference, different contrasts", {
61+
data("mtcars")
62+
mtcars$cyl <- factor(mtcars$cyl)
63+
mtcars$gear <- factor(mtcars$gear)
64+
65+
m <- lm(mpg ~ cyl + gear, data = mtcars, contrasts = list(cyl = datawizard::contr.deviation))
66+
out <- model_parameters(m, include_reference = TRUE)
67+
expect_snapshot(print(out))
68+
69+
m <- lm(mpg ~ cyl + gear, data = mtcars)
70+
out <- model_parameters(m, include_reference = TRUE)
71+
expect_snapshot(print(out))
72+
73+
m <- lm(
74+
mpg ~ cyl + gear,
75+
data = mtcars,
76+
contrasts = list(
77+
cyl = datawizard::contr.deviation,
78+
gear = contr.sum
79+
)
80+
)
81+
out <- model_parameters(m, include_reference = TRUE)
82+
expect_snapshot(print(out))
83+
84+
m <- lm(
85+
mpg ~ cyl + gear,
86+
data = mtcars,
87+
contrasts = list(
88+
cyl = contr.SAS,
89+
gear = contr.sum
90+
)
91+
)
92+
out <- model_parameters(m, include_reference = TRUE)
93+
expect_snapshot(print(out))
94+
95+
m <- lm(
96+
mpg ~ cyl + gear,
97+
data = mtcars,
98+
contrasts = list(
99+
cyl = contr.SAS,
100+
gear = contr.treatment
101+
)
102+
)
103+
out <- model_parameters(m, include_reference = TRUE)
104+
expect_snapshot(print(out))
105+
})

0 commit comments

Comments
 (0)