R语言 优化大量变量运算和变量排序

xt0899hw  于 2023-03-10  发布在  其他
关注(0)|答案(1)|浏览(160)

bounty将在5天后过期。回答此问题可获得+50声望奖励。On_an_island希望引起更多人对此问题的关注:问题中说明了对答案的期望。

我想得到一些关于加速下面代码的建议。代码的流程是相当直接的。我在Windows中运行R版本4.0.3。
1.使用combn,从df变量名(即var1*var2*var3...var1*var2*varN)创建唯一组合(m=3、4或5)的向量
1.将组合向量转换为公式列表
1.将公式列表拆分为块以避开内存限制(运行步骤4所需)
1.重复步骤3中的每个块,并在df上执行公式运算。将运算步骤产生的值保存在单独的列表(ops_list_temp)中,以便在步骤5中使用
1.对于ops_list_temp中的每个元素,根据用户指定的topn查找最大n个值的索引,并将结果保存到indices_list
1.对于indices_list中的每个元素,通过每个indices_list元素中的索引对df进行子集化,并将对应的value存储在values_list
完整的reprex如下所示,包括使用purrr::map和基本lapply的不同尝试。我还尝试使用data.table中的:=(通过下面的链接),但我无法弄清楚如何将公式列表转换为可以馈送到qoute(:=(...))的公式:
Apply a list of formulas to R data.table
在我看来,我的代码中的瓶颈之一是变量操作步骤(步骤4)。对于m=4和90个变量,总共有2,555,190个元素(RcppAlgos::comboCount(v = 90, m = 4, repetition = FALSE)。将其分成10,000个块以避开内存限制,结果是256个元素的列表。
对于m=5,有43,949,268个元素(RcppAlgos::comboCount(v = 90, m = 5, repetition = FALSE)和约4,440个元素的块列表)。
以前的瓶颈是在订购步骤,我已经设法加快了不少使用库kit和下面的链接,但任何建议,可以加快整个流程是赞赏.我在这里发布的内容使用combn of 4,因为这通常是我在工作流中使用的内容,但我也希望能够增加到combn of 5,如果速度是合理的。
Fastest way to find second (third...) highest/lowest value in vector or column

library(purrr)
library(stringr)
library(kit)

df <- data.frame(matrix(data = rnorm(80000*90,200,500), nrow = 80000, ncol = 90))
df$value <- rnorm(80000,200,500)
cols <- names(df)
cols <- cols[!grepl("value", cols)]
combination <- 4

STEP 1:
## create unique combinations of column names
ops_vec <- combn(cols, combination, FUN = paste, collapse = "*")

STEP 2:
## transform ops vector into list of formulas
ops_vec_l <- purrr::map(ops_vec, .f = function(x) str_split(x, "\\*", simplify = T))

STEP 3:
## break up the list of formulas into chunks otherwise memory error
chunks_run <- split(1:length(ops_vec_l), ceiling(seq_along(ops_vec_l)/10000))

## store results of each chunk into one final list
chunks_list <- vector("list", length = length(chunks_run))

STEP 4:
ptm <- Sys.time()
chunks_idx <- 1
for (chunks_idx in seq_along(chunks_run))
{
  STEP 4 (cont):
  ## using purrr::map
  # p <- Sys.time()
  ele_length <- length(chunks_run[[chunks_idx]])
  ops_list_temp <- vector("list", length = ele_length)
  ops_list_temp <- purrr::map(
    ops_vec_l[ chunks_run[[chunks_idx]] ], .f = function(x) df[,x[,1]]*df[,x[,2]]*df[,x[,3]]*df[,x[,4]]
  )
  # (p <- Sys.time()-p)  #Time difference of ~ 3.6 secs to complete chunk of 10,000 operations
  
  # ## using base lapply
  # p <- Sys.time()
  # ele_length <- length( ops_vec_l[ chunks_run[[chunks_idx]] ])
  # ops_list_temp <- vector("list", length = ele_length)
  # ops_list_temp <- lapply(
  #   ops_vec_l[ chunks_run[[chunks_idx]] ], function(x) df[,x[,1]]*df[,x[,2]]*df[,x[,3]]*df[,x[,4]]
  # )
  # (p <- Sys.time()-p) #Time difference of ~3.7 secs to complete a chunk of 10,000 operations
  
  ## number of rows I want to subset from df
  topn <- 250
  
  ## list to store indices of topn values for each list element
  indices_list <- vector("list", length = length(ops_list_temp))
  
  ## list to store value of the topn indices for each list element
  values_list <- vector("list", length = length(ops_list_temp))
  
  STEP 5:
  ## for each variable combination in "ops_list_temp" list, find the index (indices) of the topn values in decreasing order
  ## each element in this list should be the length of topn
  indices_list <- purrr::map(ops_list_temp, .f = function(x) kit::topn(vec = x, n = topn, decreasing = T, hasna = F))
  
  STEP 6:
  ## after finding the indices of the topn values for a given variable combination, find the value(s) corresponding to index (indices) and store in the list
  ## each element in this list, should be the length of topn
  values_list <- purrr::map(indices_list, .f = function(x) df[x,"value"])
  
  ## save completed chunk to final list
  chunks_list[[chunks_idx]] <- values_list
}
(ptm <- Sys.time()-ptm) # Time difference of 41.1 mins
ybzsozfc

ybzsozfc1#

1.当内存受限时,需要避免对大型对象进行中间分配。
1.在这种情况下,没有理由使用名称而不是整数索引来迭代。
1.在第1步中,您对值进行paste()操作,但在第2步中再次拆分它们,为什么?
1.当你需要更快的速度时,并行化可能是一条可行之路。你的问题是高度可并行化的,但它也会增加内存使用,所以你的里程可能会有所不同。
在下面的代码中,我把你的问题应用到了我的老款i56267U双核处理器上。在10000个观测值上运行并行化的future_map()需要8秒,这相当于在我的机器上运行一次for循环需要46秒,因此这会产生大约6倍的加速。由于循环没有并行化,所以如果使用更现代、内核更多的处理器,您可能会看到更大的增长,之前的准备步骤也会快得多。

library(stringr)
library(kit)
library(furrr)

plan(multisession)

# Parameters
tpn <- 250 # set topn n parameter
combination <- 4

# Data
df <- data.frame(matrix(data = rnorm(80000*90,200,500), nrow = 80000, ncol = 90))
df$value <- rnorm(80000,200,500)

# Calculations
cols <- which(names(df) != "value") # indices for all columns but `value`
cbn <- combn(cols, combination, simplify = F) # combinations

result <- cbn |> 
  future_map(\(cb) df[, cb] |> # select the respective columns 
          Reduce(f = `*`) |> # rowwise product
          kit::topn(tpn) |>
          (\(x) df[x, "value"])() # select corresponding values
        )

相关问题