writeup
Changzhou Li
2022-09-04
1 Introduction
This blog is aimed at helping sharp freshmen understand Roulette Strategies using computer simulation.
1.1 What’s Roulette Strategies
This is clear in the assignment instruction.
1.2 Background
1.2.1 Martingale
The Roulette Strategies discussed today is Martingale Strategy. Students could open the following link to get an elementary understanding of Martingale: https://www.statisticshowto.com/martingale-definition/
2 Methods
The following code simulates the Martingale strategy:
#' A single play of the Martingale strategy
#'
#' Takes a state list, spins the roulette wheel, returns the state list with updated values (for example, budget, plays, etc)
#' @param state A list with the following entries:
#' B number, the budget
#' W number, the budget threshold for successfully stoping
#' L number, the maximum number of plays
#' M number, the casino wager limit
#' plays integer, the number of plays executed
#' previous_wager number, the wager in the previous play (0 at first play)
#' previous_win TRUE/FALSE, indicator if the previous play was a win (TRUE at first play)
#' @return The updated state list
library(tidyverse)## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
## ✔ ggplot2 3.3.6 ✔ purrr 0.3.4
## ✔ tibble 3.1.8 ✔ dplyr 1.0.9
## ✔ tidyr 1.2.0 ✔ stringr 1.4.0
## ✔ readr 2.1.2 ✔ forcats 0.5.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()one_play <- function(state){
# Wager
proposed_wager <- ifelse(state$previous_win, 1, 2*state$previous_wager)
wager <- min(proposed_wager, state$M, state$B)
# Spin of the wheel
red <- rbinom(1,1,18/38)
# Update state
state$plays <- state$plays + 1
state$previous_wager <- wager
if(red){
# WIN
state$B <- state$B + wager
state$previous_win <- TRUE
}else{
# LOSE
state$B <- state$B - wager
state$previous_win <- FALSE
}
state
}
#' Stopping rule
#'
#' Takes the state list and determines if the gambler has to stop
#' @param state A list. See one_play
#' @return TRUE/FALSE
stop_play <- function(state){
if(state$B <= 0) return(TRUE)
if(state$plays >= state$L) return(TRUE)
if(state$B >= state$W) return(TRUE)
FALSE
}
#' Play roulette to either bankruptcy, success, or play limits
#'
#' @param B number, the starting budget
#' @param W number, the budget threshold for successfully stoping
#' @param L number, the maximum number of plays
#' @param M number, the casino wager limit
#' @return A vector of budget values calculated after each play.
one_series <- function(
B = 200
, W = 300
, L = 1000
, M = 100
){
# initial state
state <- list(
B = B
, W = W
, L = L
, M = M
, plays = 0
, previous_wager = 0
, previous_win = TRUE
)
# vector to store budget over series of plays
budget <- rep(NA, L)
# For loop of plays
for(i in 1:L){
new_state <- state %>% one_play
budget[i] <- new_state$B
if(new_state %>% stop_play){
return(budget[1:i])
}
state <- new_state
}
budget
}Show 5 simulations of gamler’s earnings:
for(i in 1:5){
leger<-one_series()
plot(leger, type = "l", lwd = 5, xlab = "Game Index", ylab = "Budget")
}
From above we could see that the earnings are random and could not find
any possible patterns.
Let’s increasing the repeating times and see what’s the average earnings and the distribution.
The following shows the average earnings and bar chart of winning or losing times repeating from 10 to 100,000 times.
# helper function
get_last <- function(x) x[length(x)]
# repeat 10 times:
walk_out_money <- rep(NA, 10)
for(j in seq_along(walk_out_money)){
walk_out_money[j] <- one_series(B = 200, W = 300, L = 1000, M = 100) %>% get_last
}
# Walk out money distribution
hist(walk_out_money, breaks = 100)
# Estimated probability of walking out with extra cash
mean(walk_out_money > 200)## [1] 0.6# Estimated earnings
mean(walk_out_money - 200)## [1] -20# repeat 100 times:
walk_out_money <- rep(NA, 100)
for(j in seq_along(walk_out_money)){
walk_out_money[j] <- one_series(B = 200, W = 300, L = 1000, M = 100) %>% get_last
}
# Walk out money distribution
hist(walk_out_money, breaks = 100)
# Estimated probability of walking out with extra cash
mean(walk_out_money > 200)## [1] 0.54# Estimated earnings
mean(walk_out_money - 200)## [1] -38#repeat 1000 times:
walk_out_money <- rep(NA, 1000)
for(j in seq_along(walk_out_money)){
walk_out_money[j] <- one_series(B = 200, W = 300, L = 1000, M = 100) %>% get_last
}
# Walk out money distribution
hist(walk_out_money, breaks = 100)
# Estimated probability of walking out with extra cash
mean(walk_out_money > 200)## [1] 0.497# Estimated earnings
mean(walk_out_money - 200)## [1] -51.026#repeat 10000 times:
walk_out_money <- rep(NA, 10000)
for(j in seq_along(walk_out_money)){
walk_out_money[j] <- one_series(B = 200, W = 300, L = 1000, M = 100) %>% get_last
}
# Walk out money distribution
hist(walk_out_money, breaks = 100)
# Estimated probability of walking out with extra cash
mean(walk_out_money > 200)## [1] 0.5103# Estimated earnings
mean(walk_out_money - 200)## [1] -46.8492walk_out_money <- rep(NA, 100000)
for(j in seq_along(walk_out_money)){
walk_out_money[j] <- one_series(B = 200, W = 300, L = 1000, M = 100) %>% get_last
}
# Walk out money distribution
hist(walk_out_money, breaks = 100)
# Estimated probability of walking out with extra cash
mean(walk_out_money > 200)## [1] 0.51037# Estimated earnings
mean(walk_out_money - 200)## [1] -46.85258From above we could see that as times increasing, the frequencies of winning 100 and losing 200 is approaching 0.5 and the mean of the earnings is about -50
Will changes in parameters change the average meanings? Of course! Because average earnings equal expectation as times increasing: \[E(Earnigs)=P(Earnings)*Earnings+ P(Loss) * Loss\] Lets change the input parameters: Fisrt change start money from 100 to 1000, given other parameters unchanged.
b_vec<-c(100,200,300,400,500,600,700,800,900,1000)
earning_mean<-rep(NA,length(b_vec))
i<-1
for (bb in b_vec){
walk_out_money <- rep(NA,bb)
for(j in seq_along(walk_out_money)){
walk_out_money[j] <- one_series(B = bb, W = 300, L = 1000, M = 100) %>% get_last
}
# Estimated probability of walking out with extra cash
earning_mean[i]<-mean(walk_out_money - bb)
i<-i+1
}
b_df<-data.frame(b_vec,earning_mean)
plot(b_df, type = "l", lwd = 5, xlab = "Starting Money", ylab = "Average earnings")
Then change stop thresh hold from 300 to 1000, given other parameters unchanged.
t_vec<-c(300,400,500,600,700,800,900,1000)
earning_mean<-rep(NA,length(t_vec))
i<-1
for (tt in t_vec){
walk_out_money <- rep(NA,bb)
for(j in seq_along(walk_out_money)){
walk_out_money[j] <- one_series(B = 200, W = tt, L = 1000, M = 100) %>% get_last
}
# Estimated probability of walking out with extra cash
earning_mean[i]<-mean(walk_out_money - 200)
i<-i+1
}
t_df<-data.frame(t_vec,earning_mean)
plot(t_df, type = "l", lwd = 5, xlab = "Thresh Hold", ylab = "Average earnings")
The more you want, the less you are likely to gain:( The following code
shows how to calculate average number of plays till game ends: Lets
repeat 1000 times first:
times <- rep(NA,1000)
for (tm in 1:1000){
times[tm]<-length(one_series())
}
times## [1] 187 192 34 19 148 189 253 281 188 218 200 284 209 118
## [15] 14 205 169 213 433 50 236 131 13 218 194 50 170 19
## [29] 257 213 225 316 159 191 133 395 185 79 24 80 98 233
## [43] 321 270 32 197 267 269 197 20 18 126 194 312 207 654
## [57] 192 114 241 178 45 20 294 145 151 42 40 194 189 211
## [71] 472 658 514 137 189 82 194 184 129 70 312 90 215 198
## [85] 197 280 189 169 260 445 146 555 130 90 64 35 376 215
## [99] 130 21 15 215 266 16 164 292 180 108 89 196 202 302
## [113] 217 118 318 445 35 210 228 265 204 201 167 223 54 219
## [127] 192 23 178 265 212 187 175 89 374 8 268 249 96 95
## [141] 211 583 270 270 148 203 27 402 210 139 204 73 197 184
## [155] 200 229 27 35 11 38 211 272 168 213 27 267 285 310
## [169] 194 10 87 196 269 438 359 265 185 224 53 194 200 187
## [183] 75 90 297 205 279 537 292 204 76 205 338 546 209 208
## [197] 273 42 46 203 167 88 680 236 256 173 248 64 364 194
## [211] 62 119 214 19 208 265 213 200 52 235 163 211 228 200
## [225] 218 183 200 285 118 14 70 199 37 187 249 378 57 197
## [239] 831 223 46 39 204 200 48 90 431 657 202 155 280 1000
## [253] 37 481 358 277 267 312 51 281 279 503 52 24 86 25
## [267] 173 13 271 64 218 720 148 62 270 214 271 75 185 39
## [281] 301 327 378 190 197 198 195 279 185 249 15 199 77 213
## [295] 201 141 268 330 134 230 29 258 254 220 17 196 49 218
## [309] 210 222 216 165 42 394 207 145 244 196 212 61 94 146
## [323] 220 187 201 46 352 193 211 87 344 212 593 365 89 215
## [337] 357 171 340 179 191 220 187 259 159 209 109 237 156 52
## [351] 74 181 185 210 50 179 199 277 103 228 197 8 190 73
## [365] 182 244 148 240 133 135 189 77 269 183 161 16 161 207
## [379] 201 300 24 187 270 276 215 674 111 364 194 71 259 115
## [393] 86 474 215 207 255 156 111 26 355 10 131 112 188 282
## [407] 247 687 201 205 221 218 176 220 15 38 220 197 63 194
## [421] 269 220 263 271 62 235 105 77 37 283 234 201 416 100
## [435] 364 210 62 311 199 66 215 250 331 33 168 356 31 415
## [449] 111 201 79 214 30 44 222 46 13 288 248 185 94 285
## [463] 195 206 220 189 200 177 199 320 548 269 252 191 302 228
## [477] 216 53 312 188 201 211 185 270 278 206 70 263 45 235
## [491] 72 199 234 192 14 184 210 193 199 450 393 235 230 19
## [505] 261 9 204 216 234 194 216 263 130 49 128 305 205 262
## [519] 186 201 23 210 198 97 13 319 279 89 180 204 363 183
## [533] 281 167 290 287 314 21 214 523 167 224 215 575 78 269
## [547] 162 193 181 206 192 280 208 315 53 37 69 235 187 206
## [561] 195 169 494 219 214 227 403 41 207 284 291 30 89 185
## [575] 192 150 62 231 186 189 196 87 197 110 178 134 177 95
## [589] 211 216 365 207 218 292 121 31 315 201 252 164 358 279
## [603] 222 263 11 327 189 261 329 224 496 110 229 102 275 13
## [617] 239 214 363 60 204 180 155 247 237 178 197 201 206 282
## [631] 306 210 128 214 194 8 46 218 194 268 193 46 199 229
## [645] 205 677 404 25 116 167 198 182 218 86 106 261 227 367
## [659] 44 293 59 92 311 277 201 271 269 47 136 110 243 117
## [673] 92 107 204 183 33 194 190 202 214 200 43 614 251 224
## [687] 372 81 488 208 24 115 201 32 207 191 373 264 192 47
## [701] 262 63 12 201 191 193 200 206 206 372 128 205 196 138
## [715] 403 200 268 208 35 176 266 262 106 534 42 166 47 287
## [729] 115 229 161 208 245 31 261 237 9 308 79 31 208 246
## [743] 315 403 201 98 227 19 188 431 323 209 254 116 174 63
## [757] 38 232 278 95 203 203 209 225 962 39 54 222 204 196
## [771] 313 15 51 192 199 282 24 65 313 274 188 261 46 70
## [785] 284 214 330 184 216 159 256 215 350 181 191 183 497 267
## [799] 198 198 156 149 214 168 273 266 186 22 273 329 199 595
## [813] 236 323 55 71 211 52 212 648 98 195 731 192 173 170
## [827] 287 111 359 217 276 41 170 54 421 265 546 363 310 335
## [841] 240 63 207 85 8 312 32 189 222 206 242 209 319 186
## [855] 620 298 624 26 204 79 211 214 175 207 115 197 248 52
## [869] 208 205 215 27 189 258 219 207 104 258 21 620 81 222
## [883] 205 256 180 262 181 277 196 248 180 1000 215 527 211 199
## [897] 13 32 81 224 262 204 34 190 222 185 296 226 197 108
## [911] 204 209 301 249 147 287 251 42 202 17 146 69 193 202
## [925] 206 195 267 227 793 131 169 9 83 29 285 195 386 13
## [939] 205 203 22 112 165 173 353 315 258 229 202 272 31 212
## [953] 200 143 206 167 195 193 37 25 212 245 222 199 349 194
## [967] 198 187 34 206 201 161 248 233 282 207 216 89 208 193
## [981] 15 336 192 25 298 30 72 89 10 79 66 79 261 197
## [995] 225 271 256 136 44 273mean(times)## [1] 202.034Increasing to 100,000 times to get more precise average times:
times <- rep(NA,100000)
for (tm in 1:100000){
times[tm]<-length(one_series())
}
mean(times)## [1] 201.26593 Conclusion
In this blog, the definition of Roulette Strategy is first displayed. Then the code is pulled to simulate the gamble gaming. By changing parameters, the average earnings also vary. In the long run, the house always wins because the expectation is minus, so do not risk all your money on gambling.