R:如何用每个rowSum为1生成数据帧？

Question

我有一个有15列和11行的dataframe。行值从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。在另一端，您不需要超过10个0.1。那么，通过将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]})

考虑到大小(在我的笔记本电脑上生成一个包含10个矩阵的1Mb列表)，这在不合理的时间内起作用，但它仍然返回许多重复的组合，因为每次迭代包含一些数字的副本比必要的多；例如，当选择3时，没有第二个0.5的点，或者0.2 0.3 0.5将被返回两次。

它也不是一个非常方便的格式，因为所有的矩阵都有不同的维度。如果我们向combn中添加一个函数以添加NAs，那么每个组合的长度都是10，那么lapply的长度是do.call(rbind, ... )的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执行第二个unique.matrix，然后插入NA的后置，这可能会更快，但是上面的版本对于下面的内容来说是一个很好的桥接器。

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

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

有点不顺心，真的。