diff --git a/R/sigfig.R b/R/sigfig.R index 8e8e87faf..d6fadd1b8 100644 --- a/R/sigfig.R +++ b/R/sigfig.R @@ -38,7 +38,8 @@ split_decimal <- function(x, sigfig, digits = NULL, sci_mod = NULL, si = FALSE, neg <- !is.na(x) & x < 0 "!!!!!!DEBUG `v(neg)`" - mnt <- abs(x) + abs_x <- abs(x) + mnt <- abs_x "!!!!!!DEBUG `v(mnt)`" if (!is.null(sci_mod)) { @@ -64,11 +65,14 @@ split_decimal <- function(x, sigfig, digits = NULL, sci_mod = NULL, si = FALSE, # Must divide by 10^exp, because 10^-exp may not be representable # for very large values of exp mnt_idx <- which(num & mnt != 0) - mnt[mnt_idx] <- mnt[mnt_idx] / (10^exp[mnt_idx]) + mnt[mnt_idx] <- safe_divide_10_to(mnt[mnt_idx], exp[mnt_idx]) "!!!!!!DEBUG `v(mnt)`" + + exp_display <- exp } else { - exp <- rep_along(x, NA_integer_) + exp <- 0 "!!!!!!DEBUG `v(exp)`" + exp_display <- rep_along(x, NA_integer_) } if (is.null(digits)) { @@ -95,7 +99,8 @@ split_decimal <- function(x, sigfig, digits = NULL, sci_mod = NULL, si = FALSE, rhs <- round_mnt - lhs "!!!!!!DEBUG `v(rhs)`" - reset_dec <- (diff_to_trunc(mnt) == 0) + "!!!!!!DEBUG `v(lhs * 10^exp - abs_x)`" + reset_dec <- (mnt == 0 | (rhs == 0 & within_tolerance(lhs * 10^exp, abs_x))) "!!!!!!DEBUG `v(reset_dec)`" dec[reset_dec] <- FALSE @@ -110,7 +115,7 @@ split_decimal <- function(x, sigfig, digits = NULL, sci_mod = NULL, si = FALSE, rhs = rhs, rhs_digits = rhs_digits, dec = dec, - exp = exp, + exp = exp_display, si = si ) @@ -134,24 +139,54 @@ safe_signif <- function(x, digits) { signif(x, digits) } -sqrt_eps <- sqrt(.Machine$double.eps) +safe_divide_10_to <- function(x, y) { + # Computes x / 10^y in a robust way + + x / (10^y) +} + +eps_2 <- 2 * .Machine$double.eps + +within_tolerance <- function(x, y) { + "!!!!!!DEBUG within_tolerance(`v(x)`, `v(y)`)" + l2x <- round(log2(x)) + "!!!!!!DEBUG `v(l2x)`" + l2y <- round(log2(y)) + "!!!!!!DEBUG `v(l2y)`" + + equal <- (l2x == l2y) + equal[is.na(equal)] <- FALSE + out <- equal + "!!!!!!DEBUG `v(abs((x[equal] - y[equal]) * 2 ^ -l2x[equal]))`" + out[equal] <- abs((x[equal] - y[equal]) * 2 ^ -l2x[equal]) <= eps_2 + out +} compute_rhs_digits <- function(x, sigfig) { + "!!!!!!DEBUG compute_rhs_digits(`v(x)`, `v(sigfig)`)" # If already bigger than sigfig, can round to zero. # Otherwise ensure we have sigfig digits shown exp <- compute_exp(x, sigfig) exp[is.na(exp)] <- Inf + "!!!!!!DEBUG `v(exp)" rhs_digits <- rep_along(x, 0) + "!!!!!!DEBUG `v(rhs_digits)" + if (!is.integer(x) && !all(x == trunc(x), na.rm = TRUE)) { has_rhs <- (exp <= sigfig) rhs_digits[has_rhs] <- sigfig - 1 - exp[has_rhs] to_check <- rhs_digits > 0 while (any(to_check, na.rm = TRUE)) { + "!!!!!!DEBUG `v(to_check)" + "!!!!!!DEBUG `v(rhs_digits)" + which_to_check <- which(to_check) val <- x[which_to_check] * 10^(rhs_digits[which_to_check] - 1) - resid <- diff_to_trunc(val) - resid_zero <- abs(resid) < sqrt_eps + "!!!!!!DEBUG `v(val)" + "!!!!!!DEBUG `v(val - round(val))" + + resid_zero <- within_tolerance(val, round(val)) resid_zero[is.na(resid_zero)] <- FALSE rhs_digits[which_to_check][resid_zero] <- @@ -161,6 +196,8 @@ compute_rhs_digits <- function(x, sigfig) { to_check[rhs_digits == 0] <- FALSE } } + + "!!!!!!DEBUG `v(rhs_digits)" rhs_digits } diff --git a/R/utils.R b/R/utils.R index d30580c14..72f740849 100644 --- a/R/utils.R +++ b/R/utils.R @@ -108,10 +108,6 @@ remove_as_is_class <- function(x) { x } -diff_to_trunc <- function(x) { - x - trunc(x) -} - v <- function(x) { expr <- rlang::expr_deparse(substitute(x), width = Inf) paste0(expr, " = ", rlang::expr_deparse(x, width = 80)[[1]]) diff --git a/TODO.md b/TODO.md index d8035be31..37f327a62 100644 --- a/TODO.md +++ b/TODO.md @@ -3,13 +3,13 @@ ## Next steps - Improve output: - - Revert df43c7fcea2fc8d5d159eeb298d800e54990f6fd - See open issues in "Formatting numbers" section below - : significant digits and fixed notation - : Unneeded switch to scientific notation? - Finish `num()` - formattable: class hierarchy, finish - Discuss + - Scientific notation: format `1e10` ok if it's exactly 1^10? - `num_()` and `char_()` modifiers - Choice of class, argument and attribute names - Tibble-local options for precision diff --git a/tests/testthat/_snaps/num.md b/tests/testthat/_snaps/num.md index 87caabc4d..ddb7f0916 100644 --- a/tests/testthat/_snaps/num.md +++ b/tests/testthat/_snaps/num.md @@ -48,28 +48,28 @@ notation = "si"), ) Output # A tibble: 20 x 4 - sci eng dec si - - 1 1e-13 100 e-15 0.0000000000001 100 f - 2 1e-12 1 e-12 0.000000000001 1 p - 3 1e-11 10 e-12 0.000000000010 10 p - 4 1e-10 100 e-12 0.0000000001 100 p - 5 1e- 9 1 e- 9 0.000000001 1 n - 6 1e- 8 10 e- 9 0.00000001 10 n - 7 1e- 7 100.e- 9 0.0000001 100.n - 8 1e- 6 1 e- 6 0.000001 1 µ - 9 1e- 5 10.e- 6 0.00001 10.µ - 10 1e- 4 100.e- 6 0.0001 100.µ - 11 1e- 3 1 e- 3 0.001 1 m - 12 1e- 2 10 e- 3 0.01 10 m - 13 1e- 1 100 e- 3 0.1 100 m - 14 1e+ 0 1 e+ 0 1 1 - 15 1e+ 1 10 e+ 0 10 10 - 16 1e+ 2 100 e+ 0 100 100 - 17 1e+ 3 1 e+ 3 1000 1 k - 18 1e+ 4 10 e+ 3 10000 10 k - 19 1e+ 5 100 e+ 3 100000 100 k - 20 1e+ 6 1 e+ 6 1000000 1 M + sci eng dec si + + 1 1e-13 100e-15 0.0000000000001 100f + 2 1e-12 1e-12 0.000000000001 1p + 3 1e-11 10e-12 0.00000000001 10p + 4 1e-10 100e-12 0.0000000001 100p + 5 1e- 9 1e- 9 0.000000001 1n + 6 1e- 8 10e- 9 0.00000001 10n + 7 1e- 7 100e- 9 0.0000001 100n + 8 1e- 6 1e- 6 0.000001 1µ + 9 1e- 5 10e- 6 0.00001 10µ + 10 1e- 4 100e- 6 0.0001 100µ + 11 1e- 3 1e- 3 0.001 1m + 12 1e- 2 10e- 3 0.01 10m + 13 1e- 1 100e- 3 0.1 100m + 14 1e+ 0 1e+ 0 1 1 + 15 1e+ 1 10e+ 0 10 10 + 16 1e+ 2 100e+ 0 100 100 + 17 1e+ 3 1e+ 3 1000 1k + 18 1e+ 4 10e+ 3 10000 10k + 19 1e+ 5 100e+ 3 100000 100k + 20 1e+ 6 1e+ 6 1000000 1M Code tibble::tibble(scifix = num(10^(-7:6) * 123, notation = "sci", fixed_magnitude = TRUE), engfix = num(10^(-7:6) * 123, notation = "eng", fixed_magnitude = TRUE), sifix = num( @@ -79,19 +79,19 @@ scifix engfix sifix 1 1.23e-5 12.3e-6 12.3µ - 2 12.3 e-5 123. e-6 123. µ - 3 123. e-5 1230. e-6 1230. µ + 2 12.3 e-5 123 e-6 123 µ + 3 123 e-5 1230 e-6 1230 µ 4 1230 e-5 12300 e-6 12300 µ - 5 12300. e-5 123000 e-6 123000 µ - 6 123000. e-5 1230000 e-6 1230000 µ - 7 1230000 e-5 12300000. e-6 12300000. µ - 8 12300000. e-5 123000000 e-6 123000000 µ - 9 123000000. e-5 1230000000 e-6 1230000000 µ + 5 12300 e-5 123000 e-6 123000 µ + 6 123000 e-5 1230000 e-6 1230000 µ + 7 1230000 e-5 12300000 e-6 12300000 µ + 8 12300000 e-5 123000000 e-6 123000000 µ + 9 123000000 e-5 1230000000 e-6 1230000000 µ 10 1230000000 e-5 12300000000 e-6 12300000000 µ - 11 12300000000. e-5 123000000000 e-6 123000000000 µ - 12 123000000000. e-5 1230000000000 e-6 1230000000000 µ + 11 12300000000 e-5 123000000000 e-6 123000000000 µ + 12 123000000000 e-5 1230000000000 e-6 1230000000000 µ 13 1230000000000 e-5 12300000000000 e-6 12300000000000 µ - 14 12300000000000. e-5 123000000000000 e-6 123000000000000 µ + 14 12300000000000 e-5 123000000000000 e-6 123000000000000 µ # many digits