読者です 読者をやめる 読者になる 読者になる

Mukku John Blog

取り組んでいること を つらつら と

Rプログラミング入門 20回目(最終回)

Rプログラミング入門

ベクトル化コードの続きです。

この記事で作成したスロットマシーンのシミュレーションを行います。
mukkujohn.hatenablog.com

なぜベクトル化コードにするのか?

例えば、以前作成した関数を用いて、賞金の平均を求めるとすると
こんな感じでループで1回ずつ試行して、求めます。

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

ですが、10万回で、3秒かかります。

> system.time(for (i in 1:100000){
+ winings[i] <- play()
+ })
   ユーザ   システム       経過  
      3.11       0.00       3.11 

100万回で、、、待てなかったのでbreakしました。

Timing stopped at: 290.58 434.06 735.9

735秒 ≒ 12分オーバー。我慢した方だと思います。

なので、ベクトル化コードに変更して、少しでもコードを速くするのです。

といっても、、、

今の関数は、1回(=1行)を対象にしているので、
試行回数を増やすにはループするしかありません。

なので、今の回数を複数回(=複数行)を対象に変更します。

まずは、引数分のシンボルを作成するget_many_symbols関数です。

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.1,0.52))
  matrix(vec, ncol = 3)
}

こんな感じですね。

> get_many_symbols(10)
      [,1] [,2] [,3]
 [1,] "B"  "B"  "0" 
 [2,] "BB" "B"  "0" 
 [3,] "0"  "B"  "C" 
 [4,] "7"  "0"  "B" 
 [5,] "7"  "7"  "0" 
 [6,] "0"  "B"  "BB"
 [7,] "BB" "0"  "B" 
 [8,] "0"  "B"  "0" 
 [9,] "0"  "B"  "C" 
[10,] "B"  "BB" "7" 


次に、複数行に対応したscore_many関数です。

score_many <- function(symbols){
  # 1つ行内のチェリーとダイヤを数える
  cherries <- rowSums(symbols == "C")
  diamonds <- rowSums(symbols == "DD")
  
  # ダイヤはチェリーとして数える
  prize <- c(0,2,5)[cherries + diamonds + 1]
  
  # チェリーがない場合は、賞金を0にする
  prize[!cherries] <- 0
  
  # 賞金のルックアップテーブルを作成
  payoffs <- c("DD" = 100, "7" = 80, "BBB" = 40, "BB" = 25, "B" = 10, "C" = 10,"0" = 0)
  
  # 全てのシンボルが同じ場合の賞金
  same <- symbols[ , 1] == symbols[ , 2] & symbols[ , 2] == symbols[ , 3]
  prize[same] <- payoffs[symbols[same,1]]
  
  # 全てバーの場合の賞金
  bars <- symbols == "B" | symbols == "BB" | symbols == "BBB"
  all_bars <- bars[ , 1] & bars[ , 2] & bars[ , 3] & !same
  prize[all_bars] <- 5
  
  ## ダイヤの処理
  
  # ダイヤが2個ある場合
  two_wilds <- diamonds == 2
  
  # 2列目と3列目が同じ行 → つまり1列目がダイヤ以外のシンボルの行
  one <- two_wilds & symbols[ , 1] != symbols[ , 2] & symbols[ , 2] == symbols[ , 3]
  # 1列目と3列目が同じ行 → つまり2列目がダイヤ以外のシンボルの行
  two <- two_wilds & symbols[ , 1] != symbols[ , 2] & symbols[ , 1] == symbols[ , 3]
  # 1列目と2列目が同じ行 → つまり3列目がダイヤ以外のシンボルの行
  three <- two_wilds & symbols[ , 1] == symbols[ , 2] & symbols[ , 2] != symbols[ ,3] 
  
  # 全て同じシンボルとして賞金を計算する
  # 1列目がダイヤ以外のシンボルのため、1列目のシンボルの賞金を設定する
  prize[one] <- payoffs[symbols[one, 1]]
  # 2列目がダイヤ以外のシンボルのため、2列目のシンボルの賞金を設定する
  prize[two] <- payoffs[symbols[two, 2]]
  # 3列目がダイヤ以外のシンボルのため、3列目のシンボルの賞金を設定する
  prize[three] <- payoffs[symbols[three,3]]
  
  # ダイヤが1個ある場合
  one_wilds <- diamonds == 1
  
  # ダイヤが1個で、他がバーならバーにする
  wild_bars <- one_wilds & (rowSums(bars) == 2)
  prize[wild_bars] <- 5
  
  # ダイヤ1個 + 1列目と2列目が同じ → 1列目のシンボルが全ての列に設定されているとする
  one <- one_wilds & symbols[ , 1] == symbols[ , 2]
  # ダイヤ1個 + 2列目と3列目が同じ → 2列目のシンボルが全ての列に設定されているとする
  two <- one_wilds & symbols[ , 2] == symbols[ , 3]
  # ダイヤ1個 + 3列目と1列目が同じ → 3列目のシンボルが全ての列に設定されているとする
  three <- one_wilds & symbols[ , 3] == symbols[, 1]
  
  # 全ての列のシンボルが1列目のシンボルと同じとして、1列目のシンボルの賞金を設定する
  prize[one] <- payoffs[symbols[one, 1]]
  # 全ての列のシンボルが2列目のシンボルと同じとして、2列目のシンボルの賞金を設定する
  prize[two] <- payoffs[symbols[two, 2]]
  # 全ての列のシンボルが3列目のシンボルと同じとして、3列目のシンボルの賞金を設定する
  prize[three] <- payoffs[symbols[three, 3]]
  
  # 最後、ダイヤ1個毎に賞金を倍にする
  unname(prize * 2^diamonds )
  
}

(別に真新しい関数が出ているわけでもないので、実際に動作を見ながらだと理解できる範囲です。)

そして、get_many_symbols関数とscore_many関数を利用するplay_many関数です。

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

さて、実際に速度を測定してみます。

まずは10万回。

> system.time(play_many(100000))
   ユーザ   システム       経過  
      0.17       0.01       0.19 

ループで処理した場合は、3秒だったので、15倍速くなりました。

次に100万回。(実行するのが怖い。。。)

> system.time(play_many(1000000))
   ユーザ   システム       経過  
      1.83       0.19       2.10

2秒!!
12分以上かかっても、終わらない処理がたったの2秒で完了です。

コードの処理が速い事は、つくづく重要ですね。

大量データを利用した統計解析を行うためには、とてつもなく重要な考え方であり、
ベクトル化コードにするための、スキルも必要ですね。


今まで、この本に沿って、20回に渡り、
全くの無知状態から、Rプログラミングを入門してましたが、本を読んだ感想は、別の記事にまとめます。
www.oreilly.co.jp