将以函数调用作为参数的函数转换为可调用的函数。

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 

但是如果你真的在测试表达式的功能等价性，那么传递商就更有意义了。那你就不需要不同的分支了。这样的函数应该如下所示

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)

这使我的意图更加明确。