Calculate final value without using for-loop - r

Question

upper.limit <- 15
starting.limit <- 5
lower.limit <- 0
set.seed(123)
x <- sample(-20:20)
for(i in 1:length(x)){
k <- starting.limit + x[i]
k <- ifelse(k > upper.limit, upper.limit, ifelse(k < lower.limit, lower.limit,k))
starting.limit <- k
}
My objective is to calculate the final value of starting limit at the end of the loop. The conditions are that for a given iteration, k cannot exceed upper.limit and fall below lower.limit.
I have written the above loop to achieve this. However, I have to do this for almost 10000 datasets. I wondered if there is a quicker way so that I can avoid a for loop
Thanks

Answer 1

We can design a function.
# s: starting.limit, x: the x vector, u:upper.limit, l:lower.limit
k_fun <- function(s, x, u = 15, l = 0){
k <- s + x
if (k > u){
k <- u
} else if (k < l){
k <- l
}
s <- k
return(s)
}
And then use accumulate from the purrr package to apply the function with the starting limit and the x vector. You can see how the number changes. The last number is the final output.
library(purrr)
accumulate(c(5, x), k_fun)
# [1] 5 0 11 6 15 15 0 0 10 15 9 15 8 7 3 0 3 0 15 2 2 14 15 7 4 15 15 3 15 0
# [31] 5 0 0 4 12 0 6 7 9 0 0 15
Benchmark
I used the following code to assess the performance. The accumulate is a little bit faster than a for loop on a vector with 400001 elements.
library(microbenchmark)
perf <- microbenchmark(
m1 = {upper.limit <- 15
starting.limit <- 5
lower.limit <- 0
set.seed(123)
x <- sample(-200000:200000)
for(i in 1:length(x)){
k <- starting.limit + x[i]
k <- ifelse(k > upper.limit, upper.limit, ifelse(k < lower.limit, lower.limit,k))
starting.limit <- k
}},
m2 = {
set.seed(123)
x <- sample(-200000:200000)
vec <- purrr::accumulate(c(5, x), k_fun)
k <- tail(vec, 1)
})
# Unit: milliseconds
# expr min lq mean median uq max neval
# m1 821.1735 879.3551 956.7404 941.1145 1019.8603 1290.800 100
# m2 649.3444 717.5986 773.3652 768.0313 823.5749 1006.148 100

Answer 2

you can try something like below with tidyverse
first, make x into a dataframe
x <- as.data.frame(sample(-20:20))
colnames(x) <- c("dat")
and then pipe like:
x %>%
mutate(sm = starting.limit) %>%
mutate(sm = if_else(sm+lead(dat,1) > upper.limit, upper.limit
, if_else(sm+lead(dat,1) < lower.limit, lower.limit, sm) )) %>%
select(sm) %>%
filter(sm != is.na(sm)) %>%
tail(n=1)
Effectively, modify the last select, filter and tail functions as per your need.
Benchmark
I was curious how this performs against the other solution, and tried to add my code to the microbenchmark already provided. Here goes
perf <- microbenchmark(
m1 = {upper.limit <- 15
starting.limit <- 5
lower.limit <- 0
set.seed(123)
x <- sample(-200000:200000)
for(i in 1:length(x)){
k <- starting.limit + x[i]
k <- ifelse(k > upper.limit, upper.limit, ifelse(k < lower.limit, lower.limit,k))
starting.limit <- k
}},
m2 = {
set.seed(123)
x <- sample(-200000:200000)
vec <- purrr::accumulate(c(5, x), k_fun)
k <- tail(vec, 1)
},
m3 = {
x <- sample(-200000:200000)
xd <- as.data.frame(x)
colnames(xd) <- c("dat")
xd %>%
mutate(sm = starting.limit) %>%
mutate(sm = if_else(sm+lead(dat,1) > upper.limit, upper.limit
, if_else(sm+lead(dat,1) < lower.limit, lower.limit, sm) )) %>%
select(sm) %>%
filter(sm != is.na(sm)) %>%
tail(n=1)
}
)
output:
Unit: milliseconds
expr min lq mean median uq max neval
m1 1223.49718 1255.69514 1272.2679 1260.9643 1272.3401 1392.0402 100
m2 964.76948 982.96555 1007.5521 989.5366 1007.9106 1173.2754 100
m3 68.80358 76.77386 133.0509 170.5572 177.0051 274.9299 100