Questions

1 - A fancy function

The goal of statistical simulations is to understand the properties and general patterns in random objects. One way to uncover these patterns is to do many simulations, until the trend lines in the plots become obvious.

Write a function to produce a detailed plot similar to the plot displayed in class on Monday, October 12th. Include the following features:

visually important line for median winnings at each time point
dashed line for 0.05 and 0.95 quantiles of the winning at each time point
several semitransparent lines (set alpha < 1) representing actual simulated sequences of winnings for players
informative labels, title, and caption

The function should return a ggplot object, and accept at least the following arguments:

strategy, defaulting to simple_strategy(even), or one of the other 1:1 betting strategies
quants, defaulting to 0.9, to denote the proportion of the data between the dashed lines
nplayers, with a default large enough to get reasonably smooth looking dashed quantile lines with the default strategy
nplayers_plot, defaulting to 10, number of semitransparent lines to plot
ntimes, with a default sufficiently large to see where the 0.95 quantile intersects 0 with the default strategy
print, defaulting to TRUE, whether to print the final plot

Hint: I suggest you write at least two other functions, one to compute the summary statistics at each time point, and one to do all the plotting based on the simulated data.

set.seed(1380)
NTIMES = 1000L
NPLAYERS = 500L
d = play(simple_strategy(even), nplayers = NPLAYERS, ntimes = NTIMES)

ds = split(d, d$time)
d1k = d[d$time == 1000, ]

summary_stats = function(df)
{
  time = unique(df$time)
  w = df$winnings
  data.frame(time, median = median(w), quant_lower = quantile(w, probs = 0.05), quant_upper = quantile(w, probs = 0.95))
}

summary_stats2 = function(df, quants = 0.9)
{
  time = unique(df$time)
  w = df$winnings
  lower = (1-quants) / 2
  probs = c(lower, 1 - lower)
  qx = quantile(w, probs = probs)
  data.frame(time, median = median(w), lower = qx[1], upper = qx[2])
}

Call your function with all the defaults, to make sure it works.

summary_stats(d1k)

##    time median quant_lower quant_upper
## 5% 1000    -26         -78          24

summary_stats2(d1k)

##    time median lower upper
## 5% 1000    -26   -78    24

ds = split(d, d$time)
ds2 = lapply(ds, summary_stats)

dfinal = do.call(rbind, ds2)

library(ggplot2)
nplayers_plot = d[d$player <= 50L, ]
med_color = "red"
conf_line = 2
g = ggplot(data = dfinal) +
    geom_line(data = nplayers_plot, mapping = aes(x = time, y = winnings, group = player), alpha = 0.1, size = 0.3) +
    geom_line(mapping = aes(x = time, y = median), color = med_color) +
    geom_line(mapping = aes(x = time, y = quant_lower), linetype = conf_line) + 
    geom_line(mapping = aes(x = time, y = quant_upper), linetype = conf_line)
print(g)

2 - Analysis

Use the function you wrote above to answer the following questions.

1. What happens when we increase the number of players?

set.seed(1380)
d1 = play(simple_strategy(even), nplayers = 10000L, ntimes = NTIMES)

d10k = d1[d1$time == 1000, ]
summary_stats(d10k)

##    time median quant_lower quant_upper
## 5% 1000    -26         -80          24

ds10k = split(d1, d1$time)
ds10k_2 = lapply(ds10k, summary_stats)

d10k_final = do.call(rbind, ds10k_2)

Increasing nplayers does not significantly effect the the median nor quantile.

2. Approximately how many times do you need to play before 95% of players have lost money? Explain this result to a person who thinks they can make money gambling.

According to the data above, it takes up to 24 play times to completely run out of money.

3. What happens when you use a betting strategy that does not have a 1 to 1 payout?

NTIMES = 10000L
NPLAYERS = 500L
h = play(simple_strategy(column1), nplayers = NPLAYERS, ntimes = NTIMES)
h1k = h[h$time == 1000, ]
summary_stats(h1k)

##    time median quant_lower quant_upper
## 5% 1000    -31     -103.15          41

hs1k = split(h1k, h1k$time)
hs1k_2 = lapply(hs1k, summary_stats)

hfinal = do.call(rbind, hs1k_2)

library(ggplot2)
hnplayers_plot = h[h$player <= 30L, ]
h_med_color = "red"
h_conf_line = 2
d = ggplot(data = hfinal) +
    geom_line(data = hnplayers_plot, mapping = aes(x = time, y = winnings, group = player), alpha = 0.1, size = 0.3) +
    geom_line(mapping = aes(x = time, y = median), color = h_med_color) +
    geom_line(mapping = aes(x = time, y = quant_lower), linetype = h_conf_line) + 
    geom_line(mapping = aes(x = time, y = quant_upper), linetype = h_conf_line)
print(d)

## geom_path: Each group consists of only one observation. Do you need to adjust
## the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to adjust
## the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to adjust
## the group aesthetic?

A 3 to 1 payout widens the quantile.

3 - Martingale Fails

_Pick your favorite casino and find out the minimum and maximum bet for a Euro roulette table from Online United States Casino. Suppose you have 5,000 dollars to spend on gambling, and once you lose that, you cannot play more.

Given these numbers, use a large number of simulations to answer ONE of the following questions relating to the martingale (doubling) betting strategy with a 1 to 1 payout._

On average, how long can you play before going bankrupt?
Does the martingale strategy let you play longer than the simple strategies above?
Suppose a dealer spins the roulette wheel once a minute. If you go to Las Vegas to play for a weekend, what’s the probability you will lose all your money?

#Casino: Encore
#Min bet: 100
#Max bet: 5000

db = play(simple_strategy(doublebet), nplayers = NPLAYERS, ntimes = NTIMES)
db1k = db[db$time == 1000, ]
dbs1k = split(db1k, db1k$time)
dbs1k_2 = lapply(dbs1k, summary_stats)

dbfinal = do.call(rbind, dbs1k_2)
doublebet_with_limits = function(x, initialbet = 100, maxbet = 5000, bet = even)
{
    winnings = rep(NA, length(x))
    betsize = initialbet
    current_winnings = 0 
    for(i in seq_along(x)){
        if(bet(x[i]) == 1){ 
            current_winnings = current_winnings + betsize
            betsize = initialbet
        } else {
            current_winnings = current_winnings - betsize
            betsize = 2 * betsize
            if(maxbet < betsize){
                betsize = initialbet
            }   
        }   
        winnings[i] = current_winnings
    }   
    winnings
}

db_limits = doublebet_with_limits(dbfinal)
length(dbfinal)

## [1] 4

head(dbfinal)

##      time median quant_lower quant_upper
## 1000 1000 236372    213341.1    254392.6

library(ggplot2)
dbnplayers_plot = db[db$player <= 30L, ]
db_med_color = "red"
db_conf_line = 2
b = ggplot(data = dbfinal) +
    geom_line(data = dbnplayers_plot, mapping = aes(x = time, y = winnings, group = player), alpha = 0.1, size = 0.3) +
    geom_line(mapping = aes(x = time, y = median), color = db_med_color) +
    geom_line(mapping = aes(x = time, y = quant_lower), linetype = db_conf_line) + 
    geom_line(mapping = aes(x = time, y = quant_upper), linetype = db_conf_line)
print(b)

## geom_path: Each group consists of only one observation. Do you need to adjust
## the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to adjust
## the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to adjust
## the group aesthetic?

(Ans to #1) My data reads the player will have a positive payout.

Roulette

18 October 2020

Outcomes

Instructions

Questions

1 - A fancy function

2 - Analysis

3 - Martingale Fails