Оптимизировать цикл R с таблицей данных, переданной в рекурсивную функцию - PullRequest
0 голосов
/ 29 мая 2018

Я пытаюсь запустить симуляцию, которая будет запускать n_tests для n_products для n_years, чтобы оценить увеличение спроса и последующее увеличение хранимых поддонов (предполагается линейная зависимость между спросом и хранимыми продуктами).Чтобы сделать вещи немного более острыми, спрос исходит от 2 отдельных регионов (A и B), но продукты хранятся на одном складе.

То, что я сделал в настоящее время, работает, но медленно.10 лет, 200 тестов и 25 000 продуктов требуют 10 секунд для запуска.

Настройка:

library(data.table)

n_products <- 25000
n_years <- 10
n_tests <- 200

pct_error <- 2
A_fcst <- runif(n_years, min = 1, max = 8)
B_fcst <- runif(n_years, min = 3, max = 6)

Заполните начальные DT и матрицы:

yearly_demand_A <- matrix(0, n_years, n_tests)
yearly_demand_B <- matrix(0, n_years, n_tests)

for (i in 1:n_years){
  yearly_demand_A[i,] <- rnorm(n_tests, A_fcst[i], pct_error*sqrt(i))
  yearly_demand_B[i,] <- rnorm(n_tests, B_fcst[i], pct_error*sqrt(i))
}

yearly_pallets <- matrix(0, n_years, n_tests)

demand_x_pallets <- data.table(prod_code = 1:n_products, stock_qty = as.integer(runif(n_products,1,100)), pallet_qty = as.integer(runif(n_products,10,30)), demand_A = runif(n_products,1,40), demand_B = runif(n_products,1,40))
demand_x_pallets[,pallets := ceiling(stock_qty/pallet_qty)]
demand_x_pallets[,demand := demand_A + demand_B]

for (i in 1:n_tests){
  yearly_pallets[1:n_years,i] <- number_of_pallets(yearly_demand_A[1:n_years,i], yearly_demand_B[1:n_years,i], demand_x_pallets)
}

И сама функция:

number_of_pallets <- function(fcst_A,fcst_B,d_x_p,year=0){
  pallets <- vector("double",n_years)
  new_profile <- copy(d_x_p)    #if I don't create a copy, the same DT is passed and number of pallets compunds
  if (year == 0){               #if function called without year argument call it recursively
    for(i in 1:(n_years)){
      new_profile <- number_of_pallets(fcst_A[[i]],fcst_B[[i]],new_profile,i)
      pallets[i] <- new_profile[,sum(pallets)]
    }
  }
  else{                         #calculate demand and pallet count for each product each year
    d_x_p[,demand_A := demand_A * (100+fcst_A) / 100]
    d_x_p[,demand_B := demand_B * (100+fcst_B) / 100]
    d_x_p[,new_Dmnd := demand_A + demand_B]
    d_x_p[,Dmnd_change := ifelse(demand==0,1,new_Dmnd/demand)]
    d_x_p[,stock_qty := stock_qty * Dmnd_change]
    d_x_p[,pallets := ceiling(stock_qty/pallet_qty)]
    d_x_p[,demand := new_Dmnd]
    return(d_x_p)
  }
  return(pallets)
}

Первоначально яЯ думал, что копирование DT может быть причиной замедления, но удаление строки в функции, кроме того, что она не работает должным образом, не имеет никакого значения.Это лучшее, что я сделал до сих пор после нескольких неудачных сбоев, но сейчас я полностью застрял.

Буду очень признателен за любые указания о том, как решать его по-другому.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...