在基本包中，如何在向量的两个副本之间生成唯一的无序对？

Question

给定 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))
}

这给出了一些可行但很hacky的输出。当 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

有没有更好的办法？在 、 、 和 R 的许多其他生成向量的方法之间expand.grid，outer我combn希望能够仅使用一个组合生成函数来完成此操作，而不必将 的输出combn与其他东西绑定在一起。我可以编写明显的for循环，但这似乎浪费了 R 的能力。

从开始expand.grid然后取子集是迄今为止许多答案都采用的一个选项，但我发现生成两倍于我需要的集合的想法是对内存的不良利用。这恐怕也排除了outer。

Answer 1

这里有一些方法可以做到这一点。

1) 上部.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

Answer 2

更新

这是另一个版本，灵感来自@G。格洛腾迪克

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

Answer 3

这是@G 的稍微修改的版本。格洛腾迪克的upper.tri，以及评论中两者与 @rawr 方法的比较

\n

upper.tri3 <- function(n){\n  mrow <- row(diag(n))\n  mcol <- t(mrow)\n  i <- mrow <= mcol\n  rbind(mrow[i], mcol[i])\n}\n\nlibrary(bench)\nn <- 1e4\nmark(\n  upper.tri = {\n    d <- diag(n)\n    u <- upper.tri(d, diag = TRUE)\n    rbind(row(d)[u], col(d)[u]) },\n  upper.tri3 = upper.tri3(n),\n  rawr = {\n    s <- 1:n\n    rbind(sequence(s), rep(s, s))\n  }\n)\n#> Warning: Some expressions had a GC in every iteration; so filtering is disabled.\n#> # A tibble: 3 \xc3\x97 6\n#>   expression      min   median `itr/sec` mem_alloc `gc/sec`\n#>   <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl>\n#> 1 upper.tri     3.96s    3.96s     0.252    4.47GB    0.757\n#> 2 upper.tri3    2.46s    2.46s     0.406    3.73GB    1.62 \n#> 3 rawr       372.25ms 429.55ms     2.33   763.06MB    1.16\n

\n

由 reprex 包于 2021 年 10 月 18 日创建 (v2.0.1)

\n