How to get all unique permutations of a binary matrix and their ranks in R

Question

I am trying to create a loop that would get all unique matrices. The only parameters would be a range from 0:1 and the matrix having a dimension of 4x4. This would mean that there would be 65,536 unique matrices (2^16). I define unique as no two matrices share the same elements in the same coordinates. Here is what I have so far:

binary <- function(m, n)
matrix(sample(0:1, m * n, replace = TRUE), m, n)

where m = 4 and n = 4.

Not sure how to generate a loop that would calculate all unique permutations.

Answer 1

A very fast solution using RcppAlgos::permuteGeneral.

binary2 <- function(m, n) {
  mn <- m*n
  perm <- RcppAlgos::permuteGeneral(v=0:1, m=mn, repetition=TRUE)
  lapply(1:nrow(perm), function(i) matrix(perm[i, ], nrow=m, ncol=n))
}

Edit: The benchmark (see below) revealed, a combination of rcpp and @Onyambu's array solution is very fast:

binary3.2 <- function(m, n) {
  mn <- m*n
  perm <- RcppAlgos::permuteGeneral(0:1, mn, TRUE)
  asplit(array(t(perm), c(m, n, 2^(m*n))), 3)
}

Example using 2 x 2 matrix

binary3.2(2, 2)
# [[1]]
#      [,1] [,2]
# [1,]    0    0
# [2,]    0    0
# 
# [[2]]
#      [,1] [,2]
# [1,]    0    0
# [2,]    0    1
# 
# [[3]]
#      [,1] [,2]
# [1,]    0    1
# [2,]    0    0
# 
# [[4]]
#      [,1] [,2]
# [1,]    0    1
# [2,]    0    1
# 
# [[5]]
#      [,1] [,2]
# [1,]    0    0
# [2,]    1    0
# 
# [[6]]
#      [,1] [,2]
# [1,]    0    0
# [2,]    1    1
# 
# [[7]]
#      [,1] [,2]
# [1,]    0    1
# [2,]    1    0
# 
# [[8]]
#      [,1] [,2]
# [1,]    0    1
# [2,]    1    1
# 
# [[9]]
#      [,1] [,2]
# [1,]    1    0
# [2,]    0    0
# 
# [[10]]
#      [,1] [,2]
# [1,]    1    0
# [2,]    0    1
# 
# [[11]]
#      [,1] [,2]
# [1,]    1    1
# [2,]    0    0
# 
# [[12]]
#      [,1] [,2]
# [1,]    1    1
# [2,]    0    1
# 
# [[13]]
#      [,1] [,2]
# [1,]    1    0
# [2,]    1    0
# 
# [[14]]
#      [,1] [,2]
# [1,]    1    0
# [2,]    1    1
# 
# [[15]]
#      [,1] [,2]
# [1,]    1    1
# [2,]    1    0
# 
# [[16]]
#      [,1] [,2]
# [1,]    1    1
# [2,]    1    1

...and here comes the microbenchmark

Note: used m <- 4; n <- 4

microbenchmark::microbenchmark(b.rcpp(), b.apply.exp(), b.apply.simp(), 
                               b.asplit.array(), b.array(), b.array_tree(),
                               b.rcpp.array(), b.rcpp.arr.aspl(),
                               times=5L, control=list(warmup=5L))

# Unit: milliseconds
#              expr       min        lq      mean    median        uq      max neval   cld
#          b.rcpp() 388.82227 389.27565 419.43537 408.99157 448.78494 461.3024     5   cd 
#     b.apply.exp() 446.85891 484.10602 502.78558 488.01344 518.98317 575.9664     5    de
#    b.apply.simp() 512.89587 553.52379 588.59234 569.65709 577.65281 729.2322     5     e
#  b.asplit.array() 273.01535 325.13691 320.53399 328.99840 335.36864 340.1507     5  bc  
#         b.array()  27.37996  29.33839  84.25181  39.65228  44.44757 280.4408     5 a    
#    b.array_tree() 322.98764 364.64733 424.07656 391.41701 439.77709 601.5537     5   cd 
#    b.rcpp.array()  51.87000  52.19530  66.88202  53.49471  61.88716 114.9629     5 a    
# b.rcpp.arr.aspl() 261.10201 263.29439 272.21605 278.05505 278.37984 280.2490     5  b   

second benchmark

> b.array <- function(m, n) {
+   array(t(expand.grid(rep(list(0:1),m*n))),c(m,n,2^(m*n)))
+ }
> 
> b.asplit.array <- function(m, n) {
+   asplit(array(t(expand.grid(rep(list(0:1),m*n))),c(m,n,2^(m*n))), 3)
+ }
> b.rcpp.arr <- function(m, n) {
+   perm <- RcppAlgos::permuteGeneral(0:1, m*n, TRUE)
+   array(t(perm), c(m, n, 2^(m*n)))
+ }
> 
> b.rcpp.asp.arr <- function(m, n) {
+   perm <- RcppAlgos::permuteGeneral(0:1, m*n, TRUE)
+   asplit(array(t(perm), c(m, n, 2^(m*n))), 3)
+ }
> 
> microbenchmark::microbenchmark(b.array(4, 4), b.asplit.array(4, 4),
+                                b.rcpp.arr(4, 4), b.rcpp.asp.arr(4, 4),
+                                times=100L, control=list(warmup=100L))
Unit: milliseconds
                 expr       min        lq      mean    median        uq      max neval cld
        b.array(4, 4)  22.69801  27.03368  41.87245  33.35203  37.11160 213.8378   100  a 
 b.asplit.array(4, 4) 231.28149 251.42609 302.35571 295.42282 331.09442 492.8092   100   b
     b.rcpp.arr(4, 4)  32.03322  35.92215  55.64920  50.98276  56.55712 220.2534   100  a 
 b.rcpp.asp.arr(4, 4) 245.92865 272.14143 316.28854 307.01918 335.84227 493.5027   100   b
>