Функция для извлечения элементов из столбца списка в новый столбец, используя purrr ::: map

Question

Я хочу извлечь элементы из столбца списка и сохранить их как новый столбец. Я могу сделать это вне функции, но не могу заставить это работать внутри функции.

В приведенном ниже примере кода я хочу, чтобы строка mutate(!!F_name := map(!!sum_name, ~.$statistic[[1]])) извлекала статистику теста из столбца сводки модели и сохраняла ее в новом столбце. Это дает ошибку оценки $ operator is invalid for atomic vectors.

aov_f1 <- function(df) {aov(value~ carb, data = df)}
aov_f2 <- function(df) {aov(value~ carb + gear, data = df)}

aov_sum_plus <- function(df, mod) {
  mod <- enquo(mod)
  sum_name <- paste0(quo_name(mod), "_sum")
  F_name <-paste0(quo_name(mod), "_F")

  df <- df %>%
    mutate(!!sum_name := map(!! mod, broom::tidy)) %>%
    mutate(!!F_name := map(!!sum_name, ~.$statistic[[1]]))

  df
}

mtcars_n <- gather(mtcars, obs, value, mpg:qsec) %>%
  group_by(obs) %>%
  nest() %>%
  mutate(aov1 = map(data, aov_f1)) %>%
  mutate(aov2 = map(data, aov_f2)) %>%
  aov_sum_plus(aov1) %>%
  aov_sum_plus(aov2) 

Эквивалентный код ниже дает желаемый результат.

aov_f1 <- function(df) {aov(value~ carb, data = df)}
aov_f2 <- function(df) {aov(value~ carb + gear, data = df)}

mtcars_n <- gather(mtcars, obs, value, mpg:qsec) %>%
  group_by(obs) %>%
  nest() %>%
  mutate(aov1 = map(data, aov_f1)) %>%
  mutate(aov2 = map(data, aov_f2)) %>%
  mutate(aov1_sum = map(aov1, broom::tidy)) %>%
  mutate(aov2_sum = map(aov2, broom::tidy)) %>%
  mutate(aov1_sum_f = map_dbl(aov1_sum, ~.$statistic[[1]])) %>%
  mutate(aov1_sum_p = map_dbl(aov1_sum, ~.$p.value[[1]])) %>%
  mutate(aov2_sum_f = map_dbl(aov2_sum, ~.$statistic[[1]])) %>%
  mutate(aov2_sum_p = map_dbl(aov2_sum, ~.$p.value[[1]]))

Answer 1

Вы цитируете sum_name в строку.Это не будет работать в map.Вы можете проверить это, запустив:

debugfun <- function(df, mod) {
  mod <- enquo(mod)
  sum_name <- paste0(quo_name(mod), "_sum")
  F_name <-paste0(quo_name(mod), "_F")

  quo(df <- df %>%
    mutate(!!sum_name := map(!! mod, broom::tidy),
           !!F_name := map(!!sum_name, ~.$statistic[[1]])
    )
  )
}

gather(mtcars, obs, value, mpg:qsec) %>%
  group_by(obs) %>%
  nest() %>%
  mutate(aov1 = map(data, aov_f1)) %>%
  debugfun(aov1)

Предоставление:

<quosure>
  expr: ^df <- df %>% mutate("aov1_sum" := map(^aov1, broom::tidy), "aov1_F" := map("aov1_sum", ~.$statistic[[1]]))
  env:  0000015EF2AD5C88

Это трюк с необходимостью!Использование quo для всего вашего выражения переведет его для вас.Глядя на вторую map, мы видим проблему со строками.

Вам необходимо создать символ (или имя) из ваших строк.Вы можете добавить их в свои paste0 строки:

aov_sum_plus <- function(df, mod) {
  mod <- enquo(mod)
  sum_name <- sym(paste0(quo_name(mod), "_sum"))
  F_name   <- sym(paste0(quo_name(mod), "_F"))

  mutate(
    df,
    !!sum_name := map(!! mod, broom::tidy),
    !!F_name := map_dbl(!!sum_name, ~.$statistic[[1]])
  )
}

gather(mtcars, obs, value, mpg:qsec) %>%
  group_by(obs) %>%
  nest() %>%
  mutate(aov1 = map(data, aov_f1)) %>%
  aov_sum_plus(aov1)

# A tibble: 7 x 5
  obs   data              aov1      aov1_sum         aov1_F
  <chr> <list>            <list>    <list>            <dbl>
1 mpg   <tibble [32 x 5]> <S3: aov> <tibble [2 x 6]> 13.1  
2 cyl   <tibble [32 x 5]> <S3: aov> <tibble [2 x 6]> 11.5  
3 disp  <tibble [32 x 5]> <S3: aov> <tibble [2 x 6]>  5.55 
4 hp    <tibble [32 x 5]> <S3: aov> <tibble [2 x 6]> 38.5  
5 drat  <tibble [32 x 5]> <S3: aov> <tibble [2 x 6]>  0.249
6 wt    <tibble [32 x 5]> <S3: aov> <tibble [2 x 6]>  6.71 
7 qsec  <tibble [32 x 5]> <S3: aov> <tibble [2 x 6]> 22.7