在行总和等于 1 的条件下所有可能的二进制数据矩阵

All possible matrices of binary data on condition that row sums equals 1

我正在尝试用二进制数据生成 m*n 个元素的矩阵,条件是行的总和必须等于 1。

例如,在行和等于1的情况下,二进制数据的所有可能的2*2矩阵是:

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

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

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

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

任何人都可以提供一些简洁的代码来实现这样的输出吗?或者是否有可以帮助解决此问题的功能?

base R 这可能是一个解决方案,

#    m : number of columns
#    n : number of rows

 my_fun <- function(m,n) {

    a <- max(m,n)

    mat <- diag(1, a, a)

    x <- 1:nrow(mat)

    y <- paste0(rep("x",n),collapse=",")

    exp <- paste0("expand.grid(",y,")")
    all_com <- eval(parse(text=exp ))


    out <- lapply(1:nrow(all_com),function(x){

    if(m>n) {
        mat[as.numeric(all_com[x,]),]


    }else{

      mat <- mat[as.numeric(all_com[x,]),][,1:m]
      mat <- mat[rowSums(mat)==1,]

    }
            })

    

    out <- out[lapply(out,length) == m*n]

      return(unique(out))

}
my_fun(2,2)

给予,

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

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

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

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

一种直接的方法涉及生成所有长度为 n 的向量,其中包含 n - 1 个零和 1 一个。这被简化为多重集 {0, 0, ... ,0, 1} 的所有排列。假设有 K 个这样的排列。

一旦我们拥有所有这些,我们就会生成 K 的排列,重复大小 m,其中 m 是所需的行数。我们使用这些结果中的每一个来对 0 和 1 的排列进行子集化。

下面,我们使用库 RcppAlgos 实现了这一点(披露:我是作者)。第一部分(即生成多重集合的排列)是使用 freqs 参数完成的。第二部分是使用 FUN 参数完成的,它允许传递作用于每个排列的任意函数。

library(RcppAlgos)

binMat <- function(m, n, row_sum = 1) {
    perms <- if (n == row_sum) {
        permuteGeneral(1, n, repetition = TRUE)
    } else {
        permuteGeneral(0:1, n, freqs = c(n - row_sum, row_sum))
    }
    
    permuteGeneral(nrow(perms), m, repetition = TRUE, FUN = function(x) {
        perms[x, ]
    })
}

注意,在上面可以使用 row_sum 参数生成具有不同行总和的矩阵。

这是一个例子:

binMat(3, 2)
[[1]]
     [,1] [,2]
[1,]    0    1
[2,]    0    1
[3,]    0    1

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

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

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

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

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

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

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

它也很有效:

system.time(testMany <- binMat(7, 7))
 user  system elapsed 
1.936   0.062   1.999

testMany[[1]]
     [,1] [,2] [,3] [,4] [,5] [,6] [,7]
[1,]    0    0    0    0    0    0    1
[2,]    0    0    0    0    0    0    1
[3,]    0    0    0    0    0    0    1
[4,]    0    0    0    0    0    0    1
[5,]    0    0    0    0    0    0    1
[6,]    0    0    0    0    0    0    1
[7,]    0    0    0    0    0    0    1

length(testMany)
[1] 823543