diff --git a/R/utils_format.R b/R/utils_format.R index fa0110266..fa901306c 100644 --- a/R/utils_format.R +++ b/R/utils_format.R @@ -376,14 +376,6 @@ # find factors and factor levels and check if we have any factors in the data factors <- .find_factor_levels(model_data, model, model_call = attributes(params)$model_call) - # next, check contrasts of factors. including the reference level makes - # only sense if there are contrasts that are all zeros, which means that - # the reference level is not included in the model matrix - remove_contrasts <- .remove_reference_contrasts(model) - # keep only factors with valid contrasts - if (!is.null(remove_contrasts) && length(remove_contrasts)) { - factors <- factors[setdiff(names(factors), remove_contrasts)] - } if (!length(factors)) { # in case of "on-the-fly" factors, e.g.: # m <- lm(mpg ~ cut(wt, c(0, 2.5, 3, 5)), data = mtcars) @@ -397,6 +389,14 @@ return(params) } } + # next, check contrasts of factors. including the reference level makes + # only sense if there are contrasts that are all zeros, which means that + # the reference level is not included in the model matrix + remove_contrasts <- .remove_reference_contrasts(model) + # keep only factors with valid contrasts + if (!is.null(remove_contrasts) && length(remove_contrasts)) { + factors <- factors[setdiff(names(factors), remove_contrasts)] + } # we need some more information about prettified labels etc. pretty_names <- attributes(params)$pretty_names diff --git a/tests/testthat/_snaps/include_reference.md b/tests/testthat/_snaps/include_reference.md index 535f59af7..d525ba048 100644 --- a/tests/testthat/_snaps/include_reference.md +++ b/tests/testthat/_snaps/include_reference.md @@ -64,3 +64,94 @@ | Observations | 32 | 32 | +--------------+----------------------+----------------------+ +# include_reference, different contrasts + + Code + print(out) + Output + Parameter | Coefficient | SE | 95% CI | t(27) | p + ------------------------------------------------------------------- + (Intercept) | 19.70 | 1.18 | [ 17.28, 22.11] | 16.71 | < .001 + cyl [6] | -6.66 | 1.63 | [-10.00, -3.31] | -4.09 | < .001 + cyl [8] | -10.54 | 1.96 | [-14.56, -6.52] | -5.38 | < .001 + gear [3] | 0.00 | | | | + gear [4] | 1.32 | 1.93 | [ -2.63, 5.28] | 0.69 | 0.498 + gear [5] | 1.50 | 1.85 | [ -2.31, 5.31] | 0.81 | 0.426 + Message + + Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed + using a Wald t-distribution approximation. + +--- + + Code + print(out) + Output + Parameter | Coefficient | SE | 95% CI | t(27) | p + ------------------------------------------------------------------- + (Intercept) | 25.43 | 1.88 | [ 21.57, 29.29] | 13.52 | < .001 + cyl [4] | 0.00 | | | | + cyl [6] | -6.66 | 1.63 | [-10.00, -3.31] | -4.09 | < .001 + cyl [8] | -10.54 | 1.96 | [-14.56, -6.52] | -5.38 | < .001 + gear [3] | 0.00 | | | | + gear [4] | 1.32 | 1.93 | [ -2.63, 5.28] | 0.69 | 0.498 + gear [5] | 1.50 | 1.85 | [ -2.31, 5.31] | 0.81 | 0.426 + Message + + Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed + using a Wald t-distribution approximation. + +--- + + Code + print(out) + Output + Parameter | Coefficient | SE | 95% CI | t(27) | p + ------------------------------------------------------------------- + (Intercept) | 20.64 | 0.67 | [ 19.26, 22.01] | 30.76 | < .001 + cyl [6] | -6.66 | 1.63 | [-10.00, -3.31] | -4.09 | < .001 + cyl [8] | -10.54 | 1.96 | [-14.56, -6.52] | -5.38 | < .001 + gear [1] | -0.94 | 1.09 | [ -3.18, 1.30] | -0.86 | 0.396 + gear [2] | 0.38 | 1.11 | [ -1.90, 2.67] | 0.34 | 0.734 + Message + + Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed + using a Wald t-distribution approximation. + +--- + + Code + print(out) + Output + Parameter | Coefficient | SE | 95% CI | t(27) | p + ------------------------------------------------------------------ + (Intercept) | 15.83 | 1.24 | [13.28, 18.37] | 12.75 | < .001 + cyl [8] | 0.00 | | | | + cyl [4] | 10.54 | 1.96 | [ 6.52, 14.56] | 5.38 | < .001 + cyl [6] | 3.89 | 1.88 | [ 0.03, 7.75] | 2.07 | 0.049 + gear [1] | -0.94 | 1.09 | [-3.18, 1.30] | -0.86 | 0.396 + gear [2] | 0.38 | 1.11 | [-1.90, 2.67] | 0.34 | 0.734 + Message + + Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed + using a Wald t-distribution approximation. + +--- + + Code + print(out) + Output + Parameter | Coefficient | SE | 95% CI | t(27) | p + ------------------------------------------------------------------ + (Intercept) | 14.89 | 0.92 | [13.00, 16.77] | 16.19 | < .001 + cyl [8] | 0.00 | | | | + cyl [4] | 10.54 | 1.96 | [ 6.52, 14.56] | 5.38 | < .001 + cyl [6] | 3.89 | 1.88 | [ 0.03, 7.75] | 2.07 | 0.049 + gear [3] | 0.00 | | | | + gear [4] | 1.32 | 1.93 | [-2.63, 5.28] | 0.69 | 0.498 + gear [5] | 1.50 | 1.85 | [-2.31, 5.31] | 0.81 | 0.426 + Message + + Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed + using a Wald t-distribution approximation. + diff --git a/tests/testthat/test-include_reference.R b/tests/testthat/test-include_reference.R index 4cc45e560..02e8eae81 100644 --- a/tests/testthat/test-include_reference.R +++ b/tests/testthat/test-include_reference.R @@ -56,3 +56,50 @@ test_that("include_reference, with pretty formatted cut", { ) ) }) + +test_that("include_reference, different contrasts", { + data("mtcars") + mtcars$cyl <- factor(mtcars$cyl) + mtcars$gear <- factor(mtcars$gear) + + m <- lm(mpg ~ cyl + gear, data = mtcars, contrasts = list(cyl = datawizard::contr.deviation)) + out <- model_parameters(m, include_reference = TRUE) + expect_snapshot(print(out)) + + m <- lm(mpg ~ cyl + gear, data = mtcars) + out <- model_parameters(m, include_reference = TRUE) + expect_snapshot(print(out)) + + m <- lm( + mpg ~ cyl + gear, + data = mtcars, + contrasts = list( + cyl = datawizard::contr.deviation, + gear = contr.sum + ) + ) + out <- model_parameters(m, include_reference = TRUE) + expect_snapshot(print(out)) + + m <- lm( + mpg ~ cyl + gear, + data = mtcars, + contrasts = list( + cyl = contr.SAS, + gear = contr.sum + ) + ) + out <- model_parameters(m, include_reference = TRUE) + expect_snapshot(print(out)) + + m <- lm( + mpg ~ cyl + gear, + data = mtcars, + contrasts = list( + cyl = contr.SAS, + gear = contr.treatment + ) + ) + out <- model_parameters(m, include_reference = TRUE) + expect_snapshot(print(out)) +})