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