高效找到集合差异并生成随机样本

Question

我有一个非常大的数据集，其中包含分类标签 a 和一个包含数据集中所有可能标签的向量 b：

a <- c(1,1,3,2)   # artificial data
b <- c(1,2,3,4)   # fixed categories

现在我想为 a 中的每个观察结果找到所有剩余类别的集合（即 b 的元素，不包括 a 中的给定观察结果）。从这些剩余的类别中，我想随机抽取一个。

我使用循环的方法是

goal <- numeric() # container for results

for(i in 1:4){

d       <- setdiff(b, a[i]) # find the categories except the one observed in the data
goal[i] <- sample(d,1)      # sample one of the remaining categories randomly

}

goal
[1] 4 4 1 1

但是，这必须进行多次并应用于非常大的数据集。有没有人有更有效的版本来达到预期的结果？

编辑：

不幸的是，akrun 的函数比原来的循环慢。如果有人有创意且有竞争力的结果，我很高兴听到！

Answer 1

我们可以使用vapply

vapply(a,  function(x) sample(setdiff(b, x), 1), numeric(1))

set.seed(24)
a <- sample(c(1:4), 10000, replace=TRUE)
b <- 1:4
system.time(vapply(a,  function(x) sample(setdiff(b, x), 1), numeric(1)))
#   user  system elapsed 
#  0.208   0.007   0.215

Answer 2

更新： 这是 mapply 的快速版本。此方法避免为每次迭代调用 sample()，因此速度更快一些。 -

mapply(function(x, y) b[!b == x][y], a, sample(length(b) - 1, length(a), replace = T))

这是一个没有 setdiff 的版本（setdiff 可能有点慢），尽管我认为可以进行更多优化。 -

vapply(a, function(x) sample(b[!b == x], 1), numeric(1))

基准 -

set.seed(24)
a <- sample(c(1:4), 1000, replace=TRUE)
b <- 1:4

microbenchmark::microbenchmark(
  akrun = vapply(a,  function(x) sample(setdiff(b, x), 1), numeric(1)),
  shree = vapply(a, function(x) sample(b[!b == x], 1), numeric(1)),
  shree_mapply = mapply(function(x, y) b[!b == x][y], a, sample(length(b) - 1, length(a), replace = T))
)


Unit: milliseconds
         expr     min       lq      mean   median       uq      max neval
        akrun 28.7347 30.66955 38.319655 32.57875 37.45455 237.1690   100
        shree  5.6271  6.05740  7.531964  6.47270  6.87375  45.9081   100
 shree_mapply  1.8286  2.01215  2.628989  2.14900  2.54525   7.7700   100

Answer 3

事实证明，对与数据中的标签相同的标签进行重采样是一种更快的方法，使用

 test = sample(b, length(a), replace=T)
  resample = (a == test)

  while(sum(resample>0)){

  test[resample] = sample(b, sum(resample), replace=T)
  resample = (a == test)
  }

N=10,000 的更新基准：

Unit: microseconds
                               expr       min        lq       mean    median         uq       max neval
                               loop 14337.492 14954.595 16172.2165 15227.010 15585.5960 24071.727   100
                              akrun 14899.000 15507.978 16271.2095 15736.985 16050.6690 24085.839   100
                           resample    87.242   102.423   113.4057   112.473   122.0955   174.056   100
        shree(data = a, labels = b)  5195.128  5369.610  5472.4480  5454.499  5574.0285  5796.836   100
 shree_mapply(data = a, labels = b)  1500.207  1622.516  1913.1614  1682.814  1754.0190 10449.271   100

高效找到集合差异并生成随机样本

Efficiently find set differences and generate random sample

r

sample

set

set-difference