remove range code; add digits argument

R/quantile-pred.R

@@ -133,18 +133,15 @@ as.matrix.quantile_pred <- function(x, ...) {
 }
 
 #' @export
-format.quantile_pred <- function(x, ...) {
+format.quantile_pred <- function(x, digits = 3L, ...) {
   quantile_levels <- attr(x, "quantile_levels")
   if (length(quantile_levels) == 1L) {
     x <- unlist(x)
-    out <- round(x, 3L)
+    out <- signif(x, digits = digits)
     out[is.na(x)] <- NA_real_
   } else {
-    rng <- sapply(x, range, na.rm = TRUE)
-    out <- paste0("[", round(rng[1, ], 3L), ", ", round(rng[2, ], 3L), "]")
-    out[is.na(rng[1, ]) & is.na(rng[2, ])] <- NA_character_
-    m <- median(x)
-    out <- paste0("[", round(m, 3L), "]")
+    m <- median(x, na.rm = TRUE)
+    out <- paste0("[", signif(m, digits = digits), "]")
   }
   out
 }

tests/testthat/_snaps/quantile-pred.md

@@ -120,3 +120,17 @@
       [1]  1 NA  3  4  5
       # Quantile levels:  0.556 
 
+---
+
+    Code
+      format(v)
+    Output
+      [1] "[1.72]"  "[0.568]" "[1.24]"  "[2.21]"  "[0.767]"
+
+---
+
+    Code
+      format(v, digits = 5)
+    Output
+      [1] "[1.7154]"  "[0.56784]" "[1.2393]"  "[2.2062]"  "[0.76714]"
+

tests/testthat/test-quantile-pred.R

@@ -58,6 +58,11 @@ test_that("quantile_pred formatting", {
   expect_snapshot(tibble(qntls = one_quantile))
   m[2] <- NA
   expect_snapshot(quantile_pred(m, 5/9))
+
+  set.seed(393)
+  v <- quantile_pred(matrix(exp(rnorm(20)), ncol = 4), 1:4 / 5)
+  expect_snapshot(format(v))
+  expect_snapshot(format(v, digits = 5))
 })
 
 test_that("as_tibble() for quantile_pred", {