Add support for WRS2::yuenbt() and WRS2::pb2gen()

Fixes #1083

Author: strengejacke

DESCRIPTION

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

NAMESPACE

@@ -310,6 +310,7 @@ S3method(model_parameters,pairwise.htest)
 S3method(model_parameters,pam)
 S3method(model_parameters,parameters_efa)
 S3method(model_parameters,parameters_pca)
+S3method(model_parameters,pb2)
 S3method(model_parameters,pgmm)
 S3method(model_parameters,poissonirr)
 S3method(model_parameters,poissonmfx)

NEWS.md

@@ -11,6 +11,8 @@
 
 * Argument `wb_component` now defaults to `FALSE`.
 
+* Improved support and printing for tests from package *WRS2*.
+
 ## Bug fixes
 
 * Fixed printing issue with `model_parameters()` for `htest` objects when

R/format.R

@@ -109,13 +109,6 @@ format.parameters_model <- function(x,
     }
   }
 
-  # Special print for mcp from WRS2
-  if (!is.null(m_class) && any(m_class %in% c("mcp1", "mcp2"))) {
-    x$Group1 <- paste(x$Group1, x$Group2, sep = " vs. ")
-    x$Group2 <- NULL
-    colnames(x)[1] <- "Group"
-  }
-
   # check if we have mixed models with random variance parameters
   # in such cases, we don't need the group-column, but we rather
   # merge it with the parameter column

R/methods_wrs2.R

@@ -133,49 +133,63 @@ model_parameters.yuen <- function(model, verbose = TRUE, ...) {
   fcall <- insight::safe_deparse(model$call)
 
   # the latter regexe covers `rlang::exec` or `do.call` instances
-
-  # between-subjects
   if (grepl("^(yuen\\(|WRS2::yuen\\()", fcall) ||
+    grepl("^(yuenbt\\(|WRS2::yuenbt\\()", fcall) ||
     grepl("function (formula, data, tr = 0.2, ...)", fcall, fixed = TRUE)) {
-    out <- data.frame(
-      t = model$test,
-      df_error = model$df,
-      p = model$p.value,
-      Method = "Yuen's test on trimmed means for independent samples",
-      Difference = model$diff,
-      CI = 0.95,
-      Difference_CI_low = model$conf.int[1],
-      Difference_CI_high = model$conf.int[2],
-      Estimate = model$effsize,
-      Effectsize = "Explanatory measure of effect size",
-      stringsAsFactors = FALSE
-    )
+    # between-subjects
+    method <- "Yuen's test on trimmed means for independent samples"
   } else {
     # within-subjects
-    out <- data.frame(
-      t = model$test,
-      df_error = model$df,
-      p = model$p.value,
-      Method = "Yuen's test on trimmed means for dependent samples",
-      Difference = model$diff,
-      CI = 0.95,
-      Difference_CI_low = model$conf.int[1],
-      Difference_CI_high = model$conf.int[2],
-      Estimate = model$effsize,
-      Effectsize = "Explanatory measure of effect size",
-      stringsAsFactors = FALSE
-    )
+    method <- "Yuen's test on trimmed means for dependent samples"
+  }
+
+  out <- data.frame(
+    t = model$test,
+    df_error = model$df,
+    p = model$p.value,
+    Method = method,
+    Difference = model$diff,
+    CI = 0.95,
+    Difference_CI_low = model$conf.int[1],
+    Difference_CI_high = model$conf.int[2],
+    stringsAsFactors = FALSE
+  )
+
+  if (!is.null(model$effsize)) {
+    out$Estimate <- model$effsize
+    out$Effectsize <- "Explanatory measure of effect size"
   }
 
   out
 }
 
+#' @export
+model_parameters.pb2 <- function(model, verbose = TRUE, ...) {
+  parameters <- .extract_wrs2_pb2(model)
+  parameters <- .add_htest_parameters_attributes(parameters, model, ...)
+  class(parameters) <- c("parameters_model", "see_parameters_model", class(parameters))
+  parameters
+}
+
+.extract_wrs2_pb2 <- function(model) {
+  data.frame(
+    t = model$test,
+    p = model$p.value,
+    Method = "Robust t-test for independent samples",
+    CI = 0.95,
+    CI_low = model$conf.int[1],
+    CI_high = model$conf.int[2],
+    stringsAsFactors = FALSE
+  )
+}
+
 # pairwise comparisons ----------------------
 
 #' @export
 model_parameters.mcp1 <- function(model, verbose = TRUE, ...) {
   parameters <- .extract_wrs2_mcp12(model)
   parameters <- .add_htest_parameters_attributes(parameters, model, ...)
+  attr(parameters, "no_caption") <- TRUE
   class(parameters) <- c("parameters_model", "see_parameters_model", class(parameters))
   parameters
 }
@@ -200,6 +214,7 @@ model_parameters.mcp2 <- model_parameters.mcp1
   # reorder
   col_order <- c("Group1", "Group2", "Psihat", "CI", "CI_low", "CI_high", "p", "p.crit")
   out <- out[col_order[col_order %in% names(out)]]
+  attr(parameters, "no_caption") <- TRUE
 
   out
 }

tests/testthat/_snaps/wrs2.md

@@ -0,0 +1,11 @@
+# model_parameters.mcp and robtab
+
+    Code
+      print(df_b, table_width = Inf)
+    Output
+      Group1  | Group2 | Psihat |        95% CI |     p
+      -------------------------------------------------
+      placebo |    low |  -1.00 | [-5.32, 3.32] | 0.435
+      placebo |   high |  -3.00 | [-7.32, 1.32] | 0.181
+      low     |   high |  -2.00 | [-6.32, 2.32] | 0.317
+

tests/testthat/test-wrs2.R

@@ -8,16 +8,31 @@ data(spider, package = "WRS2")
 test_that("model_parameters.t1way", {
   set.seed(123)
   df_b <- model_parameters(WRS2::t1way(libido ~ dose, data = viagra))
+  expect_named(
+    df_b,
+    c(
+      "F", "df", "df_error", "p", "Method", "Estimate", "CI", "CI_low",
+      "CI_high", "Effectsize"
+    )
+  )
 
   set.seed(123)
   df_w <- model_parameters(WRS2::rmanova(WineTasting$Taste, WineTasting$Wine, WineTasting$Taster))
+  expect_named(df_w, c("F", "df", "df_error", "p", "Method"))
 })
 
 # model_parameters.yuen ---------------------------------------------------
 
 test_that("model_parameters.yuen", {
   set.seed(123)
   df_b <- model_parameters(WRS2::yuen(Anxiety ~ Group, data = spider))
+  expect_named(
+    df_b,
+    c(
+      "t", "df_error", "p", "Method", "Difference", "CI", "Difference_CI_low",
+      "Difference_CI_high", "Estimate", "Effectsize"
+    )
+  )
 
   before <- c(190, 210, 300, 240, 280, 170, 280, 250, 240, 220)
   after <- c(210, 210, 340, 190, 260, 180, 200, 220, 230, 200)
@@ -30,6 +45,7 @@ test_that("model_parameters.yuen", {
 test_that("model_parameters.mcp and robtab", {
   set.seed(123)
   df_b <- model_parameters(WRS2::lincon(libido ~ dose, data = viagra))
+  expect_snapshot(print(df_b, table_width = Inf))
 
   set.seed(123)
   df_w <- model_parameters(WRS2::rmmcp(WineTasting$Taste, WineTasting$Wine, WineTasting$Taster))