保留其元素在同一列表中没有适当子集的向量（来自向量列表）（使用 RCPP）答案

【问题标题】：Keeping vectors (from list of vectors) whose elements do not have a proper subset within that same list (using RCPP)保留其元素在同一列表中没有适当子集的向量（来自向量列表）（使用 RCPP）
【发布时间】：2021-04-15 22:51:16
【问题描述】：

我之前在(see here) 提出过这个问题，并使用purr 包得到了满意的答案。但是，这已被证明是我程序中的瓶颈，因此我想使用 RCPP 包重写该部分。

真子集：集合 S 的真子集 S' 是严格包含在 S 中的子集，因此排除了 S 本身（注意我也排除了空集）。

假设列表中有以下向量：

a = c(1,2)
b = c(1,3)
c = c(2,4)
d = c(1,2,3,4)
e = c(2,4,5)
f = c(1,2,3)

我的目标是只保留列表中没有适当子集的向量，在本例中为 a、b 和 c。

以前的解决方案

library(purr)

possibilities <- list(a,b,c,d,e,f)
keep(possibilities,
     map2_lgl(.x = possibilities,
              .y = seq_along(possibilities),
              ~ !any(map_lgl(possibilities[-.y], function(z) all(z %in% .x)))))

【问题讨论】：

仅供参考：拼写为 Rcpp。大写 R，小写 cpp。
你的问题（我没有反对）可能会被关闭。这不是“给我写代码”订购服务。您的问题中的 Rcpp 为零，除了希望“如果这个现有代码运行得更快会不会很好”。
也不是我的反对意见，但也可能值得探索其他基础 R 优化。请在下面查看我的答案。
非常有用的建议@MauritsEvers 谢谢

标签： r rcpp

【解决方案1】：

这里的概念是避免 O(N^3) 并使用较少的顺序。这里提供的另一个答案仍然很慢，因为它大于 O(N^2)。这是一个小于 O(N^2) 的解决方案，当所有元素都是唯一的时，最坏的情况是 O(N^2)。

onlySet <- function(x){
   i <- 1
  repeat{
    y <- sapply(x[-1], function(el)!all(is.element(x[[1]], el)))
    if(all(y)){
      if(i==length(x)) break
      else i <- i+1
    }
    x <- c(x[-1][y], x[1])
  }
  x
}

现在要显示时差，请查看以下内容：

match_fun <- Vectorize(function(s1, s2) all(s1 %in% s2))
method1 <- function(a){
 mat <- outer(a, a, match_fun)
 a[colSums(mat) == 1]
}

poss <- rep(possibilities, 100)

microbenchmark::microbenchmark(method1(poss), onlySet(poss))

Unit: milliseconds
          expr      min        lq       mean    median        uq       max neval cld
 method1(poss) 840.7919 880.12635 932.255030 889.36380 923.32555 1420.1077   100   b
 onlySet(poss)   1.9845   2.07005   2.191647   2.15945   2.24245    3.3656   100  a

【讨论】：

非常好。（+1）。你介意在microbenchmark 中添加 OPs 原始方法吗？我很好奇它是如何比较的......
@MauritsEvers 甚至没有尝试过，因为它超过了 O(N^3)。单独的 OP 代码几乎需要 3 秒。所以绝对要永远等待长度为 600 的列表
我明白了。我添加了另一个与您的高性能解决方案相当的（递归）选项。

【解决方案2】：

您是否尝试过首先在基础 R 中优化解决方案？例如，以下重现了您的预期输出并使用（更快）基本 R 数组例程：

match_fun <- Vectorize(function(s1, s2) all(s1 %in% s2))
mat <- outer(possibilities, possibilities, match_fun)
possibilities[colSums(mat) == 1]
#[[1]]
#[1] 1 2
#
#[[2]]
#[1] 1 3
#
#[[3]]
#[1] 2 4

受 Onyambu 高性能解决方案的启发，这里是另一个使用递归函数的基本 R 选项

f_recursive <- function(x, i = 1) {
    if (i > length(x)) return(x)
    idx <- which(sapply(x[-i], function(el) all(x[[i]] %in% el))) + 1
    if (length(idx) == 0) f_recursive(x, i + 1) else f_recursive(x[-idx], i + 1)
}
f(possibilities)

性能与 Onyambu 的解决方案相当。

poss <- rep(possibilities, 100)
microbenchmark::microbenchmark(
    method1(poss),
    onlySet(poss),
    f_recursive(poss))
#Unit: milliseconds
#              expr        min         lq       mean     median         uq
#     method1(poss) 682.558602 710.974831 750.325377 730.627996 765.040976
#     onlySet(poss)   1.700646   1.782713   1.870972   1.819820   1.918669
# f_recursive(poss)   1.681120   1.737459   1.884685   1.806384   1.901582
#         max neval
# 1200.562889   100
#    2.371646   100
#    3.217013   100

【讨论】：