Использование пользовательской функции dplyr quosure с mutate_at

Question

Я пытаюсь создать вспомогательную функцию, которая извлекает цифры в столбце, указанном в аргументе.Я могу использовать свою функцию внутри mutate (и повторять ее для всех интересующих столбцов), но она не работает внутри mutate_at.

Вот пример того, что мои данныевыглядит так:

> set.seed(20190928)
> evalYr <- 2018
> n <- 5
> (df <- data.frame(
+     AY = sample(2016:2019, n, replace = T),
+     Pay00 = rgamma(n, 2, 1/1000),
+     Pay01 = rgamma(n, 2, 1/1000),
+     Pay02 = rgamma(n, 2, 1/1000),
+     Pay03 = rgamma(n, 2, 1/1000)
+ ))
    AY     Pay00     Pay01     Pay02     Pay03
1 2018 2520.3772 2338.9490  919.8245  629.1657
2 2016  259.7804 1543.4450  661.6488 2382.7916
3 2018 2446.3075  312.5143 2297.9717  942.5627
4 2017 1386.6288 4179.0352 2370.2669 1846.5838
5 2018  541.8261 2104.4589 2622.1758 2606.0694

Итак, я собрал (используя синтаксис dplyr) этот помощник для изменения в каждом столбце PayXX, который у меня есть:

# Helper function to get the number inside column `PayXX` name
f1 <- function(pmt) enquo(pmt) %>% quo_name() %>% str_extract('(\\d)+') %>% as.numeric()

Эта функция работаетнормально с dplyr::mutate:

> df %>% mutate(Pay00_numcol = f1(Pay00),
+               Pay01_numcol = f1(Pay01),
+               Pay02_numcol = f1(Pay02),
+               Pay03_numcol = f1(Pay03))
    AY     Pay00     Pay01     Pay02     Pay03 Pay00_numcol Pay01_numcol Pay02_numcol Pay03_numcol
1 2018 2520.3772 2338.9490  919.8245  629.1657            0            1            2            3
2 2016  259.7804 1543.4450  661.6488 2382.7916            0            1            2            3
3 2018 2446.3075  312.5143 2297.9717  942.5627            0            1            2            3
4 2017 1386.6288 4179.0352 2370.2669 1846.5838            0            1            2            3
5 2018  541.8261 2104.4589 2622.1758 2606.0694            0            1            2            3

Но когда я пытаюсь использовать ту же функцию внутри mutate_at, он возвращает NA:

> df %>% mutate_at(vars(starts_with('Pay')), list(numcol = ~f1(.)))
    AY     Pay00     Pay01     Pay02     Pay03 Pay00_numcol Pay01_numcol Pay02_numcol Pay03_numcol
1 2018 2520.3772 2338.9490  919.8245  629.1657           NA           NA           NA           NA
2 2016  259.7804 1543.4450  661.6488 2382.7916           NA           NA           NA           NA
3 2018 2446.3075  312.5143 2297.9717  942.5627           NA           NA           NA           NA
4 2017 1386.6288 4179.0352 2370.2669 1846.5838           NA           NA           NA           NA
5 2018  541.8261 2104.4589 2622.1758 2606.0694           NA           NA           NA           NA

У кого-нибудь когда-нибудь была подобная проблема?Как мне работать с функцией mutate_at в этом случае?

Спасибо,

Воспроизводимый пример

library(tidyverse)
library(stringr)
set.seed(20190928)
evalYr <- 2018
n <- 5
(df <- data.frame(
    AY = sample(2016:2019, n, replace = T),
    Pay00 = rgamma(n, 2, 1/1000),
    Pay01 = rgamma(n, 2, 1/1000),
    Pay02 = rgamma(n, 2, 1/1000),
    Pay03 = rgamma(n, 2, 1/1000)
))

# Helper function to get the number inside column `PayXX` name
f1 <- function(pmt) enquo(pmt) %>% quo_name() %>% str_extract('(\\d)+') %>% as.numeric()

# Working
df %>% mutate(Pay00_numcol = f1(Pay00),
              Pay01_numcol = f1(Pay01),
              Pay02_numcol = f1(Pay02),
              Pay03_numcol = f1(Pay03))

# Not working
df %>% mutate_at(vars(starts_with('Pay')), list(numcol = ~f1(.)))

Answer 1

Первый способ, о котором я подумал, состоит в том, что это может быть проще с изменением формы данных.Однако для получения 1) столбца «Pay00», «Pay01» и т. Д. Все еще требуется путаница tidyr функций;2) извлечь цифры;3) манипулировать, чтобы вы могли использовать tidyr::spread, чтобы вернуться к широкой форме;и 4) распределите и удалите бит «_value», который я прикрепил.

Я считаю, что есть более хороший способ сделать это с последней версией tidyr, поскольку новая функция pivot_wider должна быть в состояниипринять более одного столбца за value.Я совсем не замешивался в этом, но, может быть, кто-то еще может написать это.

library(tidyverse)

df %>%
  rowid_to_column() %>%
  gather(key, value, -AY, -rowid) %>%
  mutate(numcol = as.numeric(str_extract(key, "\\d+$"))) %>%
  gather(key = coltype, value, value, numcol) %>%
  unite(key, key, coltype) %>%
  spread(key, value) %>%
  select(AY, ends_with("value"), ends_with("numcol")) %>%
  rename_all(str_remove, "_value")
#>     AY     Pay00     Pay01     Pay02     Pay03 Pay00_numcol Pay01_numcol
#> 1 2018 2520.3772 2338.9490  919.8245  629.1657            0            1
#> 2 2016  259.7804 1543.4450  661.6488 2382.7916            0            1
#> 3 2018 2446.3075  312.5143 2297.9717  942.5627            0            1
#> 4 2017 1386.6288 4179.0352 2370.2669 1846.5838            0            1
#> 5 2018  541.8261 2104.4589 2622.1758 2606.0694            0            1
#>   Pay02_numcol Pay03_numcol
#> 1            2            3
#> 2            2            3
#> 3            2            3
#> 4            2            3
#> 5            2            3

Или, если вы хотите придерживаться подхода tidyeval: получите имена столбцов-как-предложенийВы вызываете свою функцию.Только будьте осторожны, если вы используете нотацию list(numcol = ~f1(.)), все эти предложения будут выглядеть как .

f1 <- function(pmt) {
  str_extract(rlang::as_name(enquo(pmt)), "\\d+$") %>%
    as.numeric()
}

df %>%
  mutate_at(vars(starts_with("Pay")), list(numcol = f1))
# same output as prev