rperformance

# calculate a sequence of expressions efficiently

I have some data

set.seed(1)
n <- 100
df <- data.frame(
x = sample(1:30, n, replace = T),
y = sample(1:30, n, replace = T),
z = sample(1:30, n, replace = T)
)

and vector with expressions, they may be different.

rules <- c("df\$x[i] < df\$y[i-2] - df\$x[i]",
"df\$y[i] >= mean(df\$x)",
"df\$y[i] == 20",
"df\$z[i-30] >= df\$x[5]",
"df\$y[i-5] == 16",
"df\$x[10] > sd(as.matrix(df[(i-5):i,]))")

Next, I have a function that sequentially searches for the triggering of the first expression, then the second, and so on

seq_rules <- function(df, rules, show=T){

ln <- length(rules)
res <- matrix(0,nrow = ln, ncol = 2, dimnames = list(NULL, c("row","res")))
n <- 1

for(i in 30:nrow(df)){
if(eval(str2expression(rules[n]))){
res[n,"row"] <- i
res[n,"res"] <- 1
if(show) print( cbind.data.frame(df[i,], rule=rules[n], row=i))
n <- n+1
}
if(n>ln) break
}
res
}

I would like to speed up my code. How would you write this code to make it as fast as possible? I also like your solution to be identical to mine on different seeds

=======================================

if the rules are represented as already evaluated functions

Frules <- lapply(rules,\(x) eval(str2expression(paste("function(i) {", x ,"}"))))

Then i can gain a little speed due to the absence of eval(str2expression..)) in the loop

New function

Fseq_rules <- function(df, rules){
ln <- length(rules)
res <- matrix(0,nrow = ln, ncol = 2, dimnames = list(NULL, c("row","res")))
n <- 1
for(i in 30:nrow(df)){
if(rules[[n]](i)){
res[n,"row"] <- i
res[n,"res"] <- 1
n <- n+1
}
if(n>ln) break
}
res
}

microbenchmark::microbenchmark(Fseq_rules(df, Frules),
seq_rules(df, rules,show = F),times = 100)
Unit: milliseconds
expr      min       lq     mean   median       uq      max neval
Fseq_rules(df, Frules) 1.083315 1.118951 1.283135 1.156011 1.247808 5.601309   100
seq_rules(df, rules, show = F) 2.495045 2.545790 2.779712 2.607938 2.861662 6.243315   100

Solution

• Not much faster than your original:

rules2 <- c(
"x[i] < y[i-2] - x[i]",
"y[i] >= mean(x)",
"y[i] == 20",
"z[i-30] >= x[5]",
"y[i-5] == 16",
"x[10] > sd(as.matrix(df[(i-5):i,]))"
)

seq_rules2 <- function(df, rules) {
rules <- sapply(rules, str2expression)
M <- length(rules)
res <- matrix(0L, nrow = M, ncol = 2L, dimnames = list(NULL, c("row", "res")))
j <- 1L

for (i in 30:nrow(df)) {
if (eval(rules[[j]], envir = df)) {
res[j, ] <- c(i, 1L)
j <- j + 1L
}
if(j > M) break
}
res
}

bench::mark(seq_rules(df, rules), seq_rules2(df, rules2))

You will gain a lot of speed if you replace df by a matrix. And change the rules accordingly:

M <- as.matrix(df)

rules_matrix <- c(
"df[i, 'x'] < y[i-2] - x[i]",
"df[i, 'y'] >= mean(df[, 'x'])",
"df[i, 'y'] == 20",
"df[i-30, 'z'] >= df[5, 'x']",
"df[i-5, 'y'] == 16",
"df[10, 'x'] > sd(df[(i-5):i, ])"
)

seq_rules_matrix <- function(df, rules) {
rules <- sapply(rules, str2expression)
M <- length(rules)
res <- matrix(0L, nrow = M, ncol = 2L, dimnames = list(NULL, c("row", "res")))
j <- 1L

for (i in 30:nrow(df)) {
if (eval(rules[[j]])) {
res[j, ] <- c(i, 1L)
j <- j + 1L
}
if(j > M) break
}
res
}

bench::mark(
mat = seq_rules_matrix(M, rules_matrix),
df = seq_rules2(df, rules2)
)