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

我试图在行和必须等于1的条件下，用二进制数据生成m*n元素的矩阵

例如，在行和等于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)

---

一种简单的方法是生成所有长度为n的向量，其中包含n-1个零和1个一。这被简化为多集{0，0，…，0，1}的所有置换。假设有K个这样的排列

一旦我们有了所有这些，我们就生成了重复大小为m的K的置换，其中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, ]
    })
}

它也很有效：

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

---

很好，谢谢。很好，谢谢！我想你可以去掉评估代码。我通过以下步骤使它工作：y

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