Accelerating ifelse () without writing C / C ++?

Question

I need to get the results of the following function

getScore <- function(history, similarities) { nh<-ifelse(similarities<0, 6-history,history) x <- nh*abs(similarities) contados <- !is.na(history) x2 <- sum(x, na.rm=TRUE)/sum(abs(similarities[contados]),na.rm=TRUE) x2 } 

For example, for the following vectors:

 notes <- c(1:5, NA) history <- sample(notes, 1000000, replace=T) similarities <- runif(1000000, -1,1) 

This changes inside the loop. It takes:

 ptm <- proc.time() for (i in (1:10)) getScore(history, similarities) proc.time() - ptm user system elapsed 3.71 1.11 4.67 

Initially, I suspect that the problem is with the for loop, but the result of the profiling points to ifelse() .

 Rprof("foo.out") for (i in (1:10)) getScore(history, similarities) Rprof(NULL) summaryRprof("foo.out") $by.self self.time self.pct total.time total.pct "ifelse" 2.96 65.78 3.48 77.33 "-" 0.24 5.33 0.24 5.33 "getScore" 0.22 4.89 4.50 100.00 "<" 0.22 4.89 0.22 4.89 "*" 0.22 4.89 0.22 4.89 "abs" 0.22 4.89 0.22 4.89 "sum" 0.22 4.89 0.22 4.89 "is.na" 0.12 2.67 0.12 2.67 "!" 0.08 1.78 0.08 1.78 $by.total total.time total.pct self.time self.pct "getScore" 4.50 100.00 0.22 4.89 "ifelse" 3.48 77.33 2.96 65.78 "-" 0.24 5.33 0.24 5.33 "<" 0.22 4.89 0.22 4.89 "*" 0.22 4.89 0.22 4.89 "abs" 0.22 4.89 0.22 4.89 "sum" 0.22 4.89 0.22 4.89 "is.na" 0.12 2.67 0.12 2.67 "!" 0.08 1.78 0.08 1.78 $sample.interval [1] 0.02 $sampling.time [1] 4.5 

ifelse() is my performance bottleneck. If R has a way to speed up ifelse() , there is unlikely to be a big performance boost.

However, ifelse() already a vectorized approach. It seems to me that the only chance is to use C / C ++. But is there a way to avoid using compiled code?

Answer 1

I have come across this before. We should not use ifelse() all the time. If you look at how ifelse is written by typing “ifelse” in your R console, you will see that this function is written in R, and it performs various checks, which is really inefficient.

