【发布时间】：2021-07-31 22:44:35
【问题描述】：
我正在实现超大规模救济算法的一个版本，详细信息 here。
简单地说，超大规模救济将特征集N 拆分为几个随机子集Ns，其中Ns << N。然后它计算子集Ns 中特征的浮雕权重。对于每个特征，最终权重将是该特定特征出现时在不同子集中分配的最高权重。
我有约 80000 个特征用于约 100 个主题。我可以使用以下代码在合理的时间内（在 25 个内核上运行约 5 分钟）计算 8000 个特征的 10000 个子集（为了更容易分析，它被缩减为 100 个特征）：
library(tidyverse)
library(magrittr)
library(CORElearn)
library(doParallel)
#create fake data for example
fake_table <- matrix(rnorm(100*100), ncol = 100) %>%
as_tibble()
outcome <- rnorm(100)
#create fake data for example
#VLSRelieff code
start_time <- Sys.time()
myCluster <- makeCluster(25, # number of cores to use
type = "FORK")
registerDoParallel(myCluster)
result <- foreach(x = seq(1,10000)) %dopar% {
#set seed for results consistency among different run
set.seed(x)
#subsample the features table by extracting a subset of columns
subset_index <- sample(seq(1,ncol(fake_table)),size = round(ncol(fake_table)*.01))
subset_matrix <- fake_table[,subset_index]
#assign the outcome as last column of the subset
subset_matrix[,ncol(subset_matrix)+1] <- outcome
#use the function attrEval from the CORElearn package to calculate the Relieff weights for the subset
rf_weights <- attrEval(formula = ncol(subset_matrix), subset_matrix, estimator = "RReliefFequalK")
#create a data frame with as many columns as features in the subset and only one row
#with the Relieff weigths
rf_df <- rf_weights %>%
unname() %>%
matrix(., ncol = length(.), byrow = TRUE) %>%
as_tibble() %>%
set_colnames(., names(rf_weights))}
end_time <- Sys.time()
end_time - start_time
然而，上面的代码只做了一半的工作：另一半是，对于每个特征，进入不同重复的结果并找到获得的最大值。我已经设法编写了一个工作代码，但是速度非常慢（我让它运行了 2 个小时才停止它，尽管它可以用更少的功能进行测试 - 再次，这里它被缩小到 100 个功能并且应该运行~ 7 秒）：
start_time <- Sys.time()
myCluster <- makeCluster(25, # number of cores to use
type = "FORK")
registerDoParallel(myCluster)
#get all features name
feat_names <- colnames(fake_table)
#initalize an empty vector of zeros, with the names of the features
feat_wegiths <- rep(0, length(feat_names))
names(feat_wegiths) <- feat_names
#loop in parallel on the features name, for each feature name
feat_weight_foreach <- foreach(feat = feat_names, .combine = 'c') %dopar% {
#initalize the weight as 0
current_weigth <- 0
#for all element in result (i.e. repetitions of the subsampling process)
for (el in 1:length(result)){
#assign new weight accessing the table
new_weigth <- result[[el]][[1,feat]]
#skip is empty (i.e. the features is not present in the current subset)
if(is_empty(new_weigth)){next}
#if new weight is higher than current weight assign the value to current weight
if (current_weigth < new_weigth){
current_weigth <- new_weigth}}
current_weigth
}
end_time <- Sys.time()
end_time - start_time
【问题讨论】：
-
您是否考虑过从
dplyr切换到data.table？ Here你可以找到一个基准。 -
@ismirsehregal，确实我做到了，但我不得不承认我没有遵循，因为在第二个 sn-p 中我没有使用任何 dplyr 功能（当然除了
tibble），因此，我认为这不会有太大的不同。你觉得会吗？ -
我还没有详细查看您的代码。但我很确定会有更快的 data.table 方式。也许你可以避免 for 循环。
-
您可以编辑数据以使其可扩展吗？主要是，与其让示例永远运行，不如将目标定为 2 秒，然后根据不同的变量分配轻松扩展。
-
你能把
test_matrix_reduced包括进来吗？
标签： r search optimization foreach doparallel