2015-01-26 85 views
5

我有下面的示例结构的列表:拼合列表具有复杂嵌套结构

> dput(test) 
structure(list(id = 1, var1 = 2, var3 = 4, section1 = structure(list(
    var1 = 1, var2 = 2, var3 = 3), .Names = c("var1", "var2", 
"var3")), section2 = structure(list(row = structure(list(var1 = 1, 
    var2 = 2, var3 = 3), .Names = c("var1", "var2", "var3")), 
    row = structure(list(var1 = 4, var2 = 5, var3 = 6), .Names = c("var1", 
    "var2", "var3")), row = structure(list(var1 = 7, var2 = 8, 
     var3 = 9), .Names = c("var1", "var2", "var3"))), .Names = c("row", 
"row", "row"))), .Names = c("id", "var1", "var3", "section1", 
"section2")) 


> str(test) 
List of 5 
$ id  : num 1 
$ var1 : num 2 
$ var3 : num 4 
$ section1:List of 3 
    ..$ var1: num 1 
    ..$ var2: num 2 
    ..$ var3: num 3 
$ section2:List of 3 
    ..$ row:List of 3 
    .. ..$ var1: num 1 
    .. ..$ var2: num 2 
    .. ..$ var3: num 3 
    ..$ row:List of 3 
    .. ..$ var1: num 4 
    .. ..$ var2: num 5 
    .. ..$ var3: num 6 
    ..$ row:List of 3 
    .. ..$ var1: num 7 
    .. ..$ var2: num 8 
    .. ..$ var3: num 9 

注意,section2列表包含名为rows元件。这些代表多个记录。我所拥有的是嵌套列表,其中一些元素位于根级,而其他元素是同一观察值的多个嵌套记录。我想在一个data.frame格式输出如下:

> desired 
    id var1 var3 section1.var1 section1.var2 section1.var3 section2.var1 section2.var2 section2.var3 
1 1 2 4    1    2    3    1    4    7 
2 NA NA NA   NA   NA    NA    2    5    8 
3 NA NA NA   NA   NA    NA    3    6    9 

根级元素应该填充在第一行,而row元素应该有自己的行。作为一个附加的复杂因素,row条目中的变量数量可能会有所不同。

+0

为什么你想要这个所需的输出?这似乎是一个不方便的数据格式。 – A5C1D2H2I1M1N2O1R2T1 2015-01-28 17:52:51

+0

我正在执行一个soap请求,它返回一个嵌套列表中嵌套结构的html表。我不知道为什么你认为所需的输出不方便。它以data.frame格式重新创建html表格,并在条目跨越多行时填充NA值。 – Zelazny7 2015-01-28 18:46:04

+0

您是否可以提供一个或两个以上的测试用例,因为您已经为此添加了一个赏金。你提到你正在寻找一个“通用”解决方案,所以很有可能知道应该考虑哪些场景。 – A5C1D2H2I1M1N2O1R2T1 2015-02-01 04:22:33

回答

3

下面是一个通用方法。它并不假定你只有三排;它将与你拥有的许多行一起工作。如果嵌套结构中缺少一个值(例如,第2节中的某些子列表中不存在var1),则该代码将正确地返回该单元的NA。

E.g.如果我们使用以下数据:

test <- structure(list(id = 1, var1 = 2, var3 = 4, section1 = structure(list(var1 = 1, var2 = 2, var3 = 3), .Names = c("var1", "var2", "var3")), section2 = structure(list(row = structure(list(var1 = 1, var2 = 2), .Names = c("var1", "var2")), row = structure(list(var1 = 4, var2 = 5), .Names = c("var1", "var2")), row = structure(list(var2 = 8, var3 = 9), .Names = c("var2", "var3"))), .Names = c("row", "row", "row"))), .Names = c("id", "var1", "var3", "section1", "section2")) 

的一般方法是用熔融创建一个数据帧,其中包括有关嵌套结构信息,然后dcast把它塑造成你想要的格式。

library("reshape2") 

flat <- unlist(test, recursive=FALSE) 
names(flat)[grep("row", names(flat))] <- gsub("row", "var", paste0(names(flat)[grep("row", names(flat))], seq_len(length(names(flat)[grep("row", names(flat))])))) ## keeps track of rows by adding an ID 
ul <- melt(unlist(flat)) 
split <- strsplit(rownames(ul), split=".", fixed=TRUE) ## splits the names into component parts 
max <- max(unlist(lapply(split, FUN=length))) 
pad <- function(a) { 
    c(a, rep(NA, max-length(a))) 
} 
levels <- matrix(unlist(lapply(split, FUN=pad)), ncol=max, byrow=TRUE) 

## Get the nesting structure 
nested <- data.frame(levels, ul) 
nested$X3[is.na(nested$X3)] <- levels(as.factor(nested$X3))[[1]] 
desired <- dcast(nested, X3~X1 + X2) 
names(desired) <- gsub("_", "\\.", gsub("_NA", "", names(desired))) 
desired <- desired[,names(flat)] 

