Skip to content

Improve detection of rhs digits #298

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 5 commits into from
Apr 5, 2021
Merged

Improve detection of rhs digits #298

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
afbf7a8
TODO
krlmlr Apr 5, 2021
19d6fef
Revert "REVERT ME: Output stll not perfect"
krlmlr Apr 5, 2021
8da5b2d
Extract safe_divide_10_to()
krlmlr Apr 5, 2021
a929d4c
Get rid of stray dots: compute lhs * 10^exp and compare with input
krlmlr Apr 5, 2021
cb255f8
More robust detection of rhs digits
krlmlr Apr 5, 2021
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
53 changes: 45 additions & 8 deletions R/sigfig.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)) {
Expand All @@ -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)) {
Expand All @@ -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
Expand All @@ -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
)

Expand All @@ -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] <-
Expand All @@ -161,6 +196,8 @@ compute_rhs_digits <- function(x, sigfig) {
to_check[rhs_digits == 0] <- FALSE
}
}

"!!!!!!DEBUG `v(rhs_digits)"
rhs_digits
}

Expand Down
4 changes: 0 additions & 4 deletions R/utils.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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]])
Expand Down
2 changes: 1 addition & 1 deletion TODO.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3,13 +3,13 @@
## Next steps

- Improve output:
- Revert df43c7fcea2fc8d5d159eeb298d800e54990f6fd
- See open issues in "Formatting numbers" section below
- <https://github.com/r-lib/pillar/issues/96>: significant digits and fixed notation
- <https://github.com/r-lib/pillar/issues/127>: Unneeded switch to scientific notation?
- Finish `num()`
- formattable: class hierarchy, finish <https://github.com/renkun-ken/formattable/pull/154>
- 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
Expand Down
64 changes: 32 additions & 32 deletions tests/testthat/_snaps/num.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -48,28 +48,28 @@
notation = "si"), )
Output
# A tibble: 20 x 4
sci eng dec si
<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
<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(
Expand All @@ -79,19 +79,19 @@
scifix engfix sifix
<sci> <eng> <si>
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

Expand Down