R：如何生成每个 rowSum 为 1 的数据框

Question

我有一个包含 15 列和 11 行的数据框。行值从 0.0 到 1.0，增量为 0.1。我想做的是生成所有组合，但只保留每行总和为 1 的组合。我尝试使用 expand.grid，但 15 列显然内存不足。

例如，以下代码适用于 5 列，但我需要对 15 或 20 列执行相同操作。

df <- data.frame(matrix(rep(seq(0.0,1.0,by=0.1),5), 11, 5))
df.grid <- expand.grid(df)
df.grid[which(rowSums(df.grid)==1),]

我确信有一种简单的方法可以做到这一点，但我是 R 新手。

感谢您的帮助。

Answer 1

我想我可能已经从右边的建议帖子中找到了答案。我还在检查。但这里就是答案。

library("partitions")
numColumns <- 15 
numIncrements <- 10
weights <- t(compositions(n=numIncrements, m=numColumns, include.zero=TRUE)/numIncrements)
weights

Answer 2

您需要尽量减少计算机需要完成的工作，因为您在这里要处理很多组合。首先，将您正在操作的数字集限制为最小集。鉴于 1 的总和已为 1，您的集合中不希望有多个 1。另一方面，您不希望超过十个0.1s。然后，您可以通过取 1 除以唯一数字序列的结果的底数来获得完整的集合：

x <- seq(.1, 1, by = .1)    # initialize 0.1:1 sequence
x <- rep(x, floor(1/x))    # repeat minimal set for all combinations

只有 27 个数字：

> x
 [1] 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.2 0.2 0.2 0.2 0.2 0.3 0.3 0.3 0.4 0.4 0.5 0.5 0.6
[24] 0.7 0.8 0.9 1.0

现在您需要循环 combn 组合中可能的术语数量，这将从 1 运行到 1/min(x)，即 10。然后我们可以向下索引到 colSums == 1 (combn将组合作为列返回）：

lapply(seq_len(1/min(x)), function(y){z <- combn(x, y); z[,colSums(z) == 1]})

考虑到大小（在我的笔记本电脑上需要 37 秒来生成 10 个矩阵的 1Mb 列表），这可以在不合理的时间内工作，但它仍然返回 很多 重复组合，因为每次迭代都包含更多副本一些不必要的数字；例如选择 3 时，没有第二次0.5 的意义，否则0.2 0.3 0.5 将被返回两次。

它的格式也不是非常方便，因为所有矩阵都有不同的维度。如果我们向combn 添加一个函数来添加NAs，这样每个组合的长度都是10，lapply 需要2-3 倍的时间，但它确实允许我们轻松地将它们与do.call(rbind, ... ) 和因此可以轻松地使用unique.matrix 将其简化为独特的组合。

x <- seq(.1, 1, by = .1)    # initialize 0.1:1 sequence
x <- rep(x, floor(1/x))    # repeat minimal set for all combinations
results <- lapply(seq_len(max(x)/min(x)), function(y){
  # calculate combinations; fill lengths to 10 with NA to allow easy joining later
  z <- combn(x, y, function(x){c(x, rep(NA, 10 - y))})
  z[,colSums(z, na.rm = TRUE) == 1]})    # chop to combinations with sum == 1
results <- do.call(cbind, results)    # combine 10 matrices
results <- unique.matrix(results, MARGIN = 2)    # remove remaining repeats

或者，您可以使用unique.matrix 执行第二个lapply 并在之后插入NAs，这可能会更快，但上面的版本是一个很好的过渡案例，不过。

如果我们优化可能有用的数字列表以在我们的循环中组合，我们可以计算出很多很多更少的组合，从而显着加快处理速度，使其几乎可以立即执行。仍然会有一些重复，因为对于某些组合，一些数字需要比其他组合更多地重复，但我们可以使用上述方法来简化：

results <- lapply(seq_len(10), function(y){
  x <- seq(.1, 1, by = .1)    # initialize 0.1:1 sequence
  # calculate minimum repititions of each number; .099 to avoid floating point error
  reps <- ifelse(y <= floor((1 - .1 * (y - 1)) / (x - .099)),
                 ifelse(y * x == 1, y, y - 1), 
                 floor((1 - .1 * (y - 1)) / (x - .099)) )
  x <- rep(x, reps)    # build set with necessary repeats
  # calculate combinations; fill lengths to 10 with NA to allow easy joining later
  z <- combn(x, y, FUN = function(x){c(x, rep(NA, 10 - y))})
  z[, colSums(z, na.rm = TRUE) == 1]    # chop to combinations with sum == 1
  })
results <- do.call(cbind, results)    # combine 10 matrices
results <- unique.matrix(results, MARGIN = 2)    # remove remaining repeats

请注意，reps 表达式可能在数学上并不理想，但在此处为所有 10 次迭代生成了正确的集合。 （如果你有更好的版本，请评论！）

总而言之，您会得到一个包含 41 种组合的矩阵，您可能可以手写出来。

> results
      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14] [,15] [,16]
 [1,]    1  0.1  0.2  0.3  0.4  0.5  0.1  0.1  0.1   0.1   0.2   0.2   0.2   0.3   0.1   0.1
 [2,]   NA  0.9  0.8  0.7  0.6  0.5  0.1  0.2  0.3   0.4   0.2   0.3   0.4   0.3   0.1   0.1
 [3,]   NA   NA   NA   NA   NA   NA  0.8  0.7  0.6   0.5   0.6   0.5   0.4   0.4   0.1   0.2
 [4,]   NA   NA   NA   NA   NA   NA   NA   NA   NA    NA    NA    NA    NA    NA   0.7   0.6
 [5,]   NA   NA   NA   NA   NA   NA   NA   NA   NA    NA    NA    NA    NA    NA    NA    NA
 [6,]   NA   NA   NA   NA   NA   NA   NA   NA   NA    NA    NA    NA    NA    NA    NA    NA
 [7,]   NA   NA   NA   NA   NA   NA   NA   NA   NA    NA    NA    NA    NA    NA    NA    NA
 [8,]   NA   NA   NA   NA   NA   NA   NA   NA   NA    NA    NA    NA    NA    NA    NA    NA
 [9,]   NA   NA   NA   NA   NA   NA   NA   NA   NA    NA    NA    NA    NA    NA    NA    NA
