仿真时间非常长，如何提高性能？

Question

我目前正在做一个马尔科夫链模拟，用的是 markovchain 包，以及一个内循环和一个外循环。总共有1.752亿个值要被插入到一个数据框中，可复制的示例代码如下。这个已经运行了40多个小时了，我想知道如何才能加快这个速度？而且我很好奇是否有人能给我一个指示，说明完成计算可能需要多长时间。

我已经对代码进行了改进，使用了下面的 profvis 包。

library(markovchain)
library(dplyr)
library(expss)



#States and creation of Markov transition matrix
Locations <- c("Home", "Bakery", "Grocery", "Home-Bakery", "Home-Grocery", "Bakery-Home", "Bakery-Grocery", "Grocery-Home", "Grocery-Bakery")

matrixExample <- matrix(sample(runif(81, min = 0 , max =1), replace = FALSE ), nrow = 9, ncol = 9)

matrixExample <- matrixExample / rowSums(matrixExample)
colnames(matrixExample) <- Locations
rownames(matrixExample) <- Locations

matrixExample <- as(matrixExample, "markovchain")


mcListLoop <- rep(list(matrixExample), 96)
mcList <- new("markovchainList", markovchains = mcListLoop)

z <- 10
numDays <- 365
k <- numDays * 96
battery <- 72.5

km <- runif(9, min = 5, max =120)
Locations <- c("Home", "Bakery", "Grocery", "Home-Bakery", "Home-Grocery", "Bakery-Home", "Bakery-Grocery", "Grocery-Home", "Grocery-Bakery")

averageDistance <- data.frame(cbind(Locations, km))
averageDistance$km <- as.numeric(averageDistance$km)


Iteration <- rep(seq(1:96), 365)

#Recreate dataframe
df <- data.frame(Iteration, sample(Locations, k, replace = TRUE))


df <- rmarkovchain(n=365, object = mcList, t0= "Home", include.t0 = TRUE)

#To estimate the size of list
allDf<- rep(list(df), z)


#Start of the loop
for(y in 1:z){

  df <- rmarkovchain(n=365, object = mcList, t0= "Home", include.t0 = TRUE)
  df$Begin <- 0
  df[1,3] <- battery
  df$Still <- ifelse(df$values == "Home", 1, 0)
  df$KM <- vlookup(df$values, averageDistance, lookup_column = 1, result_column = 2)
  df$Load <- ifelse(df$Still == 1, 2.75, 0)
  df$costDistance <- df$KM * 0.21
  df$End <- 0
  df[is.na(df)] <- 0
  df$reduce <- rep(seq(1:97), numDays)
  df <- df %>% filter(reduce != 97) 
  df$Load <- ifelse(df$reduce <= 69 | df$reduce >= 87, df$Load, 0)




            for(i in 1:k) {
      mainVector <- df[i,3]
      extra <- df[i,6]
      subtractingVector <- df[i,7]


      mainVector <- ifelse(mainVector < battery, pmin(mainVector + extra, battery),  mainVector )

      newMain <- mainVector - subtractingVector
      j <- i + 1
      df[j,3] <- newMain 
      }


allDf[[y]] <- df

}

在内循环中会发生以下情况：在数据帧的同一个观测中，我有电池的起始容量[i,3]，以及它是充电[i,6]（停车时）还是放电[i,7]（开车时）。下一个观测值[j,3]应该有第一个观测值[i,3]中的启动容量，并对（放电）量（[i,6]或[i,7]）进行修正。

我使用i7-8665CPU @ 1.90GHz与16gb内存运行此功能。

Answer 1

如果你想匹配你当前的计算，你可以用这个替换内循环。

  mainVector <- rep(0, nrow(df) + 1L) # pre-allocate resulting vector
  state <- battery # state at each iteration
  extra <- df[, 6]
  subtractingVector <- df[, 7]
  mainVector[1] <- state # add to resulting vector
  for (i in 1:k) {
    if (state < battery) state <- min(state + extra[i], battery)
    state <- state - subtractingVector[i]
    j <- i + 1L
    mainVector[j] <- state
  }
  df[nrow(df) + 1, ] <- NA # add NA row, so we can add longer vector to df
  df[, 3] <- mainVector

在这里，我们分开 data.frame 在循环前将列作为向量，并将结果存储在向量中。df 循环后，因为在循环中花了很多时间在这个操作上+加入新的 NA 末尾 df.

这样应该会快很多，但也可以进行其他改进。

Answer 2

你的代码似乎没有按照预期运行，有多个变量定义不正确，还有两个相同的循环。但我猜测是内部循环写得不好。

如果你有一些 df 与充电放电。

df <- data.table(charge = c(0, 0, 1, 2), discharge = c(1, 2, 0, 0))

一些初始状态。

b <- 1

然后你要计算所有的状态。

df$change <- df$charge - df$discharge
df$cumchange <- cumsum(df$change)
df$battery <- df$cumchange + b
df
#    charge discharge change cumchange battery
# 1:      0         1     -1        -1       0
# 2:      0         2     -2        -3      -2
# 3:      1         0      1        -2      -1
# 4:      2         0      2         0       1

我认为你需要这样的内循环。 如果根据你的需求进行正确的调整，这应该会快得多。

P.S.正如Roland在这次改进后提到的那样 rmarkovchain 可能会成为瓶颈。