Как искать значения в цикле и сократить время выполнения? - PullRequest
Новая
       21

Как искать значения в цикле и сократить время выполнения?

1 голос
/ 09 марта 2019

Сначала я хочу сказать, что я довольно плохо знаком с R-кодированием. Я написал некоторый R-код, который будет выполнять тысячи итераций. Код работает и получает нужные мне результаты, однако он занимает слишком много времени для запуска. Сначала я объясню, что делает код, а затем сам код. Как я могу сделать это более эффективным и заставить его работать за относительно короткое время более 200K + итераций?

Существует цикл while, который работает до тех пор, пока все доллары не достигнут целевых долларов. Сначала я генерирую случайное число, которое я просматриваю в столбце Prob в первой таблице ниже, который возвращает столбец Dist (это значение сохраняется в виде строки). Я анализирую строку и получаю значение на основе распределения и добавляю его в вектор. Затем я использую это значение, чтобы еще раз взглянуть на вторую таблицу ниже, получить коэффициент и сохранить эти коэффициенты для каждого значения во втором векторе. Я делаю этот цикл, пока не достигну своих целевых долларов. Затем я умножаю два вектора, чтобы получить вектор результата. Этот цикл while повторяется 200K + раз. 

Prob    Range       Dist
.12        5000     rgamma(1, 3, , 900) + 1000
.70      100000     rgamma(1, 1, , 900) + 5000
.85      350000     rgamma(1,0.9, , 150000) + 200000
.95     1500000     rgamma(1,0.8, , 230000) + 200000
1.0     2500000     runif(1, 1500000, 2500000)



  Range   Factor
   5000   rweibull(1, 20, 1.1)
 100000   rweibull(1, 30, 1.2)
 250000   rweibull(1, 25, 1.5)
2500000   rweibull(1, 25, 1.8)

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

t <- proc.time()
#inputs
sims <- 100
totalD <- 0
totalRev <- c(150000000)
i <- 0
set.seed(1)

ProbRnge <- matrix(c(0.12, 0.70, 0.85, 0.95, 1, 
                     5000, 100000, 350000, 1500000, 2500000,
                     1000, 5000, 100000, 350000, 1500000), ncol=3)
Dis1 <- c("rgamma(1, 3.0268, , 931.44) + 1000", "rgamma(1, 1.0664, , 931.44) + 5000", 
         "rgamma(1, 1.0664, , 931.44) + 5000", "rgamma(1, 1.0664, , 931.44) + 5000", 
         "runif(1, 1250000, 2000000)")

SizeRnge <- c(5000, 100000, 250000, 2500000)
Dis2 <- c("rweibull(1, 20, 1.1)", "rweibull(1, 30, 1.2)", "rweibull(1, 25, 1.5)", 
         "rweibull(1, 25, 1.8)")

#simulation loop
for (j in 1:sims) {

  TotalDTemp <- NULL
  FacTmp <- NULL
  TotalDTemp <- vector()
  FacTmp <- vector()

  # loop while total simulated reached target total.
  while(totalD < totalRev[1])
  {
    i = i + 1
    #find where random number falls in range and look up distribution and calculate value and store in vector
    row_i <- which.max(ProbRnge[,1] > runif(1))
    tmpSize <- max(min(eval(parse(text=Dis1[row_i])), ProbRnge[row_i, 2]), ProbRnge[row_i, 3])

    if (totalD + tmpSize > totalRev[1]) {
      tmpSize = totalRev[1] - totalD
      totalD = totalD + tmpSize
    } else {
      totalD = totalD + tmpSize }

    TotalDTemp [i] <-tmpSize

    # take value an lookup up factor to apply and store in vector
    row_i <- which.max(SizeRnge > tmpSize)
    tempRTR <- max(min(eval(parse(text=Dis2[row_i])), 2), 1)
    FacTmp [i] <- tempRTR
  }

  DfacTotal <- TotalDTemp * FacTmp

  totalD = 0
  i = 0
}

proc.time() - t

1 Ответ

1 голос
/ 10 марта 2019

Если вы профилируете свой код, вы увидите, что больше всего времени занимает анализ выражений. Вы можете сделать это заранее (до цикла), вычислив 

expr1 <- lapply(Dis1, function(text) parse(text = text))
expr2 <- lapply(Dis2, function(text) parse(text = text))

И затем использовать eval(expr1[[row_i]]) вместо eval(parse(text=Dis1[row_i])).

Для меня это сокращает время вычислений с 45 секунд до менее чем 2 секунд.

...