Как применить функцию для изменения определенной c комбинации столбцов? (purrr :: использовать предпочтительно)

Question

Предположим, у меня есть следующие данные:

data = tibble::tribble(
~id,  ~year_1, ~year_2, ~cod_1, ~cod_2, ~cod_3, ~cod_4, ~var_x,
  1,     0,      1,      5,      5,      3,      6,     "x",
  1,     0,      1,      3,      6,      14,     5,     "x",
  1,     0,      1,      2,      8,      5,      4,     "x",
  2,     1,      0,      10,     8,      2,      3,     "x",
  2,     1,      0,      3,      9,      1,      2,     "x",
  2,     1,      0,      1,      12,     0,      1,     "x"
)

Я хотел бы создать все возможные продукты из комбинации всех столбцов "year_" по всем столбцам "cod_". Я имею в виду что-то вроде этого:

data.new = data %>% 
  mutate(year_1_cod_1 = year_1 * cod_1) %>% 
  mutate(year_1_cod_2 = year_1 * cod_2) %>% 
  mutate(year_1_cod_3 = year_1 * cod_3) %>% 
  mutate(year_1_cod_4 = year_1 * cod_4) %>% 
  mutate(year_2_cod_1 = year_2 * cod_1) %>% 
  mutate(year_2_cod_2 = year_2 * cod_2) %>% 
  mutate(year_2_cod_3 = year_2 * cod_3) %>% 
  mutate(year_2_cod_4 = year_2 * cod_4)

Я могу получить все возможные комбинации, используя:

year.var = colnames(data[, grepl("year", names(data))])
cod.var = colnames(data[, grepl("cod", names(data))])
com = crossing(year.var, cod.var)
> com
# A tibble: 8 x 2
  year.var cod.var
  <chr>    <chr>  
1 year_1   cod_1  
2 year_1   cod_2  
3 year_1   cod_3  
4 year_1   cod_4  
5 year_2   cod_1  
6 year_2   cod_2  
7 year_2   cod_3  
8 year_2   cod_4  

Я мог бы использовать для l oop для перемещения по com фрейму данных и создайте каждый новый столбец. Но я бы хотел сделать это в среде dplyr::. Я думаю, что могу использовать от purrr:: до mutate по всем комбинациям, но я не уверен, как это сделать.

На самом деле в моих реальных данных у меня есть более 1k возможных комбинаций (т.е. более 1k переменных мутировать).

Answer 1

Вы можете использовать map2 до l oop над комбинацией в com и использовать transmute для создания новых столбцов путем умножения этих столбцов с использованием нестандартной оценки и, наконец, привязки его к исходному кадру данных.

library(dplyr)
library(purrr)

data %>%
  bind_cols(map2_dfc(com$year.var, com$cod.var, 
       ~data %>% transmute(!!paste(.x, .y, sep = "_") := !!sym(.x) * !!sym(.y))))

# A tibble: 6 x 16
#     id year_1 year_2 cod_1 cod_2 cod_3 cod_4 var_x year_1_cod_1 year_1_cod_2
#  <dbl>  <dbl>  <dbl> <dbl> <dbl> <dbl> <dbl> <chr>        <dbl>        <dbl>
#1     1      0      1     5     5     3     6 x                0            0
#2     1      0      1     3     6    14     5 x                0            0
#3     1      0      1     2     8     5     4 x                0            0
#4     2      1      0    10     8     2     3 x               10            8
#5     2      1      0     3     9     1     2 x                3            9
#6     2      1      0     1    12     0     1 x                1           12
# … with 6 more variables: year_1_cod_3 <dbl>, year_1_cod_4 <dbl>,
#   year_2_cod_1 <dbl>, year_2_cod_2 <dbl>, year_2_cod_3 <dbl>,
#   year_2_cod_4 <dbl>

Answer 2

library(dplyr)
library(tidyr)

data %>% 
  pivot_longer(starts_with("year"), names_to = "year", values_to = "year_val") %>% 
  pivot_longer(starts_with("cod"), names_to = "cod", values_to = "cod_val") %>% 
  mutate(year_cod = paste(year, cod, sep = "_"),
         val = year_val * cod_val) %>% 
  pivot_wider(
    id_cols = c(id, var_x),
    names_from = year_cod,
    values_from = val,
    values_fn = list(val = list)
  ) %>% 
  unnest(cols = c(-id, -var_x))
#> # A tibble: 6 x 10
#>      id var_x year_1_cod_1 year_1_cod_2 year_1_cod_3 year_1_cod_4 year_2_cod_1
#>   <dbl> <chr>        <dbl>        <dbl>        <dbl>        <dbl>        <dbl>
#> 1     1 x                0            0            0            0            5
#> 2     1 x                0            0            0            0            3
#> 3     1 x                0            0            0            0            2
#> 4     2 x               10            8            2            3            0
#> 5     2 x                3            9            1            2            0
#> 6     2 x                1           12            0            1            0
#> # … with 3 more variables: year_2_cod_2 <dbl>, year_2_cod_3 <dbl>,
#> #   year_2_cod_4 <dbl>

^{Создано в 2020-02-26 пакетом представ (v0.3.0)}