更快的替代 deparse()

Question

我维护一个依赖于重复调用的包deparse(control = c("keepNA", "keepInteger"))。control总是一样的，表达方式各不相同。deparse()似乎花了很多时间反复解释相同的选项集.deparseOpts()。

microbenchmark::microbenchmark(
    a = deparse(identity, control = c("keepNA", "keepInteger")),
    b = .deparseOpts(c("keepNA", "keepInteger"))
)
# Unit: microseconds
# expr min  lq  mean median  uq  max neval
#    a 7.2 7.4 8.020    7.5 7.6 55.1   100
#    b 3.0 3.2 3.387    3.4 3.5  6.0   100

在某些系统上，冗余.deparseOpts()调用实际上占据了deparse()（此处为火焰图）的大部分运行时间。

我真的很想只调用.deparseOpts()一次，然后将数字代码提供给deparse()，但如果不.Internal()直接调用或调用 C 代码，这似乎是不可能的，从包开发的角度来看，这两种代码都不是最佳的。

deparse
# function (expr, width.cutoff = 60L, backtick = mode(expr) %in% 
#     c("call", "expression", "(", "function"), 
#     control = c("keepNA", "keepInteger", "niceNames", 
#         "showAttributes"), nlines = -1L) 
# .Internal(deparse(expr, width.cutoff, backtick, .deparseOpts(control), 
#     nlines))
# <bytecode: 0x0000000006ac27b8>
# <environment: namespace:base>

有没有方便的解决方法？

Answer 1

1)定义一个函数，该函数生成 deparse 的副本，其环境已重置，以查找 .deparseOpts 的更改版本，该版本已设置为等于恒等函数。然后Run我们运行该函数来创建deparse2并执行它。.Internal这样就避免了直接运行。

make_deparse <- function() {
  .deparseOpts <- identity
  environment(deparse) <- environment()
  deparse
}

Run <- function() {
  deparse2 <- make_deparse()
  deparse2(identity, control = 65)
}

# test
Run()

2)另一种方法是定义一个构造函数，该函数创建一个环境，在其中放置修改后的副本deparse并向该副本添加跟踪，重新定义.deparseOpts为恒等函数。然后返回那个环境。然后我们有一些使用它的函数，在这个例子中，我们创建一个函数Run来演示它，然后执行Run。这避免了必须使用.Internal

make_deparse_env <- function() {
  e <- environment()
  deparse <- deparse
  suppressMessages(
    trace("deparse", quote(.deparseOpts <- identity), print = FALSE, where = e)
  )
  e
}

Run <- function() {
  e <- make_deparse_env()
  e$deparse(identity, control = 65)
}

# test
Run()

3)第三种方法是deparse通过添加一个新参数来重新定义，该新参数设置.deparseOpts为默认值identity并将 的control默认值设置为 65。

make_deparse65 <- function() {
  deparse2 <- function (expr, width.cutoff = 60L, backtick = mode(expr) %in% 
    c("call", "expression", "(", "function"), 
    control = 65, nlines = -1L, .deparseOpts = identity) {}
  body(deparse2) <- body(deparse)
  deparse2
}

Run <- function() {
  deparse65 <- make_deparse65()
  deparse65(identity)
}

# test
Run()