确定所有组合但使用分组变量
Determining All Combinations but With a Grouping Variable
我有以下数据列表。
Input <- list(c("1", "2"), c("3", "4"), c("5", "6", "7"))
我想从每个列表元素中取出一个项目并将它们组合成一个向量。然后，从每个列表元素中的剩余项目中，我想重复这个过程，从每个列表元素中取出另一个项目并将它们组合到另一个向量中。我想重复这些步骤，直到达到某个预定值（在本例中为 2；2 是最大数字，因为它恰好是 Input 列表中每个列表元素的最小长度）。
有很多可能的方法可以做到这一点，我希望找到一种可以 return 每种可能性的方法，例如下面的 Output 列表。我真的不关心输出的形式，只要它包含相同的信息即可。
Output <- lapply(list(rbind(as.character(c(1, 3, 5)), as.character(c(2, 4, 6))), rbind(as.character(c(1, 3, 5)), as.character(c(2, 4, 7))), rbind(as.character(c(1, 3, 6)), as.character(c(2, 4, 5))), rbind(as.character(c(1, 3, 6)), as.character(c(2, 4, 7))), rbind(as.character(c(1, 3, 7)), as.character(c(2, 4, 5))), rbind(as.character(c(1, 3, 7)), as.character(c(2, 4, 6))), rbind(as.character(c(1, 4, 5)), as.character(c(2, 3, 6))), rbind(as.character(c(1, 4, 5)), as.character(c(2, 3, 7))), rbind(as.character(c(1, 4, 6)), as.character(c(2, 3, 5))), rbind(as.character(c(1, 4, 6)), as.character(c(2, 3, 7))), rbind(as.character(c(1, 4, 7)), as.character(c(2, 3, 5))), rbind(as.character(c(1, 4, 7)), as.character(c(2, 3, 6)))), function (x) {
lapply(as.data.frame(t(x)), function (y) {
y
})
})
这个例子非常小。实际上，我可能会有更多的组（Input 列表中的列表元素）和每个组中的更多元素，并且组的大小可能与我的示例中的不同。是否有一种有效的、程序化的方式来执行此操作？我很想看到使用 base 函数的解决方案，但我对任何事情都持开放态度。 expand.grid() 函数不起作用，因为它没有考虑我的分组变量。
更新
之前好像误解了你的问题，现在我想明白了：
lst <- expand.grid(Input)
res <- Filter(
length,
combn(
1:nrow(lst),
min(lengths(Input)),
function(x) {
if (all(colSums(apply(lst[x, ], 2, duplicated)) == 0)) {
lst[x, ]
}
},
simplify = FALSE
)
)
这给出了
> res
[[1]]
Var1 Var2 Var3
1 1 3 5
8 2 4 6
[[2]]
Var1 Var2 Var3
1 1 3 5
12 2 4 7
[[3]]
Var1 Var2 Var3
2 2 3 5
7 1 4 6
[[4]]
Var1 Var2 Var3
2 2 3 5
11 1 4 7
[[5]]
Var1 Var2 Var3
3 1 4 5
6 2 3 6
[[6]]
Var1 Var2 Var3
3 1 4 5
10 2 3 7
[[7]]
Var1 Var2 Var3
4 2 4 5
5 1 3 6
[[8]]
Var1 Var2 Var3
4 2 4 5
9 1 3 7
[[9]]
Var1 Var2 Var3
5 1 3 6
12 2 4 7
[[10]]
Var1 Var2 Var3
6 2 3 6
11 1 4 7
[[11]]
Var1 Var2 Var3
7 1 4 6
10 2 3 7
[[12]]
Var1 Var2 Var3
8 2 4 6
9 1 3 7
上一个答案
您可以使用 expand.grid + combn
尝试下面的代码
lst <- lapply(Input, combn, min(lengths(Input)))
res <- do.call(
rbind,
apply(
expand.grid(lapply(lst, function(v) seq(ncol(v)))),
1,
function(k) {
expand.grid(
Map(
function(x, y) x[, y],
lst,
k
)
)
}
)
)
这给出了
> res
Var1 Var2 Var3
1 1 3 5
2 2 3 5
3 1 4 5
4 2 4 5
5 1 3 6
6 2 3 6
7 1 4 6
8 2 4 6
9 1 3 5
10 2 3 5
11 1 4 5
12 2 4 5
13 1 3 7
14 2 3 7
15 1 4 7
16 2 4 7
17 1 3 6
18 2 3 6
19 1 4 6
20 2 4 6
21 1 3 7
22 2 3 7
23 1 4 7
24 2 4 7
获取输入的最小长度n。
获取Input的第一个最小长度的元素i.
创建一个列表 x，每个输入包含大小 n 的所有唯一排列。
只取元素i.
的一种组合
expand.grid x 得到结果。
i <- which.min(lengths(Input))
n <- length(Input[[i]])
x <- lapply(Input, \(x) {
. <- do.call(expand.grid, rep(list(x), n))
asplit(.[!apply(., 1, anyDuplicated),], 1)
})
x[[i]] <- x[[i]][1]
y <- do.call(expand.grid, x)
y
# Var1 Var2 Var3
#1 2, 1 4, 3 6, 5
#2 2, 1 3, 4 6, 5
#3 2, 1 4, 3 7, 5
#4 2, 1 3, 4 7, 5
#5 2, 1 4, 3 5, 6
#6 2, 1 3, 4 5, 6
#7 2, 1 4, 3 7, 6
#8 2, 1 3, 4 7, 6
#9 2, 1 4, 3 5, 7
#10 2, 1 3, 4 5, 7
#11 2, 1 4, 3 6, 7
#12 2, 1 3, 4 6, 7
#Or more in a format like given in the question
apply(y, 1, \(.) {matrix(unlist(.), length(.[[1]]))}, simplify = FALSE)
#[[1]]
# [,1] [,2] [,3]
#[1,] "2" "4" "6"
#[2,] "1" "3" "5"
#
#[[2]]
# [,1] [,2] [,3]
#[1,] "2" "3" "6"
#[2,] "1" "4" "5"
#
#[[3]]
# [,1] [,2] [,3]
#[1,] "2" "4" "7"
#[2,] "1" "3" "5"
#
#[[4]]
# [,1] [,2] [,3]
#[1,] "2" "3" "7"
#[2,] "1" "4" "5"
#
#[[5]]
# [,1] [,2] [,3]
#[1,] "2" "4" "5"
#[2,] "1" "3" "6"
#
#[[6]]
# [,1] [,2] [,3]
#[1,] "2" "3" "5"
#[2,] "1" "4" "6"
#
#[[7]]
# [,1] [,2] [,3]
#[1,] "2" "4" "7"
#[2,] "1" "3" "6"
#
#[[8]]
# [,1] [,2] [,3]
#[1,] "2" "3" "7"
#[2,] "1" "4" "6"
#
#[[9]]
# [,1] [,2] [,3]
#[1,] "2" "4" "5"
#[2,] "1" "3" "7"
#
#[[10]]
# [,1] [,2] [,3]
#[1,] "2" "3" "5"
#[2,] "1" "4" "7"
#
#[[11]]
# [,1] [,2] [,3]
#[1,] "2" "4" "6"
#[2,] "1" "3" "7"
#
#[[12]]
# [,1] [,2] [,3]
#[1,] "2" "3" "6"
#[2,] "1" "4" "7"
生成排列的部分可以改进，例如通过使用 gtools::permutations.
基准：
Input <- list(c("1", "2"), c("3", "4"), c("5", "6", "7"))
bench::mark(check=FALSE,
TIC = {
lst <- expand.grid(Input)
Filter(
length,
combn(
1:nrow(lst),
min(lengths(Input)),
function(x) {
if (all(colSums(apply(lst[x, ], 2, duplicated)) == 0)) {
lst[x, ]
}
},
simplify = FALSE
)
)
} ,
GKi = {
n <- min(lengths(Input))
i <- match(n, lengths(Input))
x <- lapply(Input, \(x) {
. <- do.call(expand.grid, rep(list(x), n))
asplit(.[!apply(., 1, anyDuplicated),], 1)
})
x[[i]] <- x[[i]][1]
do.call(expand.grid, x) #Here we have the result
}
)
# expression min median `itr/sec` mem_alloc `gc/sec` n_itr n_gc
# <bch:expr> <bch:tm> <bch:tm> <dbl> <bch:byt> <dbl> <int> <dbl>
#1 TIC 8.66ms 9.78ms 102. 37.6KB 32.9 37 12
#2 GKi 644.1µs 676.21µs 1345. 19KB 25.7 628 12
@GKi 在这个例子中比@ThomasIsCoding 快 10 倍 并且使用更少的内存。
我有以下数据列表。
Input <- list(c("1", "2"), c("3", "4"), c("5", "6", "7"))
我想从每个列表元素中取出一个项目并将它们组合成一个向量。然后，从每个列表元素中的剩余项目中，我想重复这个过程，从每个列表元素中取出另一个项目并将它们组合到另一个向量中。我想重复这些步骤，直到达到某个预定值（在本例中为 2；2 是最大数字，因为它恰好是 Input 列表中每个列表元素的最小长度）。
有很多可能的方法可以做到这一点，我希望找到一种可以 return 每种可能性的方法，例如下面的 Output 列表。我真的不关心输出的形式，只要它包含相同的信息即可。
Output <- lapply(list(rbind(as.character(c(1, 3, 5)), as.character(c(2, 4, 6))), rbind(as.character(c(1, 3, 5)), as.character(c(2, 4, 7))), rbind(as.character(c(1, 3, 6)), as.character(c(2, 4, 5))), rbind(as.character(c(1, 3, 6)), as.character(c(2, 4, 7))), rbind(as.character(c(1, 3, 7)), as.character(c(2, 4, 5))), rbind(as.character(c(1, 3, 7)), as.character(c(2, 4, 6))), rbind(as.character(c(1, 4, 5)), as.character(c(2, 3, 6))), rbind(as.character(c(1, 4, 5)), as.character(c(2, 3, 7))), rbind(as.character(c(1, 4, 6)), as.character(c(2, 3, 5))), rbind(as.character(c(1, 4, 6)), as.character(c(2, 3, 7))), rbind(as.character(c(1, 4, 7)), as.character(c(2, 3, 5))), rbind(as.character(c(1, 4, 7)), as.character(c(2, 3, 6)))), function (x) {
lapply(as.data.frame(t(x)), function (y) {
y
})
})
这个例子非常小。实际上，我可能会有更多的组（Input 列表中的列表元素）和每个组中的更多元素，并且组的大小可能与我的示例中的不同。是否有一种有效的、程序化的方式来执行此操作？我很想看到使用 base 函数的解决方案，但我对任何事情都持开放态度。 expand.grid() 函数不起作用，因为它没有考虑我的分组变量。
更新
之前好像误解了你的问题，现在我想明白了：
lst <- expand.grid(Input)
res <- Filter(
length,
combn(
1:nrow(lst),
min(lengths(Input)),
function(x) {
if (all(colSums(apply(lst[x, ], 2, duplicated)) == 0)) {
lst[x, ]
}
},
simplify = FALSE
)
)
这给出了
> res
[[1]]
Var1 Var2 Var3
1 1 3 5
8 2 4 6
[[2]]
Var1 Var2 Var3
1 1 3 5
12 2 4 7
[[3]]
Var1 Var2 Var3
2 2 3 5
7 1 4 6
[[4]]
Var1 Var2 Var3
2 2 3 5
11 1 4 7
[[5]]
Var1 Var2 Var3
3 1 4 5
6 2 3 6
[[6]]
Var1 Var2 Var3
3 1 4 5
10 2 3 7
[[7]]
Var1 Var2 Var3
4 2 4 5
5 1 3 6
[[8]]
Var1 Var2 Var3
4 2 4 5
9 1 3 7
[[9]]
Var1 Var2 Var3
5 1 3 6
12 2 4 7
[[10]]
Var1 Var2 Var3
6 2 3 6
11 1 4 7
[[11]]
Var1 Var2 Var3
7 1 4 6
10 2 3 7
[[12]]
Var1 Var2 Var3
8 2 4 6
9 1 3 7
上一个答案
您可以使用 expand.grid + combn
lst <- lapply(Input, combn, min(lengths(Input)))
res <- do.call(
rbind,
apply(
expand.grid(lapply(lst, function(v) seq(ncol(v)))),
1,
function(k) {
expand.grid(
Map(
function(x, y) x[, y],
lst,
k
)
)
}
)
)
这给出了
> res
Var1 Var2 Var3
1 1 3 5
2 2 3 5
3 1 4 5
4 2 4 5
5 1 3 6
6 2 3 6
7 1 4 6
8 2 4 6
9 1 3 5
10 2 3 5
11 1 4 5
12 2 4 5
13 1 3 7
14 2 3 7
15 1 4 7
16 2 4 7
17 1 3 6
18 2 3 6
19 1 4 6
20 2 4 6
21 1 3 7
22 2 3 7
23 1 4 7
24 2 4 7
获取输入的最小长度n。
获取Input的第一个最小长度的元素i.
创建一个列表 x，每个输入包含大小 n 的所有唯一排列。
只取元素i.
的一种组合
expand.grid x 得到结果。
i <- which.min(lengths(Input))
n <- length(Input[[i]])
x <- lapply(Input, \(x) {
. <- do.call(expand.grid, rep(list(x), n))
asplit(.[!apply(., 1, anyDuplicated),], 1)
})
x[[i]] <- x[[i]][1]
y <- do.call(expand.grid, x)
y
# Var1 Var2 Var3
#1 2, 1 4, 3 6, 5
#2 2, 1 3, 4 6, 5
#3 2, 1 4, 3 7, 5
#4 2, 1 3, 4 7, 5
#5 2, 1 4, 3 5, 6
#6 2, 1 3, 4 5, 6
#7 2, 1 4, 3 7, 6
#8 2, 1 3, 4 7, 6
#9 2, 1 4, 3 5, 7
#10 2, 1 3, 4 5, 7
#11 2, 1 4, 3 6, 7
#12 2, 1 3, 4 6, 7
#Or more in a format like given in the question
apply(y, 1, \(.) {matrix(unlist(.), length(.[[1]]))}, simplify = FALSE)
#[[1]]
# [,1] [,2] [,3]
#[1,] "2" "4" "6"
#[2,] "1" "3" "5"
#
#[[2]]
# [,1] [,2] [,3]
#[1,] "2" "3" "6"
#[2,] "1" "4" "5"
#
#[[3]]
# [,1] [,2] [,3]
#[1,] "2" "4" "7"
#[2,] "1" "3" "5"
#
#[[4]]
# [,1] [,2] [,3]
#[1,] "2" "3" "7"
#[2,] "1" "4" "5"
#
#[[5]]
# [,1] [,2] [,3]
#[1,] "2" "4" "5"
#[2,] "1" "3" "6"
#
#[[6]]
# [,1] [,2] [,3]
#[1,] "2" "3" "5"
#[2,] "1" "4" "6"
#
#[[7]]
# [,1] [,2] [,3]
#[1,] "2" "4" "7"
#[2,] "1" "3" "6"
#
#[[8]]
# [,1] [,2] [,3]
#[1,] "2" "3" "7"
#[2,] "1" "4" "6"
#
#[[9]]
# [,1] [,2] [,3]
#[1,] "2" "4" "5"
#[2,] "1" "3" "7"
#
#[[10]]
# [,1] [,2] [,3]
#[1,] "2" "3" "5"
#[2,] "1" "4" "7"
#
#[[11]]
# [,1] [,2] [,3]
#[1,] "2" "4" "6"
#[2,] "1" "3" "7"
#
#[[12]]
# [,1] [,2] [,3]
#[1,] "2" "3" "6"
#[2,] "1" "4" "7"
生成排列的部分可以改进，例如通过使用 gtools::permutations.
基准：
Input <- list(c("1", "2"), c("3", "4"), c("5", "6", "7"))
bench::mark(check=FALSE,
TIC = {
lst <- expand.grid(Input)
Filter(
length,
combn(
1:nrow(lst),
min(lengths(Input)),
function(x) {
if (all(colSums(apply(lst[x, ], 2, duplicated)) == 0)) {
lst[x, ]
}
},
simplify = FALSE
)
)
} ,
GKi = {
n <- min(lengths(Input))
i <- match(n, lengths(Input))
x <- lapply(Input, \(x) {
. <- do.call(expand.grid, rep(list(x), n))
asplit(.[!apply(., 1, anyDuplicated),], 1)
})
x[[i]] <- x[[i]][1]
do.call(expand.grid, x) #Here we have the result
}
)
# expression min median `itr/sec` mem_alloc `gc/sec` n_itr n_gc
# <bch:expr> <bch:tm> <bch:tm> <dbl> <bch:byt> <dbl> <int> <dbl>
#1 TIC 8.66ms 9.78ms 102. 37.6KB 32.9 37 12
#2 GKi 644.1µs 676.21µs 1345. 19KB 25.7 628 12
@GKi 在这个例子中比@ThomasIsCoding 快 10 倍 并且使用更少的内存。