主页 / coding / 问题 / 78920812
Accepted
tic-toc-choc
Asked: 2024-08-28 05:28:22 +0800 CST

在 `dplyr` 中高效使用列表进行过滤

  • 772

我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 个回答

  1. Best Answer

    我们可以用来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"]]
    )
)
    • 9

  2. 您可以尝试以下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++ReduceMap

    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
    • 7

  3. 使用 base 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速度要快两倍多。

    • 4

相关问题