用tidyverse计算一个复杂的差异分数？答案

【问题标题】：Calculate a complex difference score with tidyverse?用tidyverse计算一个复杂的差异分数？
【发布时间】：2021-07-04 21:33:22
【问题描述】：

我有一个包含 70 000 行的大型数据集，我想对其执行一些操作，但我找不到合适的解决方案。

     bib sta run course finish comment day
1    42   9   1     SG  19.88      99   1
2    42  17   2      A  19.96      11   1
3    42  27   3      B  20.92      22   1
4    42  39   4      A  19.60      11   1
5    42  48   5     SG  20.24      99   1
6    42  61   6      C  22.90      33   1
7    42  76   7      B  20.70      22   1
8    42  86   8      C  22.74      33   1
9    42  93   9      C  22.75      33   1
10   42 103  10      A  19.79      11   1
11   42 114  11      B  20.67      22   1
12   42 120  12     SG  20.10      99   1

我想最终得到一个 tibble：

计算 SG 课程中每个号码布在某一天的平均完成时间。例如，19.88 + 20.24 + 20.10 / 3
通过从平均 SG 得分中减去完成来计算数据集中每个观察的差异得分。例如，19.88 - 平均值（SG）、19.96 - 平均值（SG）。

我尝试了以下方法：

第一组按天、围兜和课程。然后按 SG 过滤并计算均值：

avg.sgtime <- df %>%
  group_by(day, bib, course) %>%
  filter(course == 'SG') %>%
  mutate(avg.sg = mean(finish))

导致以下小标题

 bib   sta   run course finish comment day   avg.sg
   <int> <int> <int> <chr>   <dbl>   <int> <chr>  <dbl>
 1    42     9     1 SG       19.9      99 1       20.1
 2    42    48     5 SG       20.2      99 1       20.1
 3    42   120    12 SG       20.1      99 1       20.1
 4    42     6     1 SG       20.0      99 2       19.9
 5    42    42     5 SG       19.8      77 2       19.9
 6    42   130    15 SG       19.9      99 2       19.9
 7    42     6     1 SG       20.6      99 3       20.5
 8    42    68    12 SG       20.6      77 3       20.5
 9    42    90    15 SG       20.4      77 3       20.5

最后我使用以下语法将两个小标题连接在一起：


df %>% full_join(avg.sgtime) %>%
  mutate(diff = finish - avg.sg)

但是，这不起作用。它仅适用于 SG 课程，但不适用于课程 A、B 和 C。有没有办法解决这个问题或有更好的解决方案？

bib sta run course finish comment day   avg.sg         diff
1    42   9   1     SG  19.88      99   1 20.07333 -0.193333333
2    42  17   2      A  19.96      11   1       NA           NA
3    42  27   3      B  20.92      22   1       NA           NA
4    42  39   4      A  19.60      11   1       NA           NA
5    42  48   5     SG  20.24      99   1 20.07333  0.166666667

【问题讨论】：

标签： r dplyr tidyverse

【解决方案1】：

您可以在mutate() 中过滤finish 的值并根据这些值计算平均值：

df %>%
  group_by(day,bib) %>%
  mutate(
    avg.sg = mean(finish[course=="SG"]),
    diff = finish - avg.sg)

【讨论】：

哦，这绝对是“正确”答案:)

【解决方案2】：

以下是你的目标吗？

（请注意，我为第二个 bib 添加了一些随机值，只是为了确保连接正确完成）

您尝试的不同之处在于使用summarise() 而不是mutate() 来合并avg.sgtime 数据框，并且还删除了一些列，以便join 不会填充NAs。除了删除之外，您还可以通过将 by 参数传递给 left_join() 函数来设置要加入的相关列。

library(dplyr)
library(tidyr) # for join

avg.sgtime <- df %>%
  group_by(day, bib, course) %>%
  filter(course == 'SG') %>%
  summarise(avg.sg = mean(finish), .groups = "drop") %>%
  select(c(bib, day, avg.sg))

