如何解析和修改 R 表达式，可能使用非标准评估？答案

【问题标题】：How can I parse and modify an R expression, possibly using non-standard evaluation?如何解析和修改 R 表达式，可能使用非标准评估？
【发布时间】：2016-07-11 03:17:23
【问题描述】：

我想将一个 R 表达式解析为一个列表，并在最终将其转换为 json 对象之前选择性地修改它的各个方面。作为一个例子，我试图达到这样的目的：

{"op": "=",
      "content": {
          "lhs": "gender",
          "rhs": ["male"]
      }
}

我会从一个 R 表达式开始，例如：

gender == "male"

我可以使用pryr::ast 来获取树的文本版本，但我想将其作为列表获取，例如：

op: "=="
  [[1]]: "gender"
  [[2]]: "male"

列表的“格式”的细节不是那么重要，只是为了清楚。我的目标只是获得一个可计算和可修改的 R 表达式解析树。

【问题讨论】：

我认为本问答中的材料会很有用：stackoverflow.com/questions/33419325/… 尽管它不关注表达式的修改。
请注意，pryr 函数通过前置反引号将真正的 R names（又名 symbols）与单纯的字符值区分开来。另请注意，quote 并未真正包含在标签中，但 () 确实替代了它。左括号是 R 解析器的一个重要标记，它本身就是一个函数：is.function(`(`) #[1] TRUE .

标签： r lazy-evaluation pryr

【解决方案1】：

您正在寻找类似的东西吗？

expr <- quote(gender == "male")

expr[[1]]
# `==`
expr[[2]]
# gender
expr[[3]]
# "male"
expr[[3]] <- "female"
expr
# gender == "female"

【讨论】：

一般就是这样。我有一些更复杂的表达式，所以我需要学习如何使用由引号返回的嵌套列表，但我认为这种方法会奏效。

【解决方案2】：

这是您请求的输出部分的一种方法，使用了我评论中引用的方法的修改。这是基于 Hadley 的 pkg:pryr。有关中缀运算符的列表，请参见 ?Ops。我已经在 Hadley 的高级编程文本中看到函数 lhs 和 rhs 定义了 ... IIRC。显然，唯一标记为“ops”的函数将是中缀数学和逻辑，但是可以使用 ?groupGeneric 页面中的其他列表来更完整地标记 Math()、Complex() 和 Summary() 函数：

call_tree2(quote(gender == "male")) # relabeling of items in pryr-functions
#--------
 - call:
   - `op: ==
   - `gender
   -  "male"

函数定义如下：

library(pryr) # also loads the stringr namespace
# although the `tree` function is not exported, you can see it with:
pryr:::tree   # now for some hacking and adding of logic
tree2<-
function (x, level = 1, width = getOption("width"), branch = " - ") 
{
    indent <- str_c(str_dup("  ", level - 1), branch)
    if (is.atomic(x) && length(x) == 1) {
        label <- paste0(" ", deparse(x)[1])
        children <- NULL
    }
    else if (is.name(x)) {
        x <- as.character(x)
        if (x == "") {
            label <- "`MISSING"
        }
        if (x %in% c("+", "-", "*", "/", "^", "%%", "%/%",
"&", "|", "!","==", "!=", "<", "<=", ">=", ">") ) {
             label <- paste0("`op: ", as.character(x))}
        else {
            label <- paste0("`", as.character(x))
        }
        children <- NULL
    }
    else if (is.call(x)) {
        label <- "call:"
        children <- vapply(as.list(x), tree2, character(1), level = level + 
            1, width = width - 3)
    }
    else if (is.pairlist(x)) {
        label <- "[]"
        branches <- paste("", format(names(x)), "=")
        children <- character(length(x))
        for (i in seq_along(x)) {
            children[i] <- tree2(x[[i]], level = level + 1, width = width - 
                3, branch = branches[i])
        }
    }
    else {
        if (inherits(x, "srcref")) {
            label <- "<srcref>"
        }
        else {
            label <- paste0("", typeof(x), "")
        }
        children <- NULL
    }
    label <- str_trunc(label, width - 3)
    if (is.null(children)) {
        paste0(indent, label)
    }
    else {
        paste0(indent, label, "\n", paste0(children, collapse = "\n"))
    }
}
environment(tree2)<-environment(pryr:::tree)

现在用 call_tree2 调用它：

pryr::call_tree
call_tree2 <- 
function (x, width = getOption("width")) 
{
    if (is.expression(x) || is.list(x)) {
        trees <- vapply(x, tree2, character(1), width = width)
        out <- str_c(trees, collapse = "\n\n")
    }
    else {
        out <- tree2(x, width = width)
    }
    cat(out, "\n")
}
environment(call_tree2)<-environment(pryr::call_tree)

【讨论】：