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

5

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

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,D a,b,c 进行求和或平均值。实际列表有数十万个嵌套列表。

#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

1
这些值总是“1”吗? - David Arenburg
例如,这段代码是否有效 res <- do.call(rbind, strsplit(names(unlist(lstX)), "\\.")) ; table(res[, 1], factor(res[, 2]))?或者是 table(res[, 1], factor(res[, 2]))/2 - David Arenburg
我有二进制和加权列表,因此能够适用于两者的内容将会很棒。 - jO.
3个回答

5
这里有一个基于R语言的简单解决方案(将返回0而不是NA,不确定是否足够好)。
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 一起使用。


1
第一种解决方案非常巧妙。然而,在允许负值的更普遍的情况下,允许使用 0 而不是 NA 的第一种解决方案并不理想。不过我一定会去了解 xtabs 的! :) - stas g
1
刚要发一个类似的内容。我的起点是: data.table(nam = rapply(lstX, names), melt(lstX))。+1 - A5C1D2H2I1M1N2O1R2T1
1
(另外,xtabs有一个“data”参数,因此您不需要使用with。) :-) - A5C1D2H2I1M1N2O1R2T1
@AnandaMahto 哎呀,忘了它。 - David Arenburg
1
太棒了,如此优雅! :-) 我需要看看哪一个在处理非常长的列表时最快。 - jO.

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

1
这不是最短也不是最快的答案,但我们可以尝试像这样做:
### 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
  }))
})

小注释:你可以使用 lapply(lstX, function(x){t(sapply(x, function(y) { y <- y[names] ; names(y) <- names ; y}))}) 来获取 matlist,这样会更短。 - Cath

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接