R: make this loop go faster

Question

Currently I am working on a loop. I tried making this with a apply function but it would not work. This loop takes ages. Also I cannot work with the ifelse function as I have nested two functions within 1 statement.

Thanks in advance

I am trying to make a code which countsdown the values in the columns to 0. When a value hits 0 it has to reset to 7 and create a new column with a value of 8. (i'm doing this for the advent of code 2021 event)

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

Here are a couple options. The first is very similar to your original code, but uses a vector to store the values instead of a 1-row data.frame . The second uses sequence in a recursive function. Both give identical answers within a fraction of a second, though the recursive option is much faster still.

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