From 99a29936c036c198ddcbdeaebaf09ed62d771277 Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 11 Sep 2023 08:03:23 +0200 Subject: [PATCH] Wrong header when using identity-link with GLMs (#900) --- DESCRIPTION | 2 +- NEWS.md | 3 +++ R/utils_model_parameters.R | 12 +++++++++-- tests/testthat/test-model_parameters.glm.R | 23 ++++++++++++++-------- 4 files changed, 29 insertions(+), 11 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 0a989c508..71ffa1698 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: parameters Title: Processing of Model Parameters -Version: 0.21.1.4 +Version: 0.21.1.5 Authors@R: c(person(given = "Daniel", family = "Lüdecke", diff --git a/NEWS.md b/NEWS.md index c2e19793b..d591d521d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -5,6 +5,9 @@ * Fixed issue with wrong calculation of test-statistic and p-values in `model_parameters()` for `fixest` models. +* Fixed issue with wrong column header for `glm` models with + `family = binomial("identiy")`. + * Minor fixes for `dominance_analysis()`. # parameters 0.21.1 diff --git a/R/utils_model_parameters.R b/R/utils_model_parameters.R index abb1e3233..5aaa2f3d4 100644 --- a/R/utils_model_parameters.R +++ b/R/utils_model_parameters.R @@ -251,7 +251,11 @@ } else if ((info$is_binomial && info$is_logit) || info$is_ordinal || info$is_multinomial || info$is_categorical) { coef_col <- "Odds Ratio" } else if (info$is_binomial && !info$is_logit) { - coef_col <- "Risk Ratio" + if (info$link_function == "identity") { + coef_col <- "Exp. Risk" + } else { + coef_col <- "Risk Ratio" + } } else if (info$is_count) { coef_col <- "IRR" } @@ -261,7 +265,11 @@ } else if ((info$is_binomial && info$is_logit) || info$is_ordinal || info$is_multinomial || info$is_categorical) { coef_col <- "Log-Odds" } else if (info$is_binomial && !info$is_logit) { - coef_col <- "Log-Risk" + if (info$link_function == "identity") { + coef_col <- "Risk" + } else { + coef_col <- "Log-Risk" + } } else if (info$is_count) { coef_col <- "Log-Mean" } diff --git a/tests/testthat/test-model_parameters.glm.R b/tests/testthat/test-model_parameters.glm.R index 44adbc25d..c5cebbb75 100644 --- a/tests/testthat/test-model_parameters.glm.R +++ b/tests/testthat/test-model_parameters.glm.R @@ -3,23 +3,23 @@ skip_if_not_installed("boot") test_that("model_parameters.lm", { model <- lm(mpg ~ wt, data = mtcars) params <- model_parameters(model, verbose = FALSE) - expect_equal(c(nrow(params), ncol(params)), c(2, 9)) + expect_identical(c(nrow(params), ncol(params)), c(2L, 9L)) expect_equal(params$CI_high, c(41.119752761418, -4.20263490802709), tolerance = 1e-3) expect_equal(attributes(params)$sigma, 3.045882, tolerance = 1e-3) params <- model_parameters(model, ci = c(0.8, 0.9), verbose = FALSE) - expect_equal(c(nrow(params), ncol(params)), c(2, 10)) + expect_identical(c(nrow(params), ncol(params)), c(2L, 10L)) params <- model_parameters(model, dispersion = TRUE, bootstrap = TRUE, iterations = 500, verbose = FALSE) - expect_equal(c(nrow(params), ncol(params)), c(2, 7)) + expect_identical(c(nrow(params), ncol(params)), c(2L, 7L)) model <- lm(mpg ~ wt + cyl, data = mtcars) params <- model_parameters(model, verbose = FALSE) - expect_equal(c(nrow(params), ncol(params)), c(3, 9)) + expect_identical(c(nrow(params), ncol(params)), c(3L, 9L)) model <- lm(mpg ~ wt * cyl, data = mtcars) params <- model_parameters(model, verbose = FALSE) - expect_equal(c(nrow(params), ncol(params)), c(4, 9)) + expect_identical(c(nrow(params), ncol(params)), c(4L, 9L)) params <- model_parameters(model, component = "conditional", effects = "fixed", verbose = FALSE) }) @@ -28,7 +28,7 @@ test_that("print digits model_parameters.lm", { model <- lm(mpg ~ wt, data = mtcars) params <- model_parameters(model, digits = 4, ci_digits = 5, verbose = FALSE) out <- capture.output(print(params)) - expect_equal(out[3], "(Intercept) | 37.2851 | 1.8776 | [33.45050, 41.11975] | 19.8576 | < .001") + expect_identical(out[3], "(Intercept) | 37.2851 | 1.8776 | [33.45050, 41.11975] | 19.8576 | < .001") }) @@ -48,10 +48,10 @@ test_that("model_parameters.glm - binomial", { model <- glm(vs ~ wt + cyl, data = mtcars, family = "binomial") params <- model_parameters(model, verbose = FALSE) - expect_equal(c(nrow(params), ncol(params)), c(3, 9)) + expect_identical(c(nrow(params), ncol(params)), c(3L, 9L)) params <- suppressWarnings(model_parameters(model, bootstrap = TRUE, iterations = 500, verbose = FALSE)) - expect_equal(c(nrow(params), ncol(params)), c(3, 6)) + expect_identical(c(nrow(params), ncol(params)), c(3L, 6L)) params <- model_parameters(model, component = "conditional", effects = "fixed", verbose = FALSE) }) @@ -67,3 +67,10 @@ test_that("model_parameters.glm - Gamma - print", { mp <- model_parameters(m, exponentiate = TRUE) expect_snapshot(mp) }) + +test_that("model_parameters.glm - glm, identity link", { + data(mtcars) + m <- glm(am ~ vs, data = mtcars, family = binomial(link = "identity")) + p <- model_parameters(m) + expect_identical(attributes(p)$coefficient_name, "Risk") +})