函数中的子集以计算行总计答案

【问题标题】：Subsetting in a function to calculate a row total函数中的子集以计算行总计
【发布时间】：2011-06-02 18:44:54
【问题描述】：

我有一个包含某些工具结果的数据框，我想创建一个包含每行总数的新列。因为每次对新数据运行分析时我都有不同数量的工具，所以我需要一个函数来动态计算包含行总计的新列。

简单来说，我的数据框如下所示：

    Type    Value
1   A   10
2   A   15
3   A   20
4   A   25
5   B   30
6   B   40
7   B   50
8   B   60
9   B   70
10  B   80
11  B   90

我的目标是实现以下目标：

    A   B   Total
1   10  30  40
2   15  40  55
3   20  50  70
4   25  60  85
5       70  70
6       80  80
7       90  90

我尝试了各种方法，但这种方法最有希望：

myList <- list(a = c(10, 15, 20, 25), b = c(30, 40, 50, 60, 70, 80, 90))
tmpDF <- data.frame(sapply(myList, '[', 1:max(sapply(myList, length))))
> tmpDF
   a  b
1 10 30
2 15 40
3 20 50
4 25 60
5 NA 70
6 NA 80
7 NA 90
totalSum <- rowSums(tmpDF)
totalSum <- data.frame(totalSum)
tmpDF <- cbind(tmpDF, totalSum)
> tmpDF
   a  b totalSum
1 10 30       40
2 15 40       55
3 20 50       70
4 25 60       85
5 NA 70       NA
6 NA 80       NA
7 NA 90       NA

尽管这种方式确实成功地组合了两个不同长度的数据帧，但在此示例中，“rowSums”函数给出了错误的值。除此之外，我的原始数据不是列表格式，所以我不能应用这样的“解决方案”。

我想我把这个问题复杂化了，所以我想知道我该怎么做……

基于“类型”的数据帧的子集数据，
将这些不同长度的单独子集插入到新的数据帧中，
在此数据框中添加一个“总计”列，该列是正确的总和单个子集。

这个问题的另一个复杂之处在于，这需要在一个函数中或以其他动态方式完成，因此我不需要手动将几十个“类型”（A、B、C 和等等）在我的数据框中。

这是我目前所拥有的，它不起作用，但说明了我正在思考的路线：

TotalDf <- function(x){
    tmpNumberOfTypes <- c(levels(x$Type))
    for( i in tmpNumberOfTypes){
        subSetofData <- subset(x, Type = i, select = Value)
        if( i == 1) {
        totalDf <- subSetOfData }
        else{
        totalDf <- cbind(totalDf, subSetofData)}
    }
    return(totalDf)
}

提前感谢您对此的任何想法或想法，

问候，

EDIT:

感谢 Joris 的评论（见下文），我在正确的方向上结束了，但是，当尝试将他的解决方案转换为我的数据框时，我遇到了其他问题。他提出的答案有效，并给了我以下（正确）A 和 B 值的总和：

> tmp78 <- tapply(DF$value,DF$id,sum)
> tmp78
 1  2  3  4  5  6 
 6  8 10 12  9 10 
> data.frame(tmp78)
  tmp78
1     6
2     8
3    10
4    12
5     9
6    10

但是，当我在我的数据框上尝试此解决方案时，它不起作用：

> subSetOfData <- copyOfTradesList[c(1:3,11:13),c(1,10)]
> subSetOfData
   Instrument AccountValue
1         JPM         6997
2         JPM         7261
3         JPM         7545
11        KFT         6992
12        KFT         6944
13        KFT         7069
> unlist(sapply(rle(subSetOfData$Instrument)$lengths,function(x) 1:x))
Error in rle(subSetOfData$Instrument) : 'x' must be an atomic vector
> subSetOfData$InstrumentNumeric <- as.numeric(subSetOfData$Instrument)
> unlist(sapply(rle(subSetOfData$InstrumentNumeric)$lengths,function(x) 1:x))
     [,1] [,2]
