簡體   English   中英

展平具有復雜嵌套結構的列表

[英]Flatten a list with complex nested structure

我有一個包含以下示例結構的列表:

> 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條目中的變量數量可能會有所不同。

這是一種通用的方法。 它並不假設你只有三排; 它可以使用你擁有的很多行。 如果嵌套結構中缺少值(例如,第2節中的某些子列表不存在var1),則代碼會正確返回該單元格的NA。

例如,如果我們使用以下數據:

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"))

一般的方法是使用melt來創建一個包含嵌套結構信息的數據框,然后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

此解決方案的核心思想是展平除名為“row”的子列表之外的所有子列表。 這可以通過為每個列表元素(存儲在z )創建唯一ID,然后請求單個'row'中的所有元素應該具有相同的ID(存儲在z2 ;必須編寫遞歸函數來遍歷嵌套)來完成列表)。 然后, z2可用於對屬於同一行的元素進行分組。 結果列表可以被轉換成使用矩陣形式stri_list2matrixstringi包,然后轉換成數據幀。

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

由於當行具有復雜結構時(或者如果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                

這與蒂芙尼的回答類似,但后來又有所不同。

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

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM