add snapshot

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: parameters
 Title: Processing of Model Parameters
-Version: 0.21.5.2
+Version: 0.21.5.3
 Authors@R:
     c(person(given = "Daniel",
              family = "Lüdecke",
@@ -193,6 +193,7 @@ Suggests:
     rstanarm,
     sandwich,
     see (>= 0.8.1),
+    serp,
     sparsepca,
     survey,
     survival,
@@ -217,3 +218,4 @@ Config/Needs/website:
     r-lib/pkgdown,
     easystats/easystatstemplate
 Config/rcmdcheck/ignore-inconsequential-notes: true
+Remotes: easystats/insight

NAMESPACE

@@ -167,6 +167,7 @@ S3method(degrees_of_freedom,rq)
 S3method(degrees_of_freedom,rqs)
 S3method(degrees_of_freedom,rqss)
 S3method(degrees_of_freedom,selection)
+S3method(degrees_of_freedom,serp)
 S3method(degrees_of_freedom,summary.lm)
 S3method(degrees_of_freedom,systemfit)
 S3method(degrees_of_freedom,truncreg)

R/methods_serp.R

@@ -0,0 +1,14 @@
+#' @export
+degrees_of_freedom.serp <- function(model, method = "normal", ...) {
+  if (is.null(method)) {
+    method <- "wald"
+  }
+
+  method <- match.arg(tolower(method), choices = c("analytical", "any", "fit", "wald", "residual", "normal"))
+
+  if (method %in% c("residual", "fit")) {
+    model$rdf
+  } else {
+    degrees_of_freedom.default(model, method = method, ...)
+  }
+}

tests/testthat/_snaps/serp.md

@@ -0,0 +1,34 @@
+# model_parameters.serp
+
+    Code
+      print(mp)
+    Output
+      Parameter                  | Log-Odds |   SE |         95% CI |     z |      p
+      ------------------------------------------------------------------------------
+      (Intercept):1              |     1.40 | 0.54 | [ 0.33,  2.46] |  2.57 | 0.010 
+      (Intercept):2              |    -1.13 | 0.51 | [-2.13, -0.12] | -2.19 | 0.028 
+      (Intercept):3              |    -3.44 | 0.71 | [-4.84, -2.04] | -4.82 | < .001
+      (Intercept):4              |    -4.98 | 0.95 | [-6.85, -3.11] | -5.23 | < .001
+      tempwarm:1                 |     2.38 | 0.81 | [ 0.79,  3.97] |  2.93 | 0.003 
+      tempwarm:2                 |     2.26 | 0.71 | [ 0.87,  3.66] |  3.18 | 0.001 
+      tempwarm:3                 |     2.41 | 0.77 | [ 0.89,  3.92] |  3.11 | 0.002 
+      tempwarm:4                 |     2.51 | 0.88 | [ 0.79,  4.23] |  2.85 | 0.004 
+      contactyes:1               |     1.38 | 0.74 | [-0.08,  2.84] |  1.85 | 0.064 
+      contactyes:2               |     1.35 | 0.67 | [ 0.03,  2.66] |  2.01 | 0.044 
+      contactyes:3               |     1.35 | 0.76 | [-0.13,  2.83] |  1.78 | 0.075 
+      contactyes:4               |     1.22 | 0.86 | [-0.46,  2.89] |  1.42 | 0.156 
+      temp [warm] × contactyes:1 |     0.37 | 1.12 | [-1.82,  2.56] |  0.33 | 0.741 
+      temp [warm] × contactyes:2 |     0.35 | 1.03 | [-1.66,  2.37] |  0.34 | 0.730 
+      temp [warm] × contactyes:3 |     0.36 | 0.97 | [-1.55,  2.26] |  0.37 | 0.713 
+      temp [warm] × contactyes:4 |     0.32 | 1.02 | [-1.68,  2.33] |  0.32 | 0.751 
+    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.
+        
+      Some coefficients are very large, which may indicate issues with
+        complete separation.
+

tests/testthat/test-serp.R

@@ -0,0 +1,26 @@
+skip_if_not_installed("serp")
+skip_if_not_installed("insight", minimum_version = "0.19.8.4")
+
+test_that("model_parameters.serp", {
+  data(wine, package = "serp")
+  m1 <- serp::serp(
+    rating ~ temp * contact, slope = "penalize",
+    link = "logit", reverse = TRUE, tuneMethod = "user",
+    lambda = 5, data = ordinal::wine
+  )
+  mp <- model_parameters(m1)
+  expect_snapshot(print(mp))
+
+  # validate against coef
+  out <- coef(summary(m1))
+  expect_equal(mp$Coefficient, out[, 1], tolerance = 1e-4, ignore_attr = TRUE)
+  expect_equal(mp$SE, out[, 2], tolerance = 1e-4, ignore_attr = TRUE)
+  expect_equal(mp$z, out[, 3], tolerance = 1e-4, ignore_attr = TRUE)
+  expect_equal(mp$p, out[, 4], tolerance = 1e-4, ignore_attr = TRUE)
+
+  out <- confint(m1)
+  expect_equal(mp$CI_low, out[, 1], tolerance = 1e-4, ignore_attr = TRUE)
+
+  expect_equal(degrees_of_freedom(m1), Inf, tolerance = 1e-3)
+  expect_equal(degrees_of_freedom(m1, "residual"), 279.5938, tolerance = 1e-3)
+})