r元编程：将表达式/quosure传递到部分访问本地框架的功能

Question

我将使用以下示例来解释我的问题。但是问题不仅是关于这个特定示例的，而且更笼统地介绍了R中

。

编程

draw_hists <- function(dts, indexs, title_prefix = 'sd = ') {
  mapply(
    function(dt, index) 
    {
      hist(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_hists(raw_normals, sds)

的 。

​

​对原始数据进行排名

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)

现在假设我想抽象这些功能的一般模式，并定义一个通用的高阶函数，该功能将任何任意绘图函数及其参数作为表达式输入以灵性几乎绘制了我想绘制的任何内容。我认为这样的事情会起作用。

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

正式参数plfun_arguments_as_expr将绑定到诸如expr（dplyr :: percent_rank（dt））之类的表达式，以使绘图真正通用和灵活性。我想出以下解决方案。

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))

直方图起作用。但是

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")

我认为这可能与enquos捕获的环境范围是全局的事实，但该表达式包含名称dt由匿名函数函数（DT，index）创建的本地范围中存在绑定。这确实是此错误的原因吗？如果是这样，是否有一种整洁而干净的方法可以遵循“整洁评估”的原则？

更新

受评论启发的 ，我在这里修改了我的问题。再过，我真正想要的是使用纯粹的功能抽象来概括过程，是通过将代码作为对象作为对象并在R函数或类型的宏观编程中自由操纵来实现概括。更确切地说，我想要的是draw_expression函数，可以针对给定表达式绘制数据，而不是以前的draw_generic。以下是我到目前为止的一些尝试：

第一版将绘图表达式用x作为数据参数反对给定数据的数据参数，而没有其他indexs参数和标题。该代码已测试工作。

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))

第二版通过修改给定表达式来添加其他索引参数和标题。该代码已测试工作。

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))

第三版旨在允许呼叫表达式具有任何任意的形式参数名称，而不是x。释放假设是第一个参数对应于要绘制的数据，但是可以将其命名为任何用户。

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))

这会打印我错误：

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

显然first_arg_name必须在表达式中引用。因此，我这样做了：

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))

但是我发现了怪异的语法错误：

Error: unexpected '}' in "  }"

现在我不明白为什么会发生这种情况。有帮助吗？

另外，我不能使用enquo + evar_tidy在这里，因为enquo将捕获全局的呼叫表达式的环境，但是我想修改和操作的功能包含属于内部范围的x。因此，这不是一个整洁的评估。但是我不再仔细阅读了。我只是想尽可能自由地进行宏观编程，以及rlang提供的一些方便工具。

注意：我不是要进行任何生产工作。我只是想看到这种语言的极限，并更好地理解事物。

Answer 1

我不知道执行此操作的“整洁评估”方法，但是简单的基础方法是传递函数而不是表达式。例如，

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), ...))

“”>

^由

我在第二个示例的功能定义中使用了dt，但是我本可以使用任何变量名称，例如，这将给出相同的输出，除了轴标签：

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