Get all possible matrices by replacing only two positions in any column

Question

Let's start with the next matrix.

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)

Here 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

If I select a random column, say 4, I want to swap the two positions in this column. One such opportunity is to replace the 5th and 6th position given

      [,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

I want to do this for every possible exchange in each column, and then get all possible matrices for all columns.

Answer 1

Here's another solution:

# 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 
  }
}

Result:

> 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

Note:

Instead of creating a super long list, I created a nested matrix list with 8 elements and n subelements per element (where n is the number of unique permutations). You can block the result if you prefer the long list form.

Answer 2

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

}