Question

让我们从以下矩阵开始。

M <- matrix(c(0,0,1,1,0,0,1,1,
          0,1,1,0,0,1,1,0,
          0,0,0,0,1,1,1,1,
          0,1,0,1,1,0,1,0,
          0,0,1,1,1,1,0,0,
          0,1,1,0,1,0,0,1),nrow = 8,ncol = 6)

以下是M

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

如果我选择一个随机列，比如4，我想在该列中交换两个位置。其中一种可能性是交换第5和第6位置由

给出

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

我想为每列中的每个可能的交换执行此操作，然后为所有列执行此操作以获取所有可能的矩阵。

Answer 1

此代码按列提供0和1的每个排列。我在这里使用了一个较小的玩具示例，因为可能性的数量会变得非常大 - prod(choose(nrow(M), colSums(M)))。请注意，由于内存要求，这可能不会在给定矩阵的标准计算机上运行。

library(gtools)
set.seed(1234)
M <- matrix(sample(0:1, 16, replace = TRUE), ncol = 4)
M
#      [,1] [,2] [,3] [,4]
# [1,]    0    1    1    0
# [2,]    1    1    1    1
# [3,]    1    0    1    0
# [4,]    1    0    1    1    

perm1s <- function(n, N) {
  unique(permutations(N, N, c(rep(0, N - n), rep(1, n)), FALSE, FALSE))
}

createMat <- function(vec, lst) {
  tmp <- lapply(seq_along(vec), function(x) lst[[x]][vec[x], ])
  do.call(cbind, tmp)
}

makeMats <- function(M) {

  sums <- colSums(M)
  rows <- nrow(M)

  rowPerm <- lapply(sums, perm1s, N = rows)
  comb <- expand.grid(lapply(sapply(rowPerm, nrow), seq))
  comb <- lapply(split(comb, seq(nrow(comb))), unlist)

  mats <- lapply(comb, createMat, lst = rowPerm)
  mats

}

res <- makeMats(M)
res[[1]]
#      [,1] [,2] [,3] [,4]
# [1,]    0    0    1    0
# [2,]    1    0    1    0
# [3,]    1    1    1    1
# [4,]    1    1    1    1

在改变1列时保持其他列不变 - sum(choose(nrow(M), colSums(M)))可能性：

makeMats2 <- function(M) {

  sums <- colSums(M)
  rows <- nrow(M)

  rowPerm <- lapply(sums, perm1s, N = rows)
  ind <- rep(seq_along(rowPerm), sapply(rowPerm, nrow))
  rowPerm <- lapply(rowPerm, function(x) split(x, seq(nrow(x))))
  rowPerm <- unlist(rowPerm, recursive = FALSE)
  mats <- rep(list(M), length(rowPerm))
  mats <- mapply(function(x, y, z) {x[ , y] <- z; x}, 
                 x = mats, y = ind, z = rowPerm, SIMPLIFY = FALSE)
  mats

}

Answer 2

这是另一种解决方案：

# Return all unique permutations for c(0,0,0,0,1,1,1,1)
library(gtools)
perms = unique(permutations(8, 8, M[,1], set = FALSE))

# Create nested list
Mat_list = lapply(vector("list", ncol(M)), function(x) vector("list", nrow(perms)))

# Loop through every column and every permutations replacing each column 
# with each unique permutation one at a time
for(ii in 1:ncol(M)){
  for(jj in 1:nrow(perms)){
    New_Mat = M
    New_Mat[,ii] = perms[jj,]
    Mat_list[[ii]][[jj]] = New_Mat 
  }
}

<强>结果：

> Mat_list[[1]][[2]]
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    0    0    0    0    0    0
[2,]    0    1    0    1    0    1
[3,]    1    1    0    0    1    1
[4,]    1    0    0    1    1    0
[5,]    0    0    1    1    1    1
[6,]    1    1    1    0    1    0
[7,]    0    1    1    1    0    0
[8,]    1    0    1    0    0    1

注意：

我没有创建超长列表，而是创建了一个嵌套的矩阵列表，每个元素包含8个元素和n个子元素（其中n是唯一排列的数量）。如果您更喜欢长列表表单，可以取消列出结果。

通过在任何给定列中仅交换两个位置来获取所有可能的矩阵

2 个答案: