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

精明的讀者會注意到這個問題可以簡化為： “如何生成2的冪的所有成對排列 ？” 通過這種方式查看，我們可以避免最初處理二進制向量並將其保存到最后一步。

使用基本R函數intToBits ， 這個答案問題如何將整數轉換成二進制向量？ ，以及任何可以生成特定長度排列的函數（有很多包： 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

UPDATE

我只是張貼這個來指出@Suren的答案是如何正確的。

OP正在尋找排列而不是組合

從評論中的對話中，你會看到@Suren的解決方案在組數增加時沒有給出正確的結果（ “我也試圖獲得三個而不是兩個（或任何數字）的分組”和“這是切割一些解決方案“ ）。

似乎@ Suren的答案給出了正確的結果， g = 2 。 這是因為1:n choose 2的排列等於1:n choose 2的組合1:n choose 2與n:1 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