Есть ли способ удалить аргументы функции, если они имеют NULL в них - PullRequest
Новая
       4

Есть ли способ удалить аргументы функции, если они имеют NULL в них

1 голос
/ 31 марта 2020

У меня есть функция, которая принимает любое количество аргументов и фильтрует фрейм данных на основе этих аргументов - в основном так же, как это делает dplyr. В некоторых случаях эти аргументы могут принимать значение NULL (потому что это функция, используемая в глянце). Есть ли способ убрать эти аргументы? Ниже приведен пример кода, показывающий, что я имею в виду. 

cylFilter <- 6
mpgFilter <- 21
dispFilter <- NULL
newFilter <- function(df, ...){
  dots <- dplyr::enquos(...)
  quo <- dplyr:::all_exprs(!!!dots, .vectorised = TRUE)
  df <- dplyr:::filter_impl(df, quo)
  return(df)
}
newFilter(mtcars, cyl == cylFilter, mpg == mpgFilter, disp == dispFilter)

Желаемый результат: 

  mpg cyl disp  hp drat    wt  qsec vs am gear carb
1  21   6  160 110  3.9 2.620 16.46  0  1    4    4
2  21   6  160 110  3.9 2.875 17.02  0  1    4    4

1 Ответ

1 голос
/ 03 апреля 2020

Два возможных ответа в зависимости от того, насколько последовательны ваши фильтрующие выражения:

  1. Если ваши выражения всегда имеют форму A == B A == NULL:

    В этом случае вы можете выборочно оценить часть захваченного выражения, проверить, имеет ли оно значение NULL, и удалить его из списка захваченных аргументов 

    newFilter_opt1 <- function(df, ...) {
    dots <- dplyr::enquos(...)
    dots2 <- dplyr::enexprs(...)
    #Below could be replaced with purrr::map_logical(dots, check_not_null)
    is_ok <- vapply(dots2, check_not_null, logical(1))  
    dots <- dots[is_ok]
    quo <- dplyr:::all_exprs(!!!dots, .vectorised = TRUE)
    df <- dplyr:::filter_impl(df, quo)
    return(df)
}

check_not_null <- function(expr) {
    # In R, the expression A == B is turned into [`==`, A, B]
    # We need to check if the third part of this expression evaluates to NULL
    return(!is.null(eval(expr[[3]])))
}

  2. Если вы не знаете в какой форме появятся ваши выражения:

    Теперь гораздо сложнее проверить заранее, содержат ли захваченные выражения NULL. Вместо этого запустите каждое выражение через dplyr :: filter по отдельности и поймайте все ошибки 

    newFilter_opt2 <- function(df, ...) {
    dots <- dplyr::enquos(...)
    for (x in dots) {
        df <- filter_or_catch(df, x)
    }
    return(df)
}

filter_or_catch <- function(df, x) {
    res <- tryCatch(
        {
            dplyr::filter(df, !!x)
        },
        error = function(e) df
    )
    return(res)
}

Например, оба подхода дают желаемый результат: 

cylFilter <- 6
mpgFilter <- 21
dispFilter <- NULL
newFilter_opt1(mtcars, cyl == cylFilter, mpg == mpgFilter, disp == dispFilter)
#>   mpg cyl disp  hp drat    wt  qsec vs am gear carb
#> 1  21   6  160 110  3.9 2.620 16.46  0  1    4    4
#> 2  21   6  160 110  3.9 2.875 17.02  0  1    4    4

newFilter_opt2(mtcars, cyl == cylFilter, mpg == mpgFilter, disp == dispFilter)
#>   mpg cyl disp  hp drat    wt  qsec vs am gear carb
#> 1  21   6  160 110  3.9 2.620 16.46  0  1    4    4
#> 2  21   6  160 110  3.9 2.875 17.02  0  1    4    4

Для небольших наборов данных newFilter_opt1 значительно быстрее: 

timing <- bench::mark(newFilter_opt1(mtcars, cyl == cylFilter, mpg == mpgFilter, disp == dispFilter),
                      newFilter_opt2(mtcars, cyl == cylFilter, mpg == mpgFilter, disp == dispFilter))
timing[, 1] <- c("opt1", "opt2")
timing[, c(1:8)]
#> # A tibble: 2 x 6
#>   expression      min   median `itr/sec` mem_alloc `gc/sec`
#>   <chr>      <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl>
#> 1 opt1        315.6us  358.6us     2223.    44.5KB    10.4 
#> 2 opt2         1.77ms    2.3ms      273.    3.28KB     5.11
...