Add support for WeightIt

easystats · Aug 31, 2024 · 45eee0d · 45eee0d
1 parent e7f6c44
commit 45eee0d
Show file tree

Hide file tree

Showing 7 changed files with 145 additions and 3 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Type: Package
 Package: parameters
 Title: Processing of Model Parameters
-Version: 0.22.1.8
+Version: 0.22.1.9
 Authors@R:
     c(person(given = "Daniel",
              family = "Lüdecke",
@@ -108,6 +108,7 @@ Suggests:
     ClassDiscovery,
     clubSandwich,
     cluster,
+    cobalt,
     coda,
     coxme,
     cplm,
@@ -207,6 +208,7 @@ Suggests:
     truncreg,
     vdiffr,
     VGAM,
+    WeightIt,
     withr,
     WRS2
 VignetteBuilder:

diff --git a/NAMESPACE b/NAMESPACE
@@ -82,11 +82,13 @@ S3method(ci,mmrm_fit)
 S3method(ci,mmrm_tmb)
 S3method(ci,model_fit)
 S3method(ci,multinom)
+S3method(ci,multinom_weightit)
 S3method(ci,negbin)
 S3method(ci,negbinirr)
 S3method(ci,negbinmfx)
 S3method(ci,nestedLogit)
 S3method(ci,nlrq)
+S3method(ci,ordinal_weightit)
 S3method(ci,parameters_standardized)
 S3method(ci,pgmm)
 S3method(ci,phyloglm)
@@ -293,13 +295,15 @@ S3method(model_parameters,mmrm_fit)
 S3method(model_parameters,mmrm_tmb)
 S3method(model_parameters,model_fit)
 S3method(model_parameters,multinom)
+S3method(model_parameters,multinom_weightit)
 S3method(model_parameters,mvord)
 S3method(model_parameters,negbin)
 S3method(model_parameters,negbinirr)
 S3method(model_parameters,negbinmfx)
 S3method(model_parameters,nestedLogit)
 S3method(model_parameters,omega)
 S3method(model_parameters,onesampb)
+S3method(model_parameters,ordinal_weightit)
 S3method(model_parameters,osrt)
 S3method(model_parameters,pairwise.htest)
 S3method(model_parameters,pam)
@@ -450,6 +454,7 @@ S3method(p_value,mmrm_fit)
 S3method(p_value,mmrm_tmb)
 S3method(p_value,model_fit)
 S3method(p_value,multinom)
+S3method(p_value,multinom_weightit)
 S3method(p_value,mvord)
 S3method(p_value,negbin)
 S3method(p_value,negbinirr)
@@ -458,6 +463,7 @@ S3method(p_value,nestedLogit)
 S3method(p_value,nlrq)
 S3method(p_value,numeric)
 S3method(p_value,ols)
+S3method(p_value,ordinal_weightit)
 S3method(p_value,pggls)
 S3method(p_value,pglm)
 S3method(p_value,plm)
@@ -787,6 +793,7 @@ S3method(standard_error,mmrm_fit)
 S3method(standard_error,mmrm_tmb)
 S3method(standard_error,model_fit)
 S3method(standard_error,multinom)
+S3method(standard_error,multinom_weightit)
 S3method(standard_error,mvord)
 S3method(standard_error,mvstanreg)
 S3method(standard_error,negbin)
@@ -796,6 +803,7 @@ S3method(standard_error,nestedLogit)
 S3method(standard_error,nlrq)
 S3method(standard_error,numeric)
 S3method(standard_error,ols)
+S3method(standard_error,ordinal_weightit)
 S3method(standard_error,parameters_kurtosis)
 S3method(standard_error,parameters_skewness)
 S3method(standard_error,parameters_standardized)

diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,10 @@
 # parameters 0.22.2
 
+## New supported models
+
+* Support for models `glm_weightit`, `multinom_weightit` and `ordinal_weightit`
+  from package *WeightIt*.
+
 ## Changes
 
 * Methods for `degrees_of_freedom()` have been removed. `degrees_of_freedom()`

diff --git a/R/extract_parameters.R b/R/extract_parameters.R
@@ -91,6 +91,9 @@
       c("intercept", "location", "scale"),
       lengths(model[c("Alpha", "beta", "zeta")])
     )
+  } else if (inherits(model, "ordinal_weightit")) {
+    intercept_groups <- rep("conditional", nrow(parameters))
+    intercept_groups[grep("|", parameters$Parameter, fixed = TRUE)] <- "intercept"
   } else {
     intercept_groups <- NULL
   }
@@ -173,7 +176,6 @@
 
   # ==== test statistic - fix values for robust vcov
 
