基于分组变量迭代创建列

我有一些数据（如下），我想通过某些分组变量根据当前列的总和迭代添加列，并且我想将这些列命名为当前名称+“_tot”的粘贴值。我认为 dplyr 和 lapply 的组合是解决问题的方法，但我无法获得正确的结构。

set.seed(1234)
data <- data.frame(
    biz = sample(c("telco","shipping","tech"), 50, replace = TRUE),
    region = sample(c("mideast","americas"), 50, replace = TRUE),
    june = sample(1:50, 50, replace=TRUE),
    july = sample(100:150, 50, replace=TRUE)
    )

所以，我想做的是 1）按“区域”对这些数据进行分组，然后为接下来的每个月份添加一个新列，该列是该月值的总和（在真实的数据框中，后面有许多时期） 。

基本上我想应用这个功能

library(dplyr)
data %>% group_by(region) %>% mutate(june_tot = sum(june))

每个月，无需指定“六月”或“七月”。我的初步看法：

testfun <- function(df, col) {
    name <- paste(col, "_tot", sep="")
    data2 <- df %>% group_by(region) %>% summarise(name=sum(col))
    return(data2)
}

但应用此方法不起作用，因为我必须指定要调用初始函数的列。当然，仅仅从初始函数中删除“col”参数也是行不通的。

有什么想法如何应用这种论证？

以下是您的问题的可能解决方案dplyr（首先，因为这就是你尝试过的），然后是data.table也base R解决方案：

dplyr:

cols <- lapply(names(data)[-(1:2)], as.name)
names(cols) <- paste0(names(data)[-(1:2)], "_tot")
data %>% group_by(region) %>% mutate_each_q(funs(sum), cols)

假设除前两列外的每一列都是月度数据。按行解释：

1. we use as.name and lapply生成我们想要的列名称列表mutate作为符号
2. 我们为 1 中的符号列表赋予我们想要的新名称（即 Month_tot）。
3. 我们使用mutate_each_q（作为。。而被知道mutate_each_ in dplyr 0.3.0.2） 申请sum到我们在 1. 和 2 中创建的表达式列表。

这是（示例）结果：

Source: local data frame [50 x 6]
Groups: region

        biz   region june july june_tot july_tot
1  shipping  mideast   17  124      780     3339
2     telco americas   11  101      465     2901
3     telco  mideast   27  131      780     3339
4      tech americas   24  135      465     2901
... rows omitted

数据表：

new.names <- paste0(tail(names(data), 2L), "_tot")  # Make new names
data.table(data)[,
  (new.names):=lapply(.SD, sum),    # `lapply` `sum` to the selected columns (those in .SD), and assign to `new.names` columns
  by=region, .SDcols=-1             # group by `region`, and exclude first column from `.SD` (note `region` is excluded as well by reason of being in `by`
][]                                 # extra `[]` just to force printing

在这里，类似的逻辑，除了我们使用特殊的.SD代表每列的对象data.table我们没有分组依据。

base:

do.call(
  cbind, 
  list(
    data, 
    setNames(
      lapply(data[-(1:2)], function(x) ave(x, data$region, FUN=sum)),
      paste0(names(data[-(1:2)]), "_tot")
) ) )

这里我们使用ave要计算每个区域的总和，请使用lapply申请ave到每一列，并使用do.call(cbind, ...)重建最终的数据帧。