R wrap function call into another call without using string manipulation

Question

I'm looking for a nice way to wrap a function call into another function call. Wrapping a function before it is being called into other functions is easy, but modifying an existing call seems not so straight forward to me.

I found a way which I explain using the example below, but it is basically relying on converting the call into a list into a string, then adding the new call as string and convert everything back to language using str2lang.

Is there a cleaner way to do this?

Lets assume I'm building a custom summarise function for dplyr which will check, whether the output is a vector and in that case create a df-col by using pivot_wider(enframe(...)) on the existing call.

Here is the reprex.

library(tidyverse)

short_sum <- function(data, ...) {

  fns <- rlang::enquos(...)

  fns <- purrr::map(fns, function(x) {

    res <- rlang::eval_tidy(x, data = data)

    if ((is.vector(res)  || is.factor(res)) && length(res) > 1) {

      # is there a better way to do this (start) ---
      # get expression of call and turn it into a string
      x_expr <- as.character(list(rlang::quo_get_expr(x)))

      # construct a string with expression above wrapped in another call
      x_expr <- paste0(
        "pivot_wider(enframe(",
        x_expr,
        "), names_from = name, values_from = value)"
      )

      # turn string into language and replace expression in x
      x <- rlang::quo_set_expr(x, str2lang(x_expr))
      # is there a better way to do this (end) ---

      x
    } else {
      x
    }
  })

    dplyr::summarise(data, !!! fns, .groups="drop")
}


mtcars %>% 
  as_tibble %>% 
  short_sum(quant = quantile(mpg),
            range = range(wt))

#> # A tibble: 1 x 2
#>   quant$`0%` $`25%` $`50%` $`75%` $`100%` range$`1`  $`2`
#>        <dbl>  <dbl>  <dbl>  <dbl>   <dbl>     <dbl> <dbl>
#> 1       10.4   15.4   19.2   22.8    33.9      1.51  5.42

^{Created on 2020-06-14 by the reprex package (v0.3.0)}

This question is based on my answer here where I use the approach above.

Answer 1

I'm not 100% sure what the function does but I think you might be looking for something like this :

short_sum <- function(data, ...) {

  fns <- rlang::enquos(...)

  fns <- purrr::map(fns, function(x) {
    res <- rlang::eval_tidy(x, data = data)

    if ((is.vector(res)  || is.factor(res)) && length(res) > 1) {
      rlang::expr(pivot_wider(enframe(
        !!rlang::quo_get_expr(x)), names_from = name, values_from = value))
      # or
      # bquote(pivot_wider(enframe(
      #  .(rlang::quo_get_expr(x))), names_from = name, values_from = value))
    } else {
      x
    }
  })

  dplyr::summarise(data, !!! fns, .groups="drop")
}

expr() is like quote(), except you can use !! or !!! to unquote parts of the expression.

bquote() is like quote() as well, but in base R, and you use .() to unquote.