R 快速嵌套列表迭代

Question

我有一个非常长的嵌套列表，大小有几百万。以下是前几个条目：

d1  
[[1]]  
   x Freq  
1 NA    4

[[2]]  
   x          Freq  
1  0005073936    8  
2          NA    4  

[[3]]  
   x          Freq  
1  0005073936   14

我想用此列表中的最大频率 ("Freq") 值填充向量 "s_week"。例如，在上述情况下，答案将是

s_week=["NA","0005073936","0005073936"]

这是我尝试迭代填充此向量的尝试。

for(i in 1:length(d1)){
s_week[i]=as.character(d1[[i]]$x[which(d1[[i]]$Freq==max(d1[[i]]$Freq))][1])
}

但是，由于该列表有超过 1 亿个条目，这非常缓慢并且需要很长时间。我想知道是否有使用 lapply 或其变体的更优雅的非迭代解决方案？

在此先感谢您的帮助！

Answer 1

尝试：

unlist(lapply(d1, function(x) x[["x"]][which.max(x[["Freq"]])]))

正如@jay.sf 所建议的，您也可以使用 $ 而不是 [[:

unlist(lapply(d1, function(x) x$x[which.max(x$Freq)]))

Answer 2

那么，我们使用 $ 运算符进行提取还是使用 [[ 括号也非常重要。否则，解决方案实际上可能比 for 循环慢。 vapply 也值得一试，它类似于 sapply，但具有 pre-specified 类型的 return 值（在我们的例子中为 character(1)），因此，可能会更快。

vapply(H, function(item) item$x[which.max(item$Freq)], FUN.VALUE=character(1))

我为你做了一个基准测试。列表 H 的长度为 1e5，条目平均有 2.00 行且 SD 0.58，列 x 随机包含 NA。我希望我或多或少是对的。

H[3:5]
# [[1]]
#      x Freq
# 1 <NA>   15
# 2 <NA>    7
# 
# [[2]]
#            x Freq
# 1       <NA>    8
# 2       <NA>    7
# 3 0000765808   14
# 
# [[3]]
#            x Freq
# 1       <NA>    9
# 2 0000618128    9
# 3       <NA>    5

sapply(H[[3]], class)
#           x        Freq 
# "character"   "numeric"

基准

s_week <- NA
microbenchmark::microbenchmark(
  vapply=s_week <- vapply(H, function(item) item$x[which.max(item$Freq)],
                          FUN.VALUE=character(1)),
  sapply=s_week <- sapply(H, function(item) item$x[which.max(item$Freq)]),
  lapply2=s_week <- unlist(lapply(H, function(x) x$x[which.max(x$Freq)])),
  forloop={for(i in 1:length(H)) {
    s_week[i]=as.character(H[[i]]$x[which(H[[i]]$Freq == max(H[[i]]$Freq))][1])
  }},
  vapply2=s_week <- vapply(H, function(item) item[["x"]][which.max(item[["Freq"]])],
                           FUN.VALUE=character(1)),
  lapply=s_week <- unlist(lapply(H, function(item) item[["x"]][which.max(item[["Freq"]])])),
  sapply2=s_week <- sapply(H, function(item) item[["x"]][which.max(item[["Freq"]])]),
  times=20L)
# Unit: milliseconds
#    expr       min        lq      mean    median        uq       max neval cld
#  vapply  508.1789  525.1708  589.4401  550.5763  577.3948  956.8675    20 a  
#  sapply  526.0700  552.1580  651.5795  586.8449  631.1057 1038.6949    20 a  
# lapply2  528.9962  564.0170  594.9651  590.1182  618.8509  715.0774    20 a  
# forloop  820.0938  890.6525 1004.3736  912.5017 1048.2990 1449.8975    20  b 
# vapply2 1694.4961 1787.8798 2028.4530 1863.9924 1919.8244 3349.9039    20   c
#  lapply 1700.2831 1851.8868 2102.6394 1938.5132 2161.0250 2964.7155    20   c
# sapply2 1752.4071 1883.6729 2069.3157 1971.4675 2074.1322 3216.9192    20   c

^{注意：在 AMD FX(tm)-8350 Eight-Core 处理器上执行。}

事实证明，vapply 和 $ 似乎是最快的。 for 循环似乎实际上仍然比 lapply 和 [[ 提取方法更快。

我已将 data.table::rbindlist 排除在基准测试之外，因为它的运行速度出乎意料地慢。由于我们还没有 data.table 个对象，因此可能没有真正的优势。（或者代码可能有些缺陷？我对 data.table 不太熟悉。似乎还永久涉及一些 system 过程。）

library(data.table)
system.time(
  s_week <- rbindlist(H, idcol=TRUE)[, .SD[which.max(Freq)], by=.id][, x]
  )
#  user  system elapsed 
# 41.26   15.93   35.44

我还在修订历史记录中发现了一个 tidyverse 解决方案，该解决方案执行速度非常慢，因此也没有进入我的基准测试。

library(tidyverse)
system.time(
  s_week <- map(H, ~ .x %>% slice(which.max(Freq)) %>% pull(x)) %>% unlist
  )
#  user  system elapsed 
# 70.59    0.18   72.12

数据

set.seed(42)
H <- replicate(1e5, {
  n <- sample(1:3, 1, replace=TRUE)
  data.frame(x=sprintf("%010d", sample(9:1e6, n)), 
             Freq=round(abs(rnorm(n, 6.2, 5)) + 1), stringsAsFactors=FALSE)
}, simplify=FALSE)
# create NA's
H <- lapply(H, function(x) {
  s <- sample(1:nrow(x), sample(1:nrow(x), 1), replace=FALSE)
  if (length(s) != 0)
    x[s, 1] <- NA
  else
    x
  return(x)
})

R 快速嵌套列表迭代

R Fast nested list iteration

r

lapply

nested-lists

mapply