如何修正R语言functionTree函数以正确打印带缩进的表达式树

问题描述 #

需要编写一个functionTree函数，接收R表达式并按树形打印结构，满足以下要求：

• 赋值运算符（<-）在深度0显示，类型为function:special
• 赋值左侧部分在深度0显示
• 赋值右侧的函数调用在深度1显示，其中函数名显示为function:closure
• 函数调用的参数在深度1显示，类型为atom

原代码输出不符合预期，当前输出：

0 (function:special) -> x <- f(5)
0 (symbol) -> <-
0 (symbol) -> x
  1 (function:closure) -> f(5)
    2 (symbol) -> f
    2 (atom) -> 5
[[1]]
NULL

期望输出：

0 (function:special) -> <-
  0 (symbol) -> x
  1 (function:closure) -> f
    1 (atom) -> 5

修正后的代码 #

functionTree <- function(expr, eframe = globalenv(), maxDepth = 3, closureRecursive = FALSE, depth = 0, indentLevel = 0) {
  # Helper function to determine the type description
  getTypeDescription <- function(expr) {
    if (is.symbol(expr)) {
      # Check if the symbol points to a closure function
      sym_name <- as.character(expr)
      if (exists(sym_name, envir = eframe, inherits = TRUE)) {
        sym_val <- get(sym_name, envir = eframe, inherits = TRUE)
        if (is.function(sym_val) && is.closure(sym_val)) {
          return("function:closure")
        }
      }
      return("symbol")
    } else if (is.call(expr)) {
      funcName <- as.character(expr[[1]])
      if (funcName %in% c("<-", "=")) {
        return("function:special")
      } else if (funcName == "function") {
        return("function:closure")
      } else {
        return("function:call")
      }
    } else if (is.atomic(expr) && length(expr) == 1) {
      return("atom")
    } else {
      return("unknown")
    }
  }
  
  # Function to print the current expression and its type
  printExpression <- function(expr, depth, indentLevel) {
    indent <- paste(rep(" ", indentLevel * 2), collapse = "")
    typeDescription <- getTypeDescription(expr)
    exprDescription <- deparse(expr)
    if (length(exprDescription) > 1) {
      exprDescription <- exprDescription[1]
    }
    if (nchar(exprDescription) == 0) {
      exprDescription <- "<empty>"
    }
    cat(indent, depth, " (", typeDescription, ") -> ", exprDescription, "\n", sep = "")
  }
  
  # Base case: Stop the recursion if the maximum depth is exceeded
  if (depth > maxDepth) {
    return(invisible())
  }
  
  # Handle assignment calls first
  if (is.call(expr)) {
    funcName <- as.character(expr[[1]])
    if (funcName %in% c("<-", "=")) {
      # Print assignment operator at depth 0, indent 0
      printExpression(expr[[1]], 0, 0)
      # Print left-hand side at depth 0, indent 1
      functionTree(expr[[2]], eframe, maxDepth, closureRecursive, 0, indentLevel + 1)
      # Print right-hand side with adjusted depth and indent
      functionTree(expr[[3]], eframe, maxDepth, closureRecursive, 1, indentLevel + 1)
      return(invisible())
    } else {
      # For function calls, print the function symbol first
      printExpression(expr[[1]], depth, indentLevel)
      # Print arguments with depth same as function, indent +1
      for (sub_expr in expr[-1]) {
        functionTree(sub_expr, eframe, maxDepth, closureRecursive, depth, indentLevel + 1)
      }
      return(invisible())
    }
  }
  
  # Print non-call expressions directly
  printExpression(expr, depth, indentLevel)
}

# Example usage
f <- function(n = 0) { n ^ 2 }
a <- quote(x <- f(5))

functionTree(a)

修改说明 #

1. 拆分深度与缩进层级：新增indentLevel参数单独控制缩进，解决深度显示与缩进不一致的需求（比如赋值左侧深度0但需要缩进）。
2. 移除默认表达式打印：删除函数开头的printExpression(expr, depth)，避免输出整个赋值语句x <- f(5)。
3. 优化赋值语句处理：直接打印赋值运算符<-，再分别处理左值（深度0，缩进+1）和右值（深度1，缩进+1）。
4. 修正函数类型判断：针对symbol类型，检查其指向的环境对象是否为closure函数，确保f被识别为function:closure。
5. 重构函数调用处理：不打印整个函数调用表达式（如f(5)），直接提取函数符号打印，参数使用相同深度但增加缩进。
6. 替换lapply为for循环：避免输出多余的NULL返回值，保持输出整洁。

内容的提问来源于stack exchange，提问作者bik