r - 组不互斥时类似于 group_by 的功能

Question

我想在 R 中创建一个函数，类似于 dplyr的group_by功能，当与 summarise 结合使用时可以为组成员不互斥的数据集提供汇总统计信息。即，观察可以属于多个组。考虑它的一种方法可能是考虑标签；观察可能属于一个或多个可能重叠的标签。

例如，取 R 的 esoph数据集 (https://stat.ethz.ch/R-manual/R-devel/library/datasets/html/esoph.html) 记录了食管癌的病例对照研究。假设我对总体和每个“标签”的癌症病例的数量和比例感兴趣，其中标签是:65 岁以上； 80+ 克/天酒精； 20 克以上/天的烟草；以及满足前 3 个标准的“高风险”组。
让我们将数据集转换为长格式(每行一个参与者)，然后将这些标签(逻辑列)添加到数据集中:

library('dplyr')
data(esoph)
esophlong = bind_rows(esoph %>% .[rep(seq_len(nrow(.)), .$ncases), 1:3] %>% mutate(case=1),
                      esoph %>% .[rep(seq_len(nrow(.)), .$ncontrols), 1:3] %>% mutate(case=0)
            ) %>% 
            mutate(highage=(agegp %in% c('65-74','75+')),
                   highalc=(alcgp %in% c('80-119','120+')),
                   hightob=(tobgp %in% c('20-29','30+')),
                   highrisk=(highage & highalc & hightob)
            )

我通常的方法是创建一个数据集，其中每个观察结果都为其所属的每个标签重复，然后 summarise这个数据集:

esophdup = bind_rows(esophlong %>% filter(highage) %>% mutate(tag='age>=65'),
                     esophlong %>% filter(highalc) %>% mutate(tag='alc>=80'),
                     esophlong %>% filter(hightob) %>% mutate(tag='tob>=20'),
                     esophlong %>% filter(highrisk) %>% mutate(tag='high risk'),
                     esophlong %>% filter() %>% mutate(tag='all')
           ) %>%
           mutate(tag=factor(tag, levels = unique(.$tag)))

summary = esophdup %>%
          group_by(tag) %>%
          summarise(n=n(), ncases=sum(case), case.rate=mean(case))

这种方法对于大型数据集或大量标签效率低下，而且我经常会耗尽内存来存储它。

另一种方法是 summarise每个标签分开，然后绑定(bind)这些汇总数据集，如下:

summary.age = esophlong %>%
              filter(highage) %>%
              summarise(n=n(), ncases=sum(case), case.rate=mean(case)) %>%
              mutate(tag='age>=65')

summary.alc = esophlong %>%
              filter(highalc) %>%
              summarise(n=n(), ncases=sum(case), case.rate=mean(case)) %>%
              mutate(tag='alc>=80')

summary.tob = esophlong %>%
              filter(hightob) %>%
              summarise(n=n(), ncases=sum(case), case.rate=mean(case)) %>%
              mutate(tag='tob>=20')

summary.highrisk = esophlong %>%
              filter(highrisk) %>%
              summarise(n=n(), ncases=sum(case), case.rate=mean(case)) %>%
              mutate(tag='high risk')

summary.all = esophlong %>%
              summarise(n=n(), ncases=sum(case), case.rate=mean(case)) %>%
              mutate(tag='all')

summary=bind_rows(summary.age,summary.alc,summary.tob,summary.highrisk,summary.all)  

当我有大量标签或者我想在整个项目中为不同的汇总度量经常重用标签时，这种方法既费时又乏味。

我想到的功能，比如说group_by_tags(data, key, ...) ，它包括一个参数来指定分组列的名称，应该像这样工作:

summary = esophlong %>% 
          group_by_tags(key='tags',
                        'age>=65'=highage,
                        'alc>=80'=highalc,
                        'tob>=20'=hightob,
                        'high risk'=highrisk,
                        'all ages'=1
          ) %>%
          summarise(n=n(), ncases=sum(case), case.rate=mean(case))

摘要数据集如下所示:

> summary
       tags     n ncases case.rate
1   age>=65   273     68 0.2490842
2   alc>=80   301     96 0.3189369
3   tob>=20   278     64 0.2302158
4 high risk    11      5 0.4545455
5       all  1175    200 0.1702128

更好的是，它可以采用“因素”和“逻辑”类型的变量，以便它可以单独总结每个年龄组、65 岁以上的人和每个人:

summaryage = esophlong %>% 
          group_by_tags(key='Age.group',
                        agegp,
                        '65+'=(agegp %in% c('65-74','75+')),
                        'all'=1                 
          ) %>%
          summarise(n=n(), ncases=sum(case), case.rate=mean(case))

>summaryage
  Age.group     n ncases case.rate
1     25-34   117      1 0.0085470
2     35-44   208      9 0.0432692
3     45-54   259     46 0.1776062
4     55-64   318     76 0.2389937
5     65-74   216     55 0.2546296
6       75+    57     13 0.2280702
7       65+   273     68 0.2490842
8       all  1175    200 0.1702128

... 可能无法实现相反，您可能需要为标签传递列名的向量/列表。

有任何想法吗？

编辑:需要明确的是，解决方案应该将标签/组定义和所需的汇总统计信息作为参数，而不是内置到函数本身中。或者作为两步 data %>% group_by_tags(tags) %>% summarise_tags(stats)或一步data %>% summary_tags(tags,stats)过程。

Answer 1

这是@eddi 答案的变体。我正在接受 highage 的定义等作为函数工作的一部分:

library(data.table)
custom_summary = function(DT, tags, stats){
    setDT(DT)
    rows = stack(lapply(tags[-1], function(x) DT[eval(x), which=TRUE]))
    DT[rows$values, eval(stats), by=.(tag = rows$ind)]
}

还有一些示例用法:

data(esoph)
library(dplyr)
esophlong = bind_rows(esoph %>% .[rep(seq_len(nrow(.)), .$ncases), 1:3] %>% mutate(case=1),
                      esoph %>% .[rep(seq_len(nrow(.)), .$ncontrols), 1:3] %>% mutate(case=0)
            )

custom_summary(
    DT = esophlong, 
    tags = quote(list(
        'age>=65'   = agegp %in% c('65-74','75+'),
        'alc>=80'   = alcgp %in% c('80-119','120+'),
        'tob>=20'   = tobgp %in% c('20-29','30+'),
        'high risk' = eval(substitute(`age>=65` & `alc>=80` & `tob>=20`, as.list(tags))),
        'all ages'  = TRUE
    )),
    stats = quote(list(
        n           = .N, 
        n_cases     = sum(case), 
        case.rate   = mean(case)
    ))
)

         tag    n n_cases case.rate
1:   age>=65  273      68 0.2490842
2:   alc>=80  301      96 0.3189369
3:   tob>=20  278      64 0.2302158
4: high risk   11       5 0.4545455
5:  all ages 1175     200 0.1702128

使用技巧eval里面 DT[...]解释 in the data.table FAQ .