Эффективное использование списка для фильтрации в `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"]]
  )

Вот неполное решение, поскольку оно не обобщает без расширения для создания всех комбинаций данных, но, возможно, в некоторых случаях может быть достаточно чего-то вроде этого: library(tidyverse); dplyr::starwars |> inner_join(filter_list |> as.data.frame()). Вероятно, это было бы невозможно, если бы существовало большое количество комбинаций.

Jon Spring 27.08.2024 23:52
Стоит ли изучать PHP в 2023-2024 годах?
Стоит ли изучать PHP в 2023-2024 годах?
Привет всем, сегодня я хочу высказать свои соображения по поводу вопроса, который я уже много раз получал в своем сообществе: "Стоит ли изучать PHP в...
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
В JavaScript одним из самых запутанных понятий является поведение ключевого слова "this" в стрелочной и обычной функциях.
Приемы CSS-макетирования - floats и Flexbox
Приемы CSS-макетирования - floats и Flexbox
Здравствуйте, друзья-студенты! Готовы совершенствовать свои навыки веб-дизайна? Сегодня в нашем путешествии мы рассмотрим приемы CSS-верстки - в...
Тестирование функциональных ngrx-эффектов в Angular 16 с помощью Jest
В системе управления состояниями ngrx, совместимой с Angular 16, появились функциональные эффекты. Это здорово и делает код определенно легче для...
Концепция локализации и ее применение в приложениях React ⚡️
Концепция локализации и ее применение в приложениях React ⚡️
Локализация - это процесс адаптации приложения к различным языкам и культурным требованиям. Это позволяет пользователям получить опыт, соответствующий...
Пользовательский скаляр GraphQL
Пользовательский скаляр GraphQL
Листовые узлы системы типов GraphQL называются скалярами. Достигнув скалярного типа, невозможно спуститься дальше по иерархии типов. Скалярный тип...
3
1
50
3
Перейти к ответу Данный вопрос помечен как решенный

Ответы 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 работает более чем в два раза быстрее.

Только после нажатия кнопки «Отправить» я узнал, что есть что-то вроде reduce2.

I_O 28.08.2024 00:10

Вы можете попробовать 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

Другие вопросы по теме