-
   # deprecated argument `robust = TRUE`
   if (!is.null(vcov) || isTRUE(dots[["robust"]])) {
     parameters$Statistic <- parameters$Estimate / parameters$SE
@@ -223,7 +225,7 @@
   if (inherits(model, "polr") && !is.null(intercept_groups)) {
     parameters$Component <- "beta"
     parameters$Component[intercept_groups] <- "alpha"
-  } else if (inherits(model, c("clm", "clm2")) && !is.null(intercept_groups)) {
+  } else if (inherits(model, c("clm", "clm2", "ordinal_weightit")) && !is.null(intercept_groups)) {
     parameters$Component <- intercept_groups
   }
 

diff --git a/R/methods_weightit.R b/R/methods_weightit.R
@@ -0,0 +1,31 @@
+# model parameters -------------------
+
+#' @export
+model_parameters.ordinal_weightit <- model_parameters.clm2
+
+#' @export
+model_parameters.multinom_weightit <- model_parameters.bracl
+
+# CI ---------------------
+
+#' @export
+ci.ordinal_weightit <- ci.clm2
+
+#' @export
+ci.multinom_weightit <- ci.bracl
+
+# standard errors -----------------
+
+#' @export
+standard_error.ordinal_weightit <- standard_error.clm2
+
+#' @export
+standard_error.multinom_weightit <- standard_error.bracl
+
+# p values ----------------
+
+#' @export
+p_value.ordinal_weightit <- p_value.clm2
+
+#' @export
+p_value.multinom_weightit <- p_value.bracl
diff --git a/tests/testthat/_snaps/weightit.md b/tests/testthat/_snaps/weightit.md
@@ -0,0 +1,51 @@
+# weightit, multinom
+
+    Code
+      print(model_parameters(fit4))
+    Output
+      # Response level: 2
+      
+      Parameter   | Log-Odds |   SE |         95% CI |        z |     p
+      -----------------------------------------------------------------
+      (Intercept) | 1.68e-03 | 0.62 | [-1.22,  1.22] | 2.71e-03 | 0.998
+      treat       |     0.07 | 0.24 | [-0.39,  0.54] |     0.31 | 0.755
+      age         |    -0.03 | 0.01 | [-0.05, -0.01] |    -2.38 | 0.018
+      educ        |    -0.02 | 0.05 | [-0.11,  0.08] |    -0.33 | 0.738
+      
+      # Response level: 3
+      
+      Parameter   |  Log-Odds |   SE |         95% CI |     z |      p
+      ----------------------------------------------------------------
+      (Intercept) |     -3.01 | 0.71 | [-4.40, -1.61] | -4.23 | < .001
+      treat       |      0.16 | 0.25 | [-0.32,  0.64] |  0.67 | 0.502 
+      age         | -1.70e-04 | 0.01 | [-0.02,  0.02] | -0.01 | 0.989 
+      educ        |      0.18 | 0.05 | [ 0.08,  0.29] |  3.51 | < .001
+    Message
+      
+      Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed
+        using a Wald z-distribution approximation.
+
+# weightit, ordinal
+
+    Code
+      print(model_parameters(fit5))
+    Output
+      # Fixed Effects
+      
+      Parameter |  Log-Odds |       SE |        95% CI |     z |     p
+      ----------------------------------------------------------------
+      treat     |      0.11 |     0.19 | [-0.25, 0.48] |  0.60 | 0.549
+      age       | -7.77e-03 | 9.97e-03 | [-0.03, 0.01] | -0.78 | 0.436
+      educ      |      0.11 |     0.04 | [ 0.03, 0.18] |  2.70 | 0.007
+      
+      # Intercept
+      
+      Parameter | Log-Odds |   SE |       95% CI |    z |      p
+      ----------------------------------------------------------
+      1|2       |     1.19 | 0.52 | [0.17, 2.20] | 2.30 | 0.022 
+      2|3       |     2.29 | 0.51 | [1.28, 3.29] | 4.47 | < .001
+    Message
+      
+      Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed
+        using a Wald z-distribution approximation.
+
diff --git a/tests/testthat/test-weightit.R b/tests/testthat/test-weightit.R
@@ -0,0 +1,43 @@
+skip_if_not_installed("WeightIt")
+skip_if_not_installed("cobalt")
+skip_if_not_installed("insight", minimum_version = "0.20.4")
+
+test_that("weightit, multinom", {
+  data("lalonde", package = "cobalt")
+  set.seed(1234)
+  # Logistic regression ATT weights
+  w.out <- WeightIt::weightit(
+    treat ~ age + educ + married + re74,
+    data = lalonde,
+    method = "glm",
+    estimand = "ATT"
+  )
+  lalonde$re78_3 <- factor(findInterval(lalonde$re78, c(0, 5e3, 1e4)))
+
+  fit4 <- WeightIt::multinom_weightit(
+    re78_3 ~ treat + age + educ,
+    data = lalonde,
+    weightit = w.out
+  )
+  expect_snapshot(print(model_parameters(fit4)))
+})
+
+test_that("weightit, ordinal", {
+  data("lalonde", package = "cobalt")
+  set.seed(1234)
+  # Logistic regression ATT weights
+  w.out <- WeightIt::weightit(
+    treat ~ age + educ + married + re74,
+    data = lalonde,
+    method = "glm",
+    estimand = "ATT"
+  )
+  lalonde$re78_3 <- factor(findInterval(lalonde$re78, c(0, 5e3, 1e4)))
+
+  fit5 <- WeightIt::ordinal_weightit(
+    ordered(re78_3) ~ treat + age + educ,
+    data = lalonde,
+    weightit = w.out
+  )
+  expect_snapshot(print(model_parameters(fit5)))
+})