avg.sgtime
#> # A tibble: 3 x 3
#>     bib   day avg.sg
#>   <dbl> <dbl>  <dbl>
#> 1    42     1   20.1
#> 2    43     1   19.1
#> 3    44     2   19.3
df %>% left_join(avg.sgtime) %>%
  mutate(diff = finish - avg.sg)
#> Joining, by = c("bib", "day")
#> # A tibble: 36 x 9
#>      bib   sta   run course finish comment   day avg.sg   diff
#>    <dbl> <dbl> <dbl> <chr>   <dbl>   <dbl> <dbl>  <dbl>  <dbl>
#>  1    42     9     1 SG       19.9      99     1   20.1 -0.193
#>  2    42    17     2 A        20.0      11     1   20.1 -0.113
#>  3    42    27     3 B        20.9      22     1   20.1  0.847
#>  4    42    39     4 A        19.6      11     1   20.1 -0.473
#>  5    42    48     5 SG       20.2      99     1   20.1  0.167
#>  6    42    61     6 C        22.9      33     1   20.1  2.83 
#>  7    42    76     7 B        20.7      22     1   20.1  0.627
#>  8    42    86     8 C        22.7      33     1   20.1  2.67 
#>  9    42    93     9 C        22.8      33     1   20.1  2.68 
#> 10    42   103    10 A        19.8      11     1   20.1 -0.283
#> # … with 26 more rows

^{由reprex package (v2.0.0) 于 2021-07-04 创建}

数据


df <- tribble(~bib, ~sta, ~run, ~course, ~finish, ~comment, ~day,
              42,     9,     1,       "SG",    19.88,        99,     1,
              42,    17,     2,        "A",    19.96,        11,     1,
              42,    27,     3,        "B",    20.92,        22,     1,
              42,    39,     4,        "A",    19.60,        11,     1,
              42,    48,     5,       "SG",    20.24,        99,     1,
              42,    61,     6,        "C",    22.90,        33,     1,
              42,    76,     7,        "B",    20.70,        22,     1,
              42,    86,     8,        "C",    22.74,        33,     1,
              42,    93,     9,        "C",    22.75,        33,     1,
              42,   103,    10,        "A",    19.79,        11,     1,
              42,   114,    11,        "B",    20.67,        22,     1,
              42,   120,    12,       "SG",    20.10,        99,     1,
              
              43,     9,     1,       "SG",    19.12,        99,     1,
              43,    17,     2,        "A",    19.64,        11,     1,
              43,    27,     3,        "B",    20.62,        22,     1,
              43,    39,     4,        "A",    19.23,        11,     1,
              43,    48,     5,       "SG",    20.11,        99,     1,
              43,    61,     6,        "C",    22.22,        33,     1,
              43,    76,     7,        "B",    20.33,        22,     1,
              43,    86,     8,        "C",    22.51,        33,     1,
              43,    93,     9,        "C",    22.78,        33,     1,
              43,   103,    10,        "A",    19.98,        11,     1,
              43,   114,    11,        "B",    20.11,        22,     1,
              43,   120,    12,       "SG",    18.21,        99,     1,
              
              44,     9,     1,       "SG",    19.18,        99,     2,
              44,    17,     2,        "A",    19.56,        11,     2,
              44,    27,     3,        "B",    20.62,        22,     2,
              44,    39,     4,        "A",    19.20,        11,     2,
              44,    48,     5,       "SG",    20.74,        99,     2,
              44,    61,     6,        "C",    22.50,        33,     2,
              44,    76,     7,        "B",    20.60,        22,     2,
              44,    86,     8,        "C",    22.74,        33,     2,
              44,    93,     9,        "C",    22.85,        33,     2,
              44,   103,    10,        "A",    19.59,        11,     2,
              44,   114,    11,        "B",    20.27,        22,     2,
              44,   120,    12,       "SG",    18.10,        99,     2,
              )

【讨论】：

谢谢。工作完美。 .groups = "drop" 是如何工作的？
一般来说，对 data.frame 进行分组不会修改数据，而是修改其他动词（mutate、summarise 等）如何修改实际数据。默认情况下，分组变量保存在结果帧中。您可以使用 .groups="drop" 更改此行为。有关详细信息，请参阅?summarise。
无论如何，Michael Barrowman 的回答是不是简单多了？还是没有按预期工作？
是的。所有解决方案都有效。我同意，Barrowman 的解决方案是最易读的

