call custom functions with {{}} in dplyr

Viewed 57

I know that we can use {{}} for non standard evaluation in dplyr, but I came across a particular case and I don't know how to fix this. Suppose I have two functions that have the same prefix, e.g:

custom_mean <- function(x) {
  mean(x, na.rm = TRUE)
}

custom_sum <- function(x) {
  sum(x, na.rm = TRUE)
}

I would like to let the user choose which function to apply on a column of mtcars (that the user can also choose). This is how I would do it with two separate functions:

library(dplyr)

apply_mean_on_mtcars <- function(colname) {
  mtcars %>% 
    select({{colname}}) %>% 
    summarise(
      "custom_{{colname}}" := custom_mean({{colname}})
    )
}

apply_sum_on_mtcars <- function(colname) {
  mtcars %>% 
    select({{colname}}) %>% 
    summarise(
      "custom_{{colname}}" := custom_sum({{colname}})
    )
}

apply_mean_on_mtcars(drat)
> custom_drat
> 1    3.596563

apply_sum_on_mtcars(drat)
> custom_drat
> 1      115.09

But I would like to have a single function apply_on_mtcars() where the user can choose both the column and the function to apply (i.e custom_mean or custom_sum). I tried this, but no success:

apply_on_mtcars <- function(colname, func) {
  mtcars %>% 
    select({{colname}}) %>% 
    summarise(
      "custom_{{colname}}" := "custom_{{func}}"({{colname}})
    )
}

Error: Problem with `summarise()` input `custom_drat`.
x could not find function "custom_{{func}}"
ℹ Input `custom_drat` is ``custom_{{func}}`(drat)`.

Does somebody have a solution? In the end, the function that the user should provide when calling the function is mean or sum, not custom_mean or custom_sum.

2 Answers

We could also use match.fun

library(stringr)
library(dplyr)
apply_on_mtcars <- function(colname, func) {
  mtcars %>% 
    select({{colname}}) %>% 
    summarise(
      "custom_{{colname}}" := 
         match.fun(str_c("custom_", func))({{colname}})
    )
}


apply_on_mtcars(drat, "mean")
#    custom_drat
#1    3.596563
apply_on_mtcars(drat, "sum")
#    custom_drat
#1      115.09

What about like this:

apply_on_mtcars <- function(colname, func=c("mean", "sum")) {
  f <- match.arg(func)
  fun <- eval(parse(text=paste0("custom_", f)))
  mtcars %>% 
    select({{colname}}) %>% 
    summarise(
      "custom_{{colname}}" := fun({{colname}})
    )
}

apply_on_mtcars(drat, "mean")
# custom_drat
# 1    3.596563
 
apply_on_mtcars(drat, "sum")
# custom_drat
# 1      115.09

Related