将嵌套列表转换为数据框

Question

目标是将有时包含缺失记录的嵌套列表转换为数据框。当存在缺失记录时，其结构示例如下：

mylist <- list(
  list(
    Hit = "True",
    Project = "Blue",
    Year = "2011",
    Rating = "4",
    Launch = "26 Jan 2012",
    ID = "19",
    Dept = "1, 2, 4"
  ),
  list(Hit = "False", Error = "Record not found"),
  list(
    Hit = "True",
    Project = "Green",
    Year = "2004",
    Rating = "8",
    Launch = "29 Feb 2004",
    ID = "183",
    Dept = "6, 8"
  )
)

当没有缺失记录时，可以使用代码data.frame(do.call(rbind.data.frame, mylist))将列表转换为数据框。然而，当记录缺失时，结果会导致列不匹配。我知道有函数可以合并非匹配列的数据框，但我还没有找到一个可以应用于列表的函数。理想的结果是保留记录2对所有变量的NA值。希望能得到一些帮助。

- Ritchie Sacramento

Answer 1

你也可以在 data.table 包中使用（至少 v1.9.3）的 rbindlist：

library(data.table)

rbindlist(mylist, fill=TRUE)

##      Hit Project Year Rating      Launch  ID    Dept            Error
## 1:  True    Blue 2011      4 26 Jan 2012  19 1, 2, 4               NA
## 2: False      NA   NA     NA          NA  NA      NA Record not found
## 3:  True   Green 2004      8 29 Feb 2004 183    6, 8               NA

- hrbrmstr

---

1.9.4现已在CRAN上发布（尽管可能需要一天时间才能提供剩余的二进制文件）。 - Arun

@hrbrmstr，您是否知道一种可允许非均匀列表结构的解决方法？我遇到了 rbind/rbindlist 的问题，因为它已经期望每个项目是均匀的列表、数据框或数据表，所以无法循环利用。 - msoderstrom

我遇到了这个错误： data.table::rbindlist(mylist, fill = TRUE) 中的错误： 第1项的第3列长度为2，与长度为3的第5列不一致。只有长度为1的列可以被循环使用。 - PM0087

嵌套列表怎么样？ - PM0087

Answer 2

你可以创建一个数据框列表:

dfs <- lapply(mylist, data.frame, stringsAsFactors = FALSE)

然后使用其中之一：

library(plyr)
rbind.fill(dfs)

或更快速的

library(dplyr)
bind_rows(dfs) # in earlier versions: rbind_all(dfs)

对于dplyr::bind_rows函数，让我感到惊讶的是它选择使用""代替NA来表示缺失数据。如果您去除stringsAsFactors = FALSE，您将得到NA，但会有一个警告... 因此，suppressWarnings(rbind_all(lapply(mylist, data.frame)))虽然不美观但是速度较快的解决方案。

- flodel

---

rbind_all()已经被弃用，请使用bind_rows()代替。 - psychonomics

如果在某些行中，某些列缺少数据怎么办？在数据库中只是空的（没有NA或NULL） - PM0087

