将一个将函数调用作为参数的函数制作成可管道函数。答案

【问题标题】：Making a function that takes a function call as an argument into a pipeable function.将一个将函数调用作为参数的函数制作成可管道函数。
【发布时间】：2023-03-29 10:51:01
【问题描述】：

require(magrittr)
require(purrr)

is.out.same <- function(.call, ...) {
  ## Checks if args in .call will produce identical output in other functions
  call <- substitute(.call)               # Captures function call
  f_names <- eval(substitute(alist(...))) # Makes list of f_names


  map2(rep(list(call), length(f_names)),  # Creates list of new function calls
       f_names,
       function(.x, .y, i) {.x[[1]] <- .y; return(.x)} 
  ) %>%
    map(eval) %>%                         # Evaluates function calls
    map_lgl(identical, x = .call) %>%     # Checks output of new calls against output of original call 
    all()                                 # Returns TRUE if calls produce identical outputs
}

is.out.same(map(1:3, cumsum), lapply) # This works
map(1:3, cumsum) %>%                  # Is there any way to make this work?
  is.out.same(lapply)

我的函数将函数调用作为参数。

有什么方法可以让我的函数可管道化？现在，问题是我调用的任何函数都将在管道之前进行评估。我唯一能想到的就是使用一个函数来“取消评估”这个值，但这似乎是不可能的。

【问题讨论】：

标签： r metaprogramming lazy-evaluation purrr magrittr

【解决方案1】：

我不建议您实际这样做。管道运算符旨在使将一个函数的输出作为下一个函数的输入传递变得容易。但这根本不是你在这里所做的。您想操纵整个调用堆栈。但从技术上讲，这样做是可行的。你只需要做一些额外的工作来找到链“元数据”来查看最初传入的内容。这里我放入了两个辅助函数来提取相关信息。

find_chain_parts <- function() {
  i <- 1
  while(!("chain_parts" %in% ls(envir=parent.frame(i))) && i < sys.nframe()) {
    i <- i+1
  }
  parent.frame(i)
}

find_lhs <- function(x) {
  env <- find_chain_parts()
  if(exists("chain_parts",env)) {
    return(env$chain_parts$lhs)
  } else {
    return(do.call("substitute", list(substitute(x), parent.frame())))
  }
}

这些函数遍历调用堆栈以找到原始管道调用。如果存在，它将从左侧提取表达式，如果没有，它将仅替换原始参数。您只需更改要使用的功能

is.out.same <- function(.call, ...) {
  call <- find_lhs(.call)                # Captures function call
  f_names <- eval(substitute(alist(...))) # Makes list of f_names

  map2(rep(list(call), length(f_names)),  # Creates list of new function calls
       f_names,
       function(.x, .y, i) {.x[[1]] <- .y; return(.x)} 
  )  %>% 
    map(eval) %>%                         # Evaluates function calls
    map_lgl(identical, x = .call) %>%     # Checks output of new calls against output of original call 
    all()                                 # Returns TRUE if calls produce identical outputs
}

然后这两个都会运行

is.out.same(map(1:3, cumsum), lapply)
# [1] TRUE 
map(1:3, cumsum) %>%                  
  is.out.same(lapply)
# [1] TRUE

但是，如果您真的要测试表达式的功能等价性，那么传入 quosures 会更有意义。那么你就不需要不同的分支了。这样的函数看起来像这样

library(rlang)
is.out.same <- function(call, ...) {
  f_names <- eval(substitute(alist(...))) # Makes list of f_names

  map2(rep(list(call), length(f_names)),  # Creates list of new function calls
       f_names,
       function(.x, .y, i) {.x[[2]][[1]] <- .y; return(.x)} 
  )  %>% 
    map(eval_tidy) %>%                         # Evaluates function calls
    map_lgl(identical, x = eval_tidy(call)) %>%     # Checks output of new calls against output of original call 
    all()                                 # Returns TRUE if calls produce identical outputs
}

您可以将其称为以下方式之一

is.out.same(quo(map(1:3, cumsum)), lapply) 

quo(map(1:3, cumsum)) %>%
  is.out.same(lapply)

在我看来，这使意图更加清晰。

【讨论】：