writeup

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.Martingale betting strategy begins by wagering $1 on red. The wagers for the second third and all following games depend on the question was the last outcome red. If YES,the wager $1 on the next play. If the answer is no, the last outcome was not red, then the wager twice the amount of the previous wager. This is how Martingale strategy works. 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    
}
single_spin <- function(){
  possible_outcomes <- c(rep("red",18), rep("black",18), rep("green",2))
  sample(possible_outcomes, 1)
}

martingale_wager <- function(
    previous_wager
    , previous_outcome
    , max_wager
    , current_budget
){
  if(previous_outcome == "red") return(1)
  min(2*previous_wager, max_wager, current_budget)
}

one_play_ <- function(previous_ledger_entry, max_wager){
  # Create a copy of the input object that will become the output object
  out <- previous_ledger_entry
  out[1, "game_index"] <- previous_ledger_entry[1, "game_index"] + 1
  out[1, "starting_budget"] <- previous_ledger_entry[1, "ending_budget"]
  out[1, "wager"] <- martingale_wager(
    previous_wager = previous_ledger_entry[1, "wager"]
    , previous_outcome = previous_ledger_entry[1, "outcome"]
    , max_wager = max_wager
    , current_budget = out[1, "starting_budget"]
  )
  out[1, "outcome"] <- single_spin()
  out[1, "ending_budget"] <- out[1, "starting_budget"] + 
    ifelse(out[1, "outcome"] == "red", +1, -1)*out[1, "wager"]
  return(out)
}

one_series_ <- function(
    max_games, starting_budget, winning_threshold, max_wager
){
  # Initialize ledger
  ledger <- data.frame(
    game_index = 0:max_games
    , starting_budget = NA_integer_
    , wager = NA_integer_
    , outcome = NA_character_
    , ending_budget = NA_integer_
  )
  ledger[1, "wager"] <- 1
  ledger[1, "outcome"] <- "red"
  ledger[1, "ending_budget"] <- starting_budget
  for(i in 2:nrow(ledger)){
    #browser()
    ledger[i,] <- one_play_(ledger[i-1,], max_wager)
    if(stopping_rule(ledger[i,], winning_threshold)) break
  }
  # Return non-empty portion of ledger
  ledger[2:i, ]
}

stopping_rule <- function(
    ledger_entry
    , winning_threshold
){
  ending_budget <- ledger_entry[1, "ending_budget"]
  if(ending_budget <= 0) return(TRUE)
  if(ending_budget >= winning_threshold) return(TRUE)
  FALSE
}

profit <- function(ledger){
  n <- nrow(ledger)
  profit <- ledger[n, "ending_budget"] - ledger[1, "starting_budget"]
  return(profit)
  }

# helper function
get_last <- function(x) x[length(x)] 

#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.5218

# Estimated earnings
mean(walk_out_money - 200)

## [1] -43.4496

From above we could see that when times are 10,000, the frequencies of winning 100 and losing 200 is approaching 0.5 and the mean of the earnings is about -50

Now consider a gambler in a series of wagers when he starts with $200 at the begining. How the earnings evolve over a series of wagers at the roulette wheel?

require(magrittr)

## Loading required package: magrittr

## 
## Attaching package: 'magrittr'

## The following object is masked from 'package:purrr':
## 
##     set_names

## The following object is masked from 'package:tidyr':
## 
##     extract

#svg(filename = "loser.svg", width=16, height =9)
par(cex.axis=2, cex.lab = 2, mar = c(8,8,2,2), bg = rgb(222, 235, 247, max = 255))
set.seed(2)
ledger <- one_series_(200,200,300,500)
plot(ledger[,c(1,5)], type = "l", lwd = 5, xlab = "Game Index", ylab = "Budget")

Lets change the input parameters: Fisrt change start money from 100 to 1000, given other parameters unchanged, to see how the average earning change

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 10,000 times:

times <- rep(NA,10000)
for (tm in 1:10000){
  times[tm]<-length(one_series(200,200,300,500))
}

mean(times)

## [1] 2.5815

3 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.

4 limitations of the simulation

In some complex problems, the correlations of a large number of variables maybe be quite difficult to identify. In this case, logic may be disordered, resulting in meaningless simulation results.

Simulation might not be able to produce the best choice or result and for the real world situation,it is hard to simulate the uncertainty because conditions are too complex.