通過平均向量展平嵌套列表

Question

假設我有一個嵌套的向量列表。

lst1 <- list(`A`=c(a=1,b=1), `B`=c(a=1), `C`=c(b=1), `D`=c(a=1,b=1,c=1))
lst2 <- list(`A`=c(b=1), `B`=c(a=1,b=1), `C`=c(a=1,c=1), `D`=c(a=1,c=1))
lstX <- list(lst1, lst2)

如圖所示，每個矢量A,B,C,D出現兩次，其中a,b,c以不同的頻率存在。

怎樣才能最有效地展平列表，以便a,b,c在嵌套列表中對A,B,C,D求和或平均，如下所示。 真正的列表有幾十萬個嵌套列表。

#summed
  a b  c
A 1 2 NA
B 2 1 NA
C 1 1  1
D 2 1  2

#averaged
  a   b   c
A 0.5 1   NA
B 1   0.5 NA
C 0.5 0.5 0.5
D 1   0.5 1

Answer 1

這是一個簡單的基本R解決方案（它將返回0而不是NA s（不確定是否足夠好）

temp <- unlist(lstX)
res <- data.frame(do.call(rbind, strsplit(names(temp), "\\.")), value = temp)

總和

xtabs(value ~ X1 + X2, res)
#    X2
# X1  a b c
# A   1 2 0
# B   2 1 0
# C   1 1 1
# D   2 1 2

手段

xtabs(value ~ X1 + X2, res) / length(lstX)
#    X2
# X1  a   b   c
# A 0.5 1.0 0.0
# B 1.0 0.5 0.0
# C 0.5 0.5 0.5
# D 1.0 0.5 1.0

---

或者，更靈活的data.table解決方案

library(data.table) #V1.9.6+
temp <- unlist(lstX)
res <- data.table(names(temp))[, tstrsplit(V1, "\\.")][, value := temp]

總和

dcast(res, V1 ~ V2, sum, value.var = "value", fill = NA)
#    V1 a b  c
# 1:  A 1 2 NA
# 2:  B 2 1 NA
# 3:  C 1 1  1
# 4:  D 2 1  2

手段

dcast(res, V1 ~ V2, function(x) sum(x)/length(lstX), value.var = "value", fill = NA)
#    V1   a   b   c
# 1:  A 0.5 1.0  NA
# 2:  B 1.0 0.5  NA
# 3:  C 0.5 0.5 0.5
# 4:  D 1.0 0.5 1.0

通常，您可以使用dcast幾乎任何功能

Answer 2

我們也可以試試

library(data.table)
DT1 <- rbindlist(lapply(do.call('c', lstX),
            as.data.frame.list), fill=TRUE, idcol=TRUE) 
DT1[, lapply(.SD, sum, na.rm=TRUE), .id]
#   .id a b c
#1:   A 1 2 0
#2:   B 2 1 0
#3:   C 1 1 1
#4:   D 2 1 2

 DT1[, lapply(.SD, function(x) sum(x, na.rm=TRUE)/.N), .id]
 #  .id   a   b   c
 #1:   A 0.5 1.0 0.0
 #2:   B 1.0 0.5 0.0
 #3:   C 0.5 0.5 0.5
 #4:   D 1.0 0.5 1.0

Answer 3

這不是最短的答案，也不是最快的，但我們可以嘗試這樣的事情：

### Get all the vector names
names <- lapply(lstX, function(l) lapply(l, names))
names <- unique(unlist(names))
names
## [1] "a" "b" "c"

## Check if a name is missing, for example
setdiff(names, names(lstX[[1]][[1]]))
## [1] "c"


## Now we will check for every vectors within each list
## and fill the missing names with NA and order the results
lstX <- lapply(lstX, function(l) {
  lapply(l, function(v) {
    v[setdiff(names, names(v))] <- NA
    v[order(names(v))] ## order by names to bind it without errors
  })
})

lstX
## [[1]]
## [[1]]$A
##  a  b  c 
##  1  1 NA 

## [[1]]$B
##  a  b  c 
##  1 NA NA 

## [[1]]$C
##  a  b  c 
## NA  1 NA 

## [[1]]$D
## a b c 
## 1 1 1 


## [[2]]
## [[2]]$A
##  a  b  c 
## NA  1 NA 

## [[2]]$B
##  a  b  c 
##  1  1 NA 

## [[2]]$C
##  a  b  c 
##  1 NA  1 

## [[2]]$D
##  a  b  c 
##  1 NA  1 


### Now we can bind it
matlist <- lapply(lstX, function(l) do.call(rbind, l))
matlist
## [[1]]
##    a  b  c
## A  1  1 NA
## B  1 NA NA
## C NA  1 NA
## D  1  1  1

## [[2]]
##    a  b  c
## A NA  1 NA
## B  1  1 NA
## C  1 NA  1
## D  1 NA  1


mysum <- apply(simplify2array(matlist), c(1, 2), 
           function(x) ifelse(all(is.na(x)), NA, sum(x, na.rm = TRUE)))
mysum
##   a b  c
## A 1 2 NA
## B 2 1 NA
## C 1 1  1
## D 2 1  2


### Average over list
mysum / length(res)
##     a   b   c
## A 0.5 1.0  NA
## B 1.0 0.5  NA
## C 0.5 0.5 0.5
## D 1.0 0.5 1.0

編輯

感謝@CathG，您可以像這樣快速創建matlist

matlist <- lapply(lstX, function(x) {
  t(sapply(x, function(y) {
    y <- y[names]
    names(y) <- names
    y
  }))
})