làm phẳng danh sách lồng nhau bằng các vectơ trung bình

Question

Giả sử tôi có danh sách vectơ lồng nhau.

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) 

Như đã thấy, mỗi vector A,B,C,D xảy ra hai lần với a,b,c có ở các tần số khác nhau.

Cách hiệu quả nhất để làm phẳng danh sách sao cho số a,b,c được tổng hợp hoặc tính trung bình trên A,B,C,D trên các danh sách lồng nhau, như bên dưới. Danh sách thực có hàng trăm nghìn danh sách lồng nhau.

#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

Dưới đây là một giải pháp đơn giản cơ sở R (mà sẽ trở 0 thay vì NA s (không chắc chắn nếu đủ tốt)

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

Khoản

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 

Phương tiện

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 

---

Ngoài , linh hoạt hơn data.table giải pháp

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

tiền

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 

Phương tiện

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 

Nói chung, bạn có thể sử dụng khá nhiều bất kỳ chức năng với dcast

Answer 2

Đây không phải là câu trả lời ngắn nhất cũng không phải là nhanh nhất nhưng chúng tôi có thể thử một cái gì đó như thế này:

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

EDIT

Nhờ @CathG, bạn có thể tạo matlist một cách nhanh chóng như thế này

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

Answer 3

Chúng tôi cũng có thể thử

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