如何得到二元矩阵的所有唯一置换及其在R中的秩
我正在尝试创建一个循环，以获得所有唯一的矩阵。唯一的参数范围为0:1，矩阵的尺寸为4x4。这意味着将有65536个唯一矩阵（2^16）。我将唯一定义为在相同坐标中没有两个矩阵共享相同的元素。以下是我到目前为止的情况：如何得到二元矩阵的所有唯一置换及其在R中的秩,r,R,我正在尝试创建一个循环，以获得所有唯一的矩阵。唯一的参数范围为0:1，矩阵的尺寸为4x4。这意味着将有65536个唯一矩阵（2^16）。我将唯一定义为在相同坐标中没有两个矩阵共享相同的元素。以下是我到目前为止的情况： binary <- function(m, n) matrix(sample(0:1, m * n, replace = TRUE), m, n) binary这里有一些非常慢的代码 # Create options option <- replicate(16, c
binary <- function(m, n)
matrix(sample(0:1, m * n, replace = TRUE), m, n)
binary这里有一些非常慢的代码
# Create options
option <- replicate(16, c(0, 1), simplify = FALSE)
vector_possibilities <- expand.grid(option)
matrixes <- list()
for (i in seq_len(nrow(vector_possibilities))) {
matrixes[[i]] <- matrix(vector_possibilities[i,],4)
}
matrixes[1]
#创建选项
选项中代码的更简单（更快）版本。算法是相同的，创建一个包含16个向量的列表0:1
，将其扩展到所有可能的二进制字符串，并将此数据集的每一行强制转换为4x4矩阵
x <- replicate(4*4, 0:1, simplify = FALSE)
apply(expand.grid(x, KEEP.OUT.ATTRS = FALSE), 1, function(x) list(matrix(x, nrow = 4, ncol = 4)))
编辑
感谢用户
甚至
使用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))
}
使用2x2矩阵的示例
…现在是微基准
注：使用mb.asplit.array b.rcpp.arr b.rcpp.asp.arr微基准：：微基准（b.array（4,4），b.asplit.array（4,4），
+b.rcpp.arr（4,4），b.rcpp.asp.arr（4,4），
+时间=100L，控制=列表（预热=100L））
单位：毫秒
expr最小lq平均uq最大neval cld
b、 阵列（4，4）22.69801 27.03368 41.87245 33.35203 37.11160 213.8378 100 a
b、 asplit.数组（4,4）231.28149251.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.92865272.14143316.28854307.01918335.84227 493.5027 100 b
>
您可以通过执行以下操作获得三维数组：
x <- array(t(expand.grid(rep(list(c(0, 1)), 16))), c(4, 4, 2^16))
要将其作为矩阵列表，请执行以下操作：
asplit(x, 3) # in R version >=4.0.0
或者你可以：
purrr::array_tree(x, 3)
如何定义唯一的矩阵？所有元素都应该不同？每个矩阵不应该相同。我将“相同”定义为在同一坐标中没有两个矩阵共享相同的元素。你的意思是做expand.grid（rep（list（c（0,1）），16））
另一个选项-选项哦，这更干净了，我已经很久没有使用base了…也许你应该做array（t（expand.grid（rep（list（0:1），16）），c（4,4,2^16））
如果你想要一个列表，那么在base R中你可以使用asplit
：ieasplit（数组（t）（展开网格（rep（list（0:1），16）），c（4,4,2^16）），3）
或者用purr:：array_tree
@Onyambu替换asplit（展开网格（代表（列表（0:1），16）），c（4,4,2^16））
@onyanbu支持将其作为答案发布的建议。我已经更新了我的答案，并获得了相应的积分，但你真的应该将其作为你的答案发布。请注意，我已将微基准添加到我的答案中。asplit
产生了相当大的开销，但仍然是最快的。只需在屏幕上键入asplit
，你就不会发现它使用了循环的基础是否可以尝试使用数组树
？同样对于rcpp
是否可以在其上使用array
而不是lappy
？我相信这种组合将非常有用fast@Onyambu我添加了array\u tree
，但它比asplit
慢。@onyanbu做到了。array
vsrcpp.array
似乎有点矛盾（可能是因为“小”矩阵大小），但是，rcpp.array.asplit
似乎明显更快！刚刚做了基准测试。rcpp+array
比expand.grid+array
快。所以你需要再次检查你的基准测试。有趣的是，rcpp要比base R慢。嗯。我必须把这一点放在心上
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)
}
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
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
> 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
>
x <- array(t(expand.grid(rep(list(c(0, 1)), 16))), c(4, 4, 2^16))
x[,,1:2]
, , 1
[,1] [,2] [,3] [,4]
[1,] 0 0 0 0
[2,] 0 0 0 0
[3,] 0 0 0 0
[4,] 0 0 0 0
, , 2
[,1] [,2] [,3] [,4]
[1,] 1 0 0 0
[2,] 0 0 0 0
[3,] 0 0 0 0
[4,] 0 0 0 0
asplit(x, 3) # in R version >=4.0.0
purrr::array_tree(x, 3)