R - 生成所有可能的二元向量成对组合

Question

我正在寻找一种聪明的方法来生成两个长度为 n 的向量的所有成对组合，其中只有一个值不为零。

现在我正在做一些非常绝望的事情，通过每个组合循环：n <- 3; z <- rep(0,n); m <- apply(combn(1:n,1),2,function(k) {z[k]=1;z}) 但必须有更好的方法没有循环？

这就是我想要的，例如 n=3:

     [,1] [,2] [,3]
[1,]    1    0    0
[2,]    0    1    0  

[1,]    1    0    0
[2,]    0    0    1

[1,]    0    1    0
[2,]    1    0    0

[1,]    0    1    0
[2,]    0    0    1

[1,]    0    0    1
[2,]    1    0    0

[1,]    0    0    1
[2,]    0    1    0

非常感谢您的帮助。

Answer 1

是这样的吗？

n <- 3
g <- 2 # g must be < n 
m <- combn(n, g)
mm <- as.numeric(m)
mat <- matrix(0, nrow = g * ncol(m), ncol = n)
mat[ cbind(1:nrow(mat), mm)] <- 1

mat
#       [,1] [,2] [,3]
#[1,]    1    0    0
#[2,]    0    1    0

#[3,]    1    0    0
#[4,]    0    0    1

#[5,]    0    1    0
#[6,]    0    0    1

# mat is half the answer :)
# the other half is
mat[nrow(mat):1, ]

#      [,1] [,2] [,3]
#[1,]    0    0    1
#[2,]    0    1    0

#[3,]    0    0    1
#[4,]    1    0    0

#[5,]    0    1    0
#[6,]    1    0    0

soln <- rbind(mat, mat[nrow(mat):1, ])

# as suggested by the OP to split the soln 
d <- split(data.frame(soln), rep(1:(nrow(soln)/g), each=g))

Answer 2

精明的reader会注意到问题可以简化为："How to generate all pairwise permutations of powers of 2?"这样看，我们可以避免一开始就处理二进制矢量并将其保存到最后一步。

使用基础 R 函数 intToBits、this answer to the question How to convert integer numbers into binary vector? 和任何可以生成特定长度排列的函数（为此有很多包：gtools::permutations、RcppAlgos::permuteGeneral, iterpc, arrangements::permutations), 一行就可以得到想要的结果.

library(gtools)
t(sapply(t(gtools::permutations(3, 2, 2^(0:2))),  
         function(x) {as.integer(intToBits(x))})[1:3, ])

      [,1] [,2] [,3]
 [1,]    1    0    0
 [2,]    0    1    0

 [3,]    1    0    0
 [4,]    0    0    1

 [5,]    0    1    0
 [6,]    1    0    0

 [7,]    0    1    0
 [8,]    0    0    1

 [9,]    0    0    1
[10,]    1    0    0

[11,]    0    0    1
[12,]    0    1    0

概括很容易。

bitPairwise <- function(numBits, groupSize) {
    t(sapply(t(gtools::permutations(numBits, groupSize, 2^(0:(numBits-1)))), 
                 function(x) {as.integer(intToBits(x))})[1:numBits, ])
}

 bitPairwise(numBits = 6, groupSize = 3)[1:12, ]
      [,1] [,2] [,3] [,4] [,5] [,6]
 [1,]    1    0    0    0    0    0
 [2,]    0    1    0    0    0    0
 [3,]    0    0    1    0    0    0

 [4,]    1    0    0    0    0    0
 [5,]    0    1    0    0    0    0
 [6,]    0    0    0    1    0    0

 [7,]    1    0    0    0    0    0
 [8,]    0    1    0    0    0    0
 [9,]    0    0    0    0    1    0

[10,]    1    0    0    0    0    0
[11,]    0    1    0    0    0    0
[12,]    0    0    0    0    0    1

更新

我发布这个只是为了指出如何使@Suren 的回答正确。

The OP is looking for permutations not combinations

从评论中的对话，你会看到@Suren的解决方案在组数增加时没有给出正确的结果（"I am also trying to get groupings of three instead of 2 (or any number)"和"This is cutting off some solutions").

@Suren 的回答似乎给出了 g = 2 的正确结果。之所以如此，是因为 1:n choose 2 的排列等于 1:n choose 2 的组合与 n:1 choose 2 的组合的组合（注意 1:n 是相反的）。这正是@Suren 的回答所做的（即生成组合选择 2，以相反的顺序编写它们，然后组合）。

## original version
surenFun <- function(n, g) {
    m <- combn(n, g)
    mm <- as.numeric(m)
    mat <- matrix(0, nrow = g * ncol(m), ncol = n)
    mat[ cbind(1:nrow(mat), mm)] <- 1
    soln <- rbind(mat, mat[nrow(mat):1, ])
    split(data.frame(soln), rep(1:(nrow(soln)/g), each=g))
}

## Here is the corrected version
surenFunCorrected <- function(n, g) {
    ## changed combn to gtools::permutations or any other
    ## similar function that can generate permutations
    m <- gtools::permutations(n, g)
    ## you must transpose m
    mm <- as.numeric(t(m))
    ## change ncol(m) to nrow(m)
    mat <- matrix(0, nrow = g * nrow(m), ncol = n)
    mat[ cbind(1:nrow(mat), mm)] <- 1
    ## removed soln
    split(data.frame(mat), rep(1:(nrow(mat)/g), each=g))
}

对于 OP 中的给定示例，它以不同的顺序给出了相同的结果：

## The order is slightly different
match(surenFunCorrected(3, 2), surenFun(3, 2))
[1] 1 2 6 3 5 4

all(surenFunCorrected(3, 2) %in% surenFun(3, 2))
[1] TRUE

all(surenFun(3, 2) %in% surenFunCorrected(3, 2))
[1] TRUE

让我们用 g = 3 和 n = 4 来测试一下。

## N.B. all of the original output is
## contained in the corrected output
all(surenFun(4, 3) %in% surenFunCorrected(4, 3))
[1] TRUE

## However, there are 16 results
## not returned in the original
leftOut <- which(!(surenFunCorrected(4, 3) %in% surenFun(4, 3)))
leftOut
[1]  3  5  6  7  8  9 11 12 13 14 16 17 18 19 20 22

## E.g. 3 examples that were left out
surenFunCorrected(4, 3)[leftOut[c(1,8,16)]]
$`3`
  X1 X2 X3 X4
7  1  0  0  0
8  0  0  1  0
9  0  1  0  0

$`12`
   X1 X2 X3 X4
34  0  1  0  0
35  0  0  0  1
36  0  0  1  0

$`22`
   X1 X2 X3 X4
64  0  0  0  1
65  0  1  0  0
66  0  0  1  0

R - 生成所有可能的二元向量成对组合

R - generate all possible pairwise combinations of binary vectors

combinations

r

combinatorics

binary-data

更新