> desired 
    ## id var1 var3 section1.var1 section1.var2 section1.var3 section2.var1 section2.var2 section2.var3 
## 1 1 2 4    1    2    3    1    4    7 
## 2 NA NA NA   NA   NA   NA    2    5    8 
## 3 NA NA NA   NA   NA   NA    3    6    9 
1

该解决方案的核心思想是将除名为'row'的子列表之外的所有子列表扁平化。这可以通过为每个列表元素创建一个唯一的ID(存储在z中),然后请求单个'行'中的所有元素应该具有相同的ID(存储在z2中;必须编写递归函数来遍历嵌套列表)。然后,z2可用于对属于同一行的元素进行分组。可以使用stringi包中的stri_list2matrix将结果列表转换为矩阵形式,然后转换为数据帧。

utest <- unlist(test) 
z <- relist(seq_along(utest),test) 

recurse <- function(L) { 
    if (class(L)!='list') return(L) 
    b <- names(L)=='row' 
    L.b <- lapply(L[b],function(k) relist(rep(k[[1]],length(k)),k)) 
    L.nb <- lapply(L[!b],recurse) 
    c(L.b,L.nb) 
} 

z2 <- unlist(recurse(z)) 

library(stringi) 
desired <- as.data.frame(stri_list2matrix(split(utest,z2))) 
names(desired) <- names(z2)[unique(z2)] 

desired 
#  id var1 var3 section1.var1 section1.var2 section1.var3 section2.row.var1 
# 1 1 2 4    1    2    3     1 
# 2 <NA> <NA> <NA>   <NA>   <NA>   <NA>     2 
# 3 <NA> <NA> <NA>   <NA>   <NA>   <NA>     3 
# section2.row.var1 section2.row.var1 
# 1     4     7 
# 2     5     8 
# 3     6     9 
0

因为当行具有复杂 结构(即,如果在test每一行包含列表test`,应该如何行地结合在一起是你的问题没有得到很好的界定。同样如果在同一个表行具有不同结构?),下面的解决方案依赖于作为值列表的行。

这就是说,我猜,在一般情况下,你的清单test将 包含任何值,值列表,或行的名单(其中行是值的 列表)。另外,如果行不总是被称为“行”,这个解决方案仍然有效。

temp <- lapply(test, 
       function(x){ 
        if(!is.list(x)) 
         # x is a value 
         return(x) 
        # x is a lis of rows or values 
        out <- do.call(cbind,x) 
        if(nrow(out)>1){ 
         # x is a list of rows 
         colnames(out)<-paste0(colnames(out),'.',rownames(out)) 
         rownames(out)<-rep_len(NA,nrow(out)) 
        } 
        return(out) 
       }) 

# a function that extends a matrix to a fixt number of rows (n) 
# by appending rows of NA's 
rowExtend <- function(x,N){ 
       if((!is.matrix(x))){ 
        out<-do.call(rbind,c(list(x),as.list(rep_len(NA,N - 1)))) 
        colnames(out) <- "" 
        out 
       }else if(nrow(x) < N) 
        do.call(rbind,c(list(x),as.list(rep_len(NA,N - nrow(x))))) 
       else 
        x 
      } 

# calculate the maximum number of rows 
.nrows <- sapply(temp,nrow) 
.nrows <- max(unlist(.nrows[!sapply(.nrows,is.null)])) 

# extend the shorter rows 
(temp2<-lapply(temp, rowExtend,.nrows)) 

# calculate new column namames 
newColNames <- mapply(function(x,y) { 
         if(nzchar(y)[1L]) 
          paste0(x,'.',y) 
         else x 
         }, 
         names(temp2), 
         lapply(temp2,colnames)) 


do.call(cbind,mapply(`colnames<-`,temp2,newColNames)) 

#> id var1 var3 section1.var1 section1.var2 section1.var3 section2.row.var1 section2.row.var2 section2.row.var3 
#> 1 2 4 1    2    3    1     4     7     
#> NA NA NA NA   NA   NA   2     5     8     
#> NA NA NA NA   NA   NA   3     6     9     
0

这开始类似蒂法尼的答案,但后来有点分歧。

library(data.table) 

# flatten the first level 
flat = unlist(test, recursive = FALSE) 

# compute max length 
N = max(sapply(flat, length)) 

# pad NA's and convert to data.table (at this point it will *look* like the right answer) 
dt = as.data.table(lapply(flat, function(l) c(l, rep(NA, N - length(l))))) 

# but in reality some of the columns are lists - check by running sapply(dt, class) 
# so unlist them 
dt = dt[, lapply(.SD, unlist)] 
# id var1 var3 section1.var1 section1.var2 section1.var3 section2.row section2.row section2.row 
#1: 1 2 4    1    2    3   1   4   7 
#2: NA NA NA   NA   NA   NA   2   5   8 
#3: NA NA NA   NA   NA   NA   3   6   9