Question

我有一个输入向量，例如：

weights <- seq(0, 1, by = 0.2)

我想生成所有权重组合（允许重复），使得总和等于1。我想出了

l <- rep(list(weights), 10)
combinations <- expand.grid(l)
combinations[which(apply(combinations, 1, sum) == 1),]

问题当然是我生成了我需要的更多组合。有没有办法更有效地完成它？

编辑：谢谢你的回答。这是问题的第一部分。正如@Frank指出的那样，现在我已经将所有“解决方案”加起来为1，问题是从长度为10的向量中的解决方案中得到所有排列（不确定它是否是正确的单词）。实例：

s1 <- c(0, 0, 0.2, 0, 0, 0, 0.8, 0, 0, 0)
s2 <- c(0.8, 0, 0, 0, 0, 0, 0, 0, 0.2, 0)
etc...

Answer 1

查找与某个目标t求和的一组整数的任何子集是subset sum problem的一种形式，它是NP完全的。因此，有效地计算总和达到目标值的所有组合（允许重复）在理论上具有挑战性。

为了解决子集求和问题的特殊情况，让我们通过假设输入是正整数来重构你的问题（对于你的例子w <- c(2, 4, 6, 8, 10);我不会考虑非正数这个答案中的整数或非整数）并且目标也是一个正整数（在你的例子10中）。将D(i, j)定义为集合i的第一个j元素中总和为w的所有组合的集合。如果n中有w个元素，那么您对D(t, n)感兴趣。

让我们从几个基本案例开始：D(0, k) = {{}}表示所有k >= 0（总和为0的唯一方法是不包含任何元素）和D(k, 0) = {}表示任何k > 0（你不能总和为零元素的正数）。现在考虑以下伪代码来计算任意D(i, j)值：

for j = 1 ... n
  for i = 1 ... t
    D[(i, j)] = {}
    for rep = 0 ... floor(i/w_j)
      Dnew = D[(i-rep*w_j, j-1)], with w_j added "rep" times
      D[(i, j)] = Union(D[(i, j)], Dnew)

请注意，这可能仍然非常低效（D(t, n)可以包含指数级大量的可行子集，因此无法避免这种情况），但在许多情况下，存在相对较少数量的可行组合对于目标而言，这可能比简单地考虑集合的每个子集（有2^n个这样的子集要快得多，因此该方法总是具有指数运行时。）

让我们用R代码编写你的例子：

w <- c(2, 4, 6, 8, 10)
n <- length(w)
t <- 10
D <- list()
for (j in 0:n) D[[paste(0, j)]] <- list(c())
for (i in 1:t) D[[paste(i, 0)]] <- list()
for (j in 1:n) {
  for (i in 1:t) {
    D[[paste(i, j)]] <- do.call(c, lapply(0:floor(i/w[j]), function(r) {
      lapply(D[[paste(i-r*w[j], j-1)]], function(x) c(x, rep(w[j], r)))
    }))
  }
}
D[[paste(t, n)]]
# [[1]]
# [1] 2 2 2 2 2
# 
# [[2]]
# [1] 2 2 2 4
# 
# [[3]]
# [1] 2 4 4
# 
# [[4]]
# [1] 2 2 6
# 
# [[5]]
# [1] 4 6
# 
# [[6]]
# [1] 2 8
# 
# [[7]]
# [1] 10

代码正确识别集合中总和为10的所有元素组合。

为了有效地获取所有2002年独特的长度为10的组合，我们可以使用allPerm包中的multicool函数：

library(multicool)
out <- do.call(rbind, lapply(D[[paste(t, n)]], function(x) {
  allPerm(initMC(c(x, rep(0, 10-length(x)))))
}))
dim(out)
# [1] 2002   10
head(out)
#      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
# [1,]    2    2    2    2    2    0    0    0    0     0
# [2,]    0    2    2    2    2    2    0    0    0     0
# [3,]    2    0    2    2    2    2    0    0    0     0
# [4,]    2    2    0    2    2    2    0    0    0     0
# [5,]    2    2    2    0    2    2    0    0    0     0
# [6,]    2    2    2    2    0    2    0    0    0     0

对于给定的输入，整个操作非常快（我的计算机上0.03秒）并且没有使用大量内存。与此同时，原始帖子中的解决方案在22秒内运行并使用了15 GB内存，即使将最后一行替换为（更高）效率更高combinations[rowSums(combinations) == 1,]。

Answer 2

查看partitions库，

library(partitions)
ps <- parts(10)
res <- ps[,apply(ps, 2, function(x) all(x[x>0] %% 2 == 0))] / 10

Answer 3

对于组合，你想要这个：

combinations <- lapply(seq_along(weights), function(x) combn(weights, x))

然后是总和：