[10,]   NA   NA   NA   NA   NA   NA   NA   NA   NA    NA    NA    NA    NA    NA    NA    NA
      [,17] [,18] [,19] [,20] [,21] [,22] [,23] [,24] [,25] [,26] [,27] [,28] [,29] [,30] [,31]
 [1,]   0.1   0.1   0.1   0.1   0.2   0.2   0.1   0.1   0.1   0.1   0.1   0.1   0.2   0.1   0.1
 [2,]   0.1   0.1   0.2   0.2   0.2   0.2   0.1   0.1   0.1   0.1   0.1   0.2   0.2   0.1   0.1
 [3,]   0.3   0.4   0.2   0.3   0.2   0.3   0.1   0.1   0.1   0.2   0.2   0.2   0.2   0.1   0.1
 [4,]   0.5   0.4   0.5   0.4   0.4   0.3   0.1   0.2   0.3   0.2   0.3   0.2   0.2   0.1   0.1
 [5,]    NA    NA    NA    NA    NA    NA   0.6   0.5   0.4   0.4   0.3   0.3   0.2   0.1   0.2
 [6,]    NA    NA    NA    NA    NA    NA    NA    NA    NA    NA    NA    NA    NA   0.5   0.4
 [7,]    NA    NA    NA    NA    NA    NA    NA    NA    NA    NA    NA    NA    NA    NA    NA
 [8,]    NA    NA    NA    NA    NA    NA    NA    NA    NA    NA    NA    NA    NA    NA    NA
 [9,]    NA    NA    NA    NA    NA    NA    NA    NA    NA    NA    NA    NA    NA    NA    NA
[10,]    NA    NA    NA    NA    NA    NA    NA    NA    NA    NA    NA    NA    NA    NA    NA
      [,32] [,33] [,34] [,35] [,36] [,37] [,38] [,39] [,40] [,41]
 [1,]   0.1   0.1   0.1   0.1   0.1   0.1   0.1   0.1   0.1   0.1
 [2,]   0.1   0.1   0.1   0.1   0.1   0.1   0.1   0.1   0.1   0.1
 [3,]   0.1   0.1   0.2   0.1   0.1   0.1   0.1   0.1   0.1   0.1
 [4,]   0.1   0.2   0.2   0.1   0.1   0.1   0.1   0.1   0.1   0.1
 [5,]   0.3   0.2   0.2   0.1   0.1   0.2   0.1   0.1   0.1   0.1
 [6,]   0.3   0.3   0.2   0.1   0.2   0.2   0.1   0.1   0.1   0.1
 [7,]    NA    NA    NA   0.4   0.3   0.2   0.1   0.2   0.1   0.1
 [8,]    NA    NA    NA    NA    NA    NA   0.3   0.2   0.1   0.1
 [9,]    NA    NA    NA    NA    NA    NA    NA    NA   0.2   0.1
[10,]    NA    NA    NA    NA    NA    NA    NA    NA    NA   0.1

有点虎头蛇尾，真的。