Mukku John Blog

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

Rプログラミング入門 18回目

過去記事で作成したスロットマシンの賞金の期待値を算出していきます。
{ \displaystyle
E(prize)\ =\ \sum_{i=1}^{n}(prize_i\ \cdot\ P(prize_i))
}

シンボルの一覧はこちらです。

> wheel <- c("DD","7","BBB","BB","B","C","0")
> wheel
[1] "DD"  "7"   "BBB" "BB"  "B"   "C"   "0" 

この記事で使用したexpand.grid関数を使って、全ての組み合わせを作ります。
mukkujohn.hatenablog.com

> combos <- expand.grid(wheel, wheel,wheel, stringsAsFactors = FALSE)
> head(combos,3)
  Var1 Var2 Var3
1   DD   DD   DD
2    7   DD   DD
3  BBB   DD   DD
> tail(combos,3)
    Var1 Var2 Var3
341    B    0    0
342    C    0    0
343    0    0    0

個々のシンボルが出る確率がこちら。

> prob = c("DD" = 0.03, "7" = 0.03, "BBB" = 0.06, "BB" = 0.1,
+ "B" = 0.25, "C" = 0.01, "0" = 0.52)
> prob
  DD    7  BBB   BB    B    C    0 
0.03 0.03 0.06 0.10 0.25 0.01 0.52 

上記のルックアップテーブルを参照して、各シンボルが出る確率を並べます。

> combos$prob1 <- prob[combos$Var1]
> combos$prob2 <- prob[combos$Var2]
> combos$prob3 <- prob[combos$Var3]
> head(combos,3)
  Var1 Var2 Var3 prob1 prob2 prob3
1   DD   DD   DD  0.03  0.03  0.03
2    7   DD   DD  0.03  0.03  0.03
3  BBB   DD   DD  0.06  0.03  0.03

そして、個々の確率を掛け合わせて、組み合わせが出る確率にします。

> combos$prob <- combos$prob1 * combos$prob2 * combos$prob3
> head(combos,3)
  Var1 Var2 Var3 prob1 prob2 prob3    prob
1   DD   DD   DD  0.03  0.03  0.03 2.7e-05
2    7   DD   DD  0.03  0.03  0.03 2.7e-05
3  BBB   DD   DD  0.06  0.03  0.03 5.4e-05

本当に、組み合わせが出る確率が合っているか確認します。

> sum(combos$prob)
[1] 1

1になっているので、大丈夫ですね。

次に、個々の賞金額を算出していきます。

> symbols <- c(combos[1,1], combos[1,2] , combos[1,3])
> symbols
[1] "DD" "DD" "DD"
> score(symbols)
[1] 800

ここで、問題が、、、343行分もやってられない。。。
というわけで、ループ。

forループ

個々の要素について、同じ処理をしてくれます。
forループの書き方はこのとおり。

for ( value in that){
 this
}

実際に、各行の賞金を計算する前に、計算した賞金が入る列を用意します。

> combos$prize <- NA
> head(combos,3)
  Var1 Var2 Var3 prob1 prob2 prob3    prob prize
1   DD   DD   DD  0.03  0.03  0.03 2.7e-05    NA
2    7   DD   DD  0.03  0.03  0.03 2.7e-05    NA
3  BBB   DD   DD  0.06  0.03  0.03 5.4e-05    NA

で、forループで1行ずつ賞金を計算して設定します。

> for(i in 1:nrow(combos)){
+ symbols <- c(combos[i,1], combos[i,2],combos[i,3])
+ combos$prize[i] <- score(symbols)
+ }
> head(combos,3)
  Var1 Var2 Var3 prob1 prob2 prob3    prob prize
1   DD   DD   DD  0.03  0.03  0.03 2.7e-05   800
2    7   DD   DD  0.03  0.03  0.03 2.7e-05     0
3  BBB   DD   DD  0.06  0.03  0.03 5.4e-05     0

そして、組み合わせの確率と組み合わせの賞金の額をかけ、全てを足します。

> sum(combos$prob * combos$prize)
[1] 0.538014

1ドル払って、戻りが54セント。
・・・少ない。思っているよりやっぱり少ない。

