如何在R中输出树状人类可读的对象结构

Question

我经常向我的同行教授 R，并且解释嵌套数据（例如嵌套列表）的结构可能是一项艰巨的任务，我发现创建视觉辅助工具可以走很长的路。

然而，诸如str()之类的函数的输出有很多信息，并不是人类最易读的格式，因此我尝试将此输出格式化，然后将 RegEx 用于更易读的输出。 我经历了一些警告，并且对字符串操作不是很熟练，我希望我能得到一些帮助。

给定以下对象：

object <- list(
    a = 1:5,
    b = matrix(c(1, 3, "a", "i"), byrow = TRUE),
    l1 = list(
        data = data.frame(
            x = letters,
            y = LETTERS
        ),
        vec = "The river",
        l2 = list(
            abc = seq(1, 9, by = 2),
            col = "#445f43"
        )
    ),
    data2 = data.frame(
        x = c("a","h"),
        y = runif(2, 9, 90)
    ),
    rand = runif(12, 99, 120),
    form = y~x^4
)

预期输出将是树渲染：

object                   
├── a 'int'              
├── b 'chr'              
├── l1 'list'            
│   ├── data 'data.frame'
│   │   ├── x 'factor'   
│   │   └── y 'factor'   
│   ├── vec 'chr'        
│   └── l2 'list'        
│       ├── abc 'chr'    
│       └── col 'chr'    
├── data2 'data.frame'   
│   ├── x 'factor'       
│   └── y 'num'          
├── rand 'num'                      
└── form 'formula'          

我想编写一个函数来给出这个输出，并添加一些参数来返回列表元素的长度和其他信息，也许还有颜色编码的类。

编辑：刚刚在这里发现了与我类似的其他问题：和这里：

Answer 1

它可以帮助：

a = Hmisc::list.tree(object, fill = " | ", attr.print = F, size = F, maxlen = 1)     
  

object = list 6
 |  a = integer 5= 1 ...
 |  b = character 4= array 4 X 1= 1  ... 
 |  l1 = list 3
 |  |  data = list 2( data.frame )
 |  |  |  x = character 26= a  ... 
 |  |  |  y = character 26= A  ... 
 |  |  vec = character 1= T 
 |  |  l2 = list 2
 |  |  |  abc = double 5= 1 ...
 |  |  |  col = character 1= # 
 |  data2 = list 2( data.frame )
 |  |  x = character 2= a  ... 
 |  |  y = double 2= 11.16 ...
 |  rand = double 12= 110.91 ...
 |  form = language 3( formula )

Answer 2

我过去曾考虑过实施类似的事情，但从未考虑过。 在您的问题的提示下，我编写了一个函数str2 ，它是您所要求的简单实现。 我相信它可以得到显着改善，但这是一个开始。 它是这样工作的：

> str2(object)
object
│     
├──── a 'integer'  
├──── b 'matrix'  
├──── l1 'list'  
│      ├──── data 'data.frame' 
│      │      ├──── x 'character'
│      │      └──── y 'character'
│      ├──── vec 'character' 
│      └──── l2 'list' 
│             ├──── abc 'numeric'
│             └──── col 'character'
├──── data2 'data.frame'  
│      ├──── x 'character' 
│      └──── y 'numeric' 
├──── rand 'numeric'  
└──── form 'formula'   

它也处理未命名的列表元素：

> str2(list(1:5, list(1, 2)))
list(1:5, list(1, 2))
│     
├──── unnamed 'integer' 
└──── unnamed 'list' 
       ├──── unnamed 'numeric'
       └──── unnamed 'numeric'

并按预期使用数据框：

> str2(mtcars)
mtcars
│     
├──── mpg 'numeric'
├──── cyl 'numeric'
├──── disp 'numeric'
├──── hp 'numeric'
├──── drat 'numeric'
├──── wt 'numeric'
├──── qsec 'numeric'
├──── vs 'numeric'
├──── am 'numeric'
├──── gear 'numeric'
└──── carb 'numeric'

该函数包含 3 个可能可以组合的递归子函数，以及一些可以稍微小心矢量化的低效循环：

str2 <- function(obj)
{
  branch      <- "\u251c\u2500\u2500\u2500\u2500"
  last_branch <- "\u2514\u2500\u2500\u2500\u2500"
  trunk       <- "\u2502     "
  blank       <- "      "
  
  name_list <- function(obj)
  {
    if(is.list(obj))
    {
      o_n <- names(obj)
      if(is.null(o_n)) o_n <- character(length(obj))
      names(obj) <- sapply(seq_along(obj),  
                           function(i) {
                             if(!nzchar(o_n[i])) 
                               paste0("unnamed '", class(obj[[i]])[1], "'")
                             else paste0(o_n[i], " '", class(obj[[i]])[1], "'")
                           })
      obj <- lapply(obj, name_list)
    }
    obj
  }
  
  depth <- function(obj, lev = 0){
    if(!is.list(obj)) lev else list(lev, lapply(obj, depth, lev = lev + 1))
  }
  
  name_strip <- function(obj) {
    o_n <- names(obj)
    lapply(seq_along(o_n), function(i) c(o_n[i], name_strip(obj[[i]])))
  }
  
  obj        <- name_list(obj)
  depths     <- unlist(depth(obj))[-1]
  diffdepths <- c(diff(depths), -1)
  name_els   <- unlist(name_strip(obj))
  
  col1 <- rep(trunk, length(depths))
  col1[depths == 1] <- branch
  col1[max(which(depths == 1))] <- last_branch
  if(max(which(depths == 1)) != length(col1))
    col1[(max(which(depths == 1)) + 1):length(name_els)] <- blank
  for(i in 1:max(depths))
  {
    next_col                          <- character(length(name_els))
    next_col[which(depths == i)]      <- name_els[which(depths == i)]
    next_col[which(depths > (i + 1))] <- trunk
    next_col[which(depths == i + 1)]  <- branch
    next_col[which(depths == i + 1 & 
                   diffdepths < 0)]   <- last_branch
    
    for(j in which(next_col == name_els))
    {
      k <- j - 1
      while(k > 0)
      {
        if(next_col[k] != trunk) {
          if(next_col[k] == branch) next_col[k] <- last_branch
          break}
        next_col[k] <- blank
        k <- k - 1
      }
    }
    col1 <- cbind(col1, next_col)
  }
  col1 <- apply(col1, 1, paste, collapse = " ")
  cat(as.character(as.list(match.call())[-1]), trunk, col1, sep = "\n")
}

Answer 3

我不知道用于您的目的的现成功能。 为了生成列表结构，您需要对列表进行递归。 这是一个快速解决方案（我不打算匹配您的输出，而是给您一个想法）：

list_structure <- function(x,level=1){
  cat(strrep("-",level), "level",level,"\n")
  cat(strrep("-",level), names(x),"==",class(x),"\n")
  for (i in seq_along(x)){
    if (is.list(x[[i]])) {
      list_structure(x[[i]],level+1)
    } else {
      cat(strrep("-",level), names(x[i])," ",class(x[[i]]),"\n")
    }
  }
}

这使：

> list_structure(object)
- level 1 
- a b l1 data2 rand form == list 
- a   integer 
- b   matrix 
-- level 2 
-- data vec l2 == list 
--- level 3 
--- x y == data.frame 
--- x   factor 
--- y   factor 
-- vec   character 
--- level 3 
--- abc col == list 
--- abc   numeric 
--- col   character 
-- level 2 
-- x y == data.frame 
-- x   factor 
-- y   numeric 
- rand   numeric 
- form   formula