创建一个将函数调用作为参数进入可管道函数的函数。

时间:2018-06-11 16:48:13

标签: r metaprogramming lazy-evaluation purrr magrittr

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)

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

有没有办法使我的功能可管理?现在,问题是我调用的任何函数都将在管道之前进行评估。我唯一能想到的是使用一个函数“重新评估”该值,但这似乎不可能。

1 个答案:

答案 0 :(得分:5)

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

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)

这使我的意图更清晰。