我的问题在下面的帖子中得到了完美的解决。
原始帖子：R-生成所有可能的二进制矢量的成对组合
然而，我有一个额外的条件要添加，这将使一些解决方案无效，我需要删除它们。例如，考虑以下6个成对输出：
[,1] [,2] [,3]
[1,] 1 0 0
[2,] 0 1 0
[1,] 1 0 0
[2,] 0 0 1
[1,] 0 1 0
[2,] 1 0 0
[1,] 0 1 0
[2,] 0 0 1
[1,] 0 0 1
[2,] 1 0 0
[1,] 0 0 1
[2,] 0 1 0
在我的问题中，第三对、第五对和第六对需要删除为无效。条件是，下一个向量的位置不能早于上一个向量。如果在第一个矢量中，在第二个位置有一个1，那么在第二矢量中，1可以在第二或第三个位置，但首先不在。
这有可能在原帖子中发布的解决方案中实现吗？有没有可能有快速的解决方案，因为我需要处理大量的组合？
您可以用1替换零向量的第n个元素。
FUN <- function(m, n, ...) {
combn(n, m, function(i, ...) t(sapply(i, function(j, ...) `[<-`(rep(0, n), j, 1))), ...)
}
FUN(2, 3, simplify=FALSE)
# [[1]]
# [,1] [,2] [,3]
# [1,] 1 0 0
# [2,] 0 1 0
#
# [[2]]
# [,1] [,2] [,3]
# [1,] 1 0 0
# [2,] 0 0 1
#
# [[3]]
# [,1] [,2] [,3]
# [1,] 0 1 0
# [2,] 0 0 1
点用于循环通过可选的simplify=FALSE参数。如果你忽略它，你会得到一个数组。不知道你喜欢什么，你可以把一个设置为默认值。
FUN(2, 3)
# , , 1
#
# [,1] [,2] [,3]
# [1,] 1 0 0
# [2,] 0 1 0
#
# , , 2
#
# [,1] [,2] [,3]
# [1,] 1 0 0
# [2,] 0 0 1
#
# , , 3
#
# [,1] [,2] [,3]
# [1,] 0 1 0
# [2,] 0 0 1
这也适用于更多的行和列。
FUN(8, 10, simplify=FALSE)
# [[1]]
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
# [1,] 1 0 0 0 0 0 0 0 0 0
# [2,] 0 1 0 0 0 0 0 0 0 0
# [3,] 0 0 1 0 0 0 0 0 0 0
# [4,] 0 0 0 1 0 0 0 0 0 0
# [5,] 0 0 0 0 1 0 0 0 0 0
# [6,] 0 0 0 0 0 1 0 0 0 0
# [7,] 0 0 0 0 0 0 1 0 0 0
# [8,] 0 0 0 0 0 0 0 1 0 0
#
# [[2]]
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
# [1,] 1 0 0 0 0 0 0 0 0 0
# [2,] 0 1 0 0 0 0 0 0 0 0
# [3,] 0 0 1 0 0 0 0 0 0 0
# [4,] 0 0 0 1 0 0 0 0 0 0
# [5,] 0 0 0 0 1 0 0 0 0 0
# [6,] 0 0 0 0 0 1 0 0 0 0
# [7,] 0 0 0 0 0 0 1 0 0 0
# [8,] 0 0 0 0 0 0 0 0 1 0
# ...
编辑1
如果您希望重复的行作为有效矩阵，可以使用RcppAlgos::permuteGeneral并检查diff的值是否都大于或等于零。
FUN2 <- function(m, n) {
v <- RcppAlgos::permuteGeneral(n, m, rep=T)
v <- as.data.frame(t(v[apply(v, 1, function(x) all(diff(x) >= 0)), ]))
unname(lapply(v, function(j) t(sapply(j, function(k) `[<-`(rep(0, n), k, 1)))))
}
FUN2(2, 3)
# [[1]]
# [,1] [,2] [,3]
# [1,] 1 0 0
# [2,] 1 0 0
#
# [[2]]
# [,1] [,2] [,3]
# [1,] 1 0 0
# [2,] 0 1 0
#
# [[3]]
# [,1] [,2] [,3]
# [1,] 1 0 0
# [2,] 0 0 1
#
# [[4]]
# [,1] [,2] [,3]
# [1,] 0 1 0
# [2,] 0 1 0
#
# [[5]]
# [,1] [,2] [,3]
# [1,] 0 1 0
# [2,] 0 0 1
#
# [[6]]
# [,1] [,2] [,3]
# [1,] 0 0 1
# [2,] 0 0 1
而且速度很快！
system.time(FUN2(5, 10))
# user system elapsed
# 1.31 0.00 1.40
注意，还有一个RcppAlgos::comboGeneral函数，它类似于基本combn，但可能更快。
编辑2
我们可以使用matrixStats::rowDiffs使其更快。
FUN3 <- function(m, n) {
v <- RcppAlgos::permuteGeneral(n, m, rep=T)
v <- as.data.frame(t(v[apply(matrixStats::rowDiffs(v) >= 0, 1, all), ]))
unname(lapply(v, function(j) t(sapply(j, function(k) `[<-`(rep(0, n), k, 1)))))
}
system.time(FUN3(6, 11))
# user system elapsed
# 3.80 0.03 3.96
您可以在一个列表中获得所有这样的唯一组合，该列表以R:为基，只有一行
lapply(as.data.frame(combn(3, 2)), function(x) +rbind(1:3 == x[1], 1:3 == x[2]))
#> $V1
#> [,1] [,2] [,3]
#> [1,] 1 0 0
#> [2,] 0 1 0
#>
#> $V2
#> [,1] [,2] [,3]
#> [1,] 1 0 0
#> [2,] 0 0 1
#>
#> $V3
#> [,1] [,2] [,3]
#> [1,] 0 1 0
#> [2,] 0 0 1
这适用于任何合理长度的向量。例如，长度4:
lapply(as.data.frame(combn(4, 2)), function(x) +rbind(1:4 == x[1], 1:4 == x[2]))
#> $V1
#> [,1] [,2] [,3] [,4]
#> [1,] 1 0 0 0
#> [2,] 0 1 0 0
#>
#> $V2
#> [,1] [,2] [,3] [,4]
#> [1,] 1 0 0 0
#> [2,] 0 0 1 0
#>
#> $V3
#> [,1] [,2] [,3] [,4]
#> [1,] 1 0 0 0
#> [2,] 0 0 0 1
#>
#> $V4
#> [,1] [,2] [,3] [,4]
#> [1,] 0 1 0 0
#> [2,] 0 0 1 0
#>
#> $V5
#> [,1] [,2] [,3] [,4]
#> [1,] 0 1 0 0
#> [2,] 0 0 0 1
#>
#> $V6
#> [,1] [,2] [,3] [,4]
#> [1,] 0 0 1 0
#> [2,] 0 0 0 1
编辑
任意数量的任意长度矢量的通用解决方案是：
get_unique <- function(n_vectors, length)
{
df <- as.data.frame(combn(length, n_vectors))
lapply(df, function(x) {
+do.call(rbind, lapply(x, function(i) seq(length) == i))
})
}
或者，如果允许重复：
get_unique <- function(n_vectors, length)
{
df <- as.data.frame(cbind(combn(length, n_vectors),
matrix(rep(seq(length), each = n_vectors),
ncol = length)))
lapply(df, function(x) {
+do.call(rbind, lapply(x, function(i) seq(length) == i))
})
}
创建于2020-12-12由reprex包(v0.3.0(