display() and paired t-test output

Fixes #1085

Author: strengejacke

DESCRIPTION

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

NEWS.md

@@ -9,6 +9,11 @@
 * `model_parameters()` now shows a more informative coefficient name for binomial
   models with probit-link.
 
+## Bug fixes
+
+* Fixed printing issue with `model_parameters()` for `htest` objects when
+  printing into markdown or HTMP format.
+
 # parameters 0.24.2
 
 ## Changes

R/format.R

@@ -97,6 +97,17 @@ format.parameters_model <- function(x,
     colnames(x)[which(colnames(x) == "Mean_Group2")] <- paste0(x$Group, " = ", mean_group_values[2])
   }
 
+  # for htests, remove "$" from variable name, since this can make troubles
+  # when rendering into different output formats
+  if (!is.null(htest_type)) {
+    if (grepl("$", x$Parameter, fixed = TRUE)) {
+      x$Parameter <- gsub("(.*)\\$(.*)", "\\2", x$Parameter)
+    }
+    if (grepl("$", x$Group, fixed = TRUE)) {
+      x$Group <- gsub("(.*)\\$(.*)", "\\2", x$Group)
+    }
+  }
+
   # 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. ")

R/methods_htest.R

@@ -178,14 +178,17 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) {
 
 #' @keywords internal
 .extract_htest_boxpierce <- function(model) {
-  data.frame(
+  out <- data.frame(
     Parameter = model$data.name,
     Chi2 = model$statistic,
     df_error = model$parameter,
     p = model$p.value,
     Method = model$method,
     stringsAsFactors = FALSE
   )
+
+  attr(out, "htest_type") <- "boxpiercetest"
+  out
 }
 
 
@@ -232,6 +235,7 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) {
   )
 
   out <- out[col_order[col_order %in% names(out)]]
+  attr(out, "htest_type") <- "cortest"
   out
 }
 
@@ -283,6 +287,7 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) {
     out$Method <- model$method
   }
 
+  attr(out, "htest_type") <- "ranktest"
   out
 }
 
@@ -291,22 +296,25 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) {
 
 #' @keywords internal
 .extract_htest_levenetest <- function(model) {
-  data.frame(
+  out <- data.frame(
     df = model$Df[1],
     df_error = model$Df[2],
     `F` = model$`F value`[1], # nolint
     p = model$`Pr(>F)`[1],
     Method = "Levene's Test for Homogeneity of Variance",
     stringsAsFactors = FALSE
   )
+
+  attr(out, "htest_type") <- "levenetest"
+  out
 }
 
 
 # extract htest var.test ----------------------
 
 #' @keywords internal
 .extract_htest_vartest <- function(model) {
-  data.frame(
+  out <- data.frame(
     Parameter = model$data.name,
     Estimate = model$estimate,
     df = model$parameter[1],
@@ -318,6 +326,9 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) {
     Method = "F test to compare two variances",
     stringsAsFactors = FALSE
   )
+
+  attr(out, "htest_type") <- "vartest"
+  out
 }
 
 
@@ -433,14 +444,17 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) {
 
 #' @keywords internal
 .extract_htest_oneway <- function(model) {
-  data.frame(
+  out <- data.frame(
     `F` = model$statistic, # nolint
     df = model$parameter[1],
     df_error = model$parameter[2],
     p = model$p.value,
     Method = model$method,
     stringsAsFactors = FALSE
   )
+
+  attr(out, "htest_type") <- "onewaytest"
+  out
 }
 
 
@@ -455,7 +469,7 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) {
       model$method <- gsub("(Pearson's X\\^2: )(.*)", "Pearson's Chi2 \\(\\2\\)", model$method)
     }
     if (names(model$statistic) == "F") {
-      data.frame(
+      out <- data.frame(
         `F` = model$statistic, # nolint
         df = model$parameter[1],
         df_error = model$parameter[2],
@@ -464,7 +478,7 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) {
         stringsAsFactors = FALSE
       )
     } else {
-      data.frame(
+      out <- data.frame(
         Chi2 = model$statistic,
         df = model$parameter,
         p = model$p.value,
@@ -473,7 +487,7 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) {
       )
     }
   } else if (!is.null(model$estimate) && identical(names(model$estimate), "odds ratio")) {
-    data.frame(
+    out <- data.frame(
       `Odds Ratio` = model$estimate,
       # CI = attributes(model$conf.int)$conf.level,
       CI_low = model$conf.int[1],
@@ -484,14 +498,17 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) {
       check.names = FALSE
     )
   } else {
-    data.frame(
+    out <- data.frame(
       Chi2 = model$statistic,
       df = model$parameter,
       p = model$p.value,
       Method = model$method,
       stringsAsFactors = FALSE
     )
   }
+
+  attr(out, "htest_type") <- "chi2test"
+  out
 }
 
 
@@ -518,6 +535,7 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) {
   out$Null_value <- model$null.value
   out$p <- model$p.value
   out$Method <- model$method
+  attr(out, "htest_type") <- "proptest"
   out
 }
 
@@ -537,6 +555,7 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) {
   out$Null_value <- model$null.value
   out$p <- model$p.value
   out$Method <- model$method
+  attr(out, "htest_type") <- "binomtest"
   out
 }