r：分组、删除列和求和

Question

我在处理大型 data.frame 时遇到了一些问题。如果每个组列没有任何 0（完整），我需要对每列组求和。 IE。我只想对每个“完整”组的列求和。

这是一个需要对每一列进行分组和求和的示例，但是，我无法弄清楚如何在 dplyr 管道中工作 complete.cases

df <- data.frame(ca = c("a","b","a","c","b"),
             f = c(3,4,0,2,3),
             f2 = c(2,5,6,1,9),
             f3 = c(3,0,6,3,0)) 

结果应该是什么样子

  ca  f f2 f3
1  a NA  8  9
2  b  7 14 NA
3  c  2  1  3

这可以对每个组求和

df2 <- df %>%
    arrange(ca) %>%
    group_by(ca) %>%
    summarize_at(.cols=vars(starts_with("f")),
            .funs=funs("sum"))

这是我无法开始的工作，但似乎是我应该努力的方向

df2 <- df %>%
    arrange(ca) %>%
    group_by(ca) %>%
    summarize_(funs_(sum(complete.cases(.),na.rm=T)))

也许我需要summarize_if，任何帮助将不胜感激。

Answer 1

如果对一列进行分组，*_all 函数将对所有非分组列进行操作。您可以使用na_if 为特定值插入NAs，这使得整个过程相当简单：

df %>% mutate_all(funs(na_if(., 0L))) %>% 
    group_by(ca) %>%
    summarise_all(sum)

## # A tibble: 3 × 4
##       ca     f    f2    f3
##   <fctr> <dbl> <dbl> <dbl>
## 1      a    NA     8     9
## 2      b     7    14    NA
## 3      c     2     1     3

如果您愿意，也可以将这两个调用组合起来：

df %>% group_by(ca) %>% summarise_all(funs(sum(na_if(., 0L))))

返回相同的东西。

---

基准测试

根据 cmets，对 10000 行和 100 个非分组列进行基准测试。非常宽的数据（超过 1000 列）在这两种方法中都表现不佳，但如果您收集到 long 并按以前的变量名分组，这是可以容忍的。

library(tidyr)
set.seed(47)

df <- data.frame(ca = sample(letters[1:3], 10000, replace = TRUE), 
                 replicate(100, rpois(100, 10)))

microbenchmark::microbenchmark(
    'two stp' = {
        df %>% mutate_all(funs(na_if(., 0L))) %>% 
            group_by(ca) %>% summarise_all(sum)
    }, 'one stp' = {
        df %>% group_by(ca) %>% summarise_all(funs(sum(na_if(., 0L))))
    }, 'two stp, reshape' = {
        df %>% gather(var, val, -ca) %>% 
            mutate(val = na_if(val, 0L)) %>% 
            group_by(ca, var) %>% summarise(val = sum(val)) %>% 
            spread(var, val)
    }, 'one stp, reshape' = {
        df %>% gather(var, val, -ca) %>% 
            group_by(ca, var) %>% summarise(val = sum(na_if(val, 0L))) %>% 
            spread(var, val)
    })

## Unit: milliseconds
##              expr       min        lq      mean    median        uq      max neval cld
##           two stp 311.36733 330.23884 347.77353 340.98458 354.21105 548.4810   100   c
##           one stp 299.90327 317.38300 329.78662 326.66370 341.09945 385.1589   100  b 
##  two stp, reshape  61.72992  67.78778  85.94939  73.37648  81.04525 300.5608   100 a  
##  one stp, reshape  70.95492  77.76685  90.53199  83.33557  90.14023 297.8924   100 a  

通过dtplyr 使用data.tables 要快得多。如果您不介意学习另一种语法，那么使用data.table 写作会更快（h/t @docendodiscimus 为replace）。在这里，重塑会导致更糟糕的情况，至少使用 tidyr 函数，尽管使用 data.table::melt 和 dcast 对于极宽的数据来说它仍然可能是一个不错的选择。

library(data.table)
library(dtplyr)
set.seed(47)

df <- data.frame(ca = sample(letters[1:3], 10000, replace = TRUE), 
                 replicate(100, rpois(10000, 10)))
setDT(df)

microbenchmark::microbenchmark(
    'dtplyr 2 stp' = {
        df %>% mutate_all(funs(na_if(., 0L))) %>% 
            group_by(ca) %>% 
            summarise_all(sum)
    }, 'dtplyr 1 stp' = {
        df %>% group_by(ca) %>% 
            summarise_all(funs(sum(na_if(., 0L))))
    }, 'dt + na_if 2 stp' = {
        df[, lapply(.SD, function(x){na_if(x, 0L)})][, lapply(.SD, sum), by = ca]
    }, 'dt + na_if 1 stp' = {
        df[, lapply(.SD, function(x){sum(na_if(x, 0L))}), by = ca]
    }, 'pure dt 2 stp' = {
        df[, lapply(.SD, function(x){replace(x, x == 0L, NA)})][, lapply(.SD, sum), by = ca]
    }, 'pure dt 1 stp' = {
        df[, lapply(.SD, function(x){sum(replace(x, x == 0L, NA))}), by = ca]
    })

## Unit: milliseconds
##              expr       min        lq      mean    median        uq       max neval cld
##      dtplyr 2 stp 121.31556 130.88189 143.39661 138.32966 146.39086 355.24750   100   c
##      dtplyr 1 stp  28.30813  31.03421  36.94506  33.28435  43.46300  55.36789   100  b 
##  dt + na_if 2 stp  27.03971  29.04306  34.06559  31.20259  36.95895  53.66865   100  b 
##  dt + na_if 1 stp  10.50404  12.64638  16.10507  13.43007  15.18257  34.37919   100 a  
##     pure dt 2 stp  27.15501  28.91975  35.07725  30.28981  33.03950 238.66445   100  b 
##     pure dt 1 stp  10.49617  12.09324  16.31069  12.84595  20.03662  34.44306   100 a  

Answer 2

进入base R的一种方法是将0填充为NA，然后使用aggregate.

# fill 0s as NAs
is.na(df) <- df == 0

aggregate(cbind(f=df$f,f2=df$f2,f3=df$f3), df["ca"], sum)
  ca  f f2 f3
1  a NA  8  9
2  b  7 14 NA
3  c  2  1  3

---

注意：使用aggregate的公式接口可能会产生意想不到的结果。

aggregate(.~ca, data=df, sum)
  ca f f2 f3
1  a 3  2  3
2  c 2  1  3

“b”类别退出，变量 f 中的 a 值为 3，而不是 NA。帮助文件中的规范表明 na.action 设置为 na.omit，这会从计算中删除 NA 值。要使公式界面按需要工作，请将此值更改为 na.pass。

aggregate(.~ca, data=df, sum, na.action=na.pass)
  ca  f f2 f3
1  a NA  8  9
2  b  7 14 NA
3  c  2  1  3