通过平均向量来展平嵌套列表

Posted 2023-02-23

【中文标题】通过平均向量来展平嵌套列表

【英文标题】：flatten nested list by averaging vectors

【发布时间】：2016-02-26 21:23:44

【问题描述】：

假设我有一个嵌套的向量列表。

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

【问题讨论】：

值是否总是1s？

例如，这是否有效 res <- do.call(rbind, strsplit(names(unlist(lstX)), "\\.")) ; table(res[, 1], factor(res[, 2])) ？或table(res[, 1], factor(res[, 2]))/2 ?

我有二进制列表和加权列表，所以两者都适用的东西会很棒

【参考方案1】：

我们也可以试试

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

【参考方案2】：

这不是最短的答案也不是最快的，但我们可以尝试这样的事情：

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

【讨论】：

小评论，你可以得到matlist和lapply(lstX, function(x)t(sapply(x, function(y) y <- y[names] ; names(y) <- names ; y)))，更短

【参考方案3】：

这是一个简单的基本 R 解决方案（将返回 0 而不是 NAs（不确定是否足够好）

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 几乎可以使用任何函数

【讨论】：

第一个解决方案非常巧妙。但是，在允许负值的更一般的设置中，允许0s 而不是NAs 的第一个解决方案并不理想。不过，我一定会检查xtabs！ :)

正要发布类似的内容。我的出发点是：data.table(nam = rapply(lstX, names), melt(lstX))。 +1

（另外，xtabs 有一个“数据”参数，所以你不需要使用with。）:-)

@AnandaMahto doh，忘记了。

太棒了，太优雅了！ :-) 我需要看看哪一个是最快的，而且列表很长。