那些遇到过的问题

当组不相互驱散时,功能类似于group_by

wjc*_*lme 5 group-by r dplyr

我想创建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)
            )
Run Code Online (Sandbox Code Playgroud)

我通常的方法是创建一个数据集,其中每个观察对于它所属的每个标记都是重复的,然后是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))
Run Code Online (Sandbox Code Playgroud)

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

另一种方法是分别对summarise每个标记进行绑定,然后将这些摘要数据集绑定,如下所示:

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)
Run Code Online (Sandbox Code Playgroud)

当我有大量标签或者我想在整个项目中经常重复使用标签以进行不同的汇总测量时,这种方法既费时又乏味.

我想到的函数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))
Run Code Online (Sandbox Code Playgroud)

使用如下所示的摘要数据集:

> 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
Run Code Online (Sandbox Code Playgroud)

更好的是,它可以采用"因素"类型和"逻辑"类型的变量,以便它可以总结,例如,每个年龄组,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
Run Code Online (Sandbox Code Playgroud)

也许这是不可能的...,而您可能需要传递标签的列名称的向量/列表.

有任何想法吗？

编辑:要清楚,解决方案应该将标记/组定义和所需的摘要统计信息作为参数,而不是内置到函数本身.无论是两步data %>% group_by_tags(tags) %>% summarise_tags(stats)还是一步data %>% summary_tags(tags,stats)过程.

wjc*_*lme 2

在缺乏 tidyverse 内部知识的情况下，我避免尝试创建group_by()-type 函数，其输出应该传递给summarise()，而是创建一个结合了两者的函数（与其他答案类似，但我希望更加用户友好和通用） 。

由于group_by() %>% summarise()返回分组变量的每个嵌套组合的联合摘要信息，因此我选择了该名称summarise_marginal()，因为它将独立返回每个分组变量的边际摘要信息。

不适用于grouped_df对象的解决方案

首先，一个不适用于grouped_df类的解决方案，但在下面进行了扩展：

summarise_marginal0 <- function(.tbl, .vars, ..., .removeF=FALSE){

  dots <- quos(...)

  .tbl %>% 
    transmute(!!! .vars) %>% 
    map_dfr(
      ~ summarise(group_by(.tbl, 'value'=., add = TRUE), !!! dots) %>%  # piping .tbl %>% group_by() %>% summarise() evaluates in the wrong order for some reason
      filter_at(vars('value'), all_vars(!(.==FALSE & .removeF))) %>%  # to remove rows where a logical group is FALSE.
      mutate_at(vars('value'), as.character)  # standardises 'value' column in case map_dfr tries to convert logical to factor
      , .id='group'
    )
}


mtcars %>% 
  summarise_marginal0(
    vars(cyl, am),
    meanmpg = mean(mpg),
    meanwt = mean(wt)
  )

#> # A tibble: 5 x 4
#>   group value  meanmpg   meanwt
#>   <chr> <chr>    <dbl>    <dbl>
#> 1   cyl     4 26.66364 2.285727
#> 2   cyl     6 19.74286 3.117143
#> 3   cyl     8 15.10000 3.999214
#> 4    am     0 17.14737 3.768895
#> 5    am     1 24.39231 2.411000
Run Code Online (Sandbox Code Playgroud)

使用vars()（如使用summarise_at()或mutate_at()）捕获组可以将组与汇总函数巧妙地分开，并允许动态创建新组：

mtcars %>% 
  summarise_marginal0(
    vars(cyl, hp_lt100 = hp<100),
    meanmpg = mean(mpg),
    meanwt = mean(wt)
  )

#> # A tibble: 5 x 4
#>      group value  meanmpg   meanwt
#>      <chr> <chr>    <dbl>    <dbl>
#> 1      cyl     4 26.66364 2.285727
#> 2      cyl     6 19.74286 3.117143
#> 3      cyl     8 15.10000 3.999214
#> 4 hp_lt100 FALSE 17.45217 3.569652
#> 5 hp_lt100  TRUE 26.83333 2.316667
Run Code Online (Sandbox Code Playgroud)

我们可以使用.removeF参数来删除FALSE逻辑值。如果您想总结某些行而不是它们的赞美，则很有用：

mtcars %>% 
  summarise_marginal0(
    vars(cyl==6, hp_lt100 = hp<100, hp_lt200 = hp<200),
    meanmpg = mean(mpg),
    meanwt = mean(wt),
    .removeF = TRUE
  )

#> # A tibble: 3 x 4
#>      group value  meanmpg   meanwt
#>      <chr> <chr>    <dbl>    <dbl>
#> 1 cyl == 6  TRUE 19.74286 3.117143
#> 2 hp_lt100  TRUE 26.83333 2.316667
#> 3 hp_lt200  TRUE 21.96000 2.911320
Run Code Online (Sandbox Code Playgroud)

请注意，即使没有明确命名该cyl == 6组，我们仍然可以获得一个有用的名称。

适用于grouped_df对象的解决方案

