R语言之代码提速（对老虎机案例进行优化）

代码提速

一、向量化代码

快速的R代码都经常用到三大法宝:逻辑测试、 取子集和元素方式执行。
用到这三大法宝的R代码往往都具有一种特性:代码是向量化的。所谓向量化代码就是指代码可以接受一个含有多个值的向量作为输入,并且同时操作向量中的每一个元素。

函数abs_loop利用for循环对该向量的元素逐一取绝对值。

vec <- c(1,-2,3,4,-5)

abs_loop<-function(vec){
  for(i in 1:length(vec)){
    if(vec[i]<0){vec[i]<--vec[i]}
  }
  vec
  }

abs_loop(vec)函数abs_loop利用for循环对该向量的元素逐一取绝对值

vec<-c(1,-3,-7,6)
abs_set<-function(vec){
   negs<-vec<0
   vec[negs]<-vec[negs]* -1
   vec
   
}

abs_set(vec)使用了逻辑值取子集的方法将所有的负数同时转换成了正数。

首先生成一个包含正数和负数的长向量long,它含有1000万个数值。long<-rep(c(-1,1),5000000)
rep的作用是重复生成某一个值或向量。它的使用方法是,先指定需要重复生成的值或向量,再设定想要重复的次数。
接下来用system.time测量两个函数完成long元素的绝对值转换所需要的时间。

system.time(abs_loop(long))
system.time(abs_set(long))

不要混淆system.time和sys.time,后者的作用是返回当前的系统时间。

二、如何编写向量化代码

要编写向量化代码,可以尝试以下两种方法。
(1)对于程序中的有序步骤,使用向量化的函数来完成。
(2)对于同类情况,使用逻辑值取子集的方式来处理。尝试一次性处理完成一类情况中的所有元素

比如说,vec可以识别出vec向量中所有的负数元素。使用相同的逻辑测试,可以通过逻辑值取子集的方法取出所有的负数值。

vec<-c(1,-2,3,-4,5,-6,7,-8,9,-10)
vec<0
vec[vec<0]

下面这个函数的功能是将一个包含老虎机符号的向量转换成一批新的符号。能尝试将这段代码向量化吗?向量化之后的代码比原代码快了多少?

change_symbols<-function(vec){
  for(i in 1:length(vec)){
    if(vec[i]=="DD"){
      vec[i]<-"joker"
    }else if(vec[i]=="C"){
      vec[i]<-"ace"
    }else if(vec[i]=="7"){
      vec[i]<-"king"
    }else if(vec[i]=="B"){
      vec[i]<-"queen"
    }else if(vec[i]=="BB"){
      vec[i]<-"jack"
    }else if(vec[i]=="BBB"){
      vec[i]<-"ten"
    }else {vec[i]<-"nine"
    }
  }
  vec
}
vec<-c("DD","7","BBB","BB","B","C","0")  
change_symbols(vec)
many<-rep(vec,1000000)       
system.time(change_symbols(many))

change_symbols函数使用一个for循环将符号分成了七种情况,要向量化change_symbols,首先针对每一种情况创建一个逻辑测试。

 vec[vec=="DD"]
vec[vec=="C"]
vec[vec=="7"]
vec[vec=="B"]
vec[vec=="BB"]
vec[vec=="BBB"]
vec[vec=="0"]

针对每一种情况写出更改符号的代码。

vec[vec=="DD"]<-"joker"
vec[vec=="C"]<-"ace"
vec[vec=="7"]<-"king"
vec[vec=="B"]<-"queen"
vec[vec=="BB"]<-"jack"
vec[vec=="BBB"]<-"ten"
vec[vec=="0"]<-"nine"

把这两个步骤整合为一个函数就得到了向量化版本change_symbols,它的运行速度会加快。

change_vec<-function(vec){
  vec[vec=="DD"]<-"joker"
  vec[vec=="C"]<-"ace"
  vec[vec=="7"]<-"king"
  vec[vec=="B"]<-"queen"
  vec[vec=="BB"]<-"jack"
  vec[vec=="BBB"]<-"ten"
  vec[vec=="0"]<-"nine"
  vec
}
system.time(change_vec(many))

更快方案：使用查找表

change_vec2<-function(vec){
  tb<-c("DD"="joker","C"="ace","7"="king","B"="queen","BB"="jack","BBB"="ten","0"="nine")  
  unname(tb[vec])
}
system.time(change_vec2(many))

在R中编程时,没有代码编译这一步。省去这一步为R的编程过程带来了更好的用户体验。但遗憾的是,这也就意味着循环语句的速度难以达到C或Fortran的水平.

三、如何在R中编写快速的for循环

对于for循环,做两件事情可以明显改善每个循环的运行效率。

首先,能放在循环外的代码,就一定不要放在循环内。for循环内的每一行代码都会被运行许多次。如果某一行代码只需要运行一次,就应该把它置于循环外,以避免不必要的重复性操作。

