R:加速功能的建议(删除数据框中的重复项)

Question

我的代码遇到了一些麻烦，欢迎任何让它运行得更快的建议。 我有一个看起来像这样的数据框:

Name <- c("a","a","a","a","a","b","b","b","b","c")

Category <- c("sun","cat","sun","sun","sea","sun","sea","cat","dog","cat")

More_info <- c("table","table","table","table","table","table","table","table","table","cat")
d <- data.frame(Name,Category,More_info)

因此，我在“名称”列中的每一行都有重复的条目(重复项的数量可能会有所不同)。对于每个条目(a，b，...)，我想计算“类别”列中每个相应元素的总和，并保留出现最多的唯一类别。如果一个条目具有相同数量的类别，我想随机选取最多的类别之一。 因此在这种情况下，输出数据帧将如下所示:

Name <- c("a","b","c")

Category <- c("sun","dog","cat")

More_info <- c("table","table","table")
d <- data.frame(Name,Category,More_info)

a 保留太阳条目，因为它出现最多，b 将是狗或任何其他值，因为它们都与 b 一起出现一次，并且 c 不会改变。 我的函数如下所示:

    my_choosing_function <- function(x){
      tmp = dbSNP_hapmap[dbSNP_hapmap$refsnp_id==list_of_snps[x],]
      snp_freq <- as.data.frame(table(tmp$consequence_type_tv)) 
       best_hit <- snp_freq[order(-snp_freq$Freq),]
      best_hit$SNP<-list_of_snps[x]
      top<-best_hit[1,]
      return(top)
    }
    trst <- lapply(1:length(list_of_snps), function(x) my_choosing_function(x))
final <- do.call("rbind",trst)

我从唯一元素列表(在我们的例子中是名称)开始，对于每个元素，我都会创建一个重复条目的表，我按降序值对表进行排序并保留顶部元素。我对唯一值列表中的每个元素执行 lapply，然后对整个内容执行 rbind。

由于我的初始数据框中有 2500000 行和 1500000 个唯一元素，因此它需要很长时间才能运行。 100 行需要 4 秒，总共需要 34 小时。

我确信像 dplyr 这样的软件包可以在几分钟内完成，但找不到解决方案。有人有主意吗？ 非常感谢您的帮助!

Answer 1

注意:这应该是一个很长的注释，因为我使用 data.table 而不是 dplyr。

我建议使用data.table，因为它运行得更快。在如下所示的 data.table 方式中，它会随机选择一个，以防出现平局，而不总是第一个。

library(data.table)
library(dplyr)
library(microbenchmark)

d <- data.frame(
    Name = as.character(sample.int(10000, 2.5e6, replace = T)),
    Category = as.character(sample.int(10000, 2.5e6, replace = T)),
    More_info = rep('table', 2.5e6)
)

Mode <- function(x) {
    ux <- unique(x)
    fr1 <- tabulate(match(x, ux))
    if(n_distinct(fr1)==1) ux[sample(seq_along(fr1), 1)] else ux[which.max(fr1)]
}

system.time({
    d %>%
        group_by(Name) %>%
        slice(which(Category == Mode(Category))[1])
})
#    user  system elapsed
#  45.932   0.808  46.745

system.time({
    dt <- as.data.table(d)
    dt.max <- dt[, .N, by = .(Name, Category)]
    dt.max[, r := frank(-N, ties.method = 'random'), by = .(Name)]
    dt.max <- dt.max[r == 1, .(Name, Category)]

    dt[dt.max, on = .(Name, Category), mult = 'first']
})
#    user  system elapsed
#   2.424   0.004   2.426