R Fast nested list iteration - r

Question

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!

Answer 1

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

Answer 2

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)]))