[英]R: make this loop go faster
Currently I am working on a loop.目前我正在处理一个循环。 I tried making this with a apply function but it would not work.
我尝试使用 apply function 进行此操作,但它不起作用。 This loop takes ages.
这个循环需要很长时间。 Also I cannot work with the
ifelse
function as I have nested two functions within 1 statement.我也无法使用
ifelse
function,因为我在 1 个语句中嵌套了两个函数。
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)我正在尝试编写一个将列中的值倒计时到 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}
}
}
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
.第一个与您的原始代码非常相似,但使用向量而不是 1 行
data.frame
来存储值。 The second uses sequence
in a recursive function.第二个使用递归 function 中的
sequence
。 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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.