R快速嵌套列表迭代

时间:2019-06-21 15:58:14

标签: r lapply nested-lists mapply

我有一个非常长的嵌套列表,大小为几百万。这是前几项:

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或其变体的更优雅的非迭代解决方案?

预先感谢您的帮助!

2 个答案:

答案 0 :(得分:2)

好吧,我们使用$运算符进行提取还是使用[[括号也非常重要。否则,解决方案实际上可能比for循环慢。 vapply也值得一试,它类似于sapply,但具有预先指定的返回值类型(在我们的情况下为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八核处理器上执行。

事实证明,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)
})

答案 1 :(得分: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)]))