我有非常大的資料集，bdd_cases有 150,000 行和bdd_control1500 萬行。在這里，為了簡單起見，我減少了這些資料集的大小并作為驅動鏈接給出。別的不說，我試圖從添加匹配行bdd_control以bdd_cases基于cluster_case與subset變數。
我for loop為此目的撰寫了以下內容，它非常適合此處給出的小型資料集示例。即使對于這個小資料集，它也需要大約 13 秒。
#import data
id1 <- "199TNlYFwqzzWpi1iY5qX1-M11UoC51Cp"
id2 <- "1TeFCkqLDtEBz0JMBHh8goNWEjYol4O2z"
bdd_cases <- as.data.frame(read.csv(sprintf("https://docs.google.com/uc?id=%s&export=download", id1)))
bdd_control <- as.data.frame(read.csv(sprintf("https://docs.google.com/uc?id=%s&export=download", id2)))
#declare empty dataframe
bdd_temp <- NULL
list_p <- unique(bdd_cases$cluster_case)
#for loop
for (i in 1:length(list_p)) {
temp <- bdd_cases %>%
filter(cluster_case==list_p[i]) #select the first case from bdd_cases
temp0 <- bdd_control %>% filter(subset==temp$subset) #select the rows from bdd_control that match the first case above on the subset variable
temp <- rbind(temp, temp0) #bind the two
temp$cluster_case <- list_p[i] #add the ith cluster_case to all the rows
temp <- temp %>%
group_by(cluster_case) %>% #group by cluster case
mutate(age_diff = abs(age - age[case_control=="case"]), #calculate difference in age between case and controls
fup_diff = foll_up - foll_up[case_control=="case"], #calculate difference in foll_up between case and controls
age_fup = ifelse(age_diff<=2 & fup_diff==0,"accept","delete")) %>% #keep the matching controls and remove the other controls for the ith cluster_case
filter(age_fup=="accept") %>%
select(-age_fup)
bdd_temp <- bdd_temp %>% # finally add this matched case and control to the empty dataframe
bind_rows(temp)
}
當我for loop對具有數百萬行的原始資料集進行相同嘗試時，我的問題就出現了。我的程式已經運行了 2 天。我正在運行它，R studio server它有 64 個內核和 270 GB RAM。
我已經參考了以前的帖子（加速 R 中的回圈操作），它討論了矢量化和使用串列而不是資料幀。但是，我無法將這些應用于我的特定情況。
我可以對我的命令進行任何具體的改進以for loop加快執行速度嗎？
速度的任何一點改進都意味著很多。謝謝。
uj5u.com熱心網友回復：
這應該會大大加快速度。
在我的系統上，速度增益大約是 5 倍。
#import data
id1 <- "199TNlYFwqzzWpi1iY5qX1-M11UoC51Cp"
id2 <- "1TeFCkqLDtEBz0JMBHh8goNWEjYol4O2z"
library(data.table)
# use fread for reading, fast and get a nice progress bar as bonus
bdd_cases <- fread(sprintf("https://docs.google.com/uc?id=%s&export=download", id1))
bdd_control <- fread(sprintf("https://docs.google.com/uc?id=%s&export=download", id2))
#Put everything in a list
L <- lapply(unique(bdd_cases$cluster_case), function(x){
temp <- rbind(bdd_cases[cluster_case == x, ],
bdd_control[subset == bdd_cases[cluster_case == x, ]$subset])
temp[, cluster_case := x]
temp[, `:=`(age_diff = abs(age - age[case_control=="case"]),
fup_diff = foll_up - foll_up[case_control=="case"])]
temp[age_diff <= 2 & fup_diff == 0, ]
})
#Rowbind the list
final <- rbindlist(L, use.names = TRUE, fill = TRUE)
轉載請註明出處，本文鏈接：https://www.uj5u.com/shujuku/377304.html