передача вектора в case_when внутри mutate_at

Question

Я хочу создать три новые переменные (назовите их one, two и three), используя тот же обобщенный mutate, но с другой существующей переменной, используемой внутри mutate. Для этого я хочу написать блок короткого кода, который выполняет то же самое, что и следующий (подробный) код:

mtcars.modified <- mtcars %>%

  mutate(one = factor(case_when(
    mpg < 10 ~ "lt10",
    mpg >= 10 & mpg <= 20 ~ "10to20",
    mpg > 20 ~ "gt20"),
    ordered=T, levels = c("lt10", "10to20", "gt20"))) %>%

  mutate(two = factor(case_when(
    disp < 10 ~ "lt10",
    disp >= 10 & disp <= 20 ~ "10to20",
    disp > 20 ~ "gt20"),
    ordered=T, levels = c("lt10", "10to20", "gt20"))) %>%

  mutate(three = factor(case_when(
    qsec < 10 ~ "lt10",
    qsec >= 10 & qsec <= 20 ~ "10to20",
    qsec > 20 ~ "gt20"),
    ordered =T, levels = c("lt10", "10to20", "gt20")))

Один из способов обобщить это - использовать суффикс поведения mutate_at, а затем переименовать:

mtcars.modified <- mtcars %>%
  mutate_at(c("mpg", "disp", "qsec"),
            funs(mod = factor(case_when(
              . < 10 ~ "lt10",
              . >= 10 & . <= 20 ~ "10to20",
              . > 20 ~ "gt20"),
              ordered =T, levels = c("lt10", "10to20", "gt20")))) %>%
  rename(one = mpg_mod,
         two = disp_mod,
         three = qsec_mod)

Хотя это похоже на обходной путь. Есть ли способ, которым я могу сделать это без необходимости rename после этого? Я подумал, могу ли я дать one, two и three в качестве .vars и затем каким-то образом передать второй набор переменных в case_when. Это похоже на проблему map2, когда у вас есть два соответствующих вектора и функция, которая получает элементы из обоих векторов попарно.

Это была моя (неудачная) попытка использовать map2 в аргументе funs:

mtcars.modified <- mtcars %>%
  mutate_at(c("one", "two", "three"),
            funs(map2(.x = ., .y = c(mpg, disp, qsec), 
                      ~ factor(case_when(
                        .y < 10 ~ "lt10",
                        .y >= 10 & .y <= 20 ~ "10to20",
                        .y > 20 ~ "gt20"),
                        ordered =T, levels = c("lt10", "10to20", "gt20")))))

Я бы хотел хранить все внутри mtcars %>% трубы, не создавая именованную функцию и не разрывая трубу.

Answer 1

Если вы используете функцию dplyr::vars, вы можете переименовать ее перед применением.

mtcars %>%
  mutate_at(
    vars(one = mpg, two = disp, three = qsec),
    funs(
      case_when(
        . < 10 ~ 'lt10',
        . >= 10 & . <= 20 ~ "10to20",
        . > 20 ~ 'gt20'
      ) %>%
        ordered(levels = c('lt10', '10to20', 'gt20'))
    )
  )

Это также работает с замечательным предложением @ seisdrum использовать base::cut

mtcars %>%
  mutate_at(
    vars(one = mpg, two = disp, three = qsec),
    cut,
    breaks = c(-Inf, 10, 20, Inf),
    labels = c("lt10", "10to20", "gt20")
  )

Answer 2

library(tidyverse)
mtcars %>%
  dplyr::mutate_at(c("mpg", "disp", "qsec"), cut,
                   breaks = c(-Inf, 10, 20, Inf),
                   labels = c("lt10", "10to20", "gt20")) %>%
  head()
#>      mpg cyl disp  hp drat    wt   qsec vs am gear carb
#> 1   gt20   6 gt20 110 3.90 2.620 10to20  0  1    4    4
#> 2   gt20   6 gt20 110 3.90 2.875 10to20  0  1    4    4
#> 3   gt20   4 gt20  93 3.85 2.320 10to20  1  1    4    1
#> 4   gt20   6 gt20 110 3.08 3.215 10to20  1  0    3    1
#> 5 10to20   8 gt20 175 3.15 3.440 10to20  0  0    3    2
#> 6 10to20   6 gt20 105 2.76 3.460   gt20  1  0    3    1

Вы можете использовать функцию вырезания для этой задачи. Делает ли это то, что вы хотите?

Если вы хотите сохранить исходные столбцы и вам нужен суффикс _mod в модифицированных, вы можете сделать следующее:

library(tidyverse)
mtcars %>%
  dplyr::mutate_at(c("mpg", "disp", "qsec"),
                   dplyr::funs(
                     mod = cut(.,
                               breaks = c(-Inf, 10, 20, Inf),
                               labels = c("lt10", "10to20", "gt20")
                               )
                     )
                   ) %>%
  head()
#>    mpg cyl disp  hp drat    wt  qsec vs am gear carb mpg_mod disp_mod
#> 1 21.0   6  160 110 3.90 2.620 16.46  0  1    4    4    gt20     gt20
#> 2 21.0   6  160 110 3.90 2.875 17.02  0  1    4    4    gt20     gt20
#> 3 22.8   4  108  93 3.85 2.320 18.61  1  1    4    1    gt20     gt20
#> 4 21.4   6  258 110 3.08 3.215 19.44  1  0    3    1    gt20     gt20
#> 5 18.7   8  360 175 3.15 3.440 17.02  0  0    3    2  10to20     gt20
#> 6 18.1   6  225 105 2.76 3.460 20.22  1  0    3    1  10to20     gt20
#>   qsec_mod
#> 1   10to20
#> 2   10to20
#> 3   10to20
#> 4   10to20
#> 5   10to20
#> 6     gt20