planB
planB

Reputation: 11

fast mapply in R or vectorization

I have a quite large data frame, about 10 million rows, in my example this is represented by vectors x1 and y1.

set.seed(100)
x1<-round(runif(10000,min=1,max=5),0) #random values [1;2;3;4;5]
x2<-runif(10000,min=0,max=1) #random num (0,1]

I want to compute the new vector xx with the help of the following table 'rvps'.

rvps<-data.frame(Q_cat=c(1,2,2,2,3,3,3,4,4,5),prov_calc=c(0,1,10,20,21,30,50,51,60,100),
       s3_from=c(0.00,0.00,0.90,0.99,0.00,0.60,0.65,0.00,0.99,0.00), 
       s3_to=c(1.00,0.90,0.99,1.00,0.60,0.65,1.00,0.99,1.00,1.00))

I made several solutions:

#sol№1
library(doParallel)
xx1<-foreach(i=1:length(x1)) %do% {rvps$prov_calc[x1[i]==rvps$Q_cat & x2[i]>rvps$s3_from & x2[i]<=rvps$s3_to]}
#system.time=2.87

Too slow

#sol№2
xx2<-ifelse(x1==1,0,
     ifelse(x1==2,
            ifelse(x2>0 & x2<=0.9,1,
            ifelse(x2>0.9 & x2<=0.99,10,
            ifelse(x2>0.99 & x2<=1,20,20))),
     ifelse(x1==3,
            ifelse(x2>0 & x2<=0.6,21,
            ifelse(x2>0.6 & x2<=0.65,30,
            ifelse(x2>0.65 & x2<=1,50,50))),
     ifelse(x1==4,
            ifelse(x2>0 & x2<=0.99,51,
            ifelse(x2>0.99 & x2<=1,60,60)),
     ifelse(x1==5,100,100)))))
#system.time=0.02

without my table (all boundaries entered manualy) but fast

#sol№3
rvps.prob<-function(X,Y) {rvps$prov_calc[X==rvps$Q_cat & Y>rvps$s3_from & Y<=rvps$s3_to]}
xx3<-mapply(rvps.prob,x1,x2)
#system.time=0.59

mapply solution. Faster than my first try but not as rapid as I need. How can I vectorize my task? The same question in russian.

upd: a few more solutions from my colleagues. All lose to vectorized functions

#4 вариант #system.time=1.03
system.time(for(i in 1:length(x1))
{
  if (rvps$prov_calc[x1[i]==rvps$Q_cat & x2[i]>rvps$s3_from & x2[i]<=rvps$s3_to]) 
    xx4[i] <- rvps$prov_calc[x1[i]==rvps$Q_cat & x2[i]>rvps$s3_from & x2[i]<=rvps$s3_to]
  else xx4[i] <- 0
})

#5 вариант #system.time=3.57
system.time({
  xx5<-unlist(foreach(i=1:length(x1)) %do% {rvps$prov_calc[x1[i]==rvps$Q_cat & x2[i]>rvps$s3_from & x2[i]<=rvps$s3_to]})
  })

#6 вариант #system.time=2.24
system.time(for(i in 1:length(x1))
{
  for(j in 1:length(rvps$prov_calc)) 
    if (x1[i]==rvps$Q_cat[j] & x2[i]>rvps$s3_from[j] & x2[i]<=rvps$s3_to[j]) {xx6[i] <- rvps$prov_calc[j];break}
})

Upvotes: 1

Views: 337

Answers (1)

planB
planB

Reputation: 11

Quintessence of my work is presented below.

Initial data:

mm1<-round(runif(200000,min=1,max=5),0) #random values [1;2;3;4;5]
mm2<-runif(200000,min=0,max=1) #random num (0,1]  

Vectorization with {dplur} №1:

system.time({
mm3<-if_else(mm1==1,0,
  if_else(mm1==2 & mm2>0 & mm2<= 0.9,1,
  if_else(mm1==2 & mm2>0.9 & mm2<= 0.99,10,
  if_else(mm1==2 & mm2>0.99 & mm2<= 1,20,
  if_else(mm1==3 & mm2>0.0 & mm2<= 0.6,21,
  if_else(mm1==3 & mm2>0.6 & mm2<= 0.65,30,
  if_else(mm1==3 & mm2>0.65 & mm2<= 1,50,
  if_else(mm1==4 & mm2>0 & mm2<= 0.99,51,  
  if_else(mm1==4 & mm2>0.99 & mm2<= 1,60,
  if_else(mm1==5,100,100))))))))))
}) #system.time=0.14

Vectorization with {dplur} №2:

system.time({
mm3<-case_when(
  mm1==1 ~ 0,
  mm1==2 & mm2>0 & mm2<= 0.9 ~ 1,
  mm1==2 & mm2>0.9 & mm2<= 0.99 ~ 10,
  mm1==2 & mm2>0.99 & mm2<= 1 ~ 20,
  mm1==3 & mm2>0.0 & mm2<= 0.6 ~ 21,
  mm1==3 & mm2>0.6 & mm2<= 0.65 ~ 30,
  mm1==3 & mm2>0.65 & mm2<= 1 ~ 50,
  mm1==4 & mm2>0 & mm2<= 0.99 ~ 51,  
  mm1==4 & mm2>0.99 & mm2<= 1 ~ 60,
  mm1==5 ~ 100) #system.time=0.14
}) #system.time=0.08

Upvotes: 0

Related Questions