Question

我只想首先说我是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

Answer 1

如果对代码进行概要分析，则会看到花费最多时间的是对表达式的解析。您可以通过计算

事先（在循环之前）执行此操作

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秒。

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

1 个答案: