代码之家 › 专栏 › 技术社区 › moodymudskipper

取整数字并保留足够的有效数字以区别于其邻居

rounding r

moodymudskipper · 技术社区 · 7 年前

我有一个递增数的向量,如下面的:

set.seed(1)
numbers  <- cumsum(abs(rnorm(10,100,100)))
# [1]   37.35462  155.71895  172.15609  431.68417  564.63495  582.58811  731.33101  905.16348 1062.74162 1132.20278

我想选择最小数量的有效数字,然后对这些数字进行四舍五入,确保始终保留足够的数字,这样连续的数字就不会四舍五入为相同的值。

请参阅以下示例(预期输出):

magic(numbers, n = 1)
# [1]   40  160  170  400  560  580  700  900 1060 1130

37.35462 四舍五入为 40 因为我只要一个数字( n = 1 )
我绕不过去 155.71895 到 200 因为 172.15609 会四舍五入到 二百 同样的规则,所以我决定 一百五十五点七一八九五 到 160 ,和 一百七十二点一五六零九 到 170
我可以安全地绕行 431.68417 到 400 因为它离 一百七十二点一五六零九 和 564.63495

等。。。

对于n=2或3,我们将得到:

magic(numbers, n = 2)
# [1]   37  160  170  430  560  580  730  910 1060 1130

magic(numbers, n = 3)
# [1]   37.4  156  172  432  565  583  731  905 1060 1130

我的目标是得到非线性分布分位数的可读值。

3 回复 | 直到 7 年前

r2evans 7 年前

#' Minimum preferred significant digits
#'
#' @details
#' Facilitate reducing numbers to their least *distinguishable*
#' significant digits, where "distinguishable" means
#' "between neighbors". This means that if reducing more digits would
#' cause two neighbors to reduce to the same number, then the
#' reduction cannot take place.
#'
#' References:
#'
#' - [Original question on StackOverflow](https://stackoverflow.com/q/51616332/3358272) (and [my answer](https://stackoverflow.com/a/51617325/3358272))
#' 
#' @param numbers numeric, length 2 or more
#' @param n integer, number of preferred remaining significant digits
#' @return numeric vector
#' @export
#' @md
#' @examples
#' \dontrun{
#' set.seed(1)
#' numbers  <- cumsum(abs(rnorm(10,100,100)))
#' # [1]   37.35462  155.71895  172.15609  431.68417  564.63495  582.58811  731.33101  905.16348 1062.74162 1132.20278
#' magic(numbers, 1)
#' #  [1]   40  160  170  400  560  580  700  900 1060 1130
#' magic(numbers, 2)
#' #  [1]   37  160  170  430  560  580  730  910 1060 1130
#' magic(numbers, 3)
#' #  [1]   37.4  156.0  172.0  432.0  565.0  583.0  731.0  905.0 1060.0 1130.0
#' magic(c(1,2.4,2.6,4),1)
#' # [1] 1 2 3 4
#' }
magic <- function(numbers, n=1L) {
  stopifnot(length(numbers) > 1L)
  logscale <- ceiling(log10(abs(numbers)))
  logdiff <- log10(diff(numbers))
  keepoom <- floor(pmin(c(Inf, logdiff), c(logdiff, Inf)))
  roundpoints <- 5*(10^keepoom)
  out <- signif(numbers, pmax(n, logscale - (1+keepoom)))
  dupes <- duplicated(out)
  if (any(dupes)) {
    dupes <- dupes | c(dupes[-1], FALSE)
    out2 <- signif(numbers, pmax(n, logscale - keepoom))
    out[dupes] <- out2[dupes]
  }
  out
}

示例用法:

magic(numbers, 1)
#  [1]   40  160  170  400  560  580  700  900 1060 1130
## [1]   40  160  170  400  560  580  700  900 1060 1130 # yours
magic(numbers, 2)
#  [1]   37  160  170  430  560  580  730  910 1060 1130
## [1]   37  160  170  430  560  580  730  910 1060 1130 # yours
magic(numbers, 3)
#  [1]   37.4  156.0  172.0  432.0  565.0  583.0  731.0  905.0 1060.0 1130.0
## [1]   37.4  156  172  432  565  583  731  905 1060 1130 # yours
magic(c(1,2.4,2.6,4),1)
# [1] 1 2 3 4
## [1] 1:4 # yours, from comments

moodymudskipper 7 年前

我想出了一个递归的选择,借钱 signif 来自@r2evans:

magic <- function(numbers,n){
  rounded <- signif(numbers,n)
  dupes   <- duplicated(rounded) | duplicated(rounded,fromLast = TRUE) 
  if (any(dupes)) rounded[dupes] <- magic(numbers[dupes], n+1)
  rounded
}

magic(numbers,1)
# [1]   40  160  170  400  560  580  700  900 1060 1130
magic(numbers,2)
# [1]   37  160  170  430  560  580  730  910 1060 1130
magic(numbers,3)
# [1]   37.4  156.0  172.0  432.0  565.0  583.0  731.0  905.0 1060.0 1130.0

正如@DigEmAll在注释中所提到的,当原始向量中存在重复项时,它将失败(这确实可能发生在我所声明的用例中)。

-1

RBeginner 7 年前

i=0
while(length(unique(numbers))==length(numbers)&&i<20){i<-i+1;numbers<-round(numbers,digits=(20-i));}

只要数字不再是等长的,或者超过了i,这个代码就可以运行,当你只有很小的差异时,只需将20调整到一个更高的值。

希望能有所帮助。

我想选择最小数量的有效数字,然后取整这些数字,确保我始终保持足够的数字连续的数字不会四舍五入到相同的值。

我的结论是:

     set.seed(1)
    numbers  <- cumsum(abs(rnorm(10,100,100)))
numbers<-numbers/10000
     i=0
     while(length(unique(numbers))==length(numbers)&&i<20){i<-i+1;numbers<-round(numbers,digits=(20-i));}

编辑:我知道问题出在哪里了:你不仅要舍入数字,还要舍入逗号上方的值,如果你想这样做,只需转换变量,除以(在本例中是10000),然后再乘以。但我想我发现了另一个错误,这段代码实际上只是提供了I,所以您需要运行:

set.seed(1) numbers <- cumsum(abs(rnorm(10,100,100)))

然后使用之前的i来运行

round(numbers/10000,digits=(20-i+1))*10000

很抱歉,我不得不离开这里,看看结果。