R dplyr write function for logical expression in filter

user_8393879 0
Viewed 164

I would like to automate the logical expression in statements like dplyr::filter or dplyr::case_when. For a reproducible example consider the mtcars and with a special column called id:

library(tidyverse)
dd <- mtcars %>% as_tibble() %>% mutate(id = letters[1:32])

The goal is to get the same result as with

identifier <- "d"
dd %>%
  filter(id == identifier)

by using a function instead of the logical expression, like so

identifier <- "d"
is_id <- function(foo_id){
  # body
}
dd %>%
  filter(is_id(identifier))

The goal is to make a function is_id, which returns the logical expression used by filter. The function is_id <- function(car_id){ #body } should therefore evaluate the expression dd$id == foo_id and return the logical vector of its results. This should be achieved without repeating the .data argument (dd in this case) , e.g. not filter(dd, is_id(dd, "c")).

Is there a way to achieve this, and if so how?

dplyr r
2 Answers

Depending on your data it might not be super performant, but you can use cur_data_all() inside your custom function. This function will also work without the pipe and it can also take several identifiers.

library(dplyr)

dd <- mtcars %>% as_tibble() %>% mutate(id = letters[1:32])

identifier <- "d"

is_id <- function(x){
  dat <- dplyr::cur_data_all()
  dat[["id"]] == x
}

dd %>%
  filter(is_id(identifier))

#> # A tibble: 1 x 12
#>     mpg   cyl  disp    hp  drat    wt  qsec    vs    am  gear  carb id   
#>   <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <chr>
#> 1  21.4     6   258   110  3.08  3.22  19.4     1     0     3     1 d

idenfifiers <- c("a", "b")
filter(dd, is_id(idenfifiers))

#> # A tibble: 2 x 12
#>     mpg   cyl  disp    hp  drat    wt  qsec    vs    am  gear  carb id   
#>   <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <chr>
#> 1    21     6   160   110   3.9  2.62  16.5     0     1     4     4 a    
#> 2    21     6   160   110   3.9  2.88  17.0     0     1     4     4 b

Created on 2021-02-18 by the reprex package (v0.3.0)

user_93493020 
dd <- mtcars %>% as_tibble() %>% mutate(id = letters[1:32])
                                                     

identifier <- "d"

is_id <- function(x){
  data <- x[, "id"]
  rtn <- data == identifier
  return(rtn)
}

dd %>% 
  filter(is_id(.))

# A tibble: 1 x 12
    mpg   cyl  disp    hp  drat    wt  qsec    vs    am  gear  carb id   
  <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <chr>
1  21.4     6   258   110  3.08  3.22  19.4     1     0     3     1 d
user_141559140
Related