Update format_p.R to remove leading zeros consistently

NEWS.md

@@ -8,6 +8,9 @@
   `component` argument gains the `"full"` option, to return the full
   variance-covariance matrix, including the random effects (theta parameters).
 
+* `format_p()` now also gets a `lead_zero` argument, to keep or drop the leading
+  zero of a formatted p-value.
+
 * `format_table()` now also formats ROPE columns for superiority and inferiority.
 
 * `format_table()` protects integer columns for non-specific column types.

R/format_p.R

@@ -17,6 +17,9 @@
 #'   If `"scientific"`, control the number of digits by adding the value as
 #'   a suffix, e.g.m `digits = "scientific4"` to have scientific notation
 #'   with 4 decimal places.
+#' @param lead_zero Logical, if `FALSE` (default), removes leading zero
+#'   before decimal separator. Otherwise, retain leading zero except when
+#'   p value is truncated
 #' @param ... Arguments from other methods.
 #' @inheritParams format_value
 #'
@@ -40,6 +43,7 @@ format_p <- function(p,
                      missing = "",
                      decimal_separator = NULL,
                      digits = 3,
+                     lead_zero = FALSE,
                      ...) {
   # only convert p if it's a valid numeric, or at least coercible to
   # valid numeric values...
@@ -59,6 +63,15 @@ format_p <- function(p,
     digits <- 3
   }
 
+  # hard-coded thresholds for small p-values, including or excluding leading zero
+  if (lead_zero) {
+    low_p <- "< 0.001***"
+    high_p <- "> 0.999"
+  } else {
+    low_p <- "< .001***"
+    high_p <- "> .999"
+  }
+
   if (is.character(digits) && grepl("scientific", digits, fixed = TRUE)) {
     digits <- tryCatch(as.numeric(gsub("scientific", "", digits, fixed = TRUE)),
       error = function(e) NA
@@ -79,22 +92,22 @@ format_p <- function(p,
     )
   } else if (digits <= 3) {
     p_text <- ifelse(is.na(p), NA,
-      ifelse(p < 0.001, "< .001***", # nolint
-        ifelse(p < 0.01, paste0("= ", format_value(p, digits), "**"), # nolint
-          ifelse(p < 0.05, paste0("= ", format_value(p, digits), "*"), # nolint
-            ifelse(p > 0.999, "> .999", # nolint
-              paste0("= ", format_value(p, digits))
+      ifelse(p < 0.001, low_p, # nolint
+        ifelse(p < 0.01, paste0("= ", format_value(p, digits, lead_zero = lead_zero), "**"), # nolint
+          ifelse(p < 0.05, paste0("= ", format_value(p, digits, lead_zero = lead_zero), "*"), # nolint
+            ifelse(p > 0.999, high_p, # nolint
+              paste0("= ", format_value(p, digits, lead_zero = lead_zero))
             )
           )
         )
       )
     )
   } else {
     p_text <- ifelse(is.na(p), NA,
-      ifelse(p < 0.001, paste0("= ", format_value(p, digits), "***"), # nolint
-        ifelse(p < 0.01, paste0("= ", format_value(p, digits), "**"), # nolint
-          ifelse(p < 0.05, paste0("= ", format_value(p, digits), "*"), # nolint
-            paste0("= ", format_value(p, digits))
+      ifelse(p < 0.001, paste0("= ", format_value(p, digits, lead_zero = lead_zero), "***"), # nolint
+        ifelse(p < 0.01, paste0("= ", format_value(p, digits, lead_zero = lead_zero), "**"), # nolint
+          ifelse(p < 0.05, paste0("= ", format_value(p, digits, lead_zero = lead_zero), "*"), # nolint
+            paste0("= ", format_value(p, digits, lead_zero = lead_zero))
           )
         )
       )

tests/testthat/test-format.R

@@ -12,7 +12,7 @@
   expect_identical(format_value(0.0000000123, digits = 8), "0.00000001")
   expect_identical(format_value(c(0.012, 0.45, -0.03), lead_zero = FALSE), c(".01", ".45", "-.03"))
   expect_identical(format_value(c(1.012, 0.45, -0.03), lead_zero = FALSE), c("1.01", ".45", "-.03"))
   expect_identical(format_value(c(1.012, 0.45, -0.03), lead_zero = FALSE, decimal_point = ","), c("1,01", ",45", "-,03"))
   expect_identical(format_value(c(0.45, -0.03), style_positive = "plus"), c("+0.45", "-0.03"))
   expect_identical(format_value(c(0.45, -0.03), style_positive = "plus", lead_zero = FALSE), c("+.45", "-.03"))
   expect_equal(
@@ -44,7 +44,7 @@
 test_that("format_ci", {
   expect_identical(
     format_ci(c(123, 123, 123, 123), c(123, 12345, 123456, 123456789012), width = "auto"),
     c("95% CI [123.00,   123.00]", "95% CI [123.00, 12345.00]", "95% CI [123.00, 1.23e+05]", "95% CI [123.00, 1.23e+11]")
   )
   expect_identical(
     format_ci(c(123, 123, 123, 123), c(123, 12345, 123456, 123456789012), width = "auto", digits = 5),
@@ -143,6 +143,17 @@
   expect_identical(nchar(format_p(0.02)), 9L)
   expect_identical(nchar(format_p(0.02, stars = TRUE)), 10L)
   expect_identical(nchar(format_p(0.02, stars_only = TRUE)), 1L)
+
+  expect_identical(format_p(0.02), "p = .020")
+  expect_identical(format_p(0.02, lead_zero = TRUE), "p = 0.020")
+  expect_identical(format_p(0.02, stars = TRUE), "p = .020*")
+  expect_identical(format_p(0.02, stars = TRUE, lead_zero = TRUE), "p = 0.020*")
+  expect_identical(format_p(0.0214568, digits = "apa"), "p = .021")
+  expect_identical(format_p(0.0214568, digits = "apa", lead_zero = TRUE), "p = 0.021")
+  expect_identical(format_p(0.00003, digits = "apa"), "p < .001")
+  expect_identical(format_p(0.00003, digits = "apa", lead_zero = TRUE), "p < 0.001")
+  expect_identical(format_p(0.00003, digits = 5), "p = .00003")
+  expect_identical(format_p(0.00003, digits = 5, lead_zero = TRUE), "p = 0.00003")
 })
 
 test_that("format_table, other CI columns", {