Rまたはベクトル化の高速マッピング

Question

私は非常に大きなデータフレーム、約1,000万行を持っています。私の例では、これはベクトルx1と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] 

私は、次の表に「rvps」の助けを借りて、新しいベクトルxxを計算したいです。私のテーブルなし

#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 

#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 

遅すぎる（すべての境界がてmanualy入力された）が、速い

#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ソリューション：

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)) 

は、私はいくつかのソリューションを作りました。私の最初の試みよりも速いが、私が必要とするほど速くはない。どのようにタスクをベクトル化できますか？ The same question in russian。

更新：私の同僚からのいくつかの解決策。すべてベクトル化関数を失う

#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} 
}) 

Answer 1

私の仕事の完全性は以下のとおりです。

初期データ：{dplur}№1と

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] 

ベクトル化：{dplur}№2と

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 

ベクトル化：

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