r - 加速 R 中向量的 setdiff()、intersect()、union() 操作

Question

我有一个数据表dt1 :

<表类="s-表"><头>id1id2V1V2<正文>1一个c(1, 2, 3, 4)c(1, 3, 6)2bc(2, 6, 9, 8)c(8, 5)

我想添加新列，这些列是 setdiff() 的结果, intersect()和 union()在 V1 上的操作和 V2变量。

预期输出:

<表类="s-表"><头>id1id2V1V2diff_V1_V2相交_V1_V2union_V1_V2<正文>1一个c(1, 2, 3, 4)c(1, 3, 6)c(2, 4)c(1, 3)c(1, 2, 3, 4, 6)2bc(2, 6, 9, 8)c(8, 5)c(2, 6, 9)c(8)c(2, 5, 6, 8, 9)

我试过:

dt_new <- dt1[, c("diff_V1_V2", "intersect_V1_V2", "union_V1_V2") := list(
              Map(setdiff, V1, V2),
              Map(intersect, V1, V2),
              Map(union, V1, V2))]

但是我的真实向量很长，所以这些操作需要很长时间。

那么，如何才能加快这些操作或如何使用其他函数/方法获得类似的结果？我正在寻找最有效的方法。
或者是否可以并行计算？

Answer 1

朴素的方法:

Naive <- function (a, b) {
  list(intersect = intersect(a, b),
       union = union(a, b),
       adiffb = setdiff(a, b))
}

您可以利用基础数学在向量 a 和 b 的一次扫描中完成所有三个操作，而不是通过三个函数调用进行三次扫描。此外，如果您确定两个向量中都没有重复值，则可以跳过昂贵的 unique。

SetOp <- function (a, b, no.dup.guaranteed = FALSE) {
  if (no.dup.guaranteed) {
    au <- a
    bu <- b
  } else {
    au <- unique(a)
    bu <- unique(b)
  }
  ind <- match(bu, au, nomatch = 0)
  INTERSECT <- au[ind]
  DIFF <- au[-c(ind, length(au) + 1)]  ## https://stackoverflow.com/a/52772380
  UNION <- c(bu, DIFF)
  list(intersect = INTERSECT, union = UNION, adiffb = DIFF)
}

SetOp(a = c(1, 2, 3, 4), b = c(1, 3, 6))
SetOp(a = c(2, 6, 9, 8), b = c(8, 5))

一些基准:

## no duplicated values in either a or b; can set no.dup.guaranteed = TRUE
a <- sample.int(11000, size = 10000, replace = FALSE)
b <- sample.int(11000, size = 10000, replace = FALSE)

microbenchmark::microbenchmark(naive = Naive(a, b),
                               better = SetOp(a, b),
                               fly = SetOp(a, b, no.dup.guaranteed = TRUE))
#Unit: milliseconds
#   expr      min       lq     mean   median       uq      max neval
#  naive 6.457302 6.489710 6.751996 6.511399 6.567941 8.571623   100
# better 3.251701 3.268873 3.377910 3.277086 3.306723 3.880755   100
#    fly 1.734898 1.749300 1.805163 1.755927 1.767114 3.326179   100

## lots of duplicated values in both a and b; must have no.dup.guaranteed = FALSE
a <- sample.int(100, size = 10000, replace = TRUE)
b <- sample.int(100, size = 10000, replace = TRUE)

microbenchmark::microbenchmark(naive = Naive(a, b),
                               better = SetOp(a, b))
#Unit: microseconds
#   expr      min       lq      mean   median       uq      max neval
#  naive 1421.702 1431.023 1653.1339 1443.147 1483.255 3809.031   100
# better  396.193  398.695  446.7062  400.293  412.046 1995.294   100

如果你想进一步加速，你需要考虑如何加速unique()。这并不容易，因为您可能无法击败 R 使用的内部算法。

---

I see additional speed improvement replacing unique() with the R fast Rfast::sort_unique().

谢谢@M.Viking .很高兴看到your answer .我没有时间在我的操作系统上安装 GNU 科学库 (GSL)，所以无法自己安装和试用 Rfast。

以下是对您的基准测试结果的一些评论。

• “better2”比“fly”快的原因是因为 match 在排序向量上更快。所以是的，即使 a 和 b 中没有重复值，应用 sort_unique 仍然是个好主意。

• 您可能还想尝试 Rfast 中的 Match 函数。我在包的文档中发现了这个函数，但不知道它与 R 的基本版本相比有多快。此外，文档没有明确说明 Match 如何处理不匹配。相比之下，基本版本 match 有一个有用的参数 nomatch 我将其设置为 0 以避免 NA 索引。

Good ideas. Unfortunately Rfast::Match() is not a drop in replacement for base::match(). However, luckily, fastmatch::fmatch() is a fast drop in replacement for match().

我们在这里进行了一次非常鼓舞人心的迭代!很高兴知道!很棒的 R 社区有这么多有用的工具!

---

My V1 and V2 variables do not contain duplicates, so there is no need to use the unique function, if I understand correctly?

直觉上，是的，因为我们不想做额外的工作。但有趣的是，M.Viking's answer 中的基准测试结果表明值得对向量进行排序以加速匹配。所以你实际上可以使用 M.Viking 给出的 SetOp2()。

我认为将 base::match 替换为 fastmatch::fmatch 的 SetOp3() 在您的应用程序中不值得。根据其文档，fmatch 只有在我们执行重复匹配时才比 match 快，例如 match(a, key), match( b,key)等，其中key被复用。 M.Viking 的基准测试支持这一点，因为 microbenchmark() 重复 SetOp3(a, b) 100 次。在第一次运行时，fmatch 和 match 一样快；那么在接下来的 99 次运行中它比 match 快得多。然而，在您的应用程序中，每个向量只使用一次。由于不存在重用，我们最好继续使用 match。

So, how can I apply your solution to each row of my data (V1 and V2 are lists there)?

我们必须使用循环或类似循环的函数，例如您在问题中使用的 Map。唯一的问题是我们需要一些后处理来提取结果。见下文。

V1 <- list(a1 = c(1, 2, 3, 4), a2 = c(2, 6, 9, 8))
V2 <- list(b1 = c(1, 3, 6), b2 = c(8, 5))

## or: ans <- Map(SetOp2, V1, V2)
ans <- Map(SetOp, V1, V2, no.dup.guaranteed = TRUE)
## post-processing
INTERSECT <- lapply(ans, "[[", 1)
UNION <- lapply(ans, "[[", 2)
SETDIFF <- lapply(ans, "[[", 3)

---

关于并行处理的其他想法

jblood94's answer通过并行计算更进一步。好工作!这是练习 parallel 的一个很好的练习。但原则上，我们不想并行此任务，因为它受内存限制而不是 CPU 限制。我们只是从内存中扫描数据，而不进行复杂的 CPU 运算。众所周知，并行处理对于这种工作来说并不乐观，我不希望有很大的加速。似乎 jblood94 能够获得 82.89/34.21 = 2.42 的串行处理加速。但是，他/她没有提到使用了多少个 CPU 内核。例如，如果利用 8 个内核，那么 2.42 的加速比就很差了。