sums <- lapply(combinations, colSums)
inds <- lapply(sums, function(x) which(x == 1))
lapply(seq_along(inds), function(x) combinations[[x]][, inds[[x]]])

Answer 4

如果您想使用基数R，这是我为解决此问题而准备的一小段递归代码。它以列表的形式返回结果，因此不是对特定问题的完整答案。

combnToSum = function(target, values, collapse = T) {

  if(any(values<=0)) stop("All values must be positive numbers.")

  appendValue = function(root) {
    if(sum(root) == target) return(list(root))

    candidates = values + sum(root) <= target
    if(length(root)>0 & collapse) candidates = candidates & values >= root[1]

    if(!any(candidates)) return(NULL)

    roots = lapply(values[candidates], c, root)
    return(unlist(lapply(roots, addValue), recursive = F))
  }

  appendValue(integer(0))
}

代码相当高效，可以瞬间解决测试问题。

combnToSum(1, c(.2,.4,.6,.8,1))
# [[1]]
# [1] 0.2 0.2 0.2 0.2 0.2
#
# [[2]]
# [1] 0.4 0.2 0.2 0.2
#
# [[3]]
# [1] 0.6 0.2 0.2
#
# [[4]]
# [1] 0.4 0.4 0.2
#
# [[5]]
# [1] 0.8 0.2
#
# [[6]]
# [1] 0.6 0.4
#
# [[7]]
# [1] 1

当values包含的数字相对于target较小时，可能会发生错误。例如，尝试找到所有10美元的零钱兑换方式：

combnToSum(1000, c(1, 5, 10, 25))

产生以下错误

# enter code here`Error: evaluation nested too deeply: infinite recursion / options(expressions=)?

我将appendValue作为嵌套在combnToSum范围内的函数，这样就不必为每次调用都复制并传递target和values（内部，在R中）。我也喜欢漂亮干净的签名combnToSum(target, values);用户不需要知道中间值root。

也就是说，appendValue可以是带有签名appendValue(target, values, root)的独立函数，在这种情况下，您可以只使用appendValue(1, c(0.2, 0.4, 0.6, 0.8, 1), integer(0))来获得相同的答案。但是您可能会丢失对负值的错误检查，或者如果将错误检查放入appendValue，则每次对该函数的递归调用都会进行错误检查，这似乎效率不高。

设置collapse = F将返回所有具有唯一顺序的排列。

combnToSum(1, c(.2,.4,.6,.8,1), collapse = F)
# [[1]]
# [1] 0.2 0.2 0.2 0.2 0.2
# 
# [[2]]
# [1] 0.4 0.2 0.2 0.2
# 
# [[3]]
# [1] 0.2 0.4 0.2 0.2
# 
# [[4]]
# [1] 0.6 0.2 0.2
# 
# [[5]]
# [1] 0.2 0.2 0.4 0.2
# 
# [[6]]
# [1] 0.4 0.4 0.2
# 
# [[7]]
# [1] 0.2 0.6 0.2
# 
# [[8]]
# [1] 0.8 0.2
# 
# [[9]]
# [1] 0.2 0.2 0.2 0.4
# 
# [[10]]
# [1] 0.4 0.2 0.4
# 
# [[11]]
# [1] 0.2 0.4 0.4
# 
# [[12]]
# [1] 0.6 0.4
# 
# [[13]]
# [1] 0.2 0.2 0.6
# 
# [[14]]
# [1] 0.4 0.6
# 
# [[15]]
# [1] 0.2 0.8
# 
# [[16]]
# [1] 1

Answer 5

如果您打算仅使用base R来实现它，那么另一种方法是递归。

假设x <- c(1,2,4,8)和s <- 9表示目标总和，那么以下函数可以帮助您：

f <- function(s, x, xhead = head(x,1), r = c()) {
  if (s == 0) {
    return(list(r))
  } else {
    x <- sort(x,decreasing = T)
    return(unlist(lapply(x[x<=min(xhead,s)], function(k) f(round(s-k,10), x[x<= round(s-k,10)], min(k,head(x[x<=round(s-k,10)],1)), c(r,k))),recursive = F)) 
  }
}

f(s,x)给出的内容：

[[1]]
[1] 8 1

[[2]]
[1] 4 4 1

[[3]]
[1] 4 2 2 1

[[4]]
[1] 4 2 1 1 1

[[5]]
[1] 4 1 1 1 1 1

[[6]]
[1] 2 2 2 2 1

[[7]]
[1] 2 2 2 1 1 1

[[8]]
[1] 2 2 1 1 1 1 1

[[9]]
[1] 2 1 1 1 1 1 1 1

[[10]]
[1] 1 1 1 1 1 1 1 1 1

注意：round(*,digits=10)用于处理浮点数，其中digits应适应输入的小数。

集合到目标值的集合的所有可能组合

5 个答案: