Infinite loop in coin-flipping game - r

Question

Consider the following coin-flipping game:
A single play of the game consists of repeatedly flipping a fair coin until the difference between the number of heads tossed and the number of tails is 4.
You are required to pay 1 dollar for each flip of the coin, and you may not quit during the play of the game.
You receive 10 dollars at the end of each play of the game. The “winnings” from the game is defined as the 10 received at the end minus the amount paid. a. Simulate this game to estimate the expected winnings from many plays of the game. b. Suppose we use a biased coin. Find value(s) of P(tail) that make the game fair, meaning the expected winnings is 0 dollar.
This is the question that I'm supposed to answer and here is my try
h <- function() {
A <- c("H", "T")
s <- sample(A,4, replace = T)
heads <- length(which(s=="H"))
tails <- length(which(s =="T"))
w <- heads - tails
counter <- 4
while (w != 4) {
s <- sample(A,1)
w <- heads - tails
heads <- length(which(s=="H"))
tails <- length(which(s =="T"))
counter <- counter +1
}
return(counter)
}
h()
But I think this gave me a infinite loop, can anyone help please?

Answer 1

You are recomputing w in ever iteration of the loop based on the current value of heads and tails. But these values will always be 1 and 0 (or 0 and 1). So w is always either -1 or 1, never any other value.
Another error in your code is that you only stop when heads is 4 ahead. But according to the rules, the game should also stop when tails is 4 ahead: only the absolute difference matters.
The logic of your code could be fixed, but a much simpler logic would work (note that the following code uses self-explanatory variable names, which makes the resulting code much more readable):
h = function () {
sides = c('H', 'T')
diff = 0L
cost = 0L
repeat {
cost = cost + 1L
flip = sample(sides, 1L)
if (flip == 'H') diff = diff + 1L
else diff = diff - 1L
if (abs(diff) == 4L) return(cost)
}
}
You can simplify this further because the labels of the coin sides don’t actually matter. All you care about is a coin toss that returns one of two results.
We can implement that as a separate function. The return value of the function isn’t very important, as long as we have a fixed convention: it could be in c('H', 'T'), or c(FALSE, TRUE), or c(0L, 1L), etc. For our purposes, it would be convenient to return either -1L or 1L, so that our function h could directly add that value to diff:
coin_toss = function () {
sample(c(-1L, 1L), 1L)
}
But there’s a different way of obtaining a coin toss: a Bernoulli trial of size 1. And using a Bernoulli trial has a nice property: we can trivially extend our function to allow unfair (biased) coin tosses. So here’s the same function, but with an optional bias parameter (by default the coin toss is fair):
coin_toss = function (bias = 0.5) {
rbinom(1L, 1L, prob = bias) * 2L - 1L
}
(rbinom(…) returns either 0L or 1L. To transform the domain of values into c(-1L, 1L), we multiply by 2 and subtract 1.)
Now let’s change h to use this function:
h = function (bias = 0.5) {
cost = 0L
diff = 0L
repeat {
cost = cost + 1L
diff = diff + coin_toss(bias)
if (abs(diff) == 4L) return(cost)
}
}
coin_toss() is either 0 or 1 but, depending on its value, we either

Answer 2

