Эффективное использование списка для фильтрации в `dplyr`

В моем filter_list большое количество элементов. Фильтрация ниже работает, но как сделать dplyr::filter более кратким?

Я не мог заставить all_of работать.

filter_list <- list(
  hair_color = c("blond", "brown"),
  skin_color = "light"
)

dplyr::starwars |> 
  dplyr::filter(
    hair_color %in% filter_list[["hair_color"]],
    skin_color %in% filter_list[["skin_color"]]
  )

3
50
3

Ответы:

Решено

Мы могли бы использовать reduce2 для итеративного применения filter операторов, например:

library(purrr); library(dplyr)

out <- starwars |> 
  reduce2(
    .x = filter_list, .y = names(filter_list), .init = _,
    .f = \(df, x, y) filter(df, .data[[y]] %in% x)
  )
# A tibble: 8 × 14
  name     height  mass hair_color skin_color eye_color birth_year sex   gender homeworld species films vehicles
  <chr>     <int> <dbl> <chr>      <chr>      <chr>          <dbl> <chr> <chr>  <chr>     <chr>   <lis> <list>  
1 Leia Or…    150    49 brown      light      brown             19 fema… femin… Alderaan  Human   <chr> <chr>   
2 Beru Wh…    165    75 brown      light      blue              47 fema… femin… Tatooine  Human   <chr> <chr>   
3 Padmé A…    185    45 brown      light      brown             46 fema… femin… Naboo     Human   <chr> <chr>   
4 Cordé       157    NA brown      light      brown             NA NA    NA     Naboo     NA      <chr> <chr>   
5 Dormé       165    NA brown      light      brown             NA fema… femin… Naboo     Human   <chr> <chr>   
6 Raymus …    188    79 brown      light      brown             NA male  mascu… Alderaan  Human   <chr> <chr>   
7 Rey          NA    NA brown      light      hazel             NA fema… femin… NA        Human   <chr> <chr>   
8 Poe Dam…     NA    NA brown      light      brown             NA male  mascu… NA        Human   <chr> <chr>

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

all.equal(
  out, 
  dplyr::starwars |> 
    dplyr::filter(
      hair_color %in% filter_list[["hair_color"]],
      skin_color %in% filter_list[["skin_color"]]
    )
)

Использование базы Maping и Reduceing:


    names(filter_list) |> 
      Map(f = \(varname) starwars |> filter(.data[[varname]] %in% filter_list[[varname]])) |> 
      Reduce(f = \(stack, piece) inner_join(stack, piece))

Обратите внимание, что принятое решение с purrr::reduce2 работает более чем в два раза быстрее.


Вы можете попробовать rowMeans + mapply, как показано ниже.

starwars %>%
  filter(
    rowMeans(mapply(`%in%`, select(., names(filter_list)), filter_list)) == 1
  )

или Reduce + Map

starwars %>%
  filter(Reduce(`&`, Map(`%in%`, select(., names(filter_list)), filter_list)))

или просто базовая комбинация R subset + Reduce + Map

subset(starwars, Reduce(`&`, Map(`%in%`, starwars[names(filter_list)], filter_list)))

что дает

# A tibble: 8 × 14
  name      height  mass hair_color skin_color eye_color birth_year sex   gender
  <chr>      <int> <dbl> <chr>      <chr>      <chr>          <dbl> <chr> <chr> 
1 Leia Org…    150    49 brown      light      brown             19 fema… femin…
2 Beru Whi…    165    75 brown      light      blue              47 fema… femin…
3 Padmé Am…    185    45 brown      light      brown             46 fema… femin…
4 Cordé        157    NA brown      light      brown             NA NA    NA
5 Dormé        165    NA brown      light      brown             NA fema… femin…
6 Raymus A…    188    79 brown      light      brown             NA male  mascu…
7 Rey           NA    NA brown      light      hazel             NA fema… femin…
8 Poe Dame…     NA    NA brown      light      brown             NA male  mascu…
# ℹ 5 more variables: homeworld <chr>, species <chr>, films <list>,
#   vehicles <list>, starships <list>

Контрольный показатель

Если «Эффективность» (в названии) относится к скорости, вы можете проверить это здесь.

axeman <- \() {
  starwars |>
    reduce2(
      .x = filter_list, .y = names(filter_list), .init = _,
      .f = \(df, x, y) filter(df, .data[[y]] %in% x)
    )
}

i_o <- \() {
  names(filter_list) |>
    Map(f = \(varname) starwars |> filter(.data[[varname]] %in% filter_list[[varname]])) |>
    Reduce(f = \(stack, piece) inner_join(stack, piece))
}

tic1 <- \() {
  starwars %>%
    filter(
      rowMeans(mapply(`%in%`, select(., names(filter_list)), filter_list)) == 1
    )
}

tic2 <- \() {
  starwars %>%
    filter(Reduce(`&`, Map(`%in%`, select(., names(filter_list)), filter_list)))
}

tic3 <- \() {
  subset(starwars, Reduce(`&`, Map(`%in%`, starwars[names(filter_list)], filter_list)))
}

microbenchmark(
  axeman(),
  i_o(),
  tic1(),
  tic2(),
  tic3(),
  unit = "relative",
  check = "equal"
)

который показывает

Unit: relative
     expr       min         lq      mean    median        uq       max neval
 axeman()  11.98158   9.977999  9.679677  10.74786  9.652521  4.009427   100
    i_o() 172.43091 130.316298 96.607907 121.01399 96.094325 15.142344   100
   tic1()  12.45654  11.237299 11.433905  12.15965 12.796552  2.417425   100
   tic2()  12.14343  10.864622 10.723350  11.55505 11.580282  4.656169   100
   tic3()   1.00000   1.000000  1.000000   1.00000  1.000000  1.000000   100