diff --git a/R/sigfig.R b/R/sigfig.R index 114d3fa3f..7950b9ab6 100644 --- a/R/sigfig.R +++ b/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 } diff --git a/tests/testthat/_snaps/format_decimal.md b/tests/testthat/_snaps/format_decimal.md index a86de2ae1..da7daf080 100644 --- a/tests/testthat/_snaps/format_decimal.md +++ b/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." + diff --git a/tests/testthat/test-format_decimal.R b/tests/testthat/test-format_decimal.R index acf3b322a..e2ba20744 100644 --- a/tests/testthat/test-format_decimal.R +++ b/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)) + }) +})