Instead of using ifelse() we can do this:

 getScore <- function(history, similarities) { ######## old code ####### # nh <- ifelse(similarities < 0, 6 - history, history) ######## old code ####### ######## new code ####### nh <- history ind <- similarities < 0 nh[ind] <- 6 - nh[ind] ######## new code ####### x <- nh * abs(similarities) contados <- !is.na(history) sum(x, na.rm=TRUE) / sum(abs(similarities[contados]), na.rm = TRUE) } 

And then check the profiling result again:

 Rprof("foo.out") for (i in (1:10)) getScore(history, similarities) Rprof(NULL) summaryRprof("foo.out") # $by.total # total.time total.pct self.time self.pct # "getScore" 2.10 100.00 0.88 41.90 # "abs" 0.32 15.24 0.32 15.24 # "*" 0.26 12.38 0.26 12.38 # "sum" 0.26 12.38 0.26 12.38 # "<" 0.14 6.67 0.14 6.67 # "-" 0.14 6.67 0.14 6.67 # "!" 0.06 2.86 0.06 2.86 # "is.na" 0.04 1.90 0.04 1.90 # $sample.interval # [1] 0.02 # $sampling.time # [1] 2.1 

We have a 2+ increase in productivity . In addition, the profile is more like a flat profile, without any one part dominating the runtime.

In R, vector indexing / reading / writing is done at the speed of the C code, so whenever we can, use a vector.

---

Testing @ Matveyevsky answer

 mat_getScore <- function(history, similarities) { ######## old code ####### # nh <- ifelse(similarities < 0, 6 - history, history) ######## old code ####### ######## new code ####### ind <- similarities < 0 nh <- ind*(6-history) + (!ind)*history ######## new code ####### x <- nh * abs(similarities) contados <- !is.na(history) sum(x, na.rm=TRUE) / sum(abs(similarities[contados]), na.rm = TRUE) } Rprof("foo.out") for (i in (1:10)) mat_getScore(history, similarities) Rprof(NULL) summaryRprof("foo.out") # $by.total # total.time total.pct self.time self.pct # "mat_getScore" 2.60 100.00 0.24 9.23 # "*" 0.76 29.23 0.76 29.23 # "!" 0.40 15.38 0.40 15.38 # "-" 0.34 13.08 0.34 13.08 # "+" 0.26 10.00 0.26 10.00 # "abs" 0.20 7.69 0.20 7.69 # "sum" 0.18 6.92 0.18 6.92 # "<" 0.16 6.15 0.16 6.15 # "is.na" 0.06 2.31 0.06 2.31 # $sample.interval # [1] 0.02 # $sampling.time # [1] 2.6 

A? Slower?

The full profiling result shows that this approach spends more time on floating-point multiplication "*" , and the logical one is not "!" seems pretty expensive. Although my approach only requires floating point addition / subtraction.

Well, the result may also be architecture dependent. I'm currently testing Intel Nahalem (Intel Core 2 Duo). Therefore, benchmarking between the two approaches on different platforms is welcome.

---

Note

All profiling uses OP data in question.

Answer 2

You can use logical multiplication for this task to achieve the same effect:

 s <- similarities < 0 nh <- s*(6-history) + (!s)*history 

Test for i7-3740QM:

 f1 <- function(history, similarities) { s <- similarities < 0 s*(6-history) + (!s)*history} f2 <- function(history, similarities) ifelse(similarities<0, 6-history,history) f3 <- function(history, similarities) { nh <- history ind <- similarities<0 nh[ind] <- 6 - nh[ind] nh } microbenchmark(f1(history, similarities), f2(history, similarities), f3(history, similarities)) ## Unit: milliseconds ## expr min lq mean median uq max neval cld ## f1(history, similarities) 22.830260 24.6167695 28.31384860 24.89869950000000 25.651655 81.043713 100 a ## f2(history, similarities) 364.514460 412.7117810 408.37156626 415.10114899999996 417.345748 437.977256 100 c ## f3(history, similarities) 84.220279 86.2894795 92.64614571 87.18016549999999 89.616522 149.243051 100 b 

In E5-2680 v2:

 ## Unit: milliseconds ## expr min lq mean median uq max neval cld ## f1(history, similarities) 20.03963 20.10954 21.41055 20.68597 21.25920 50.95278 100 a ## f2(history, similarities) 314.54913 315.96621 324.91486 319.50290 325.93168 378.26016 100 c ## f3(history, similarities) 73.81413 73.92162 76.10418 74.79893 75.84634 105.98770 100 b 

On the T5600 (Core2 Duo Mobile):

 ## Unit: milliseconds expr min lq mean median uq max neval cld ## f1(history, similarities) 147.2953 152.9307 171.0870 155.5632 167.0998 344.7524 100 b ## f2(history, similarities) 408.5728 493.3886 517.0573 501.6993 525.8573 797.9624 100 c ## f3(history, similarities) 102.9621 110.6003 131.1826 112.9961 125.3906 303.1170 100 a 

Yeah! My approach is slower in Core 2 architecture.

Answer 3

Here is a faster ifelse , although it is not faster than the answers above, it supports the ifelse structure.

 ifelse_sign <- function(b,x,y){ x[!b] <- 0 y[b] <-0 x + y + b *0 }