summarise_marginal0()可以扩展到处理grouped_df以下返回的对象group_by()：

summarise_marginal <- function(.tbl, .vars, ...){

  dots <- quos(...)

  .tbl %>%
    nest() %>%
    mutate(
      summarised = map(data, ~summarise_marginal0(., .vars, !!! dots))
    ) %>% 
    unnest(summarised) %>%
    purrrlyr::slice_rows(group_vars(.tbl))
}


mtcars %>% 
  group_by(am) %>%
  summarise_marginal(
    vars(cyl, hp_lt100 = hp<100),
    meanmpg = mean(mpg),
    meanwt = mean(wt)
  )

#> # A tibble: 10 x 5
#> # Groups:   am [2]
#>       am    group value  meanmpg   meanwt
#>    <dbl>    <chr> <chr>    <dbl>    <dbl>
#>  1     1      cyl     4 28.07500 2.042250
#>  2     1      cyl     6 20.56667 2.755000
#>  3     1      cyl     8 15.40000 3.370000
#>  4     1 hp_lt100 FALSE 20.61429 2.756857
#>  5     1 hp_lt100  TRUE 28.80000 2.007500
#>  6     0      cyl     4 22.90000 2.935000
#>  7     0      cyl     6 19.12500 3.388750
#>  8     0      cyl     8 15.05000 4.104083
#>  9     0 hp_lt100 FALSE 16.06875 3.925250
#> 10     0 hp_lt100  TRUE 22.90000 2.935000
Run Code Online (Sandbox Code Playgroud)

事实上，summarise_marginal()它适用于分组和未分组data.frame，因此这个函数本身就合适。

这是一个有用的解决方案，但考虑到它的group_by()用途超出了summarise()，例如与nest()or ，我认为 a （或任何最好的名称）do()的想法值得追求。group_by_marginal()group_by_tag()

一些遗留问题：

  • 该函数需要将整数、因子和逻辑列转换为字符，以便它们的值都很好地位于同一values列中。这稍微违反了整洁数据原则，尽管与gather()行为方式没有什么不同。

  • 假设一个函数是可能的，如果不解决每个组中的值放置位置的歧义，group_by_marginal()就无法传递它的输出。mutate()从上面的示例中，应该为带有和 的meanmpg行赋予哪个值？(from ) 和( from ) 都是相关的。（请注意， 没有歧义，因为它将返回 的联合汇总函数）。三种可能的选择：cyl==4am==026.66364cyl==417.14737am==0group_by() %>% mutate()cyl==4 & am==0group_by_marginal() %>% mutate()

    1. 应该禁止。
    2. 它应该创建多个列，例如meanmpg_cyl和meanmpg_am。
    3. 它应该为每个组复制行。
  • 速度。我确信我对这个概念的实施效率很低，并且可以改进。

最后，演示原始示例问题：

bind_rows(
  esoph %>% .[rep(seq_len(nrow(.)), .$ncases), 1:3] %>% mutate(case=1),
  esoph %>% .[rep(seq_len(nrow(.)), .$ncontrols), 1:3] %>% mutate(case=0)
) %>%
summarise_marginal(
  vars(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,
       all = 1),
  n=length(agegp),
  ncases=sum(case),
  case.rate=mean(case),
  .removeF=TRUE
)

#> # A tibble: 5 x 5
#>      group value     n ncases case.rate
#>      <chr> <chr> <int>  <dbl>     <dbl>
#> 1  highage  TRUE   273     68 0.2490842
#> 2  highalc  TRUE   301     96 0.3189369
#> 3  hightob  TRUE   278     64 0.2302158
#> 4 highrisk  TRUE    11      5 0.4545455
#> 5      all     1  1175    200 0.1702128
Run Code Online (Sandbox Code Playgroud)

归档时间：

查看次数：

613 次

最近记录：

7 年，7 月 前
相关归档
R中向量和列表数据类型有什么区别？ 113
在R中保存和加载模型 26
如何在R中使用'hclust'作为函数调用 17
如何在R中获得屏幕分辨率 13
ggplot使用小饼图作为geom_point的点 11
R：将相似地址组合在一起 8
'$'运算符在这个R代码片段中做了什么？ 2
如何使用dplyr仅选择少于n个级别的列(type = factor)？ 2
如何在matplotlib pandas中将两个文件的两个条形图组合在一张图中 2
在链接管道中删除某些数据框列后，重命名所有数据框列 1
难疑归档
如何在Java中将String转换为int？ 2882
如何使用CSS垂直居中文本？ 2190
什么是反思,为什么它有用？ 2011
<meta http-equiv ="X-UA-Compatible"content ="IE = edge">是做什么用的？ 1378
SOAP与REST(差异) 1206
URL.Combine的URL？ 1186
UTF-8一路走来 1146
为什么使用Redux而不是Facebook Flux？ 1126
visibility:hidden和display:none之间有什么区别？ 1121
git:撤消所有工作目录更改,包括新文件 1108