时间戳

首页 > 解决方案 > 在原始帖子“R - 生成二进制向量的所有可能成对组合”中添加附加条件

r - 在原始帖子“R - 生成二进制向量的所有可能成对组合”中添加附加条件

问题描述

我的问题在下面的帖子中几乎得到了完美的解决。

原帖：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

在我的问题中，需要将第 3、5 和第 6 对视为无效删除。条件是，后面的向量不能在早于前一个向量的位置有 1。如果在第一个向量中，第二个位置有一个 1，那么在第二个向量中，1 可以在第二个或第三个位置，但不是在第一个位置。

这可以在原始帖子中发布的解决方案中实现吗？由于我需要处理大量组合，是否有可能为此提供快速解决方案？

标签： rcombinationspermutationcombinatorics

解决方案

您可以将向量的第 n个元素从零中替换为1.

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并检查这些differences 是否都大于或等于零。

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类似于 basecombn但可能更快的函数。

编辑 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

推荐阅读