Применить функцию к подмножеству многих столбцов в 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 (много других столбцов, усеченных здесь для ясности) сгруппирован в Дата , Seq1 , Компонент и Seq2 .В то время как Component"Smooth" и Seq1"NA" являются постоянными, в пределах Component"Bounce" уровень существует несколько Seq2 уровней, например "1 "," 2 "и т. Д.

Как суммировать каждый столбец X , всегда константу" NA "с каждым уровнем Seq2 ?

Требуемые результаты:

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 .

Аналогичным примером может быть Суммирование нескольких групп столбцов , Как применить функцию к подмножеству столбцов в r? или даже, возможно, https://github.com/jennybc/row-oriented-workflows.

^{Создано в 2018-10-23 для пакета Представить (v0.2.1)}

Answer 1

Вот мое решение.Эта проблема на самом деле не является задачей purrr, потому что на самом деле нет ничего, на что вы хотите сопоставить одну функцию.Вместо этого я понимаю, что проблема заключается в том, что вы хотите сопоставить каждое значение X в строке Bounce с соответствующими значениями Smooth row X тех же Date и Seq1 (итолько один такой ряд).Это означает, что это действительно проблема слияния или объединения, и тогда подход состоит в том, чтобы настроить объединение, чтобы вы могли сопоставить правильные значения и сделать сумму.Итак, я иду следующим образом:

1. Разделить данные на строки Smooth и строки Bounce и gather, чтобы все значения X были в одном столбце
2. Соедините smooths на bounces с left_join, так что каждой исходной строке 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

^{Создано в 2018-10-31 пакетом Представить (v0.2.1)}