Ｒプログラミング入門 ２０回目（最終回）
ベクトル化コードの続きです。
この記事で作成したスロットマシーンのシミュレーションを行います。
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){ # １つ行内のチェリーとダイヤを数える 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秒で完了です。
コードの処理が速い事は、つくづく重要ですね。
大量データを利用した統計解析を行うためには、とてつもなく重要な考え方であり、
ベクトル化コードにするための、スキルも必要ですね。
今まで、この本に沿って、２０回に渡り、
全くの無知状態から、Rプログラミングを入門してましたが、本を読んだ感想は、別の記事にまとめます。
www.oreilly.co.jp
