使用 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

使用 purrr::map 将列表列中的元素提取到新列中的函数

Function to extract elements from a list column into a new column using purrr:::map

r

dplyr

purrr

rlang