R：使這個循環 go 更快

Question

目前我正在處理一個循環。 我嘗試使用 apply function 進行此操作，但它不起作用。 這個循環需要很長時間。 我也無法使用ifelse function，因為我在 1 個語句中嵌套了兩個函數。

提前致謝

我正在嘗試編寫一個將列中的值倒計時到 0 的代碼。當一個值達到 0 時，它必須重置為 7 並創建一個值為 8 的新列。（我這樣做是為了代碼的出現2021 年活動）

dag6 <- data.frame(var1 = 2,
                  var2 = 5,
                  var3 = 6,
                  var4 = 1,
                  var5 = 3,
                  var6 = 6) # Example data as loaded from file

row <- as.data.frame(8)

for (j in 1:80) {
  print(j)
  for (i in 1:ncol(dag6)) 
  {if (dag6[1,i] == 0) {
    dag6[1,i] <- 7
    dag6 <- cbind(dag6, row)
  }
    else {dag6[1,i] <- dag6[1,i]-1}
  }
}

Answer 1

這里有幾個選項。 第一個與您的原始代碼非常相似，但使用向量而不是 1 行data.frame來存儲值。 第二個使用遞歸 function 中的sequence 。 兩者都在幾分之一秒內給出相同的答案，盡管遞歸選項更快。

iter <- 80L
res <- 8L
term1 <- res - 1L
v <- as.integer(c(2,5,6,1,3,6))

fLoop <- function() {
  dag6 <- v
  
  for (j in 1:iter) {
    for (i in seq_along(dag6)) {
      if (dag6[i] == 0L) {
        dag6[i] <- term1
        dag6 <- c(dag6, res)
      }
      else {dag6[i] <- dag6[i]-1L
      }
    }
  }
  
  return(dag6)
}

fRec <- function() {
  term2 <- iter - res
  term3 <- iter - 1L
  term4 <- res + 1L
  
  fSpawn <- function(v) {
    bln <- v < term2
    if (any(bln)) {
      return(c(v, fSpawn(sequence((term3 - v[bln])%/%res, v[bln] + term4, res))))
    } else {
      return(v)
    }
  }
  
  ans <- sort(fSpawn(sequence((term3 + res - v)%/%res, v + 1, res)))
  bln <- ans == iter
  return(c((c(v, ans[!bln]) - iter)%%res, rep(res, sum(bln))))
}


identical(fRec(), fLoop())
#> [1] TRUE
microbenchmark::microbenchmark(fLoop = fLoop(), fRec = fRec())
#> Unit: microseconds
#>   expr     min       lq      mean   median       uq     max neval
#>  fLoop 28163.8 31294.75 33478.856 32800.85 34596.40 45336.5   100
#>   fRec   351.6   394.70   462.042   446.15   489.15  1214.5   100