在基础包中，如何在向量的两个副本之间生成唯一的无序对？
Within the base packages, how can I generate the unique unordered pairs between two copies of a vector?
给定 n=2，我想要一组值 (1, 1)、(1, 2) 和 (2, 2)。对于 n=3，我想要 (1, 1)、(1, 2)、(1, 3)、(2, 2)、(2, 3) 和 (3, 3)。依此类推 n=4、5 等
我想完全在基础库中完成此操作。最近，我开始使用
gen <- function(n)
{
x <- seq_len(n)
cbind(combn(x, 2), rbind(x, x))
}
这提供了一些可行但不可靠的输出。我们得到以下 n=4.
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
x 1 1 1 2 2 3 1 2 3 4
x 2 3 4 3 4 4 1 2 3 4
有没有更好的方法？在 expand.grid、outer、combn 和 R 的许多其他生成向量的方法之间，我希望能够只用一个组合生成函数来做到这一点，而不必绑定在一起combn 的输出与其他东西。我可以编写明显的 for 循环，但这似乎是对 R 功能的浪费。
从 expand.grid 开始，然后进行子集化是迄今为止许多答案都采用的一个选项，但我发现生成两倍我需要的集合的想法是对内存的不当使用。这可能也排除了 outer.
这里有一些方法可以做到这一点。
1) upper.tri
n <- 4
d <- diag(n)
u <- upper.tri(d, diag = TRUE)
rbind(row(d)[u], col(d)[u])
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
## [1,] 1 1 2 1 2 3 1 2 3 4
## [2,] 1 2 2 3 3 3 4 4 4 4
最后一行代码也可以写成：
t(sapply(c(row, col), function(f) f(d)[u]))
2) 组合
n <- 4
combn(n+1, 2, function(x) if (x[2] == n+1) x[1] else x)
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
## [1,] 1 1 1 1 2 2 2 3 3 4
## [2,] 2 3 4 1 3 4 2 4 3 4
这个的变体是：
co <- combn(n+1, 2)
co[2, ] <- ifelse(co[2, ] == n+1, co[1, ], co[2, ])
co
3) 列表理解
library(listcompr)
t(gen.matrix(c(i, j), i = 1:n, j = i:n))
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
## [1,] 1 1 2 1 2 3 1 2 3 4
## [2,] 1 2 2 3 3 3 4 4 4 4
性能
library(microbenchmark)
library(listcompr)
n <- 25
microbenchmark(
upper.tri = {
d <- diag(n)
u <- upper.tri(d, diag = TRUE)
rbind(row(d)[u], col(d)[u]) },
upper.tri2 = {
d <- diag(n)
u <- upper.tri(d, diag = TRUE)
t(sapply(c(row, col), function(f) f(d)[u])) },
combn = combn(n+1, 2, function(x) if (x[2] == n+1) x[1] else x),
combn2 = {
co <- combn(n+1, 2)
co[2, ] <- ifelse(co[2, ] == n+1, co[1, ], co[2, ])
co
},
listcompr = t(gen.matrix(c(i, j), i = 1:n, j = i:n)))
给予：
Unit: microseconds
expr min lq mean median uq max neval cld
upper.tri 41.8 52.00 65.761 61.30 77.15 132.6 100 a
upper.tri2 110.8 128.95 187.372 154.85 178.60 3024.6 100 a
combn 1342.8 1392.25 1514.038 1432.90 1473.65 7034.7 100 a
combn2 687.5 725.50 780.686 765.85 812.65 1129.4 100 a
listcompr 97889.0 100321.75 106442.425 101347.95 105826.55 307089.4 100 b
更新
这是另一个版本，灵感来自
gen <- function(n) t(which(upper.tri(diag(n), diag = TRUE), arr.ind = TRUE))
或
gen <- function(n) {
unname(do.call(
cbind,
sapply(
seq(n),
function(k) rbind(k, k:n)
)
))
}
您可以像下面这样尝试 expand.grid + subset
gen <- function(n) {
unname(t(
subset(
expand.grid(rep(list(seq(n)), 2)),
Var1 <= Var2
)
))
}
你会看到
> gen(2)
[,1] [,2] [,3]
[1,] 1 1 2
[2,] 1 2 2
> gen(3)
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 1 1 2 1 2 3
[2,] 1 2 2 3 3 3
> gen(4)
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 1 1 2 1 2 3 1 2 3 4
[2,] 1 2 2 3 3 3 4 4 4 4
这里是@G 的略微修改版本。 Grothendieck 的 upper.tri，以及两者与评论中@rawr 方法的比较
upper.tri3 <- function(n){
mrow <- row(diag(n))
mcol <- t(mrow)
i <- mrow <= mcol
rbind(mrow[i], mcol[i])
}
library(bench)
n <- 1e4
mark(
upper.tri = {
d <- diag(n)
u <- upper.tri(d, diag = TRUE)
rbind(row(d)[u], col(d)[u]) },
upper.tri3 = upper.tri3(n),
rawr = {
s <- 1:n
rbind(sequence(s), rep(s, s))
}
)
#> Warning: Some expressions had a GC in every iteration; so filtering is disabled.
#> # A tibble: 3 × 6
#> expression min median `itr/sec` mem_alloc `gc/sec`
#> <bch:expr> <bch:tm> <bch:tm> <dbl> <bch:byt> <dbl>
#> 1 upper.tri 3.96s 3.96s 0.252 4.47GB 0.757
#> 2 upper.tri3 2.46s 2.46s 0.406 3.73GB 1.62
#> 3 rawr 372.25ms 429.55ms 2.33 763.06MB 1.16
由 reprex 包 (v2.0.1) 创建于 2021-10-18
您可以使用 expand.grid。我认为它是最直观易读的解决方案。
simple_solution <- function(x) {
df <- expand.grid(1:x, 1:x)
return(df[df$Var1 <= df$Var2, ])
}
> simple_solution(4)
Var1 Var2
1 1 1
5 1 2
6 2 2
9 1 3
10 2 3
11 3 3
13 1 4
14 2 4
15 3 4
16 4 4
给定 n=2，我想要一组值 (1, 1)、(1, 2) 和 (2, 2)。对于 n=3，我想要 (1, 1)、(1, 2)、(1, 3)、(2, 2)、(2, 3) 和 (3, 3)。依此类推 n=4、5 等
我想完全在基础库中完成此操作。最近，我开始使用
gen <- function(n)
{
x <- seq_len(n)
cbind(combn(x, 2), rbind(x, x))
}
这提供了一些可行但不可靠的输出。我们得到以下 n=4.
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
x 1 1 1 2 2 3 1 2 3 4
x 2 3 4 3 4 4 1 2 3 4
有没有更好的方法？在 expand.grid、outer、combn 和 R 的许多其他生成向量的方法之间，我希望能够只用一个组合生成函数来做到这一点，而不必绑定在一起combn 的输出与其他东西。我可以编写明显的 for 循环，但这似乎是对 R 功能的浪费。
从 expand.grid 开始，然后进行子集化是迄今为止许多答案都采用的一个选项，但我发现生成两倍我需要的集合的想法是对内存的不当使用。这可能也排除了 outer.
这里有一些方法可以做到这一点。
1) upper.tri
n <- 4
d <- diag(n)
u <- upper.tri(d, diag = TRUE)
rbind(row(d)[u], col(d)[u])
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
## [1,] 1 1 2 1 2 3 1 2 3 4
## [2,] 1 2 2 3 3 3 4 4 4 4
最后一行代码也可以写成：
t(sapply(c(row, col), function(f) f(d)[u]))
2) 组合
n <- 4
combn(n+1, 2, function(x) if (x[2] == n+1) x[1] else x)
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
## [1,] 1 1 1 1 2 2 2 3 3 4
## [2,] 2 3 4 1 3 4 2 4 3 4
这个的变体是：
co <- combn(n+1, 2)
co[2, ] <- ifelse(co[2, ] == n+1, co[1, ], co[2, ])
co
3) 列表理解
library(listcompr)
t(gen.matrix(c(i, j), i = 1:n, j = i:n))
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
## [1,] 1 1 2 1 2 3 1 2 3 4
## [2,] 1 2 2 3 3 3 4 4 4 4
性能
library(microbenchmark)
library(listcompr)
n <- 25
microbenchmark(
upper.tri = {
d <- diag(n)
u <- upper.tri(d, diag = TRUE)
rbind(row(d)[u], col(d)[u]) },
upper.tri2 = {
d <- diag(n)
u <- upper.tri(d, diag = TRUE)
t(sapply(c(row, col), function(f) f(d)[u])) },
combn = combn(n+1, 2, function(x) if (x[2] == n+1) x[1] else x),
combn2 = {
co <- combn(n+1, 2)
co[2, ] <- ifelse(co[2, ] == n+1, co[1, ], co[2, ])
co
},
listcompr = t(gen.matrix(c(i, j), i = 1:n, j = i:n)))
给予：
Unit: microseconds
expr min lq mean median uq max neval cld
upper.tri 41.8 52.00 65.761 61.30 77.15 132.6 100 a
upper.tri2 110.8 128.95 187.372 154.85 178.60 3024.6 100 a
combn 1342.8 1392.25 1514.038 1432.90 1473.65 7034.7 100 a
combn2 687.5 725.50 780.686 765.85 812.65 1129.4 100 a
listcompr 97889.0 100321.75 106442.425 101347.95 105826.55 307089.4 100 b
更新
这是另一个版本，灵感来自
gen <- function(n) t(which(upper.tri(diag(n), diag = TRUE), arr.ind = TRUE))
或
gen <- function(n) {
unname(do.call(
cbind,
sapply(
seq(n),
function(k) rbind(k, k:n)
)
))
}
您可以像下面这样尝试 expand.grid + subset
gen <- function(n) {
unname(t(
subset(
expand.grid(rep(list(seq(n)), 2)),
Var1 <= Var2
)
))
}
你会看到
> gen(2)
[,1] [,2] [,3]
[1,] 1 1 2
[2,] 1 2 2
> gen(3)
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 1 1 2 1 2 3
[2,] 1 2 2 3 3 3
> gen(4)
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 1 1 2 1 2 3 1 2 3 4
[2,] 1 2 2 3 3 3 4 4 4 4
这里是@G 的略微修改版本。 Grothendieck 的 upper.tri，以及两者与评论中@rawr 方法的比较
upper.tri3 <- function(n){
mrow <- row(diag(n))
mcol <- t(mrow)
i <- mrow <= mcol
rbind(mrow[i], mcol[i])
}
library(bench)
n <- 1e4
mark(
upper.tri = {
d <- diag(n)
u <- upper.tri(d, diag = TRUE)
rbind(row(d)[u], col(d)[u]) },
upper.tri3 = upper.tri3(n),
rawr = {
s <- 1:n
rbind(sequence(s), rep(s, s))
}
)
#> Warning: Some expressions had a GC in every iteration; so filtering is disabled.
#> # A tibble: 3 × 6
#> expression min median `itr/sec` mem_alloc `gc/sec`
#> <bch:expr> <bch:tm> <bch:tm> <dbl> <bch:byt> <dbl>
#> 1 upper.tri 3.96s 3.96s 0.252 4.47GB 0.757
#> 2 upper.tri3 2.46s 2.46s 0.406 3.73GB 1.62
#> 3 rawr 372.25ms 429.55ms 2.33 763.06MB 1.16
由 reprex 包 (v2.0.1) 创建于 2021-10-18
您可以使用 expand.grid。我认为它是最直观易读的解决方案。
simple_solution <- function(x) {
df <- expand.grid(1:x, 1:x)
return(df[df$Var1 <= df$Var2, ])
}
> simple_solution(4)
Var1 Var2
1 1 1
5 1 2
6 2 2
9 1 3
10 2 3
11 3 3
13 1 4
14 2 4
15 3 4
16 4 4