将函数应用于 R 中许多列的子集

Question

如何将函数应用于分组行的多列？例如；

library(tidyverse)
data <- tribble(
  ~Date,      ~Seq1, ~Component, ~Seq2,  ~X1,  ~X2,   ~X3,   
  "01/01/18", 1,     "Smooth",   NA,     3.98,  2.75,  1.82, 
  "01/01/18", 2,     "Smooth",   NA,     1.02,  0.02, -0.04, 
  "01/01/18", 3,     "Smooth",   NA,     3.48,  3.06,  1.25, 
  "01/01/18", 3,     "Bounce",   1,      2.01, -0.43, -0.52, 
  "01/01/18", 3,     "Bounce",   2,      1.94,  1.53,  1.92) %>%
mutate_at(vars(Date, Seq1, Component, Seq2), funs(factor))

X 值的每一列（更多列，为清楚起见此处截断）被分组为 Date、Seq1、Component 和 Seq2。虽然 Component "Smooth" 和 Seq1 "NA" 是恒定的，但在 Component "Bounce" 级别内有多个 Seq2 级别，例如“1”、“2”等

如何对每个 X 列求和，Seq2 的每个级别始终为常数“NA”？

想要的结果是：

expected <- tribble(
~Date,      ~Seq1, ~Component, ~Seq2,  ~X1,  ~X2,   ~X3,   
"01/01/18", 1,     "Smooth",   NA,     3.98,  2.75,  1.82, 
"01/01/18", 2,     "Smooth",   NA,     1.02,  0.02, -0.04, 
"01/01/18", 3,     "Smooth",   NA,     3.48,  3.06,  1.25, 
"01/01/18", 3,     "Bounce",   1,      5.49,  3.49,  1.77, 
"01/01/18", 3,     "Bounce",   2,      5.42,  4.59,  3.17)

以下示例仅添加每个 Seq1 级别。

data %>% 
  group_by(Date, Seq1) %>%
  mutate_at(vars(starts_with("X")), funs(sum(.)))
#> # A tibble: 5 x 7
#> # Groups:   Date, Seq1 [3]
#>   Date     Seq1  Component  Seq2    X1    X2    X3
#>   <fct>    <fct> <fct>     <fct> <dbl> <dbl> <dbl>
#> 1 01/01/18 1     Smooth    <NA>   3.98  2.75  1.82
#> 2 01/01/18 2     Smooth    <NA>   1.02  0.02 -0.04
#> 3 01/01/18 3     Smooth    <NA>   7.43  4.16  2.65
#> 4 01/01/18 3     Bounce    1      7.43  4.16  2.65
#> 5 01/01/18 3     Bounce    2      7.43  4.16  2.65

我确信purrr 或apply 函数系列中存在解决方案，但是，我在解决这个示例时（好几天）一直没有成功。实际数据有大约 180 个 X 列，有数百个 Date 和 Seq1 组合，以及多个 Seq2 级别。

类似的例子可能是Summing Multiple Groups of Columns、How to apply a function to a subset of columns in r?，甚至可能是https://github.com/jennybc/row-oriented-workflows。

^{由reprex package (v0.2.1) 于 2018 年 10 月 23 日创建}

Answer 1

这是我的解决方案。这个问题并不是真正的purrr 任务，因为您没有真正想要将单个函数映射到的内容。相反，我理解的问题是，您希望将Bounce 行中的每个X 值与相同Date 和Seq1 的对应Smooth 行X 值匹配（还有只是这样的一行）。这意味着它实际上是一个合并或连接问题，然后方法是设置连接，以便您可以匹配正确的值并进行求和。所以我如下：

1. 将数据拆分为Smooth 行和Bounce 行和gather，以便所有X 值都在一列中
2. 使用left_join 将smooths 加入bounces，因此每个原始Bounce 行现在都有对应的Smooth。
3. mutate 将总和放入一个新列，然后选择/重命名这些列以与原始列相同
4. bind_rows 加入新相加的bounces 和spread 以返回原始布局。

这应该对任意数量的Date、Seq1、Seq2 和X 值具有鲁棒性。

library(tidyverse)
data <- tribble(
  ~Date,      ~Seq1, ~Component, ~Seq2,  ~X1,  ~X2,   ~X3,   
  "01/01/18", 1,     "Smooth",   NA,     3.98,  2.75,  1.82, 
  "01/01/18", 2,     "Smooth",   NA,     1.02,  0.02, -0.04, 
  "01/01/18", 3,     "Smooth",   NA,     3.48,  3.06,  1.25, 
  "01/01/18", 3,     "Bounce",   1,      2.01, -0.43, -0.52, 
  "01/01/18", 3,     "Bounce",   2,      1.94,  1.53,  1.92)

smooths <- data %>%
  filter(Component == "Smooth") %>%
  gather(X, val, starts_with("X"))

bounces <- data %>%
  filter(Component == "Bounce") %>%
  gather(X, val, starts_with("X")) %>%
  left_join(smooths, by = c("Date", "Seq1", "X")) %>%
  mutate(val = val.x + val.y) %>%
  select(Date, Seq1, Component = Component.x, Seq2 = Seq2.x, X, val)

bounces %>%
  bind_rows(smooths) %>%
  spread(X, val)
#> # A tibble: 5 x 7
#>   Date      Seq1 Component  Seq2    X1    X2    X3
#>   <chr>    <dbl> <chr>     <dbl> <dbl> <dbl> <dbl>
#> 1 01/01/18     1 Smooth       NA  3.98  2.75  1.82
#> 2 01/01/18     2 Smooth       NA  1.02  0.02 -0.04
#> 3 01/01/18     3 Bounce        1  5.49  2.63  0.73
#> 4 01/01/18     3 Bounce        2  5.42  4.59  3.17
#> 5 01/01/18     3 Smooth       NA  3.48  3.06  1.25

^{由reprex package (v0.2.1) 于 2018 年 10 月 31 日创建}