fix: Fix formatting of numbers of the form 9.99...995

R/sigfig.R

@@ -44,7 +44,8 @@ split_decimal <- function(x, sigfig, digits = NULL, sci_mod = NULL, si = FALSE,
   "!!!!!!DEBUG `v(mnt)`"
 
   if (!is.null(sci_mod)) {
-    exp <- fix_exp(num, compute_exp(mnt, sigfig, digits), fixed_exponent, sci_mod, si)
+    exp <- compute_exp_display(mnt, sigfig, digits)
+    exp <- fix_exp(num, exp, fixed_exponent, sci_mod, si)
     "!!!!!!DEBUG `v(exp)`"
     unit <- attr(exp, "unit")
 
@@ -259,7 +260,8 @@ compute_extra_sigfig <- function(x) {
 
 LOG_10 <- log(10)
 
-compute_exp <- function(x, sigfig, digits) {
+compute_exp_display <- function(x, sigfig, digits = NULL) {
+  "!!!!!!DEBUG compute_exp_display(`v(x)`, `v(sigfig)`, `v(digits)`)"
   if (is.null(sigfig)) {
     sigfig <- abs(digits)
   }
@@ -276,6 +278,16 @@ compute_exp <- function(x, sigfig, digits) {
   ret <- rep_along(x, NA_integer_)
   nonzero <- which(x != 0 & is.finite(x))
   ret[nonzero] <- as.integer(floor(log10(x[nonzero]) - offset))
+  "!!!!!!DEBUG `v(ret)`"
+  ret
+}
+
+compute_exp <- function(x, sigfig) {
+  "!!!!!!DEBUG compute_exp(`v(x)`, `v(sigfig)`)"
+  ret <- rep_along(x, NA_integer_)
+  nonzero <- which(x != 0 & is.finite(x))
+  ret[nonzero] <- as.integer(floor(log10(x[nonzero])))
+  "!!!!!!DEBUG `v(ret)`"
   ret
 }
 

tests/testthat/_snaps/format_decimal.md

@@ -88,3 +88,34 @@
        -Inf       
         Inf       
 
+# 9.99...95 (tidyverse/tibble#1648)
+
+    Code
+      format(num(x[1], sigfig = 3))
+    Output
+      [1] "9.99"
+    Code
+      format(num(x[2], sigfig = 6))
+    Output
+      [1] "9.99999"
+    Code
+      format(num(x[3], sigfig = 7))
+    Output
+      [1] "9.999999"
+    Code
+      format(num(x[4], sigfig = 11))
+    Output
+      [1] "9.9999999999"
+    Code
+      format(num(x[5], sigfig = 14, notation = "dec"))
+    Output
+      [1] "9.9999999999999"
+    Code
+      format(num(x[6], sigfig = 16))
+    Output
+      [1] "9."
+    Code
+      format(num(x[7], sigfig = 16))
+    Output
+      [1] "9."
+

tests/testthat/test-format_decimal.R

@@ -22,14 +22,24 @@ test_that("compute_rhs_digits() works", {
   )
 })
 
+test_that("compute_exp_display() returns NA if not relevant", {
+  x <- c(NA, NaN, Inf, 0, 1, 100, 0.001)
+  expect_equal(compute_exp_display(x, 6), c(NA, NA, NA, NA, 0, 2, -3))
+})
+
 test_that("compute_exp() returns NA if not relevant", {
   x <- c(NA, NaN, Inf, 0, 1, 100, 0.001)
   expect_equal(compute_exp(x, 6), c(NA, NA, NA, NA, 0, 2, -3))
 })
 
-test_that("compute_exp() respectis significant digits", {
+test_that("compute_exp_display() respects significant digits (#174)", {
+  x <- c(0.9, 0.99, 0.999, 0.99949, 0.9995, 0.99951, 0.9999, 0.99999, 0.999999)
+  expect_equal(compute_exp_display(x, 3), c(-1, -1, -1, -1, 0, 0, 0, 0, 0))
+})
+
+test_that("compute_exp() respects significant digits for rhs computation (#1648)", {
   x <- c(0.9, 0.99, 0.999, 0.99949, 0.9995, 0.99951, 0.9999, 0.99999, 0.999999)
-  expect_equal(compute_exp(x, 3), c(-1, -1, -1, -1, 0, 0, 0, 0, 0))
+  expect_equal(compute_exp(x, 3), c(-1, -1, -1, -1, -1, -1, -1, -1, -1))
 })
 
 test_that("special values appear in LHS", {
@@ -138,3 +148,26 @@ test_that("width computation", {
   expect_decimal_width(c(1.2, -Inf))
   expect_decimal_width(c(1, Inf))
 })
+
+test_that("9.99...95 (tidyverse/tibble#1648)", {
+  # Declaring the constants inside expect_snapshot() perturbs the input
+  x <- c(
+    0x1.3fd70a3d70a3dp+3,
+    0x1.3ffff583a53b8p+3,
+    0x1.3ffffef39085ep+3,
+    0x1.3ffffffff920cp+3,
+    0x1.3ffffffffffe3p+3,
+    0x1.3fffffffffffep+3,
+    0x1.3ffffffffffffp+3
+  )
+
+  expect_snapshot({
+    format(num(x[1], sigfig = 3))
+    format(num(x[2], sigfig = 6))
+    format(num(x[3], sigfig = 7))
+    format(num(x[4], sigfig = 11))
+    format(num(x[5], sigfig = 14, notation = "dec"))
+    format(num(x[6], sigfig = 16))
+    format(num(x[7], sigfig = 16))
+  })
+})