R Fast nested list iteration

user_1580733 0
Viewed 1399

I have an extremely long nested list of size several million. Here are the first few entries:

d1  
[[1]]  
   x Freq  
1 NA    4

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

[[3]]  
   x          Freq  
1  0005073936   14

I want to populate the vector "s_week" with maximum frequency ("Freq") values from this list. For instance, in the above case, the answer will be

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

Here's my attempt to populate this vector iteratively.

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

However, this is excruciatingly slow and takes forever as the list has more than 100 million entries. I was wondering if there's a more elegant non-iterative solution using lapply or its variants?

Thanks in advance for the help!

mapply lapply nested-lists r
2 Answers

Well, it is also highly important whether we use the $ operator for the extraction or the [[ brackets. Otherwise the solution might actually be slower than a for loop. vapply is also worth a try, it's similar to sapply, but has a pre-specified type of return value (in our case character(1)) and, thus, might be faster. 

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

I did a benchmark for you. List H has length 1e5, entries have an average of 2.00 rows with SD 0.58, column x contains NA at random. I hope I got it more or less right.

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"

Benchmark

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

Note: Performed on a AMD FX(tm)-8350 Eight-Core Processor.

As it turns out, vapply with $ seems to be fastest. The for loop seems actually still to be faster than the lapply with [[ method for extraction.

I've taken data.table::rbindlist out of the benchmark since it performed unexpectedly slow. There might not really be an advantage since we don't have data.table objects yet. (Or probably the code is somewhat flawed? I'm not too familiar with data.table. It seems that also some system process is permanently involved.)

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

I also found a tidyverse solution in the revision history that performed very slow and therefore also didn't make it into my benchmark.

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

Data

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)
})
user_65740380

Try:

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

As @jay.sf suggests, you may also rather use $ instead of [[:

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