Inconsistent formatting of p-values

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: performance
 Title: Assessment of Regression Models Performance
-Version: 0.14.0.1
+Version: 0.14.0.2
 Authors@R:
     c(person(given = "Daniel",
              family = "Lüdecke",

NAMESPACE

@@ -143,11 +143,13 @@ S3method(cronbachs_alpha,parameters_pca)
 S3method(display,check_itemscale)
 S3method(display,compare_performance)
 S3method(display,performance_model)
+S3method(display,test_likelihoodratio)
 S3method(display,test_performance)
 S3method(fitted,BFBayesFactor)
 S3method(format,compare_performance)
 S3method(format,performance_model)
 S3method(format,performance_rmse)
+S3method(format,test_likelihoodratio)
 S3method(format,test_performance)
 S3method(logLik,cpglm)
 S3method(logLik,iv_robust)
@@ -345,10 +347,12 @@ S3method(print,test_performance)
 S3method(print_html,check_group_variation)
 S3method(print_html,check_itemscale)
 S3method(print_html,compare_performance)
+S3method(print_html,test_likelihoodratio)
 S3method(print_html,test_performance)
 S3method(print_md,check_itemscale)
 S3method(print_md,compare_performance)
 S3method(print_md,performance_model)
+S3method(print_md,test_likelihoodratio)
 S3method(print_md,test_performance)
 S3method(r2,Arima)
 S3method(r2,BBreg)

NEWS.md

@@ -1,3 +1,10 @@
+# performance (devel)
+
+## Changes
+
+* Formatting of p-values in `test_likelihoodratio()` is now consistent with
+  formatted p-values from other functions.
+
 # performance 0.14.0
 
 ## Breaking Changes

R/test_likelihoodratio.R

@@ -67,6 +67,13 @@ plot.test_likelihoodratio <- function(x, ...) {
 
 #' @export
 print.test_likelihoodratio <- function(x, digits = 2, ...) {
+  cat(insight::export_table(format(x, digits = digits, ...), digits = digits, ...))
+  invisible(x)
+}
+
+
+#' @export
+format.test_likelihoodratio <- function(x, digits = 2, p_digits = 3, ...) {
   # Footer
   if ("LogLik" %in% names(x)) {
     best <- which.max(x$LogLik)
@@ -76,22 +83,39 @@ print.test_likelihoodratio <- function(x, digits = 2, ...) {
   }
 
   # value formatting
-  x$p <- insight::format_p(x$p, name = NULL)
+  x$p <- insight::format_p(x$p, digits = p_digits, name = NULL, ...)
 
   if (is.null(attributes(x)$estimator)) {
     estimator_string <- ""
   } else {
     estimator_string <- sprintf(" (%s-estimator)", toupper(attributes(x)$estimator))
   }
 
-  cat(insight::export_table(
-    x,
-    digits = digits,
-    caption = c(paste0("# Likelihood-Ratio-Test (LRT) for Model Comparison", estimator_string), "blue"),
-    footer = footer
-  ))
+  attr(x, "table_footer") <- footer
+  attr(x, "table_caption") <- c(paste0("# Likelihood-Ratio-Test (LRT) for Model Comparison", estimator_string), "blue")
+  x
+}
 
-  invisible(x)
+
+#' @export
+print_md.test_likelihoodratio <- function(x, digits = 2, ...) {
+  insight::export_table(format(x, digits = digits, ...), format = "markdown", ...)
+}
+
+
+#' @export
+print_html.test_likelihoodratio <- function(x, digits = 2, ...) {
+  insight::export_table(format(x, digits = digits, ...), format = "html", ...)
+}
+
+
+#' @export
+display.test_likelihoodratio <- function(object, format = "markdown", digits = 2, ...) {
+  if (format == "markdown") {
+    print_md(x = object, digits = digits, ...)
+  } else {
+    print_html(x = object, digits = digits, ...)
+  }
 }
 
 

tests/testthat/_snaps/test_likelihoodratio.md

@@ -0,0 +1,28 @@
+# test_likelihoodratio - print p-digits
+
+    Code
+      test_likelihoodratio(m1, m2)
+    Output
+      # Likelihood-Ratio-Test (LRT) for Model Comparison (OLS-estimator)
+
+      Name | Model | df | df_diff |  Chi2 |      p
+      --------------------------------------------
+      m1   |    lm |  3 |         |       |       
+      m2   |    lm |  7 |       4 | 40.32 | < .001
+
+---
+
+    Code
+      insight::print_md(test_likelihoodratio(m1, m2), p_digits = 3)
+    Output
+      [1] "Table: # Likelihood-Ratio-Test (LRT) for Model Comparison (OLS-estimator)"
+      [2] ""                                                                         
+      [3] "|Name | Model| df| df_diff|  Chi2|      p|"                               
+      [4] "|:----|-----:|--:|-------:|-----:|------:|"                               
+      [5] "|m1   |    lm|  3|        |      |       |"                               
+      [6] "|m2   |    lm|  7|       4| 40.32| < .001|"                               
+      attr(,"format")
+      [1] "pipe"
+      attr(,"class")
+      [1] "knitr_kable" "character"  
+

tests/testthat/test-test_likelihoodratio.R

@@ -28,14 +28,14 @@
   m3 <- lm(mpg ~ wt + cyl, data = mtcars)
 
   rez <- test_likelihoodratio(m1, m2, m3)
   expect_equal(rez$Name, c("m1", "m2", "m3"))
 
   rez <- test_likelihoodratio(list(m1, m2, m3))
   expect_equal(rez$Name, c("Model 1", "Model 2", "Model 3"))
 
   models <- list(m1, m2, m3)
   rez <- test_likelihoodratio(models)
   expect_equal(rez$Name, c("Model 1", "Model 2", "Model 3"))
 })
 
 test_that("test_likelihoodratio - reversed order", {
@@ -62,7 +62,7 @@
 test_that("test_likelihoodratio - lme4 ML", {
   t1 <- test_lrt(m1, m2, m3)
   t2 <- suppressMessages(anova(m1, m2, m3))
   expect_equal(attributes(t1)$estimator, "ml")
   expect_equal(t1$Chi2, c(NA, 85.26365, 0.84141), tolerance = 1e-3)
   expect_equal(t1$p, c(NA, 0, 0.35899), tolerance = 1e-3)
   # close, but not the same
@@ -72,14 +72,14 @@
 
 test_that("test_likelihoodratio - lme4 OLS", {
   t2 <- test_lrt(m1, m2, m3, estimator = "ols")
   expect_equal(attributes(t2)$estimator, "ols")
   expect_equal(t2$Chi2, c(NA, 105.73844, 1.04346), tolerance = 1e-3)
   expect_equal(t2$p, c(NA, 0, 0.30702), tolerance = 1e-3)
 })
 
 test_that("test_likelihoodratio - lme4 REML", {
   expect_warning(t3 <- test_lrt(m1, m2, m3, estimator = "REML"))
   expect_equal(attributes(t3)$estimator, "reml")
   expect_equal(t3$Chi2, c(NA, 89.32933, 2.85635), tolerance = 1e-3)
   expect_equal(t3$p, c(NA, 0, 0.09101), tolerance = 1e-3)
 })
@@ -93,7 +93,7 @@
   t2 <- test_lrt(m1, m2, m3)
   expect_equal(t1$`Pr(>Chi)`, t2$p, tolerance = 1e-3)
   expect_equal(t1$Deviance, t2$Chi2, tolerance = 1e-3)
   expect_equal(attributes(t2)$estimator, "ml")
 })
 
 m1 <- lm(Sepal.Length ~ Petal.Width, data = iris)
@@ -104,5 +104,14 @@
   t1 <- anova(m1, m2, m3, test = "LRT")
   t2 <- test_lrt(m1, m2, m3)
   expect_equal(t1$`Pr(>Chi)`, t2$p, tolerance = 1e-3)
   expect_equal(attributes(t2)$estimator, "ols")
 })
+
+test_that("test_likelihoodratio - print p-digits", {
+  data(mtcars)
+  m1 <- lm(mpg ~ hp, data = mtcars)
+  m2 <- lm(mpg ~ hp * as.factor(gear), data = mtcars)
+
+  expect_snapshot(test_likelihoodratio(m1, m2))
+  expect_snapshot(insight::print_md(test_likelihoodratio(m1, m2), p_digits = 3))
+})