Infinite loop in coin-flipping game

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?

Solution

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