第二件事情是要确保用来存储循环输出结果的对象必须具备足够的容量,以容纳循环的所有结果。

system.time({output<-rep(NA,1000000)
for(i in 1:1000000){
  output[i]<-i+1
}
})

system.time({
  output<-NA
  for(i in 1:1000000){
    output[i]<-i+1
  }
})

在第二个例子中,循环每前进一步,R都必须延长output的长度以容纳新的输出结果。要做到这一点,R就需要在内存中找到一个新的位置以存放更大的对象。

因此,在循环结束的时候,R已经output将在内存中反复重写了100万次。在第一个例子中,output的大小在循环过程中始终没有任何改变;R可以在循环之前就在内存中定义好一个固定长度的output对象,并且在for循环的整个过程中都使用同一个output.

四、向量化编程实战

winnings<-vector(length=1000000)
for(i in 1:1000000){
  winnings[i]<-play()
}
mean(winnings)

system.time(for(i in 1:1000000){
  winnings[i]<-play()
})

重写get_symbols函数以生成n个老虎机符号组合,并且将结果置于一个n×3的矩阵之中：

get_many_symbols<-function(n){
  wheel<-c("DD","7","BBB","BB","B","C","0")
  vec<-sample(wheel,size=3*n,replace=TRUE,
              prob=c(0.03,0.03,0.06,0.1,0.25,0.01,0.52))
  matrix(vec,ncol=3)
}
get_many_symbols(5)

重新编写一个play函数,它的参数为n。该函数在一个数据框中输出n个奖金值。

play_many<-function(n){
  symb_mat<-get_many_symbols(n=n)
  data.frame(w1=symb_mat[,1],w2=symb_mat[,2],
             w3=symb_mat[,3],prize=score_many(symb_mat))
}

编写一个向量化版本的score函数。假设数据存储在一个 n×3矩阵中,并且该矩阵的每一行都存储了一次老虎机游戏转出的符号组合。

重新编写后的计算金额的代码：

score_many<-function(symbols){
  #第1步根据樱桃和钻石的出现情况分配基础金额
  ##计算在每个符号组合中樱桃和钻石出现的次数
  cherries<-rowSums(symbols=="C")
  diamonds<-rowSums(symbols=="DD")
  ##将百搭的钻石视为樱桃,计算樱桃出现的次数
  prize<-c(0,2,5)[cherries+diamonds+1]
  ##但当一个樱桃都没有时例外
  ##(当cherries==0时,cherries被强制转换为FALSE)
  prize[!cherries]<-0
  #第2步:当符号组合是三个相同的符号时,改变奖金值
  same<-symbols[,1]==symbols[,2]&symbols[,2]==symbols[,3]
  payoffs<-c("DD"=100,"7"=80,"BBB"=40,"BB"=25,"B"=10,"C"=10,"0"=0)
  prize[same]<-payoffs[symbols[same,1]]
  #第3步:当符号组合中都是杠时,改变奖值
  bars<-symbols=="B"|symbols=="BB"|symbols=="BBB"
  all_bars<-bars[,1]&bars[,2]&bars[,3]&!same
  prize[all_bars]<-5
  #第4步:处理百搭符号
  ##当有两个钻石时
  two_wilds<-diamonds==2
  ###识别出非百搭符号
  one<-two_wilds&symbols[,1]!=symbols[,2]&symbols[,2]==symbols[,3]
  two<-two_wilds&symbols[,1]!=symbols[,2]&symbols[,1]==symbols[,3]
  three<-two_wilds&symbols[,1]==symbols[,2]&symbols[,2]!=symbols[,3]
  #当作三个相同的符号处理
  prize[one]<-payoffs[symbols[one,1]]
  prize[two]<-payoffs[symbols[two,2]]
  prize[three]<-payoffs[symbols[three,3]]
  ##当有一个钻石时
  one_wild<-diamonds==1
  ##当作全是杠来处理(如果合适的话)
  wild_bars<-one_wild&(rowSums(bars)==2)
  prize[wild_bars]<-5
  ###当作三个相同的符号处理(如果合适的话)
  one<-one_wild&symbols[,1]==symbols[,2]
  two<-one_wild&symbols[,2]==symbols[,3]
  three<-one_wild&symbols[,3]==symbols[,1]
  prize[one]<-payoffs[symbols[one,1]]
  prize[two]<payoffs[symbols[two,2]]
  prize[three]<-payoffs[symbols[three,3]]
  #第5步:根据组合中出现的钻石个数,加倍奖金值
  unname(prize*2^diamonds)
}
system.time(play_many(10000000))

可以看到计算了10000000金额采用了7秒多，可以说是速度得到了大幅度的提升。

标签：代码,time,提速,案例,循环,vec,量化,output,老虎机
来源： https://blog.csdn.net/sjjsaaaa/article/details/111824045