有没有办法加快combn命令以获取从矢量中取出的2个元素的所有独特组合？
通常这样设置如下：
# Get latest version of data.table
library(devtools)
install_github("Rdatatable/data.table", build_vignettes = FALSE)
library(data.table)
# Toy data
d <- data.table(id=as.character(paste0("A", 10001:15000)))
# Transform data
system.time({
d.1 <- as.data.table(t(combn(d$id, 2)))
})
然而，combn比使用data.table计算所有可能的组合慢10倍（23秒对比我的计算机3秒）。
system.time({
d.2 <- d[, list(neighbor=d$id[-which(d$id==id)]), by=c("id")]
})
处理非常大的向量，我正在寻找一种通过仅计算唯一组合（如combn）来节省内存的方法，但是使用data.table的速度（参见第二个代码片段）。
我感谢任何帮助。
答案 0 :(得分：20)
您可以使用combnPrim
gRbase
source("http://bioconductor.org/biocLite.R")
biocLite("gRbase") # will install dependent packages automatically.
system.time({
d.1 <- as.data.table(t(combn(d$id, 2)))
})
# user system elapsed
# 27.322 0.585 27.674
system.time({
d.2 <- as.data.table(t(combnPrim(d$id,2)))
})
# user system elapsed
# 2.317 0.110 2.425
identical(d.1[order(V1, V2),], d.2[order(V1,V2),])
#[1] TRUE
答案 1 :(得分：17)
以下是使用data.table函数foverlaps()的一种方式，结果也很快！
require(data.table) ## 1.9.4+
d[, `:=`(id1 = 1L, id2 = .I)] ## add interval columns for overlaps
setkey(d, id1, id2)
system.time(olaps <- foverlaps(d, d, type="within", which=TRUE)[xid != yid])
# 0.603 0.062 0.717
请注意，foverlaps() 不会计算所有排列。删除自身重叠需要子集xid != yid。通过实现ignoreSelf参数，可以更有效地在内部处理子集 - 类似于IRanges::findOverlaps。
现在只需使用获得的ID执行子集：
system.time(ans <- setDT(list(d$id[olaps$xid], d$id[olaps$yid])))
# 0.576 0.047 0.662
完全，~1.4秒。
优点是，即使您的data.table d有超过1列可以获取组合并使用相同数量的内存，您也可以采用相同的方式（因为我们返回索引）。在这种情况下，您只需：
cbind(d[olaps$xid, your_cols, with=FALSE], d[olaps$yid, your_cols, with=FALSE])
但它仅限于替换combn(., 2L)。不超过2L。
答案 2 :(得分：9)
这是使用Rcpp的解决方案。
library(Rcpp)
library(data.table)
cppFunction('
Rcpp::DataFrame combi2(Rcpp::CharacterVector inputVector){
int len = inputVector.size();
int retLen = len * (len-1) / 2;
Rcpp::CharacterVector outputVector1(retLen);
Rcpp::CharacterVector outputVector2(retLen);
int start = 0;
for (int i = 0; i < len; ++i){
for (int j = i+1; j < len; ++j){
outputVector1(start) = inputVector(i);
outputVector2(start) = inputVector(j);
++start;
}
}
return(Rcpp::DataFrame::create(Rcpp::Named("id") = outputVector1,
Rcpp::Named("neighbor") = outputVector2));
};
')
# Toy data
d <- data.table(id=as.character(paste0("A", 10001:15000)))
system.time({
d.2 <- d[, list(neighbor=d$id[-which(d$id==id)]), by=c("id")]
})
# 1.908 0.397 2.389
system.time({
d[, `:=`(id1 = 1L, id2 = .I)] ## add interval columns for overlaps
setkey(d, id1, id2)
olaps <- foverlaps(d, d, type="within", which=TRUE)[xid != yid]
ans <- setDT(list(d$id[olaps$xid], d$id[olaps$yid]))
})
# 0.653 0.038 0.705
system.time(ans2 <- combi2(d$id))
# 1.377 0.108 1.495
使用Rcpp函数获取索引然后形成data.table，效果更好。
cppFunction('
Rcpp::DataFrame combi2inds(const Rcpp::CharacterVector inputVector){
const int len = inputVector.size();
const int retLen = len * (len-1) / 2;
Rcpp::IntegerVector outputVector1(retLen);
Rcpp::IntegerVector outputVector2(retLen);
int indexSkip;
for (int i = 0; i < len; ++i){
indexSkip = len * i - ((i+1) * i)/2;
for (int j = 0; j < len-1-i; ++j){
outputVector1(indexSkip+j) = i+1;
outputVector2(indexSkip+j) = i+j+1+1;
}
}
return(Rcpp::DataFrame::create(Rcpp::Named("xid") = outputVector1,
Rcpp::Named("yid") = outputVector2));
};
')
system.time({
indices <- combi2inds(d$id)
ans2 <- setDT(list(d$id[indices$xid], d$id[indices$yid]))
})
# 0.389 0.027 0.425
答案 3 :(得分：6)
如果没有基准，标题中带有 快速 的任何变体的帖子都是不完整的。在发布任何基准测试之前，我想提及一下，自从发布此问题以来，已经发布了arrangements和RcppAlgos（我是作者）两个高度优化的软件包，用于生成组合{ 1}}。
为了让您了解它们在R和combn上的速度，这是一个基本基准：
gRbase::combnPrim现在，我们针对发布组合选择2和生成microbenchmark(arrangements::combinations(20, 10),
combn(20, 10),
gRbase::combnPrim(20, 10),
RcppAlgos::comboGeneral(20, 10),
unit = "relative")
Unit: relative
expr min lq mean median uq max neval
arrangements::combinations(20, 10) 1.364092 1.244705 1.198256 1.265019 1.192174 3.658389 100
combn(20, 10) 82.672684 61.589411 52.670841 59.976063 58.584740 67.596315 100
gRbase::combnPrim(20, 10) 6.650843 5.290714 5.024889 5.303483 5.514129 4.540966 100
RcppAlgos::comboGeneral(20, 10) 1.000000 1.000000 1.000000 1.000000 1.000000 1.000000 100
对象这一非常特殊的情况对发布的其他函数进行基准测试。
功能如下：
data.table这是OP给出的示例的基准：
funAkraf <- function(d) {
a <- comb2.int(length(d$id)) ## comb2.int from the answer given by @akraf
data.table(V1 = d$id[a[,1]], V2 = d$id[a[,2]])
}
funAnirban <- function(d) {
indices <- combi2inds(d$id)
ans2 <- setDT(list(d$id[indices$xid], d$id[indices$yid]))
ans2
}
funArrangements <- function(d) {as.data.table(arrangements::combinations(x = d$id, k = 2))}
funArun <- function(d) {
d[, `:=`(id1 = 1L, id2 = .I)] ## add interval columns for overlaps
setkey(d, id1, id2)
olaps <- foverlaps(d, d, type="within", which=TRUE)[xid != yid]
ans <- setDT(list(d$id[olaps$xid], d$id[olaps$yid]))
ans
}
funGRbase <- function(d) {as.data.table(t(gRbase::combnPrim(d$id,2)))}
funOPCombn <- function(d) {as.data.table(t(combn(d$id, 2)))}
funRcppAlgos <- function(d) {as.data.table(RcppAlgos::comboGeneral(d$id, 2))}
我们看到@AnirbanMukherjee提供的功能是完成此任务最快的功能，其次是d <- data.table(id=as.character(paste0("A", 10001:15000)))
microbenchmark(funAkraf(d),
funAnirban(d),
funArrangements(d),
funArun(d),
funGRbase(d),
funOPCombn(d),
funRcppAlgos(d),
times = 10, unit = "relative")
Unit: relative
expr min lq mean median uq max neval
funAkraf(d) 2.961790 2.869365 2.612028 2.948955 2.215608 2.352351 10
funAnirban(d) 1.000000 1.000000 1.000000 1.000000 1.000000 1.000000 10
funArrangements(d) 1.384152 1.427382 1.473522 1.854861 1.258471 1.233715 10
funArun(d) 2.785375 2.543434 2.353724 2.793377 1.883702 2.013235 10
funGRbase(d) 4.309175 3.909820 3.359260 3.921906 2.727707 2.465525 10
funOPCombn(d) 22.810793 21.722210 17.989826 21.492045 14.079908 12.933432 10
funRcppAlgos(d) 1.359991 1.551938 1.434623 1.727857 1.318949 1.176934 10
/ RcppAlgos（非常接近计时）。
它们都给出相同的结果：
arrangements感谢@Frank指出如何比较两个identical(funAkraf(d), funOPCombn(d))
#[1] TRUE
identical(funAkraf(d), funArrangements(d))
#[1] TRUE
identical(funRcppAlgos(d), funArrangements(d))
#[1] TRUE
identical(funRcppAlgos(d), funAnirban(d))
#[1] TRUE
identical(funRcppAlgos(d), funArun(d))
#[1] TRUE
## different order... we must sort
identical(funRcppAlgos(d), funGRbase(d))
[1] FALSE
d1 <- funGRbase(d)
d2 <- funRcppAlgos(d)
## now it's the same
identical(d1[order(V1, V2),], d2[order(V1,V2),])
#[1] TRUE
，而无需经历创建新data.tables然后安排它们的麻烦：
data.tables答案 4 :(得分：2)
如果您不想使用其他依赖项，这里有两个base-R解决方案：
comb2.int使用rep和其他序列生成函数来生成所需的输出。
comb2.mat创建一个矩阵，使用upper.tri()获取上三角形，which(..., arr.ind = TRUE)获取列和行索引=＆gt;所有组合。
comb2.int comb2.int <- function(n, rep = FALSE){
if(!rep){
# e.g. n=3 => (1,1), (1,2), (1,3), (2,2), (2,3), (3,3)
x <- rep(1:n,(n:1)-1)
i <- seq_along(x)+1
o <- c(0,cumsum((n-2):1))
y <- i-o[x]
}else{
# e.g. n=3 => (1,2), (1,3), (2,3)
x <- rep(1:n,n:1)
i <- seq_along(x)
o <- c(0,cumsum(n:2))
y <- i-o[x]+x-1
}
return(cbind(x,y))
}
comb2.mat comb2.mat <- function(n, rep = FALSE){
# Use which(..., arr.ind = TRUE) to get coordinates.
m <- matrix(FALSE, nrow = n, ncol = n)
idxs <- which(upper.tri(m, diag = rep), arr.ind = TRUE)
return(idxs)
}
combn(.)：for(i in 2:8){
# --- comb2.int ------------------
stopifnot(comb2.int(i) == t(combn(i,2)))
# => Equal
# --- comb2.mat ------------------
m <- comb2.mat(i)
colnames(m) <- NULL # difference 1: colnames
m <- m[order(m[,1]),] # difference 2: output order
stopifnot(m == t(combn(i,2)))
# => Equal up to above differences
}
使用返回值作为索引：
v <- LETTERS[1:5]
c <- comb2.int(length(v))
cbind(v[c[,1]], v[c[,2]])
#> [,1] [,2]
#> [1,] "A" "B"
#> [2,] "A" "C"
#> [3,] "A" "D"
#> [4,] "A" "E"
#> [5,] "B" "C"
#> [6,] "B" "D"
#> [7,] "B" "E"
#> [8,] "C" "D"
#> [9,] "C" "E"
#> [10,] "D" "E"
时间（combn）=〜5倍时间（comb2.mat）= ~80倍时间（comb2.int）：
library(microbenchmark)
n <- 800
microbenchmark({
comb2.int(n)
},{
comb2.mat(n)
},{
t(combn(n, 2))
})
#> Unit: milliseconds
#> expr min lq mean median uq max neval
#> { comb2.int(n) } 4.394051 4.731737 6.350406 5.334463 7.22677 14.68808 100
#> { comb2.mat(n) } 20.131455 22.901534 31.648521 24.411782 26.95821 297.70684 100
#> { t(combn(n, 2)) } 363.687284 374.826268 391.038755 380.012274 389.59960 532.30305 100