How to round to the nearest human readable number in log-scale?-CodePudding

For numbers between 1 and 10, I want to round into any of the four numbers, 1, 2, 5, and 10.

For numbers between 10 and 100, I want to round into any of the four numbers, 10, 20, 50, and 100.

For numbers between .1 and 1, I want to round into any of the four numbers, .1, .2, .5 and 1.

For other ranges, the rounding rule is similar except scaled by a power of 10.

I may use a for-loop and if-else to program this. But it will not be efficient. Can anybody provide a more efficient solution (e.g., based on vectorized operations)?

CodePudding user response：

First I define a function to return the value of v closest to the scalar x.

Then in the second function I first take the floor of log10(x) to get the correct order of magnitude, then find which of log10(c(1,2,5,10)) the remainder is closest to, and reassemble.

closestTo <- function(x, v){
  sapply(x , function(x) v[which.min(abs(v-x))])
}
roundNicely <- function(x){
  10^(floor(log(x,10))   closestTo(log(x,10)%%1, log10(c(1,2,5,10))))
}


> roundNicely(c(.009,0.012,.501,.499,1.2,4.5,19,21))
[1]  0.01  0.01  0.50  0.50  1.00  5.00 20.00 20.00

CodePudding user response：

This solution uses a similar idea as the one above, with a twist; here, I am mapping the vector of desired values to the order of magnitude of x and then finding the closest match.

custom.round <- function(x, r = c(1,2,5,10)){

  m <- 10^(floor(log10(x)))
  r[[which.min(abs((m * r) - x))]] * m

## use this other variation if the desired behavior is "rounding" in log-scale
# r[[which.min(abs(r - (x/m)))]] * m
    
}


sapply(c(.009,0.012,.501,.499,1.2,4.5,19,21), custom.round)
#> [1]  0.01  0.01  0.50  0.50  1.00  5.00 20.00 20.00

CodePudding user response：

This is just a slightly more efficient version of @George Savva's solution. It uses vapply and avoids redundant calculations.

f <- \(x) {
  ls <- log10(c(1, 2, 5, 10))
  lx <- log10(x)
  t2 <- vapply(lx %% 1, \(r) ls[which.min(abs(ls - r))], numeric(1))
  10^(floor(lx)   t2)
}

x <- runif(5e5)
stopifnot(all.equal(f(x), roundNicely(x)))
microbenchmark::microbenchmark(f=f(x), rNice=roundNicely(x), times=3L)
# Unit: milliseconds
#  expr      min       lq      mean    median       uq       max neval cld
#     f 774.6042 775.2385  810.7454  775.8729  828.816  881.7592     3  a 
# rNice 940.4319 997.3334 1045.3822 1054.2350 1097.857 1141.4798     3   b