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

时间:2018-09-11 14:09:47

标签: r dplyr purrr rlang

我想从列表列中提取元素,并将其存储为新列。我可以在函数外部执行此操作,但是无法在函数内部执行此操作。

在下面的示例代码中,我希望行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]]))

1 个答案:

答案 0 :(得分: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