I'd like to answer your questions, both a) and b) part. I'll use my codes to save my time.
It's a cool game, where software simulation could prove to be very helpful.
The bare bones of the game is "never ending loop", which eventually ends when absolute difference of the number of heads and tails is equal 4. The payoff is then recorded. As Konrad Rudolph mentioned, the game is of Bernoulli type. The game is simulated with the code below:
n_games <- 1000 # number of games to play
bias <- 0.5
game_payoff <- c()
for (i in seq_len(n_games)) {
cost <- 0
flip_record <- c()
payoff <- c()
repeat{
cost <- cost + 1
flip <- rbinom(1, 1, prob = bias)
flip_record <- c(flip_record, flip)
n_tails <- length(flip_record) - sum(flip_record) # number of 0s/tails
n_heads <- sum(flip_record) # number of 1s/heads
if (abs(n_tails - n_heads) == 4) {
game_payoff <- c(game_payoff, 10 - cost) # record game payoff
print(paste0("single game payoff: ", 10 - cost)) # print game payoff
break
}
}
}
With a large number of runs, e.g. another loop over this loop, we learn, that the expected value is very close to -6. Thus, the game has negative expected value. It follows from this code:
library(ggplot2)
seed <- 122334
# simulation
n_runs <- 100
n_games <- 10000
bias <- 0.5
game_payoff <- c()
expected_value_record <- c()
for (j in seq_len(n_runs)) {
for (i in seq_len(n_games)) {
cost <- 0
flip_record <- c()
payoff <- c()
repeat{
cost <- cost + 1
flip <- rbinom(1, 1, prob = bias)
flip_record <- c(flip_record, flip)
# print(flip_record)
n_tails <- length(flip_record) - sum(flip_record) # number of 0s/tails
n_heads <- sum(flip_record) # number of 1s/heads
if (abs(n_tails - n_heads) == 4) {
game_payoff <- c(game_payoff, 10 - cost) # record game payoff
print(paste0("single game payoff: ", 10 - cost))
break
}
}
}
expected_value_record <- c(expected_value_record, mean(game_payoff))
game_payoff <- c()
}
# plot expected value
expected_value_record <- cbind.data.frame("run" = seq_len(length(expected_value_record)), expected_value_record)
ggplot(data = expected_value_record) +
geom_line(aes(x = run, y = expected_value_record)) +
scale_x_continuous(breaks = c(seq(1, max(expected_value_record$run), by = 3), max(expected_value_record$run))) +
labs(
title = "Coin flip experiment: expected value in each run. ",
caption = paste0("Number of runs: ", n_runs, ". ", "Number of games in each run: ", n_games, "."),
x = "Run",
y = "Expected value") +
geom_hline(yintercept = mean(expected_value_record$expected_value_record), size = 1.4, color = "red") +
annotate(
geom = "text",
x = 0.85 * n_runs,
y = max(expected_value_record$expected_value_record),
label = paste0("Mean across runs: ", mean(expected_value_record$expected_value_record)),
color = "red") +
theme(plot.title = element_text(hjust = 0.5), plot.caption = element_text(hjust = 0.5))
Graphics:
Let's now look at part b) of the question with another simulation. The loop has been wrapped into a function, which with the help of sapply we run over a sequence of probabilities:
library(ggplot2)
seed <- 122334
# simulation function
coin_game <- function(n_runs, n_games, bias = 0.5){
game_payoff <- c()
expected_value_record <- c()
for (j in seq_len(n_runs)) {
for (i in seq_len(n_games)) {
cost <- 0
flip_record <- c()
payoff <- c()
repeat{
cost <- cost + 1
flip <- rbinom(1, 1, prob = bias)
flip_record <- c(flip_record, flip)
# print(flip_record)
n_tails <- length(flip_record) - sum(flip_record) # number of 0s/tails
n_heads <- sum(flip_record) # number of 1s/heads
if (abs(n_tails - n_heads) == 4) {
game_payoff <- c(game_payoff, 10 - cost) # record game payoff
break
}
}
}
expected_value_record <- c(expected_value_record, mean(game_payoff))
game_payoff <- c()
}
return(expected_value_record)
}
# run coin_game() on a vector of probabilities - introduce bias to find fair game conditions
n_runs = 1
n_games = 1000
expected_value_record <- sapply(seq(0.01, 0.99, by = 0.01), coin_game, n_runs = n_runs, n_games = n_games)
# plot expected value
expected_value_record <- cbind.data.frame("run" = seq_len(length(expected_value_record)), "bias" = c(seq(0.01, 0.99, by = 0.01)), expected_value_record)
ggplot(data = expected_value_record) +
geom_line(aes(x = bias, y = expected_value_record)) +
scale_x_continuous(breaks = c(seq(min(expected_value_record$bias), max(expected_value_record$bias), by = 0.1), max(expected_value_record$bias))) +
scale_y_continuous(breaks = round(c(0, seq(min(expected_value_record$expected_value_record), max(expected_value_record$expected_value_record), length.out = 10)), digits = 4)) +
labs(
title = "Coin flip experiment: expected value for each probability level",
caption = paste0("Number of runs per probability level: ", n_runs, ". ", "Number of games in each run: ", n_games, "."),
x = "Probability of success in Bernoulli trial",
y = "Expected value") +
geom_hline(yintercept = 0, size = 1.4, color = "red") +
geom_text(aes(x = 0.1, y = 0, label = "Fair game", hjust = 1, vjust = -1), size = 4, color = "red") +
theme(plot.title = element_text(hjust = 0.5), plot.caption = element_text(hjust = 0.5))
Graphics:
Examination of the expected_value_record dataframe suggests, the game is fair when probability values are within ranges: 0.32-0.33 or 0.68-0.69.
It's easy to tweak the last code to squeeze more robust numbers out of it.