glm model misreported as bernoulli

Fixes #825
easystats · Oct 29, 2023 · 26e0e09 · 26e0e09
1 parent 026b973
commit 26e0e09
Show file tree

Hide file tree

Showing 6 changed files with 37 additions and 9 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Type: Package
 Package: insight
 Title: Easy Access to Model Information for Various Model Objects
-Version: 0.19.6.3
+Version: 0.19.6.4
 Authors@R: 
     c(person(given = "Daniel",
              family = "Lüdecke",

diff --git a/NEWS.md b/NEWS.md
@@ -14,6 +14,9 @@
 * Fixed issue in `find_predictors()` for survival models with `strata()`,
   containing more that one variable.
 
+* Fixed issue in `model_info()`, where in some cases logistic regression models
+  were erroneously considered as `"bernoulli"` models.
+
 # insight 0.19.6
 
 ## General

diff --git a/R/format_value.R b/R/format_value.R
@@ -204,7 +204,7 @@ format_percent <- function(x, ...) {
                                          .as_percent = FALSE,
                                          .zap_small = FALSE, ...) {
   x_nonmiss <- x[!is.na(x)]
-  if (is.numeric(x) && !all(.is.int(x_nonmiss))) {
+  if (is.numeric(x) && !all(.is_integer(x_nonmiss))) {
     .format_value(
       x,
       digits = digits,
@@ -215,7 +215,7 @@ format_percent <- function(x, ...) {
     )
   } else if (anyNA(x)) {
     .convert_missing(x, .missing)
-  } else if (is.numeric(x) && all(.is.int(x_nonmiss)) && !is.null(.width)) {
+  } else if (is.numeric(x) && all(.is_integer(x_nonmiss)) && !is.null(.width)) {
     format(x, justify = "right", width = .width)
   } else {
     as.character(x)
@@ -313,7 +313,7 @@ format_percent <- function(x, ...) {
 }
 
 
-.is.int <- function(x) {
+.is_integer <- function(x) {
   tryCatch(
     expr = {
       ifelse(is.infinite(x), FALSE, x %% 1 == 0)
@@ -328,6 +328,6 @@ format_percent <- function(x, ...) {
 }
 
 
-.is.fraction <- function(x) {
-  !all(.is.int(x)) && is.numeric(x) && n_unique(x) > 2
+.is_fraction <- function(x) {
+  !all(.is_integer(x)) && is.numeric(x) && n_unique(x) > 2
 }
diff --git a/R/n_obs.R b/R/n_obs.R
@@ -88,7 +88,7 @@ n_obs.glm <- function(x, disaggregate = FALSE, ...) {
       }
 
       # response is a fraction
-    } else if (!is.data.frame(resp_data) && .is.fraction(resp_data)) {
+    } else if (!is.data.frame(resp_data) && .is_fraction(resp_data)) {
       .nobs <- sum(get_weights(x))
     }
     .nobs <- as.integer(.nobs)

diff --git a/R/utils_model_info.R b/R/utils_model_info.R
@@ -72,8 +72,11 @@
       if ((is.data.frame(resp) || is.matrix(resp)) && ncol(resp) == 1) {
         resp <- as.vector(resp[[1]])
       }
-      if (!is.data.frame(resp) && !is.matrix(resp) && all(.is.int(.factor_to_numeric(resp[[1]])))) {
-        is_bernoulli <- TRUE
+      if (!is.data.frame(resp) && !is.matrix(resp)) {
+        if (is.list(resp)) {
+          resp <- resp[[1]]
+        }
+        is_bernoulli <- all(.is_integer(.factor_to_numeric(resp)))
       }
     }
   } else if (all(fitfam == "bernoulli")) {

diff --git a/tests/testthat/test-model_info.R b/tests/testthat/test-model_info.R
@@ -83,3 +83,25 @@ test_that("model_info-tweedie", {
   expect_false(mi$is_poisson)
   expect_identical(mi$family, "Tweedie")
 })
+
+test_that("model_info, glm bernoulli", {
+  set.seed(1)
+  tot <- rep(10, 100)
+  suc <- rbinom(100, prob = 0.9, size = tot)
+  dat <- data.frame(tot, suc)
+  dat$prop <- suc / tot
+
+  mod <- glm(prop ~ 1,
+    family = binomial,
+    data = dat,
+    weights = tot
+  )
+
+  expect_true(model_info(mod)$is_binomial)
+  expect_false(model_info(mod)$is_bernoulli)
+
+  data(mtcars)
+  mod <- glm(am ~ 1, family = binomial, data = mtcars)
+  expect_true(model_info(mod)$is_binomial)
+  expect_true(model_info(mod)$is_bernoulli)
+})