如何让bind_rows的.id参数保留嵌套列表中tibble的对象名称？

我正在处理一个大型嵌套tibble列表，此前已解决部分问题，但在转换为可用DataFrame的最后一步遇到阻碍。我希望生成的DataFrame包含id列，显示列表中tibble的对象名称，但使用bind_rows(.id='id')时，该列仅生成数字索引而非对象名称。

简化示例代码 #

a <- tibble (a=numeric(7),
           b=letters[7:1],
           c=integer(length=1))

b <- tibble (a=integer(length=1),
           b=as.numeric(8),
           c=letters[7:1])


c <- tibble(.rows = 2)

A <- list(list(a,b,c))
B <- list(A,list(a,b,c)) 
C <- list(A,B)

riddle <- list(A,B,C)

当前处理代码（id列为数字索引） #

rrapply(riddle, condition = function(x) all(dim(x)>0),  
        f =  function(x) 
        {
          # 重命名为唯一列名
          names(x) <- make.unique(names(x))
          x %>%  
            # 若列表元素列类型不匹配，将所有列转为字符型
            mutate(across(everything(), as.character))
        },      classes = "data.frame", how= "flatten") %>% 
  # 将扁平化后的data.frame/tibble合并为单个数据集
  bind_rows(.id="id") %>%
  # 转换列类型
  type.convert(as.is = TRUE) 

解决方案 #

核心问题原因 #

你当前的嵌套列表（如A <- list(list(a,b,c))）中的tibble元素是匿名的，rrapply扁平化后无法追踪原始对象名称，导致bind_rows(.id="id")只能生成数字索引。要解决这个问题，需要先给嵌套列表中的每个tibble元素添加名称，再通过rrapply的melt模式保留名称路径。

方案1：重构带名称的嵌套列表（推荐） #

如果可以重新构建原始列表，直接为每个tibble元素赋予名称，后续处理会更简单：

# 给基础tibble构建带名称的列表
a_named <- list("a" = tibble (a=numeric(7), b=letters[7:1], c=integer(length=1)))
b_named <- list("b" = tibble (a=integer(length=1), b=as.numeric(8), c=letters[7:1]))
c_named <- list("c" = tibble(.rows = 2))

# 构建带名称的嵌套列表
A <- list(a_named, b_named, c_named)
B <- list(A, a_named, b_named, c_named) 
C <- list(A, B)

riddle_named <- list(A, B, C)

# 处理并保留名称
rrapply(riddle_named, 
        condition = function(x) all(dim(x)>0),  
        f =  function(x) {
          names(x) <- make.unique(names(x))
          x %>% mutate(across(everything(), as.character))
        },      
        classes = "data.frame", 
        how= "melt") %>%
  # 从路径中提取tibble的原始名称（最后一级路径）
  mutate(id = sapply(LIST, function(path) tail(path, 1))) %>%
  # 移除路径列，合并数据
  select(-LIST) %>%
  bind_rows() %>%
  # 转换列类型
  type.convert(as.is = TRUE)

方案2：为现有匿名列表添加名称 #

如果无法修改原始riddle列表，可通过递归遍历，根据tibble的特征为其匹配并添加原始名称：

# 递归为嵌套列表中的tibble添加名称
add_names <- function(x) {
  if (is.data.frame(x)) {
    # 根据tibble的特征匹配原始名称
    if (nrow(x) ==7 && all(colnames(x) == c("a","b","c"))) {
      return(list("a" = x))
    } else if (nrow(x) ==7 && x$b[1] == 8) {
      return(list("b" = x))
    } else if (nrow(x) ==2 && ncol(x)==0) {
      return(list("c" = x))
    }
  } else if (is.list(x)) {
    lapply(x, add_names)
  } else {
    x
  }
}

# 为原始列表添加名称
riddle_named <- add_names(riddle)

# 后续处理同方案1
rrapply(riddle_named, 
        condition = function(x) all(dim(x)>0),  
        f =  function(x) {
          names(x) <- make.unique(names(x))
          x %>% mutate(across(everything(), as.character))
        },      
        classes = "data.frame", 
        how= "melt") %>%
  mutate(id = sapply(LIST, function(path) tail(path, 1))) %>%
  select(-LIST) %>%
  bind_rows() %>%
  type.convert(as.is = TRUE)

关键说明 #

• 使用rrapply的how="melt"模式，会返回包含每个元素路径（LIST列）的结果，路径中包含我们添加的对象名称。
• 通过sapply(LIST, function(path) tail(path, 1))提取路径的最后一级，即可得到tibble的原始对象名称，作为id列的值。

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