如何在循环中查找值并减少 运行 时间?

How to lookup values in a loop and reduce run time?

首先我只想说我是 R 编码的新手。我编写了一些 R 代码,这些代码将 运行 经过数千次迭代。该代码可以运行并获得我需要的结果,但是 运行 花费的时间太长了。我将首先解释代码在做什么,然后解释代码本身。我怎样才能提高效率并在相对较短的时间内完成 200K+ 次迭代运行?

有一个 while 循环 运行s 直到总美元达到目标美元。首先我生成一个随机数,我在第一个 table 的 Prob 列中查找它,在 returns 下面的 Dist 列(这个值存储为一个字符串)。我解析字符串并根据分布获取一个值并将其添加到向量中。然后我使用这个值再次查找下面的第二个 table 并获得一个因子并将这些因子保存在第二个向量中的每个值。我这样做循环,直到我达到我的目标美元。然后我将两个向量相乘以获得我的结果向量。然后这个 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

如果分析您的代码,您会发现花费最多时间的是解析表达式。您可以通过计算

预先(在循环之前)做到这一点
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 秒。