R metaprogramming: pass expression/quosure to function that partially accesses local frame

Question

I will use the following example to explain my question. But the question is not only about this specific example, but more general about meta-programming in R.

I have two specific functions to make plots

Specific function 1

draw_hists <- function(dts, indexs, title_prefix = 'sd = ') {
  mapply(
    function(dt, index) 
    {
      hist(dt, main = paste(title_prefix, as.character(index)))
    },
    dts, indexs
  )
}

plots histograms

sds <- c(0.1, 0.5, 5, 100)
raw_normals <- purrr::map(sds, ~rnorm(500, mean = 1, sd = .x))
draw_hists(raw_normals, sds)

Specific function 2

plots scatter plots of percentage ranks against raw data

draw_percentage <- function(dts, indexs, title_prefix = 'sd = ') {
  mapply(
    function(dt, index) 
    {
      plot(dt, dplyr::percent_rank(dt), main = paste(title_prefix, as.character(index)))
    },
    dts, indexs
  )
}

sds <- c(0.1, 0.5, 5, 100)
raw_normals <- purrr::map(sds, ~rnorm(500, mean = 1, sd = .x))
draw_percentage(raw_normals, sds)

Now assume I want to abstract out the general patterns of these functions and define a generic higher-order function that takes inputs of any arbitrary plotting function and its argument as an expression to be flexible enough drawing nearly whatever I want to draw. I thought something like this would work.

draw_generic <- function(dts, indexs, plfun, plfun_arguments_as_expr) { 
 ....
}

The formal parameter plfun_arguments_as_expr would bind to an expression such like expr(dplyr::percent_rank(dt)) to make the plotting truly generic and flexible. I come up with the following solution.

draws_generic <- function(dts, indexs, plfun, title_prefix = 'sd =', ...) {
  dots <- enquos(...)
  mapply(
    function(dt, index) 
    {
      eval_tidy(
        expr(
          plfun(dt, main = paste(title_prefix, as.character(index)), !!!dots)
        )
      )
    }
    ,
    dts, indexs
  )
}

draws_generic(raw_normals, sds, hist)
draws_generic(raw_normals, sds, plot, dplyr::percent_rank(dt))

The histogram works. But the percent_rank one gives me error

Error in x[!nas] : object of type 'closure' is not subsettable
In addition: Warning message:
In is.na(x) : is.na() applied to non-(list or vector) of type 'closure'
Called from: rank(x, ties.method = "min", na.last = "keep")

I think this might be related to the fact that the environment scope captured by enquos is global, but the expression contains a name dt for which its binding existed in local scope created by the anonymous function function(dt, index). Is this truly the reason of this error? If so, is there a neat and clean way to fix it that follows principles of "tidy evaluation"?

Update

Inspired by the comments, I modify here my question. In stead of using a pure functional abstraction to generalize procedures, what I really want is to achieve generalization by treating code as object and manipulate it freely in a R function or kind of macro programming. More precisely what I want is a draw_expression function to plot data against a given expression instead of previous draw_generic. Below are some of my attempts so far:

The 1st version plots a plotting expression with x as data argument against given data without additional indexs parameter and title. The code has been tested working.

draw_expression_1 <- function(dts, plexpr) {
  plexpr <- enexpr(plexpr)
  lapply(dts, eval(expr(function(x) !!plexpr)))
}

draw_expression_1(raw_normals, hist(x))
draw_expression_1(raw_normals, plot(x, dplyr::percent_rank(x))

The 2nd version adds additional indexs parameter and titles by modifying the given expression. The code has been tested working.

draw_expression_2 <- function(dts, indexs, plexpr, title_prefix = 'sd =') {
  plexpr <- enexpr(plexpr)
  mapply(eval(expr(function(x, index) {
    UQ(rlang::call_modify(plexpr, main = quote(paste(title_prefix, as.character(index)))))
    })), dts, indexs)
}

draw_expression_2(raw_normals, sds, hist(x))
draw_expression_2(raw_normals, sds, plot(x, dplyr::percent_rank(x))

The 3rd version is aimed at allowing the call expression to have any arbitrary formal parameter name instead of x. Release the assumption to be that the 1st parameter corresponds to the data to be plotted, but it can be named whatever users wished.

draw_expression_3 <- function(dts, indexs, plexpr, title_prefix = 'sd =') {
  plexpr <- enexpr(plexpr)
  first_arg_name <- rlang::call_args(plexpr)
  mapply(eval(expr(function(first_arg_name, index) {
    UQ(rlang::call_modify(plexpr, main = quote(paste(title_prefix, as.character(index)))))
  })), dts, indexs)
}

draw_expression_3(raw_normals, sds, hist(x))
draw_expression_3(raw_normals, sds, plot(x, dplyr::percent_rank(x))

This prints me error:

Error in plot(x, dplyr::percent_rank(x), main = paste(title_prefix, as.character(index))) : 
  object 'x' not found

Apparently first_arg_name has to been unquoted in the expression. Thus I did this:

draw_expression_3 <- function(dts, indexs, plexpr, title_prefix = 'sd =') {
  plexpr <- enexpr(plexpr)
  first_arg_name <- rlang::call_args(plexpr)
  mapply(eval(expr(function(UQ(first_arg_name), index) {
    UQ(rlang::call_modify(plexpr, main = quote(paste(title_prefix, as.character(index)))))
  })), dts, indexs)
}

draw_expression_3(raw_normals, sds, hist(x))
draw_expression_3(raw_normals, sds, plot(x, dplyr::percent_rank(x))

But I got weird syntax error:

Error: unexpected '}' in "  }"

Now I don't understand why this happens. Any help?

Also I could not use enquo + eval_tidy here, since enquo will capture the environment of the call expression which is global, but the expression inside the function that I would like to modify and manipulate contains x which belongs to the inner scope. Thus this is not a tidy evaluation. But I am not perusing that anymore. I simply want do macro programming as freely as I can with base R plus some of convenient tools provided by rlang.

NOTE: I am not trying to do any production work. I am just trying to see the limit of this language and understand things better.

Answer 1

I don't know the "tidy evaluation" way to do this, but the simpler base R method is to pass a function rather than an expression. For example,

sds <- c(0.1, 0.5, 5, 100)
raw_normals <- purrr::map(sds, ~rnorm(500, mean = 1, sd = .x))

draws_generic2 <- function(dts, indexs, plfun, title_prefix = 'sd =') {
  mapply(
    function(dt, index) 
    {
      plfun(dt, main = paste(title_prefix, as.character(index)))
    },
    dts, indexs
  )
  invisible(NULL)
}

par(mfrow=c(2,2))
draws_generic2(raw_normals, sds, hist)

draws_generic2(raw_normals, sds, function(dt, ...) plot(dt, dplyr::percent_rank(dt), ...))

^{Created on 2022-04-15 by the reprex package (v2.0.1)}

I used dt in my function definition in the second example, but I could have used any variable name, e.g. this would give the same output except for the axis labels:

draws_generic2(raw_normals, sds, 
               function(x, ...) plot(x, dplyr::percent_rank(x), ...))