Question

我有一个数据集，其中包含我想四舍五入到最接近的整数的非整数值。这很简单，但是除了四舍五入外，我还需要一个函数来完成两件事：

它应该将一半（0.5、1.5、2.5等）向上或向下四舍五入，同时始终始终铺地板，例如2.4和天花板2.6
我希望函数每次都给出完全相同的结果，同时仍然将一半左右的中间案例四舍五入。

Answer 1

因为根据OP，不仅应该将严格等于.5舍入限制的数字而且应该将非常接近其舍入限制的数字视为随机向上舍入或向下舍入的候选对象，因此，可以（或应该）删除x%%1==0.5。在这种情况下，在四舍五入之前对所有数字添加很小的扰动就足够了。 jitter()函数会添加这样的随机扰动，这会影响舍入的结果。这可以根据种子值以可复制的方式完成。确定哪些数字是“随机舍入候选”的容差范围将是抖动的大小，可以通过可选参数amount指定该大小。

因此，可以使用如下功能：

random_round <- function(x, seed = 123, tol = 1.e-6) { 
                  set.seed(seed) 
                  round(jitter(x, amount = tol))
                 }

Answer 2

您可以使用ifelse进一步向量化您的解决方案，而不必使用sapply：

FOO <- function(x, seed){
  set.seed(seed)
  ifelse(x %% 1 == .5, round(x + sample(c(-1, 1), 1) * .01), round(x))
}

test <- c(4.5, 3.4, 6.8, 3.5)

FOO(test, 1)
[1] 4 3 7 3

这快了好几倍。微基准测试：

set.seed(10)
test <- sample(1:10, 10000, replace = T)
test <- test - sample(seq(0, 1, .1), 10000, replace = T)

microbenchmark(LAP = FOO(test, 1),
               Samuel = round_r(test), unit = "ms", times = 1000L)

Unit: milliseconds
   expr       min        lq      mean   median        uq      max neval cld
    LAP  1.172478  1.197225  1.493402  1.20718  1.237616 158.8736  1000  a 
 Samuel 41.040701 46.280868 50.014392 49.02561 52.908411 215.4537  1000   b

@AndreElrico建议的另一种版本，速度要快30％：

FOO2 <- function(x, seed){
  set.seed(seed)
  ifelse(x %% 1 == .5, sample(c(ceiling,floor),1)[[1]](x), round(x))
}

Answer 3

我认为只要对向量进行矢量化处理，就不应该在每个数字上sapply()。

round_rs <- function(x) {
  set.seed(111)
  x + sample(c(0.5, -0.5), length(x), replace = TRUE)
}

table(round_rs(v[v %% 1 == 0.5]))

或者，完成：

 round_rs <- function(x) {
  set.seed(111)
  rn <- v %% 1 == 0.5
  x[rn] <- x[rn] + sample(c(0.5, -0.5), sum(rn), replace = TRUE)
  x[!rn] <- round(x[!rn])
  x
}

microbenchmark(LAP1 = FOO(test, 1),
               erocoar = round_rs(test), 
               LAP2 = FOO2(test), unit = "ms", times = 1000L)

Unit: milliseconds
    expr      min       lq      mean   median       uq       max neval
    LAP1 1.388751 1.402546 1.8448210 1.488841 1.631277 77.461753  1000
 erocoar 0.464842 0.472542 0.7619839 0.483449 0.535098 75.046116  1000
    LAP2 0.994486 1.009243 1.2846360 1.061694 1.165955  3.814334  1000

Answer 4

编辑：基于RHertel's的答案，我对代码进行了编辑，以使其更好地适合这种情况。

在阶段I中，创建了一个函数，该函数抖动并舍入非常接近n + 0.5的值。在阶段II中，该功能将应用于给定变量中的所有非整数值。

设置

library(tidyverse)
var1 <- c(rep(10.5,10^4),rep(20.1,10^4),rep(30.9,10^4))
var2 <- c(rep(10.5,10^4),rep(20.1,10^4),rep(30.9,10^4))
data <- as.data.frame(cbind(var1,var2))

第一阶段

round_r <- function(x,seed=111, tol=1.e-6) { 
  set.seed(seed) 
  round(ifelse(near(x%%1,0.5), jitter(x, amount = tol), x))
}

第二阶段

data2 <- data %>% mutate_at(vars(var1,var2),
                      funs(ifelse(.==.%/%1,.,round_r(.))))

# results
table(data)
table(data2)

> table(data)
var2
var1  10.5  20.1  30.9
10.5 10000     0     0
20.1     0 10000     0
30.9     0     0 10000

> table(data2)
var2
var1  10    11    20    31
10  4994     0     0     0
11     0  5006     0     0
20     0     0 10000     0
31     0     0     0 10000

如果要真正随机取整，请记住使用set.seed擦除行！

如果代码仍然可以改进，我想听听！

用R

4 个答案: