r - 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 package 创建于 2020-07-01 (v0.3.0)}

问题是我需要替换掉部分代码，这样我的函数才能正常工作。该函数找到响应式命令并将它们更改为供用户在其环境中访问的函数。这是我的一部分 shinyobjects包(不要脸的外挂)。

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

并将其转换为

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

在 `[` 的这种边缘情况之前，我一直使用的方法一直很好.

解决方案应该能够将每个表达式作为我可以操纵的东西返回。这是一个更复杂的示例，应该返回一个长度为 5 的字符串向量。我也很高兴将此讨论离线进行，因为我愿意为该功能提供一个总体上更好的方法。你可以找到我的联系方式here

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)

即

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