as.character 从解析的 R 脚本中删除反引号

Question

我正在搜索 R 脚本，但不确定为什么as.character()删除`[`. 有什么方法可以将代码作为字符串向量正确返回吗？

注意 `[`(. < 5)变成(. < 5)[]

注意：我不是在寻找更好的方法来进行这个调用，因为这不是我的代码。

code <- 
  "1:10 %>% `[`(. < 5) %>% mean()
   a <- 1:3"

# fine
parse(text = code)
#> expression(1:10 %>% `[`(. < 5) %>% mean(), a <- 1:3)

# not fine
as.character(parse(text = code))
#> [1] "1:10 %>% (. < 5)[] %>% mean()" 
#> [2] "a <- 1:3"

^{由reprex 包(v0.3.0)于 2020 年 7 月 1 日创建}

问题是我需要替换掉部分代码，以便我的函数工作。该函数查找反应命令并将它们更改为用户可以在其环境中访问的函数。它是我的Shinyobjects包（无耻插件）的一部分。

a <- reactive({
  input$n * 100
})

并将其转换为

a <- function() {
  input$n *100
}

我一直使用的方法一直很好，直到`[`.

解决方案应该能够将每个表达式作为我可以操作的东西返回。这是一个更复杂的例子，应该返回一个长度为 5 的字符串向量。我也很高兴将这个讨论脱机，因为我对这个功能的整体方法持开放态度。你可以在这里找到我的联系方式

code <- 
'library(tidyverse)
library(shiny)

1:10 %>% `[`(. < 5) %>% mean()

df <- reactive({
  mpg %>% 
  filter(cty > input$cty)
})

renderPlot(
  ggplot(df(), aes(class)) +
  geom_bar()
)'  

Answer 1

（我对此进行了一些编辑以进一步解释这种行为）：

问题是magrittr的管道运算符不一致地使用非标准评估。

表达方式

`[`(. < 5)

是合法的 R 代码，相当于被解析的代码：

 (. < 5)[]

然而，这是一个足够奇怪的表达，magrittr被它弄糊涂了，并且不会变形

 1:10 %>% (. < 5)[] 

以同样的方式转变

 1:10 %>% `[`(. < 5)

我不会将其称为错误magrittr（如果您仔细观察，它是记录在案的行为），但这肯定是由点的不一致处理引起的不便。通常，如果您将一个点放在一个magrittr链中的术语中，那是前一个结果被放入的唯一位置。例如，这不会打印“foobar”两次：

"foobar" %>% cat("arg1", ., "arg3")

但是，如果点在链中的函数调用中，它也会插入到开头：

"foobar" %>% cat("arg1", identity(.), "arg3")

确实打印了两次。

magrittr正在评估1:10 %>% [(. < 5)作为

`[`(1:10, 1:10 < 5)

IE

(1:10)[1:10 < 5]

真的为了一致性，它需要你输入

1:10 %>% `[`(., . < 5)

但它试图提供帮助，这对您想做的事情毫无帮助。

我想您可以编写一个函数来自己检测这些情况，并显式插入额外的点。

编辑添加：这是这样一个功能：

explicitDots <- function(expr) {
  nestedDot <- function(lang) {
    if (is.call(lang)) {
      for (i in seq_along(lang)) {
        if (nestedDot(lang[[i]]))
          return(TRUE)
      }
      return(FALSE)
    } else 
      identical(lang, quote(.))
  }
  fixLang <- function(lang) {
    if (is.call(lang)) {
      fn <- lang[[1]]
      if (as.character(fn) == "%>%") {
        lang[[2]] <- fixLang(lang[[2]])
        lang[[3]] <- fixLang(lang[[3]])
      } else {
        hasTopLevelDot <- FALSE
        hasNestedDot <- FALSE
        for (i in seq_along(lang)[-1]) {
          if (identical(lang[[i]], quote(.))) {
            hasTopLevelDot <- TRUE
            break
          }
          hasNestedDot <- hasNestedDot || nestedDot(lang[[i]])
        }
        if (hasNestedDot && !hasTopLevelDot) {
          # Insert a dot in position 2
          lang <- lang[c(1,seq_along(lang))]
          lang[[2]] <- quote(.)
        }
      }
    }
    lang
  }
  expr <- removeSource(expr)
  for (i in seq_along(expr)) {
    expr[[i]] <- fixLang(expr[[i]])
  }
  expr
}

这是一个使用它的例子：

code <- 
  "1:10 %>% `[`(. < 5) %>% mean()
   a <- 1:3"

p <- parse(text = code)
explicitDots(p)

产生了这个输出：

expression(1:10 %>% .[. < 5] %>% mean(), a <- 1:3)