model_parameters.averaging() fails (#1046)

* `model_parameters.averaging()` fails
Fixes #1045

* add test

* news

DESCRIPTION

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

NEWS.md

@@ -16,6 +16,8 @@
 
 ## Bug fixes
 
+* Fixed bug in `p_value()` for objects of class `averaging`.
+
 * Fixed bug when extracting 'pretty labels' for model parameters, which could
   fail when predictors were character vectors.
 

R/methods_averaging.R

@@ -66,9 +66,27 @@ p_value.averaging <- function(model, component = "conditional", ...) {
     s <- summary(model)$coefmat.subset
   }
 
+  # to data frame
+  s <- as.data.frame(s)
+
+  # do we have a p-value column based on t?
+  pvcn <- which(colnames(s) == "Pr(>|t|)")
+  # if not, do we have a p-value column based on z?
+  if (length(pvcn) == 0) {
+    pvcn <- which(colnames(s) == "Pr(>|z|)")
+  }
+  # if not, default to ncol
+  if (length(pvcn) == 0) {
+    if (ncol(s) > 4) {
+      pvcn <- 5
+    } else {
+      pvcn <- 4
+    }
+  }
+
   .data_frame(
     Parameter = .remove_backticks_from_string(params$Parameter),
-    p = as.vector(s[, 5])
+    p = as.vector(s[, pvcn])
   )
 }
 

tests/testthat/_snaps/averaging.md

@@ -0,0 +1,50 @@
+# MuMIn link functions
+
+    Code
+      print(mp)
+    Output
+      Parameter     | Log-Odds |   SE |         95% CI |    z |      p
+      ----------------------------------------------------------------
+      (Intercept)   |    -1.01 | 0.26 | [-1.51, -0.50] | 3.91 | < .001
+      var cont      |    -0.42 | 0.25 | [-0.90,  0.07] | 1.70 | 0.090 
+      var binom [1] |    -0.71 | 0.62 | [-1.92,  0.50] | 1.15 | 0.250 
+    Message
+      
+      Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed
+        using a Wald z-distribution approximation.
+      
+      The model has a log- or logit-link. Consider using `exponentiate =
+        TRUE` to interpret coefficients as ratios.
+
+# ggpredict, glmmTMB averaging
+
+    Code
+      print(mp)
+    Output
+      Parameter    | Coefficient |       SE |                95% CI |        z |      p
+      ---------------------------------------------------------------------------------
+      cond((Int))  |       -0.11 |     0.22 | [    -0.55,     0.32] |     0.52 | 0.605 
+      cond(income) |       -0.01 | 3.20e-03 | [    -0.02,    -0.01] |     4.07 | < .001
+      zi((Int))    |      -23.11 | 17557.33 | [-34434.85, 34388.63] | 1.32e-03 | 0.999 
+    Message
+      
+      Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed
+        using a Wald z-distribution approximation.
+
+# ggpredict, poly averaging
+
+    Code
+      print(mp)
+    Output
+      Parameter   | Coefficient |     SE |            95% CI |    z |      p
+      ----------------------------------------------------------------------
+      (Intercept) |      954.50 | 123.60 | [712.26, 1196.75] | 7.72 | < .001
+      gear        |      -24.81 |  18.54 | [-61.14,   11.52] | 1.34 | 0.181 
+      mpg         |      -51.21 |  11.60 | [-73.96,  -28.47] | 4.41 | < .001
+      mpg^2       |        0.79 |   0.26 | [  0.29,    1.30] | 3.07 | 0.002 
+      am [1]      |      -30.80 |  32.30 | [-94.11,   32.52] | 0.95 | 0.340 
+    Message
+      
+      Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed
+        using a Wald z-distribution approximation.
+

tests/testthat/test-averaging.R

@@ -0,0 +1,67 @@
+skip_on_cran()
+
+skip_if_not_installed("MuMIn")
+skip_if_not_installed("withr")
+skip_if_not_installed("glmmTMB")
+skip_if_not_installed("betareg")
+
+withr::with_options(
+  list(na.action = "na.fail"),
+  test_that("MuMIn link functions", {
+    library(MuMIn) # nolint
+    set.seed(1234)
+    dat <- data.frame(
+      outcome = rbinom(n = 100, size = 1, prob = 0.35),
+      var_binom = as.factor(rbinom(n = 100, size = 1, prob = 0.2)),
+      var_cont = rnorm(n = 100, mean = 10, sd = 7),
+      group = sample(letters[1:4], size = 100, replace = TRUE),
+      stringsAsFactors = FALSE
+    )
+    dat$var_cont <- as.vector(scale(dat$var_cont))
+    m1 <- glm(
+      outcome ~ var_binom + var_cont,
+      data = dat,
+      family = binomial(link = "logit")
+    )
+    out <- MuMIn::model.avg(MuMIn::dredge(m1), fit = TRUE)
+    mp <- model_parameters(out)
+    expect_snapshot(print(mp))
+  })
+)
+
+test_that("ggpredict, glmmTMB averaging", {
+  library(MuMIn) # nolint
+  data(FoodExpenditure, package = "betareg")
+  m <- glmmTMB::glmmTMB(
+    I(food / income) ~ income + (1 | persons),
+    ziformula = ~1,
+    data = FoodExpenditure,
+    na.action = "na.fail",
+    family = glmmTMB::beta_family()
+  )
+  set.seed(123)
+  dr <- MuMIn::dredge(m)
+  avg <- MuMIn::model.avg(object = dr, fit = TRUE)
+  mp <- model_parameters(avg)
+  expect_snapshot(print(mp))
+})
+
+
+withr::with_options(
+  list(na.action = "na.fail"),
+  test_that("ggpredict, poly averaging", {
+    library(MuMIn)
+    data(mtcars)
+    mtcars$am <- factor(mtcars$am)
+
+    set.seed(123)
+    m <- lm(disp ~ mpg + I(mpg^2) + am + gear, mtcars)
+    dr <- MuMIn::dredge(m, subset = dc(mpg, I(mpg^2)))
+    dr <- subset(dr, !(has(mpg) & !has(I(mpg^2))))
+    mod.avg.i <- MuMIn::model.avg(dr, fit = TRUE)
+    mp <- model_parameters(mod.avg.i)
+    expect_snapshot(print(mp))
+  })
+)
+
+unloadNamespace("MuMIn")