从嵌套列表中提取到数据框答案

【问题标题】：Extracting from Nested list to data frame从嵌套列表中提取到数据框
【发布时间】：2017-01-04 14:59:56
【问题描述】：

我会将我的列表中的dput 放在底部，以便 q 可以重现。输入是a 而不是x。

我有一个名为 x 的大型嵌套列表，我正在尝试从中构建数据框，但无法弄清楚。

我已经完成了第一部分：

for(i in 1:3){a[[i]]<-x$results[[i]]$experiences
indx <- lengths(a)
zz <- as.data.frame(do.call(rbind,lapply(a, `length<-`, max(indx))))}

为此，我使用了以下答案： Converting nested list (unequal length) to data frame

这给我留下了一个带有 n 列结果的 data.frame，其中 n 是任何 i 的最大结果：

  v1   v2   v3
1 NULL NULL NULL
2  *    *    *
3 NULL NULL NULL

每个 * 是另一个嵌套列表，格式为 list(experience = list(duration = ...

例如，第 2 行第 v1 列中的第一个 *。我不想要总清单。我只想要：

a[[2]][[1]]$experience$start

或根据原始列表 x：

x$results[[2]]$experiences[[1]]$experience$start

我觉得我几乎完成了一些调整。我试过了：

for(i in 1:3){a[[i]]<-x$results[[i]]$experiences
indx <- lengths(a)
for(y in 1:length(a[[i]])) aa <- rbind(aa,tryCatch(x$results[[i]]$experiences[[y]]$experience$start, error=function(e) print(NA)))
zz <- as.data.frame(do.call(rbind,lapply(aa, `length<-`, max(indx))))}

导致：

  v1     v2     v3
1  NA     NA     NA
2  NA     NA     NA
3 2014    NA     NA
4 2012    NA     NA
5 2006    NA     NA
6  NA     NA     NA
7  NA     NA     NA

在最后一行尝试使用 cbind 而不是 rbind 并将所有日期放在第一行。

我还尝试了以下方法：

for(i in 1:3){a[[i]]<-lengths(x$results[[i]]$experiences)
  indx <- lengths(a)
for(y in 1:length(indx)){tt[i] <- tryCatch(x$results[[i]]$experiences[[y]]$experience$start, error=function(e) print(""))}
zz <- as.data.frame(do.call(rbind,lapply(tt, `length<-`, max(indx))))}

这很接近，构建了正确的格式，但只返回第一个结果：

  v1   v2  v3
1 NA   NA  NA
2 2014 NA  NA
3 NA   NA  NA

我想要的格式是：

 V1  V2  V3
1 NA  NA  NA
2 2014 2012 2006
3 NA  NA  NA

((样本数据现在在底部))

最新尝试：

执行以下操作，但仅返回每个 a[[i]] 的第一个开始日期，第二个循环我需要使列表 aa[i][y] 有所不同。

 for(i in 1:3){a[[i]]<-x$results[[i]]$experiences
 for(y in 1:length(a[[i]])){aa[i][y] = if(is.null(a[[i]][[y]]$experience$start)){"NULL"}else{a[[i]][[y]]$experience$start}}}

所以对于dput2，我想要这个表格：

  v1    v2  v3   v4   v5   v6   v7   v8
1 2015
2 2011 2007 null null null null null null
3 2016 2015 2015 2015 2013 2010

我不介意空格是 null 还是 na

更新

下面的答案几乎可以工作，但是在我的数据中，结构发生了变化，名称的顺序（角色名称、持续时间等）发生了变化，从而破坏了答案，因为cumsum 用于确定何时找到新列表。如果您有duration，则start 的键是9 和1，cumsum 部分将它们标记为两个不同的列表。

我写了以下内容：

my.list <- list(structure(
  list(
    experience = structure(
      list(
        start = "1",
        end = "1",
        roleName = "a",
        summary = "a",
        duration = "a",
        current = "a",
        org = structure(list(name = "a", url = "a"), .Names = c("name","url")),
        location = structure(
          list(
            displayLocation = NULL,
            lat = NULL,
            lng = NULL
          ),
          .Names = c("displayLocation",
                     "lat", "lng")
        ) ),.Names = c("start", "end", "roleName", "summary", "duration", "current", "org", "location")),
    `_meta` = structure(
      list(weight = 1L, `_sources` = list(structure(
        list(`_origin` = "a"), .Names = "_origin"
      ))),.Names = c("weight", "_sources"))),.Names = c("experience", "_meta")))

然后：

aa <- lapply(1:length(a), function(y){tryCatch(lapply(1:length(a[[y]]), 
                     function(i){a[[y]][[i]]$experience[names(my.list2[[1]]$experience)]}), error=function(e) print(list()))})

这会改变结构，使key2 始终处于正确的顺序。

然而，在这个循环之后我发现我有另一个问题。

有时我在体验列表中只有一个角色名。如果连续发生两次，则重复键。 cumsum 将它们视为相同的体验，而不是单独的体验。

这意味着我无法创建 df3，因为行的标识符重复。即使我可以通过删除麻烦的行，名称也不会匹配，因为下面的解决方案中的i 匹配使用序列的名称，如果我删除任何更改长度的行。

这是我的总代码，以获得更多洞察力：

for(i in 1:x$count){a[[i]]<-x$results[[i]]$experiences}

  aa <- lapply(1:length(a), function(y){tryCatch(lapply(1:length(a[[y]]), 
                     function(i){a[[y]][[i]]$experience[names(my.list2[[1]]$experience)]}), error=function(e) print(list()))})

  aaa <- unlist(aa)
  dummydf <- data.frame(b=c("start", "end", "roleName", "summary", 
                            "duration", "current", "org.name",  "org.url"), key=1:8)

  df <- data.frame(a=aaa, b=names(aaa))
  df2 <- left_join(df, dummydf)
  df2$key2 <- as.factor(cumsum(df2$key < c(0, df2$key[-length(df2$key)])) +1)

  df_split <- split(df2, df2$key2)
  df3 <- lapply(df_split, function(x){
    x %>% select(-c(key, key2)) %>% spread(b, a)
  }) %>% data.table::rbindlist(fill=TRUE) %>% t
  df3 <- data.frame(df3)
  i <- sapply(seq_along(aa), function(y) rep(y, sapply(aa, function(x) length(x))[y])) %>% unlist
  names(df3) <- paste0(names(df3), "_", i)
  df4 <- data.frame(t(df3))
  df4$dates <- as.Date(NA)
  df4$dates <- as.Date(df4$start)
  df4 <- data.frame(dates = df4$dates)
  df4 <- t(df4)
  df4 <- data.frame(df4)
  names(df4) <- paste0(names(df4), "_", i)
  df4[] <- lapply(df4[], as.character)
  l1 <- lapply(split(stack(df4), sub('.*_', '', stack(df4)[,2])), '[', 1)
  df5 <- t(do.call(cbindPad, l1))
  df5 <- data.frame(df5)

cbindpad 取自this question

包含问题的新示例代码：

dput3 = 
list(list(), list(
structure(list(experience = structure(list(
  duration = "1", start = "2014", 
  end = "3000", roleName = "a", 
  summary = "aaa", 
  org = structure(list(name = "a"), .Names = "name"), 
  location = structure(list(displayLocation = NULL, lat = NULL, 
    lng = NULL), .Names = c("displayLocation", "lat", "lng"
    ))), .Names = c("duration", "start", "end", "roleName", "summary", 
    "org", "location")), `_meta` = structure(list(weight = 1L, `_sources` = list(
      structure(list(`_origin` = ""), .Names = "_origin"))), .Names = c("weight", 
      "_sources"))), .Names = c("experience", "_meta")), 
structure(list(
        experience = structure(list(end = "3000", 
        start = "2012", duration = "2", 
        roleName = "a", summary = "aaa", 
        org = structure(list(name = "None"), .Names = "name"), 
        location = structure(list(displayLocation = NULL, lat = NULL, lng = NULL), .Names = c("displayLocation", "lat", "lng"))), .Names = c("duration", "start", "end", "roleName", 
        "summary", "org", "location")), `_meta` = structure(list(
          weight = 1L, `_sources` = list(structure(list(`_origin` = " "), .Names = "_origin"))), .Names = c("weight", "_sources"))), .Names = c("experience", "_meta")), 
  structure(list(
            experience = structure(list(duration = "3", 
            start = "2006", end = "3000", 
            roleName = "a", summary = "aaa", org = structure(list(name = " "), .Names = "name"), 
            location = structure(list(displayLocation = NULL, lat = NULL, lng = NULL), .Names = c("displayLocation", "lat", "lng"))), .Names = c("duration", "start", "end", "roleName",
            "summary", "org", "location")), `_meta` = structure(list(weight = 1L, `_sources` = list(structure(list(`_origin` = ""), .Names = "_origin"))), .Names = c("weight", 
            "_sources"))), .Names = c("experience", "_meta")),
  structure(list(
            experience = structure(list(roleName = "a",  
            location = structure(list(displayLocation = NULL, lat = NULL, lng = NULL), .Names = c("displayLocation", "lat", "lng"))), .Names = c("roleName", 
           "location")), `_meta` = structure(list(
            weight = 1L, `_sources` = list(structure(list(`_origin` = " "), .Names = "_origin"))), .Names = c("weight", "_sources"))), .Names = c("experience", "_meta")),
structure(list(
            experience = structure(list(roleName = "a",  
            location = structure(list(displayLocation = NULL, lat = NULL, lng = NULL), .Names = c("displayLocation", "lat", "lng"))), .Names = c("roleName", 
            "location")), `_meta` = structure(list(
            weight = 1L, `_sources` = list(structure(list(`_origin` = " "), .Names = "_origin"))), .Names = c("weight", "_sources"))), .Names = c("experience", "_meta"))
            ), 
            list(
structure(list(experience = structure(list(
              duration = "1", start = "2014", 
              end = "3000", roleName = "a", 
              summary = "aaa", 
              org = structure(list(name = "a"), .Names = "name"), 
              location = structure(list(displayLocation = NULL, lat = NULL, 
                lng = NULL), .Names = c("displayLocation", "lat", "lng"
                ))), .Names = c("duration", "start", "end", "roleName", "summary", 
                "org", "location")), `_meta` = structure(list(weight = 1L, `_sources` = list(
                  structure(list(`_origin` = ""), .Names = "_origin"))), .Names = c("weight", 
                  "_sources"))), .Names = c("experience", "_meta"))))

【问题讨论】：

我无法将您的预期输出与您提供的 dput 关联起来。这些日期在哪里？
你能把它编辑成你的问题吗？重要的是您的示例与您的预期输出相匹配，尤其是对于此类复杂的操作
dput 现在更实用了

标签： r list dataframe

【解决方案1】：

也许这会有所帮助

library(dplyr)
library(tidyr)

a <- unlist(a)

df <- data.frame(a=a, b=names(a)) %>% mutate(key=cumsum(b=="experience.duration")) %>% 
      split(.$key) %>% lapply(function(x) x %>% select(-key) %>% spread(b, a)) %>% 
      do.call(rbind, .) %>% t %>% data.frame

df$key <- rownames(df)

然后您可以过滤感兴趣的行

上面将等价于

rbind(unlist(a)[1:8], unlist(a)[9:16],unlist(a)[17:24]) %>% t

更新

试试这个dput2

a <- unlist(dput2)

library(dplyr)
library(tidyr)

dummydf <- data.frame(b=c("experience.start", "experience.end", "experience.roleName", "experience.summary", 
                      "experience.org", "experience.org.name",  "experience.org.url", 
                      "_meta.weight", "_meta._sources._origin", "experience.duration"), key=1:10)


df <- data.frame(a=a, b=names(a))

df2 <- left_join(df, dummydf)
df2$key2 <- as.factor(cumsum(df2$key < c(0, df2$key[-length(df2$key)])) +1)
df_split <- split(df2, df2$key2)
df3 <- lapply(df_split, function(x){
       x %>% select(-c(key, key2)) %>% spread(b, a)
       }) %>% data.table::rbindlist(fill=TRUE) %>% t

df3 <- data.frame(df3)
i <- sapply(seq_along(dput2), function(y) rep(y, sapply(dput2, function(x) length(x))[y])) %>% unlist
names(df3) <- paste0(names(df3), "_", i)

View(df3)

【讨论】：

尽量以“代表”的身份分享dput。
@Olivia 我已经更新了。它适用于指定的dplut2
列名不能重复。
我有以下列名称x#_y 其中y 是数据所在的列表。
我没有指定，但是dummydf 的顺序必须预设以匹配您列表中的顺序。

【解决方案2】：

使用上面的dput3 设法弄清楚了一些事情：

a <- dput3

aa <- lapply(1:length(a), function(y){tryCatch(lapply(1:length(a[[y]]), 
  function(i){if(is.null(a[[y]][[i]]$experience$start)){"Null"}else{a[[y]][[i]]$experience$start}}),error=function(e) print(list()))})


for(i in 1:length(aa)){for(y in 1:length(aa[[i]])){tryCatch(for(z in length(aa[[i]][[y]]))
     {test <- rbind(test, data.frame(key = i, key2= y))},error=function(e) print(0))}}

aaa <- unlist(aa)
df <- data.frame(a=aaa)
df2 <- cbind(df, test)
i <- sapply(seq_along(aa), function(y) rep(y, sapply(aa, function(x) length(x))[y])) %>% unlist

df5 <- data.frame(dates = df2$a)
df5 <- t(df5)
df5 <- data.frame(df5)
names(df5) <- paste0(names(df5), "_", i)
df5[] <- lapply(df5[], as.character)
l1 <- lapply(split(stack(df5), as.numeric(sub('.*_', '', stack(df5)[,2]))), '[', 1)
df6 <- t(do.call(cbindPad, l1))
df6 <- data.frame(df6)

将尝试扩展它，使其适用于多个垂直领域（目前在 aa 我隔离 start）

【讨论】：