[1,]    1    1
[2,]    2    2
[3,]    3    3
> subSetOfData$id <- unlist(sapply(rle(subSetOfData$InstrumentNumeric)$lengths,function(x) 1:x))
Error in `$<-.data.frame`(`*tmp*`, "id", value = c(1L, 2L, 3L, 1L, 2L,  : 
  replacement has 3 rows, data has 6

我有一个令人不安的想法，我在兜圈子……

【问题讨论】：

您发现自己的 rls 不适用于因子。但是有些奇怪。我无法重现您的错误，它对我来说很好。你更新到 R 2.12.1 了吗？无论如何，如果您在安装 plyr 时遇到内部错误，明智的做法是花 2 分钟重新安装 R。实际上不会花费更长的时间。
@Joris：我还没有更新到最新版本，因为我总是对这些东西有点犹豫（2 分钟听起来足以鼓励更新。:)）。您在重现“plyr 错误”或“取消列表”功能中的错误时遇到问题吗？我真的希望前者，否则它表明 R 的标准功能与 2.12.1 版本与 2.11 版本存在差异。
我无法复制其中任何一个，但我指的是 unlist 函数。我可以确认 2.12 确实与 2.11 有点不同，但我发现的所有变化都是为了更好。据我所知，2.12.1 运行平稳且没有错误。更新绝对是个不错的选择。
@Joris：我已经更新了 R 并且仍然遇到 unlist 错误（这没关系，因为使用 lapply 我仍然能够计算总数）。图书馆重塑现在确实有效。 :) 所以感谢您的鼓励，即使我没有达到两分钟的目标。 ;) 哈哈
是的，正如 pchalasani 所说。 sapply 仅在每个级别中的案例数量不同时才有效。我错过了那个，对不起。所以 lapply 是要走的路。

标签： function r sum subset

【解决方案1】：

两个想法：

1) 你可以在 rowSums 中使用 na.rm=T

2) 你怎么知道哪一个必须和哪一个搭配？您可以添加一些索引。

例如：

DF <- data.frame(
  type=c(rep("A",4),rep("B",6)),
  value = 1:10,
  stringsAsFactors=F
)


DF$id <- unlist(lapply(rle(DF$type)$lengths,function(x) 1:x))

现在这使您可以轻松地tapply 原始数据帧上的总和

tapply(DF$value,DF$id,sum)

而且，更重要的是，以正确的形式获取您的数据框：

> DF
   type value id
1     A     1  1
2     A     2  2
3     A     3  3
4     A     4  4
5     B     5  1
6     B     6  2
7     B     7  3
8     B     8  4
9     B     9  5
10    B    10  6

> library(reshape)
> cast(DF,id~type)
  id  A  B
1  1  1  5
2  2  2  6
3  3  3  7
4  4  4  8
5  5 NA  9
6  6 NA 10

【讨论】：

感谢 Joris，建议 1 解决了总行中的 NA 问题。好点你的第二个建议。匹配（例如准时）是需要进一步分析的东西，我不想让这个问题太长。但是，它们已经匹配，因为 A 的第一个值与 B 的第一个值大致发生在同一时间段。
@Jura ：然后你可以添加一些 id。我用一个例子调整了我的答案，允许一个简单的演员。
@Joris：感谢您的进一步阐述，但是在输入“DF$Total *tmp*, "Total", value = c(6L, 8L, 10L, 12L, : 替换有 6 行，数据有 10" 或者这是可以预期的并且依赖于 reshape 包？我是问是因为我无法安装 plyr 包（reshape 取决于它）（R 给出内部错误），我宁愿不删除并重新安装 R 来尝试解决这个“plyr 错误”，除非我的问题绝对需要它.（抱歉又打扰你了）
@Jura25：使用lapply 代替sapply，它应该可以工作。 sapply 尽可能帮助我将结果放入矩阵形式——在我们的例子中，JPM 和 KFT 的数量相同，因此 sapply 将结果放入矩阵形式中，并且您最终将矩阵分配给数据框的id 列，这会产生奇怪的结果。但是lapply 不会这样做，因此unlist 会将预期的结果“展平”为向量。
@Jura ：对不起，错误地复制了代码，现在更正它。当然，你不能像它一样轻敲它。在重铸或您自己改造后，一个简单的rowSums(...,na.rm=T) 就可以很好地工作。

【解决方案2】：

TV <- data.frame(Type = c("A","A","A","A","B","B","B","B","B","B","B")
             , Value = c(10,15,20,25,30,40,50,60,70,80,90)
             , stringsAsFactors = FALSE)

# Added Type C for testing
# TV <- data.frame(Type = c("A","A","A","A","B","B","B","B","B","B","B", "C", "C", "C")
#                  , Value = c(10,15,20,25,30,40,50,60,70,80,90, 100, 150, 130)
#                  , stringsAsFactors = FALSE)

lnType <- with(TV, tapply(Value, Type, length))
lnType <- as.integer(lnType)
lnType

id <- unlist(mapply(FUN = rep_len, length.out = lnType, x = list(1:max(lnType))))
(TV <- cbind(id, TV))

require(reshape2)
tvWide <- dcast(TV, id ~ Type)

# Alternatively
# tvWide <- reshape(data = TV,  direction = "wide", timevar = "Type",  ids = c(id, Type))

tvWide <- subset(tvWide, select = -id)

# If you want something neat without the <NA>
# for(i in 1:ncol(tvWide)){
#
#     if (is.na(tvWide[j,i])){
#       tvWide[j,i] = 0
#     }
#     
#   }
# }

tvWide
transform(tvWide, rowSum=rowSums(tvWide, na.rm = TRUE))

【讨论】：