如何迭代逻辑谓词列表?

时间:2018-01-31 16:05:12

标签: r dplyr purrr

更新:在尝试编写包含一些dplyr操作的自定义函数时,以下问题可能是常见的初学者不可遵循的方法。在这些情况下,tt可能是时候学习非标准评估和最佳实践的概念:http://dplyr.tidyverse.org/articles/programming.html

我正在尝试映射数据集以替换多个值。鉴于我想多次这样做,是否有可能(或一个好主意)使用指定的逻辑谓词创建一个列表然后再purrr::map

例如,在starwars数据集中,如果我想替换符合特定条件的skin_color值,我可以这样做:

library(tidyverse)
#> -- Attaching packages -------------------------------------------------------------- tidyverse 1.2.1 --
#> v ggplot2 2.2.1.9000     v purrr   0.2.4     
#> v tibble  1.4.2          v dplyr   0.7.4     
#> v tidyr   0.7.2          v stringr 1.2.0     
#> v readr   1.1.1          v forcats 0.2.0
#> -- Conflicts ----------------------------------------------------------------- tidyverse_conflicts() --
#> x dplyr::filter() masks stats::filter()
#> x dplyr::lag()    masks stats::lag()

replaced_starwars <- starwars %>% 
  mutate(skin_color = replace(skin_color, (hair_color == "none" & eye_color == "black"), 
                              "SOMETHING_HERE"))

head(filter(replaced_starwars, hair_color == "none" & eye_color == "black"), 5)
#> # A tibble: 5 x 13
#>   name    height  mass hair_color skin_color   eye_color birth_year gender
#>   <chr>    <int> <dbl> <chr>      <chr>        <chr>          <dbl> <chr> 
#> 1 Nien N~    160  68.0 none       SOMETHING_H~ black           NA   male  
#> 2 Gasgano    122  NA   none       SOMETHING_H~ black           NA   male  
#> 3 Kit Fi~    196  87.0 none       SOMETHING_H~ black           NA   male  
#> 4 Plo Ko~    188  80.0 none       SOMETHING_H~ black           22.0 male  
#> 5 Lama Su    229  88.0 none       SOMETHING_H~ black           NA   male  
#> # ... with 5 more variables: homeworld <chr>, species <chr>, films <list>,
#> #   vehicles <list>, starships <list>

如何将逻辑谓词存储在列表中,然后使用my_function

映射它们
my_function <- function(my_data, lgc_predicates, replacement){
  out <- my_data %>% mutate(species = replace(species, lgc_predicates, replacement))
  return(out)
}

pred_list <- list('hair_color == "blond" & eye_color == "yellow"',
                  'hair_color == "none" & eye_color == "brown"',
                  'hair_color == "brown" & eye_color == "red"',
                  'hair_color == "none" & eye_color == "black"')

replaced_starwars <- map(starwars, 
                     my_function, 
                     lgc_predicates = pred_list, replacement = "SOMETHING_HERE")
#> Error in UseMethod("mutate_"): no applicable method for 'mutate_' applied to an object of class "character"

1 个答案:

答案 0 :(得分:2)

在这种情况下我个人喜欢dplyr::case_when

output <- starwars %>%
            mutate(skin_color = case_when(
                hair_color == "blond" & eye_color == "yellow" ~ "SOMETHING_HERE",
                hair_color == "none" & eye_color == "brown" ~ "SOMETHING_HERE",
                hair_color == "brown" & eye_color == "red" ~ "SOMETHING_HERE",
                hair_color == "none" & eye_color == "black" ~ "SOMETHING_HERE",
                TRUE ~ skin_color))

head(filter(output, hair_color == "none" & eye_color == "black"), 5)

# A tibble: 5 x 13
  # name  heig~  mass hair~ skin~ eye_~ birt~ gend~ home~ spec~ films vehi~ star~
  # <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> <lis> <lis> <lis>
# 1 Nien~   160  68.0 none  SOME~ black  NA   male  Sull~ Sull~ <chr~ <chr~ <chr~
# 2 Gasg~   122  NA   none  SOME~ black  NA   male  Troi~ Xexto <chr~ <chr~ <chr~
# 3 Kit ~   196  87.0 none  SOME~ black  NA   male  Glee~ Naut~ <chr~ <chr~ <chr~
# 4 Plo ~   188  80.0 none  SOME~ black  22.0 male  Dorin Kel ~ <chr~ <chr~ <chr~
# 5 Lama~   229  88.0 none  SOME~ black  NA   male  Kami~ Kami~ <chr~ <chr~ <chr~

您甚至可以传递参数列表,但您必须同时取消列表和列名称:

pred_list <- list(!! hair_color == "blond" & !! eye_color == "yellow" ~ "SOMETHING_HERE",
                  !! hair_color == "none" & !! eye_color == "brown" ~ "SOMETHING_HERE",
                  !! hair_color == "brown" & !! eye_color == "red" ~ "SOMETHING_HERE",
                  !! hair_color == "none" & !! eye_color == "black" ~ "SOMETHING_HERE",
                  TRUE ~ !! skin_color)

output <- starwars %>%
        mutate(skin_color = case_when(!!! pred_list))