R Быстрая итерация вложенного списка

Question

У меня очень длинный вложенный список размером в несколько миллионов. Вот первые несколько записей:

d1  
[[1]]  
   x Freq  
1 NA    4

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

[[3]]  
   x          Freq  
1  0005073936   14

Я хочу заполнить вектор "s_week" значениями максимальной частоты ("Freq") из этого списка. Например, в приведенном выше случае ответ будет

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

Однако, это мучительно медленно и занимает бесконечно, поскольку в списке более 100 миллионов записей. Мне было интересно, есть ли более элегантное не итеративное решение, использующее lapply или его варианты?

Заранее спасибо за помощь!

Answer 1

Ну, также очень важно, используем ли мы оператор $ для извлечения или [[ скобки.В противном случае решение на самом деле может быть медленнее, чем цикл 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)
})

Answer 2

Попробуйте:

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

Как подсказывает @jay.sf, вы можете также использовать $ вместо [[:

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