r - 制作一个将函数调用作为参数传递给可管道函数的函数。

Question

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)

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

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

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

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