この記事をよくみると、ダイヤはワイルドカードな扱いです。
mukkujohn.hatenablog.com
ですが、この記事で作成したscore関数では、ワイルドカード扱いになってません。
mukkujohn.hatenablog.com

そこで、ダイヤがワイルドカードとなるように修正して、
再度、シンボルの組み合わせの賞金額を設定するところから行います。

score関数を修正したのがこちら。

score <- function(symbols){
  
  diamonds <- sum(symbols == "DD")
  cherries <- sum(symbols == "C")
  
  #ダイヤはワイルドカードなので、同じシンボルが3つ揃っているか
  #3つともバーになっているかはダイヤ以外で考える
  slots <- symbols[symbols != "DD"]
  same <- length(unique(slots)) == 1
  bars <- slots %in% c("B","BB","BBB")
  
  if(diamonds == 3){
    prize <- 100
  }else if(same){
    payouts <- c("7" = 80, "BBB" = 40, "BB" = 25, "B" = 10, "C" = 10, "0" = 0)
    prize <- unname(payouts[slots[1]])
  }else if(all(bars)){
    prize <- 5
  }else if(cherries > 0){
    prize <- c(0,2,5)[cherries + diamonds + 1] 
  }else{
    prize <- 0
  }
  
  prize * 2^diamonds
}

再度、シンボルの組み合わせの賞金額を算出して。

for(i in 1:nrow(combos)){
  symbols <- c(combos[i,1], combos[i,2],combos[i,3])
  combos$prize[i] <- score(symbols) 
}
> head(combos,3)
  Var1 Var2 Var3 prob1 prob2 prob3    prob prize
1   DD   DD   DD  0.03  0.03  0.03 2.7e-05   800
2    7   DD   DD  0.03  0.03  0.03 2.7e-05   320
3  BBB   DD   DD  0.06  0.03  0.03 5.4e-05   160

期待値を求めると。

> sum(combos$prize * combos$prob)
[1] 0.934356

1ドル払って、93セント戻り。良心的。

forループを使って、スロットマシンの賞金額を求めましたが、
Rには、whileループや、repeatループもあります。

whileループ

書き方はこちら。

while(condition){
 code
}

conditionTRUEの間、繰り返し続けます。

というわけで、お金なくなるまでスロットします。

plays_till_broke <- function(start_with){
  cash <- start_with
  n<-0
  while(cash >0){
    cash <- cash -1 + play()
    n <- n + 1
  }
  n
}

100ドルでスタート。

> plays_till_broke(100)
[1] 956

956回プレイしたみたいですね。途中で何か大きく当たったようです。

10ドルでスタート。

> plays_till_broke(10)
[1] 17

17回でした。まぁ、こんなもんですよね。

repeatループ

このループはやばい。
[Esc]キーをわざわざ押すか、breakコマンドに行き当たるまで繰り返し続けます。
なんで、こんなループあるの?何に使うの?いや、絶対使わないでしょ。こんなの。

というわけで、さっきのwhileループで作成したplays_till_broke関数を
repeatループに変えてみます。

plays_till_broke <- function(start_with){
  cash <- start_with
  n <- 0
  repeat{
    cash <- cash - 1 + play()
    n <- n + 1
    if(cash <= 0){
      break
    }
  }
  n
}

100ドルでスタート。

> plays_till_broke(100)
[1] 588

やっぱり、途中で何かしら大きく当たってますね。

もう一度。

> plays_till_broke(100)
[1] 268

う~ん、まだ回数多いような気がするなぁ。

えい。

> plays_till_broke(100)
[1] 1204
> plays_till_broke(100)
[1] 270
> plays_till_broke(100)
[1] 1888
> plays_till_broke(100)
[1] 854
> plays_till_broke(100)
[1] 674
> plays_till_broke(100)
[1] 2016
> plays_till_broke(100)
[1] 31173
> plays_till_broke(100)
[1] 220
> plays_till_broke(100)
[1] 187
> plays_till_broke(100)
[1] 168
> plays_till_broke(100)
[1] 315
> plays_till_broke(100)
[1] 533
> plays_till_broke(100)
[1] 1685

当たりがとまらないやつ(31173回)もいれば、すぐ無くしたやつ(168回)もいますね。