时间戳

首页 > 解决方案 > 有效计算列表的出现次数

r - 有效计算列表的出现次数

问题描述

我有一个包含几百万个列表的列表，这些子列表有几个不同的可能值，可能是 10 到 100。

我想计算这些值的出现次数。

下面的代码有效，但速度很慢。我们可以更快地做到这一点吗？

count_by_list <- function(lst, var_nm = as.character(substitute(lst)), count_nm = "n"){
  unique_lst <- unique(lst)
  res <- tibble::tibble(!!var_nm := unique_lst, !!count_nm := NA)
  for(i in seq_along(unique_lst)){
    res[[count_nm]][[i]] <- sum(lst %in% res[[var_nm]][i])
  }
  res
}

x <- list(
  list(a=1, b=2),
  list(a=1, b=2),
  list(b=3),
  list(b=3, c=4))

count_by_list(x)
#> # A tibble: 3 x 2
#>   x                    n
#>   <list>           <int>
#> 1 <named list [2]>     2
#> 2 <named list [1]>     1
#> 3 <named list [2]>     1

由reprex 包（v0.3.0）于 2019-11-29 创建

我尝试使用库进行散列，digest但它实际上更慢，并且随着 n 的增加变得更糟：

library(digest)
count_by_list2 <- function(lst, var_nm = as.character(substitute(lst)), count_nm = "n"){
  unique_lst <- unique(lst)
  digested   <- vapply(lst, digest, character(1))
  res        <- as.data.frame(table(digested))
  names(res) <- c(var_nm, count_nm)
  res[[1]] <- unique_lst
  res
}

如果您需要进行基准测试，您可以使用x_big <- unlist(replicate(10000 ,x, F), recursive = FALSE).

我添加了标签rcpp，parallel processing因为这些可能会有所帮助，这些并不是对答案的限制。

标签： rperformanceparallel-processingcount

解决方案

此方法比示例中的 OP 原始循环快 30 倍x_big。一个值得注意的预防措施是，如果子列表的任何元素包含多个记录，则此方法将失败。

library(data.table)

molten_lst <- rbindlist(x, fill = T)
cnt_lst <- molten_lst[, .N, names(molten_lst)]

tibble(x = cnt_lst[, 
                   list(apply(.SD, 1, function(x) as.list(na.omit(x)))),
                   .SDcols = names(molten_lst),
                   by = .(seq_len(nrow(cnt_lst)))]$V1,
           n = cnt_lst[['N']])

这里有两种备份方法。我遇到了 NSE / quasi-quotation 问题，所以!!var_nam被简化了。第一种方法是对您的原始功能进行一些调整 - 主要是通过lst在循环期间过滤。

enhanced_loop <- function(lst, var_nm = as.character(substitute(lst)), count_nm = "n"){
  unique_lst <- unique(lst)
  cnts <- vector('integer', length(unique_lst))

  for (i in seq_along(unique_lst)[-length(unique_lst)]){
    ind <- lst %in% unique_lst[i]
    lst <- lst[!ind]
    cnts[i] <- sum(ind)
  }
  cnts[length(unique_lst)] <- length(lst)
  tibble::tibble(x := unique_lst, !!count_nm := cnts)
}

这使循环得出合乎逻辑的结论——使用match()而不是%in%这样的努力不会重复：

tabulate_match <- function(lst, var_nm = as.character(substitute(lst)), count_nm = "n"){
  unique_lst <- unique(lst)
  cnts <- tabulate(match(lst, unique_lst))
  tibble::tibble(x := unique_lst, !!count_nm := cnts)
}

表现：

# A tibble: 7 x 13
  expression                min  median `itr/sec` mem_alloc `gc/sec` n_itr
  <bch:expr>              <bch> <bch:t>     <dbl> <bch:byt>    <dbl> <int>
1 molten_dt                25ms  25.1ms     39.7     2.71MB     0        5
2 tabulate_match(x_big)   237ms 247.2ms      3.41    1.42MB     2.05     5
3 enhanced_loop(x_big)    344ms 352.6ms      2.82    2.83MB     1.69     5
4 table_sapply            381ms 384.9ms      2.59    3.76MB     7.77     5
5 vapply_tab_match(x_big) 412ms 429.3ms      2.14    4.21MB     3.85     5
6 dt_thing(x_big)         442ms 464.6ms      2.15    2.83MB     7.31     5
7 count_by_list(x_big)    759ms 768.4ms      1.24     3.4MB     2.23     5

推荐阅读