我遇到了这个错误：Error in (function (..., row.names = NULL, check.rows = FALSE, check.names = TRUE, : arguments imply differing number of rows: 1, 0 - PM0087

Answer 3

我刚刚为这个问题开发了一个解决方案，它也适用于这里，所以我在这里提供它:

tl <- function(e) { if (is.null(e)) return(NULL); ret <- typeof(e); if (ret == 'list' && !is.null(names(e))) ret <- list(type='namedlist') else ret <- list(type=ret,len=length(e)); ret; };
mkcsv <- function(v) paste0(collapse=',',v);
keyListToStr <- function(keyList) paste0(collapse='','/',sapply(keyList,function(key) if (is.null(key)) '*' else paste0(collapse=',',key)));

extractLevelColumns <- function(
    nodes, ## current level node selection
    ..., ## additional arguments to data.frame()
    keyList=list(), ## current key path under main list
    sep=NULL, ## optional string separator on which to join multi-element vectors; if NULL, will leave as separate columns
    mkname=function(keyList,maxLen) paste0(collapse='.',if (is.null(sep) && maxLen == 1L) keyList[-length(keyList)] else keyList) ## name builder from current keyList and character vector max length across node level; default to dot-separated keys, and remove last index component for scalars
) {
    cat(sprintf('extractLevelColumns(): %s\n',keyListToStr(keyList)));
    if (length(nodes) == 0L) return(list()); ## handle corner case of empty main list
    tlList <- lapply(nodes,tl);
    typeList <- do.call(c,lapply(tlList,`[[`,'type'));
    if (length(unique(typeList)) != 1L) stop(sprintf('error: inconsistent types (%s) at %s.',mkcsv(typeList),keyListToStr(keyList)));
    type <- typeList[1L];
    if (type == 'namedlist') { ## hash; recurse
        allKeys <- unique(do.call(c,lapply(nodes,names)));
        ret <- do.call(c,lapply(allKeys,function(key) extractLevelColumns(lapply(nodes,`[[`,key),...,keyList=c(keyList,key),sep=sep,mkname=mkname)));
    } else if (type == 'list') { ## array; recurse
        lenList <- do.call(c,lapply(tlList,`[[`,'len'));
        maxLen <- max(lenList,na.rm=T);
        allIndexes <- seq_len(maxLen);
        ret <- do.call(c,lapply(allIndexes,function(index) extractLevelColumns(lapply(nodes,function(node) if (length(node) < index) NULL else node[[index]]),...,keyList=c(keyList,index),sep=sep,mkname=mkname))); ## must be careful to translate out-of-bounds to NULL; happens automatically with string keys, but not with integer indexes
    } else if (type%in%c('raw','logical','integer','double','complex','character')) { ## atomic leaf node; build column
        lenList <- do.call(c,lapply(tlList,`[[`,'len'));
        maxLen <- max(lenList,na.rm=T);
        if (is.null(sep)) {
            ret <- lapply(seq_len(maxLen),function(i) setNames(data.frame(sapply(nodes,function(node) if (length(node) < i) NA else node[[i]]),...),mkname(c(keyList,i),maxLen)));
        } else {
            ## keep original type if maxLen is 1, IOW don't stringify
            ret <- list(setNames(data.frame(sapply(nodes,function(node) if (length(node) == 0L) NA else if (maxLen == 1L) node else paste(collapse=sep,node)),...),mkname(keyList,maxLen)));
        }; ## end if
    } else stop(sprintf('error: unsupported type %s at %s.',type,keyListToStr(keyList)));
    if (is.null(ret)) ret <- list(); ## handle corner case of exclusively empty sublists
    ret;
}; ## end extractLevelColumns()
## simple interface function
flattenList <- function(mainList,...) do.call(cbind,extractLevelColumns(mainList,...));

执行：

## define data
mylist <- list(structure(list(Hit='True',Project='Blue',Year='2011',Rating='4',Launch='26 Jan 2012',ID='19',Dept='1, 2, 4'),.Names=c('Hit','Project','Year','Rating','Launch','ID','Dept')),structure(list(Hit='False',Error='Record not found'),.Names=c('Hit','Error')),structure(list(Hit='True',Project='Green',Year='2004',Rating='8',Launch='29 Feb 2004',ID='183',Dept='6, 8'),.Names=c('Hit','Project','Year','Rating','Launch','ID','Dept')));

## run it
df <- flattenList(mylist);
## extractLevelColumns():
## extractLevelColumns(): Hit
## extractLevelColumns(): Project
## extractLevelColumns(): Year
## extractLevelColumns(): Rating
## extractLevelColumns(): Launch
## extractLevelColumns(): ID
## extractLevelColumns(): Dept
## extractLevelColumns(): Error

df;
##     Hit Project Year Rating      Launch   ID    Dept            Error
## 1  True    Blue 2011      4 26 Jan 2012   19 1, 2, 4             <NA>
## 2 False    <NA> <NA>   <NA>        <NA> <NA>    <NA> Record not found
## 3  True   Green 2004      8 29 Feb 2004  183    6, 8             <NA>

我的函数比1.9.6版本的data.table::rbindlist()更加强大，因为它可以处理任意层级的嵌套和不同长度的向量。在相关问题中，我的函数能够正确地将OP的列表展平为数据框，但是data.table::rbindlist()会出现错误："Error in rbindlist(jsonRList, fill = T) : Column 4 of item 16 is length 2, inconsistent with first column of that item which is length 1. rbind/rbindlist doesn't recycle as it already expects each item to be a uniform list, data.frame or data.table"。

- bgoldst

---

哇，终于找到了解决我面临的列表类型扁平化的方法。谢谢。 - jcarlos

在一个复杂的列表上尝试了这个操作，结果出现了错误：extractLevelColumns(lapply(nodes, function(node) if (length(node) < : error: inconsistent types () at /V1/2. - dca

@GabrielFair（以及@dca），如果您发布列表的链接（例如在GitHub上），那么我可能能够对我的代码进行调试和改进，以处理您的列表，或者至少改进错误消息以使其更加描述/清晰。 - bgoldst

谢谢，抱歉我应该更清楚。我遇到了你在帖子底部提到的无法展开OP列表的相同错误。如果我自己无法解决这个问题，我会创建一个新的SO问题。再次感谢。 - Gabriel Fair

我也遇到了一个错误：Error in extractLevelColumns(lapply(nodes, [[, key), ..., keyList = c(keyList, : error: inconsistent types - JLC

你能否编写一个完整的打平事物的包？这太棒了，谢谢。 - gladys_c_hugh

Answer 4

这里有一个解决方案，可以将任何嵌套/不均匀的列表转换为数据框。对于许多情况，特别是列表中包含列表的情况，rbindlist无法胜任。所以我必须创建比rbindlist更好的东西。

rbindlist.v2 <- function(l)
{
   l <- l[lapply(l, class) == "list"]
   df <- foreach(element = l, .combine = bind_rows, .errorhandling = 'remove') %do%
         {df = unlist(element); df = as.data.frame(t(df)); rm(element); return(df)}
   rm(l)
   return(df)
}

对于大型列表，您可以通过将%do%替换为%dopar%来加快处理过程。这也是我个人案例所需要的。

- ishonest

---

这个函数非常酷。你能不能请友好地解释一下这个函数是如何工作的？我试图理解它的工作原理，但对我来说并不十分简单。 - Jakub.Novotny

%do% 函数定义在哪里？ - Ben

%do% 运算符似乎来自 foreach 库。无论如何，在我的情况下代码不起作用 - 它生成了一行超过 489,000 列的数据。 - anpami

Answer 5

替代 @ishonest：

df <- purrr::map_dfr(l,function(y){
  y[[1]]
})

这里有一些其他方法，取决于列表的嵌套方式：

列表中包含列表

df <- purrr::map_dfr(r,function(x){
    unlist(x)
})

如果嵌套列表更加复杂，其中一些元素是列表：

format_json_list <- function(r){
  purrr::map_dfr(r,function(x){
    #Base object, e.g. Vessel info
    b <- x[[1]]
    # object's events, e.g. paces Vessel visited 
    df <- purrr::map_dfr(x[[2]],function(y){
        v <- y[[1]]
        p <- y[2:length(y)]
        dplyr::bind_cols(v,p)
    })
    dplyr::bind_cols(b,df)
  })
}

对于一些复杂的 JSON，重复变量命名可能会成为一个问题。其中一种解决方法是指定命名。下面的代码是硬编码名称。我认为这可以做到动态。

purrr::map_dfr(vo, function(vessels){
      if(is.list(vessels)){
        vinfo <- purrr::map_dfr(vessels, function(vessel){
          if(!is.list(vessel)){
            #print(vessel)
            vessel
          }
        }) %>%  dplyr::rename_all(~ paste0("Vessel.", .))
        calinfo <- purrr::map_dfr(vessels$Callings, function(calling){
          if(is.list(calling)){
            call <- purrr::map_dfr(calling, function(call){
              if(!is.list(call)){
                call
              }
            })
            callport <- purrr::map_dfr(calling$Port, function(port){
              if(!is.list(port)){
                port
              }
            }) %>% dplyr::rename_all(~ paste0("Port.", .))
            dplyr::bind_cols(call, callport)
          }
        }) %>%  dplyr::rename_all(~ paste0("Calling.", .))
        bind_cols(vinfo, calinfo)
      } 
    }, .id ="Vessel" ) 
  })

- Aaron C

Answer 6

如果你喜欢purrr：

> te <- list(structure(list(Hit = "True", Project = "Blue", Year = "2011", 
Rating = "4", Launch = "26 Jan 2012", ID = "19", Dept = "1, 2, 4"), .Names = c("Hit", "Project", "Year", "Rating", "Launch", "ID", "Dept")), structure(list(
Hit = "False", Error = "Record not found"), .Names = c("Hit", 
"Error")), structure(list(Hit = "True", Project = "Green", Year = "2004", 
Rating = "8", Launch = "29 Feb 2004", ID = "183", Dept = "6, 8"), .Names = c("Hit", "Project", "Year", "Rating", "Launch", "ID", "Dept")))

> str(te)
List of 3
 $ :List of 7
  ..$ Hit    : chr "True"
  ..$ Project: chr "Blue"
  ..$ Year   : chr "2011"
  ..$ Rating : chr "4"
  ..$ Launch : chr "26 Jan 2012"
  ..$ ID     : chr "19"
  ..$ Dept   : chr "1, 2, 4"
 $ :List of 2
  ..$ Hit  : chr "False"
  ..$ Error: chr "Record not found"
 $ :List of 7
  ..$ Hit    : chr "True"
  ..$ Project: chr "Green"
  ..$ Year   : chr "2004"
  ..$ Rating : chr "8"
  ..$ Launch : chr "29 Feb 2004"
  ..$ ID     : chr "183"
  ..$ Dept   : chr "6, 8"
> purrr::map_dfr(te,as_tibble)
# A tibble: 3 × 8
  Hit   Project Year  Rating Launch      ID    Dept    Error           
  <chr> <chr>   <chr> <chr>  <chr>       <chr> <chr>   <chr>           
1 True  Blue    2011  4      26 Jan 2012 19    1, 2, 4 NA              
2 False NA      NA    NA     NA          NA    NA      Record not found
3 True  Green   2004  8      29 Feb 2004 183   6, 8    NA

   

- Fredrik Karlsson