随机的矢量化并行选择？

Question

我有两个向量“H”和“L”，它们有 200 个数值。我想创建一个名为“HL”的第三个向量，其中包含来自 H 和 L 的 200 个随机样本。但是，我希望它们被并行选择，就像 pmin 和 pmax 函数一样。

简化示例：

H <- 1:5
L <- 6:10

# rbind(H,L)
#   [,1] [,2] [,3] [,4] [,5]
# H    1    2    3    4    5
# L    6    7    8    9   10
# intended result is then a random pick from each 'column' shown above, e.g:

HL <- c(6,2,8,4,10)

有没有办法在不使用循环的情况下做到这一点？

任何建议将不胜感激 谢谢

Answer 1

您只需要来自伯努利（即 0 或 1）分布的 N 个样本，其中 N 是 H/L 中值的数量。然后，您可以使用抽样分别从 H 或 L 中进行选择。使用 ifelse 确保您需要的“并行选择”。

set.seed(1)
N <- length(H)
HorL <- rbinom(N, 1, 0.5)

# the select
results <- ifelse(HorL, H, L)

results
# [1]  6  7  3  4 10

这一切都总结为一个很好的衬里：

ifelse( rbinom(H, 1, 0.5), H, L)

---

来自@Arun： 一种（相对）更快的实现方式（不再需要ifelse）是：

idx <- which(!as.logical(rbinom(H, 1, 0.5)))
vv <- H
vv[idx] <- L[idx]

---

解释

@Gabriel，这个想法是您从两个选项之一中进行选择。您可以有效地掷硬币，如果是正面，则从 H 中选择，如果是反面，则从 L 中选择。这是伯努利分布，更一般的形式是二项分布。 R 可以提供这种方式的随机数。

因此，我们向 R 询问其中许多 N，然后相应地从 H 或 L 中选择。

“从 .. 中选择”部分是 R 诡计。

• 请注意，我们可以将0, 1 视为TRUE, FALSE 或A, B 等。

• 使用ifelse 方法应该有点不言自明。如果为 TRUE，则从一个来源中选择，如果为 FALSE，则从另一个来源中选择。

Arun 的方法更有创意。他的方法使用相同的“抛硬币”机制在集合之间进行选择，但具有速度优势。 （我们说的是纳秒，但仍然如此）。 他的方法本质上说：

• 从一组开始，比如说 H。
• 掷硬币。
• 只要硬币是尾巴，就将 H 的那个元素替换为 L 的相同索引元素。 （请注意，“相同索引”方面就是您所说的“并行选择”）

Answer 2

library(data.table)
set.seed(1350)

# Create an example data table:
dt <- data.table(ID=1:200,H=sample(1:1000,200),L=sample(1001:2000,200),key="ID")
# (If you already have a data frame 'df', you can use):
# dt <- as.data.table(df)

set.seed(5655)
# Add a column that randomly samples between H and L:
dt[,HL:=sample(c(H,L),1),by=ID]
dt

#       ID   H    L   HL
#  1:   1 837 1391 1391
#  2:   2 999 1573 1573
#  3:   3 566 1275  566
#  4:   4 347 1709 1709
#  5:   5 129 1627  129
# ---                  
#196: 196  67 1879 1879
#197: 197 652 1811 1811
#198: 198 569 1160 1160
#199: 199  17 1026   17
#200: 200 221 1500 1500

编辑 2： 如 cmets 中所指出的，如果 H 有重复项，我的初始答案将给出不正确的值。我添加了显示data.table 更快的时间，但是当我更正答案时，它确实要慢得多，正如 cmets 中所建议的那样。 （错误答案会更快，因为它是按重复值分组的，因此要考虑的行数要少得多...）

简而言之，我错了，你最好选择另一个答案。

---

这是一个合适的基准：

set.seed(1350) 

H <- sample(1:200, 200) 
L <- sample(201:400, 200)

usingDataTable <- quote({
  dt <- data.table(H, L)
  dt[,HL:=sample(c(H,L),1),by=H]
})


dt2 <- data.table(H, L)
usingDataTable.NoInitialize <- quote({
  dt2[,HL:=sample(c(H,L),1),by=H]
})

usingVectors <- quote ({
  ifelse( rbinom(H, 1, 0.5), H, L)
})



microbenchmark(eval(usingVectors), eval(usingDataTable), eval(usingDataTable.NoInitialize), times=100L)

Unit: microseconds
                              expr      min       lq   median        uq      max neval
                eval(usingVectors)   55.021   61.148   66.760   69.4605 1682.163   100
              eval(usingDataTable) 1635.676 1745.437 1795.245 1851.0950 3629.179   100
 eval(usingDataTable.NoInitialize) 1458.573 1537.618 1596.237 1669.3750 3683.756   100