pretty_labels attribute includes NAs with interactions

Fixes #1032

Author: strengejacke

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: parameters
 Title: Processing of Model Parameters
-Version: 0.23.0.2
+Version: 0.23.0.3
 Authors@R:
     c(person(given = "Daniel",
              family = "Lüdecke",

NEWS.md

@@ -5,6 +5,11 @@
 * The `robust` argument, which was deprecated for a long time, is now no longer
   supported. Please use `vcov` and `vcov_args` instead.
 
+## Bug fixes
+
+* Fixed bug when extracting 'pretty labels' for model parameters, which could
+  fail when predictors were character vectors.
+
 # parameters 0.23.0
 
 ## Breaking Changes

R/format_parameters.R

@@ -412,6 +412,9 @@ format_parameters.parameters_model <- function(model, ...) {
 
     # coefficient names (not labels)
     preds <- lapply(colnames(mf), function(i) {
+      if (is.character(mf[[i]])) {
+        mf[[i]] <- as.factor(mf[[i]])
+      }
       if (is.factor(mf[[i]])) {
         i <- paste0(i, levels(mf[[i]]))
       }

R/utils_model_parameters.R

@@ -51,7 +51,7 @@
   attr(params, "bootstrap") <- bootstrap
   attr(params, "iterations") <- iterations
   attr(params, "p_adjust") <- p_adjust
-  attr(params, "robust_vcov") <- isTRUE(list(...)$robust) || "vcov" %in% names(list(...))
+  attr(params, "robust_vcov") <- "vcov" %in% names(list(...))
   attr(params, "ignore_group") <- isFALSE(group_level)
   attr(params, "ran_pars") <- isFALSE(group_level)
   attr(params, "show_summary") <- isTRUE(include_info)

tests/testthat/_snaps/pretty_names.md

@@ -0,0 +1,18 @@
+# pretty_labels
+
+    Code
+      print(p)
+    Output
+      Parameter   | Log-Odds |   SE |       95% CI |    z |      p
+      ------------------------------------------------------------
+      (Intercept) |     0.44 | 0.07 | [0.30, 0.58] | 6.07 | < .001
+      X           |     0.26 | 0.10 | [0.06, 0.46] | 2.52 | 0.012 
+      M [b]       |     0.57 | 0.11 | [0.36, 0.78] | 5.29 | < .001
+      M [c]       |     0.97 | 0.11 | [0.75, 1.19] | 8.75 | < .001
+      X × M [b]   |     0.89 | 0.17 | [0.56, 1.24] | 5.17 | < .001
+      X × M [c]   |     1.41 | 0.21 | [1.00, 1.84] | 6.58 | < .001
+    Message
+      
+      Uncertainty intervals (profile-likelihood) and p-values (two-tailed)
+        computed using a Wald z-distribution approximation.
+

tests/testthat/test-pretty_namesR.R renamed to tests/testthat/test-pretty_names.R

@@ -33,3 +33,30 @@ test_that("pretty_names", {
     )
   )
 })
+
+
+test_that("pretty_labels", {
+  set.seed(1024)
+  N <- 5000
+  X <- rbinom(N, 1, .5)
+  M <- sample(c("a", "b", "c"), N, replace = TRUE)
+  b <- runif(8, -1, 1)
+  Y <- rbinom(N, 1, prob = plogis(
+    b[1] + b[2] * X +
+    b[3] * (M == "b") + b[4] * (M == "b") + b[5] * (M == "c") +
+    b[6] * X * (M == "a") + b[7] * X + (M == "b") +
+    b[8] * X * (M == "c")
+  ))
+  dat <- data.frame(Y, X, M, stringsAsFactors = FALSE)
+  mod <- glm(Y ~ X * M, data = dat, family = binomial)
+
+  p <- parameters(mod)
+  expect_identical(
+    attr(p, "pretty_labels"),
+    c(
+      `(Intercept)` = "(Intercept)", X = "X", Mb = "M [b]", Mc = "M [c]",
+      `X:Mb` = "X × M [b]", `X:Mc` = "X × M [c]"
+    )
+  )
+  expect_snapshot(print(p))
+})