【解决方案3】：

感谢@Marcelo Avila 为我提供了非常好的提示：

我希望这是您正在寻找的：

library(dplyr)

df %>%
  group_by(bib, day) %>%
  mutate(across(finish, ~ mean(.x[course == "SG"]), .names = "avg_{.col}"),
         diff = finish - avg_finish, 
         avg_finish = ifelse(course == "SG", avg_finish, NA))


# A tibble: 12 x 9
# Groups:   bib, day [1]
     bib   sta   run course finish comment   day avg_finish    diff
   <int> <int> <int> <chr>   <dbl>   <int> <int>      <dbl>   <dbl>
 1    42     9     1 SG       19.9      99     1       20.1 -0.193 
 2    42    17     2 A        20.0      11     1       NA   -0.113 
 3    42    27     3 B        20.9      22     1       NA    0.847 
 4    42    39     4 A        19.6      11     1       NA   -0.473 
 5    42    48     5 SG       20.2      99     1       20.1  0.167 
 6    42    61     6 C        22.9      33     1       NA    2.83  
 7    42    76     7 B        20.7      22     1       NA    0.627 
 8    42    86     8 C        22.7      33     1       NA    2.67  
 9    42    93     9 C        22.8      33     1       NA    2.68  
10    42   103    10 A        19.8      11     1       NA   -0.283 
11    42   114    11 B        20.7      22     1       NA    0.597 
12    42   120    12 SG       20.1      99     1       20.1  0.0267

我还使用亲爱的@Marcelo Avila 的数据集添加了另一种替代解决方案，稍作改动：

df %>%
  group_by(bib, day) %>%
  mutate(across(finish, ~ mean(.x[select(cur_data(), course) == "SG"]), .names = "avg_{.col}"),
         diff = finish - avg_finish, 
         avg_finish = ifelse(course == "SG", avg_finish, NA))

# A tibble: 36 x 9
# Groups:   bib, day [3]
     bib   sta   run course finish comment   day avg_finish   diff
   <dbl> <dbl> <dbl> <chr>   <dbl>   <dbl> <dbl>      <dbl>  <dbl>
 1    42     9     1 SG       19.9      99     1       20.1 -0.193
 2    42    17     2 A        20.0      11     1       NA   -0.113
 3    42    27     3 B        20.9      22     1       NA    0.847
 4    42    39     4 A        19.6      11     1       NA   -0.473
 5    42    48     5 SG       20.2      99     1       20.1  0.167
 6    42    61     6 C        22.9      33     1       NA    2.83 
 7    42    76     7 B        20.7      22     1       NA    0.627
 8    42    86     8 C        22.7      33     1       NA    2.67 
 9    42    93     9 C        22.8      33     1       NA    2.68 
10    42   103    10 A        19.8      11     1       NA   -0.283
# ... with 26 more rows

【讨论】：

这是一个比我的更优雅的解决方案。我试图避免加入，但没有想到这种方法。但是，这与我在答案中生成的df 并没有正确运行（包括更多天数和围兜）。您能否也用这些数据进行测试？
显然，使用mean(.x[course == "SG"]) 代替mean(.x[df$course == "SG"]) 有效。有什么理由直接使用 df$course 而不是course？ --- 或者将 na.rm = TRUE, 添加到 mean() 也可以。
非常感谢亲爱的@MarceloAvila，是的，你是对的。我对df$course 持怀疑态度，因为它似乎使用了整个course 变量而不管分组，因为它没有考虑分组。我还添加了另一个更适合 tidyverse 的替代方案，强调每个组中的 course 值。
across 中的第一个参数是 .cols，您可以在其中选择要应用函数的列。在这里，我根据问题的要求选择了finish。我们使用由~ 和mean(.x) 组成的lamba 样式公式，而不是function(x) mean(x)。所以.x这里指的是我们选择的列finish，在它的所有值中，我选择了对应的course值等于SG的值。第二种解决方案更清晰。