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)

我从一个唯一元素列表（在我们的例子中是Name）开始，对于每个元素，我做一个重复条目的表，我按降序值排序表并保留顶部元素。我为唯一值列表中的每个元素做了一个lapply，然后对整个事物做了一个重复。

由于我的初始数据框中有250万行和1500000个唯一元素，因此需要永久运行。 100行的4秒，这对于lapply来说总共需要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

Answer 2

我们可以修改here中的Mode功能，然后按filter

进行分组

library(dplyr)

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

d %>% 
  group_by(Name) %>%
  slice(which(Category == Mode(Category))[1])

Answer 3

对@ mt1022的解决方案进行一些轻微的调整可以产生边际加速，没有什么可以打电话回家，但如果你发现你的数据增长了另一个数量级则可能会有用。

library(data.table)
library(dplyr)

d <- data.frame(
 Name = as.character(sample.int(10000, 2.5e6, replace = T)),
 Category = as.character(sample.int(5000, 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 
# 40.459   0.180  40.743 

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 
# 4.196   0.052   4.267 

调整包括

• 使用setDT()代替as.data.table()以避免复制
• 使用stats::runif()直接生成随机决胜局，这是data.table随机选项frank()内部执行的内容
• 使用setkey()对表格进行排序
• 通过行索引.I对表进行子设置，其中每个组中的行等于每个组中的观察数.N。 （这将返回每个组的最后一行）

结果：

system.time({
 dt.max <- setDT(d)[, .(Count = .N), keyby = .(Name, Category)]
 dt.max[,rand := stats::runif(.N)]
 setkey(dt.max,Name,Count, rand)
 dt.max[dt.max[,.I[.N],by = .(Name,Category)]$V1,.(Name,Category,Count)]
})

# user  system elapsed 
# 1.722   0.057   1.750