Как преобразовать мой код для скорости (для l oop)

Question

ОБНОВЛЕНИЕ: я сократил свой код до основных элементов, чтобы сократить его

function_impact_cal c работает очень медленно (26 секунд для кадра данных 100000 записей). Я думаю, что основная причина - это для l oop (может быть, применить или карта поможет?). Ниже я моделирую данные, записываю функцию impact_cal c и записываю время выполнения.

library(dplyr)
library(data.table)
library(reshape2)

###########################################################
# Start Simulate Data
###########################################################


BuySell <- function(m = 40, s = 4) {
  S <- pmax(round(rnorm(10, m, s), 2), 0)
  S.sorted <- sort(S)
  data.frame(buy = rev(head(S.sorted, 5)), sell = tail(S.sorted, 5))
}

number_sates <- 10000

lst <- replicate(number_sates, BuySell(), simplify = FALSE)

# assemble prices data frame

prices <- as.data.frame(data.table::rbindlist(lst))
prices$state_id <- rep(1:number_sates, each = 5)
prices$level <- rep(1:5, times = number_sates)

prices$quantities <- round(runif(number_sates * 5, 100000, 1000000), 0)
# reshape to long format
prices_long <- reshape2::melt(prices,
  id.vars = c("state_id", "quantities", "level"),
  value.name = "price"
) %>%
  rename("side" = "variable") %>%
  setDT()

###########################################################
# End  Simulate Data
###########################################################

Вот функция impact_cal c, которая работает очень медленно.

##########################################################
# function to optimize

impact_calc <- function(data, required_quantity) {
  
  # get best buy and sell
  
   best_buy <- data[, ,.SDcols = c("price", "side", "level")][side == "buy" & level == 1][1, "price"][[1]]

  best_sell <- data[, ,.SDcols = c("price", "side", "level")][side == "sell" & level == 1][1, "price"][[1]]
  
  # calculate mid
  
  mid <- 0.5 * (best_buy + best_sell)
  
 
    # buys
   
    remaining_qty <- required_quantity
    impact <- 0
    
     data_buy <- data[, ,][side == "buy"]
    
    
    levels <- data_buy[, ,][side == "buy"][, level]
    
    
    
    # i think this for loop is slow!
    
    for (level in levels) {
      price_difference <- mid - data_buy$price[level]
      if (data_buy$quantities[level] >= remaining_qty) {
        impact <- impact + remaining_qty * price_difference
        remaining_qty <- 0
        
        break
      } else {
        impact <- impact + data_buy$quantities[level] * price_difference
        remaining_qty <- remaining_qty - data_buy$quantities[level]
      }
    }
    
    rel_impact <- impact / required_quantity / mid
 
  
  
  return_list <- list("relative_impact" = rel_impact)
}

Результаты со временем выполнения:

start_time <- Sys.time()
impact_buys <- prices_long[, impact_calc(.SD, 600000), by = .(state_id)]
end_time <- Sys.time()

end_time - start_time
# for 100000 data frame it takes
#Time difference of 26.54057 secs

Спасибо за помощь!

Answer 1

Подозрение

OP верно: заменив для l oop векторными операциями, мы можем ускорить вычисление более чем в 100 раз:

required_quantity <- 600000
setDT(prices)
library(bench)
mark(
  orig = prices_long[, impact_calc(.SD, required_quantity), by = .(state_id)],
  mod1 = prices_long[, impact_calc2(.SD, required_quantity), by = .(state_id)],
  vec_w = prices[, {
    mid <- 0.5 * (buy[1L] + sell[1L])
    tmp <- cumsum(quantities) - required_quantity
    list(relative_impact = 
           sum(pmin(quantities, pmax(0, quantities - tmp)) * (mid - buy)) / 
           required_quantity / mid)
  }, by = .(state_id)],
  min_time = 1.0
)

# A tibble: 3 x 13
  expression      min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time result    memory    time  gc    
  <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm> <list>    <list>    <lis> <list>
1 orig          28.1s    28.1s    0.0356    2.21GB     1.39     1    39      28.1s <data.ta~ <Rprofme~ <bch~ <tibb~
2 mod1          13.1s    13.1s    0.0762  658.42MB     1.45     1    19     13.12s <data.ta~ <Rprofme~ <bch~ <tibb~
3 vec_w       175.1ms  196.9ms    5.19    440.19KB     2.59     6     3      1.16s <data.ta~ <Rprofme~ <bch~ <tibb~

В дополнение к ускорению векторизованная версия vec_w выделяет значительно меньше памяти (примерно в 5000 раз).

Обратите внимание, что векторизованная версия vec_w использует исходный набор данных prices в широком формате. Таким образом, нет необходимости изменять формат данных из широкого формата в длинный.

Второй тестовый пример mod1 - это версия impact_calc(), где код за пределами для l Код oop был изменен, чтобы лучше использовать синтаксис data.table. Только эти незначительные изменения приводят к ускорению в 2 раза.

Результаты идентичны, что проверяется mark().

Объяснение vec_w

Если я правильно понимаю, ОП считает количество в данном заказе level, пока не будет достигнуто required_quantity. Последний уровень рассматривается только частично в той степени, которая требуется для точного соответствия required_quantity.

В векторизованной версии это может быть достигнуто с помощью вложенного ifelse(), как показано в этом примере:

library(data.table)
r <- 5
dt <- data.table(q = 1:4)
dt[, csq := cumsum(q)]
dt[, tmp := csq - r]
dt[, aq := ifelse(tmp < 0, q, ifelse(q - tmp > 0, q - tmp, 0))][]

   q csq tmp  aq
1: 1   1  -4   1
2: 2   3  -2   2
3: 3   6   1   2
4: 4  10   5   0

Временная переменная tmp содержит разницу между накопленной суммой количеств q и требуемым количеством r.

Первое ifelse() проверяет, меньше ли совокупная сумма количеств q требуемого количества r. В таком случае используйте q без вычета. В противном случае используйте часть q, которая требуется для пополнения накопленной суммы фактических количеств aq1, чтобы получить требуемое количество r.

Вторая ifelse() гарантирует, что количество q минус вычет положительный (что имеет место для неполного уровня) или ноль (для остальных уровней ниже).

Фактические количества aq = c(1, 2, 2, 0), полученные на предыдущих шагах, суммируются с запрошенным количеством r = 5.

Теперь конструкции ifelse() можно заменить на pmin() и pmax():

dt[, aq := pmin(q, pmax(q - tmp, 0))]

Я проверил в отдельном тесте (здесь не публикуется), что pmin() / pmax() подход немного быстрее, чем вложенный ifelse().

Объяснение mod1

В функции impact_calc() некоторые строки кода могут быть изменены для использования синтаксиса data.table .

Таким образом,

best_buy <- data[, .SD,.SDcols = c("price", "side", "level")][side == "buy" & level == 1][1, "price"][[1]]
best_sell <- data[, .SD,.SDcols = c("price", "side", "level")][side == "sell" & level == 1][1, "price"][[1]]

становится

best_buy <- data[side == "buy" & level == 1, first(price)]
best_sell <- data[side == "sell" & level == 1, first(price)]

и

data_buy <- data[, ,][side == "buy"]
levels <- data_buy[, ,][side == "buy"][, level]

становится

data_buy <- data[side == "buy"]
levels <- data[side == "buy", level]

Я был весьма удивлен, узнав, что эти модификации за пределами для l oop уже получили существенное увеличение скорости.