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，然后對整個事情進行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

Answer 2

我們可以從這里修改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()的random選項內部進行的操作
• 使用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