add print_html method

Author: strengejacke

NAMESPACE

@@ -613,6 +613,7 @@ S3method(print,parameters_sem)
 S3method(print,parameters_simulate)
 S3method(print,parameters_standardized)
 S3method(print_html,compare_parameters)
+S3method(print_html,equivalence_test_lm)
 S3method(print_html,parameters_brms_meta)
 S3method(print_html,parameters_efa)
 S3method(print_html,parameters_efa_summary)

R/equivalence_test.R

@@ -854,3 +854,73 @@ plot.equivalence_test_lm <- function(x, ...) {
   insight::check_if_installed("see")
   NextMethod()
 }
+
+
+# helper for print_html / print_md --------------------
+
+.print_equivalence_test_lm <- function(
+  x,
+  digits = 2,
+  ci_brackets = c("(", ")"),
+  zap_small = FALSE,
+  format = "markdown",
+  ...
+) {
+  rule <- attributes(x)$rule
+  rope <- attributes(x)$rope
+
+  if (is.null(rule)) {
+    table_caption <- "Test for Practical Equivalence"
+  } else if (rule == "cet") {
+    table_caption <- "Conditional Equivalence Testing"
+  } else if (rule == "classic") {
+    table_caption <- "TOST-test for Practical Equivalence"
+  } else {
+    table_caption <- "Test for Practical Equivalence"
+  }
+
+  if ("Component" %in% colnames(x)) {
+    x <- x[x$Component %in% c("conditional", "count"), ]
+  }
+
+  formatted_table <- insight::format_table(
+    x,
+    pretty_names = TRUE,
+    digits = digits,
+    ci_width = NULL,
+    ci_brackets = ci_brackets,
+    zap_small = zap_small,
+    ...
+  )
+
+  colnames(formatted_table)[which(colnames(formatted_table) == "Equivalence (ROPE)")] <- "H0"
+  formatted_table$ROPE <- NULL
+
+  # col_order <- c("Parameter", "H0", "% in ROPE", colnames(formatted_table)[grepl(" CI$", colnames(formatted_table))])
+  # col_order <- c(col_order, setdiff(colnames(formatted_table), col_order))
+  # formatted_table <- formatted_table[col_order]
+
+  # replace brackets by parenthesis
+  if (!is.null(ci_brackets) && "Parameter" %in% colnames(formatted_table)) {
+    formatted_table$Parameter <- gsub("[", ci_brackets[1], formatted_table$Parameter, fixed = TRUE)
+    formatted_table$Parameter <- gsub("]", ci_brackets[2], formatted_table$Parameter, fixed = TRUE)
+  }
+
+  if (!is.null(rope)) {
+    names(formatted_table)[names(formatted_table) == "% in ROPE"] <- sprintf(
+      "%% in ROPE (%.*f, %.*f)",
+      digits,
+      rope[1],
+      digits,
+      rope[2]
+    ) # nolint
+  }
+
+  insight::export_table(
+    formatted_table,
+    format = format,
+    caption = table_caption,
+    align = "firstleft",
+    ...
+  )
+}

R/print.parameters_model.R

@@ -101,12 +101,6 @@
 #' so this is just for completeness.
 #' @param align Only applies to HTML tables. May be one of `"left"`,
 #' `"right"` or `"center"`.
-#' @param digits,ci_digits,p_digits Number of digits for rounding or
-#' significant figures. May also be `"signif"` to return significant
-#' figures or `"scientific"` to return scientific notation. Control the
-#' number of digits by adding the value as suffix, e.g. `digits = "scientific4"`
-#' to have scientific notation with 4 decimal places, or `digits = "signif5"`
-#' for 5 significant figures (see also [signif()]).
 #' @param subtitle Table title (same as caption) and subtitle, as strings. If `NULL`,
 #' no title or subtitle is printed, unless it is stored as attributes (`table_title`,
 #' or its alias `table_caption`, and `table_subtitle`). If `x` is a list of

R/print_html.R

@@ -347,6 +347,27 @@ print_html.parameters_efa_summary <- function(x, digits = 3, ...) {
 print_html.parameters_pca_summary <- print_html.parameters_efa_summary
 
 
+# Equivalence test ----------------------------
+
+#' @export
+print_html.equivalence_test_lm <- function(
+  x,
+  digits = 2,
+  ci_brackets = c("(", ")"),
+  zap_small = FALSE,
+  ...
+) {
+  .print_equivalence_test_lm(
+    x,
+    digits = digits,
+    ci_brackets = ci_brackets,
+    zap_small = zap_small,
+    format = .check_format_backend(...),
+    ...
+  )
+}
+
+
 # p_function ----------------------------
 
 #' @rdname p_function

R/print_md.R

@@ -295,61 +295,13 @@ print_md.equivalence_test_lm <- function(
   zap_small = FALSE,
   ...
 ) {
-  rule <- attributes(x)$rule
-  rope <- attributes(x)$rope
-
-  if (is.null(rule)) {
-    table_caption <- "Test for Practical Equivalence"
-  } else if (rule == "cet") {
-    table_caption <- "Conditional Equivalence Testing"
-  } else if (rule == "classic") {
-    table_caption <- "TOST-test for Practical Equivalence"
-  } else {
-    table_caption <- "Test for Practical Equivalence"
-  }
-
-  if ("Component" %in% colnames(x)) {
-    x <- x[x$Component %in% c("conditional", "count"), ]
-  }
-
-  formatted_table <- insight::format_table(
+  .print_equivalence_test_lm(
     x,
-    pretty_names = TRUE,
     digits = digits,
-    ci_width = NULL,
     ci_brackets = ci_brackets,
     zap_small = zap_small,
-    ...
-  )
-
-  colnames(formatted_table)[which(colnames(formatted_table) == "Equivalence (ROPE)")] <- "H0"
-  formatted_table$ROPE <- NULL
-
-  # col_order <- c("Parameter", "H0", "% in ROPE", colnames(formatted_table)[grepl(" CI$", colnames(formatted_table))])
-  # col_order <- c(col_order, setdiff(colnames(formatted_table), col_order))
-  # formatted_table <- formatted_table[col_order]
-
-  # replace brackets by parenthesis
-  if (!is.null(ci_brackets) && "Parameter" %in% colnames(formatted_table)) {
-    formatted_table$Parameter <- gsub("[", ci_brackets[1], formatted_table$Parameter, fixed = TRUE)
-    formatted_table$Parameter <- gsub("]", ci_brackets[2], formatted_table$Parameter, fixed = TRUE)
-  }
-
-  if (!is.null(rope)) {
-    names(formatted_table)[names(formatted_table) == "% in ROPE"] <- sprintf(
-      "%% in ROPE (%.*f, %.*f)",
-      digits,
-      rope[1],
-      digits,
-      rope[2]
-    ) # nolint
-  }
-
-  insight::export_table(
-    formatted_table,
     format = "markdown",
-    caption = table_caption,
-    align = "firstleft"
+    ...
   )
 }