Flipping Coins until First Head

[swaheera]

I am working with the R programming language.

• Suppose there are 10 coins : each coin has 0.5 probability of heads and 0.5 probability of tails
• Each turn, I randomly generate an integer between 0 and 10. I then randomly select those many coins (sampling without replacement)
• I then flip those coins
• I want to repeat this process until at least one head has appeared in all coins

Here is the R code I wrote for this problem (1 = head, 0 = tails, -1 = not selected):

  multi_coins_flip_until_first_head <- function(n) {
      count_coins <- numeric(n)
      head_seen_coins <- logical(n)
      flips_coins <- vector("list", n)
      while(any(!head_seen_coins)) {
         selected_coins <- sample(seq_len(n), sample(seq_len(n), 1))
        for (i in seq_len(n)) {
          if (i %in% selected_coins) {
            flip <- sample(c(1, 0), 1)
            count_coins[i] <- count_coins[i] + 1
            flips_coins[[i]] <- c(flips_coins[[i]], flip)
            if (flip == 1) {
              head_seen_coins[i] <- TRUE
            }
          } else {
            flips_coins[[i]] <- c(flips_coins[[i]], -1)
          }
        }
      }
      return(list("Number of Flips for First Head" = count_coins, "Sequence" = flips_coins))
    }

When I look at the results of this function:

> multi_coins_flip_until_first_head(10)
    $`Number of Flips for First Head`
     [1] 10  7  5  9  5  8  7  9  5  7
    
    $Sequence
    $Sequence[[1]]
     [1]  0 -1 -1  1 -1  0  1  0 -1 -1 -1 -1  0 -1 -1  1 -1  0  0 -1 -1 -1  1 -1
    
    $Sequence[[2]]
     [1] -1 -1  0 -1  1 -1  0 -1  0 -1 -1 -1 -1  1 -1 -1 -1 -1  0 -1 -1 -1 -1  1
    
    $Sequence[[3]]
     [1] -1 -1 -1 -1 -1  0 -1 -1  0 -1  0 -1 -1 -1  0 -1 -1 -1 -1 -1 -1 -1 -1  1
    
    $Sequence[[4]]
     [1]  0  1 -1  1 -1 -1 -1  0 -1 -1  0 -1 -1 -1  1 -1  0  1 -1 -1 -1 -1  1 -1
    
    $Sequence[[5]]
     [1] -1 -1  1 -1  1 -1 -1 -1 -1 -1 -1  1 -1 -1 -1 -1  0 -1 -1  0 -1 -1 -1 -1
    
    $Sequence[[6]]
     [1] -1 -1 -1 -1 -1 -1 -1 -1 -1  0 -1  1 -1 -1  1  0 -1  1 -1 -1  1  1 -1  0
    
    $Sequence[[7]]
     [1] -1  0 -1 -1 -1  1  1  0 -1 -1 -1 -1 -1  1 -1 -1 -1 -1 -1  1  1 -1 -1 -1
    
    $Sequence[[8]]
     [1]  1  0  1  0 -1 -1 -1 -1 -1  0 -1 -1 -1 -1 -1  1 -1 -1  0  1 -1  0 -1 -1
    
    $Sequence[[9]]
     [1] -1 -1 -1 -1 -1 -1 -1 -1 -1 -1  1  1  0 -1 -1 -1  1 -1 -1 -1 -1  0 -1 -1
    
    $Sequence[[10]]
     [1] -1 -1 -1 -1  1 -1 -1 -1  1  1 -1 -1  1  0 -1 -1 -1 -1 -1 -1  0 -1  1 -1

It is telling me that the first coin took 10 flips to get the first head - but when I inspect the output Sequence[[1]], I can see that the first head appeared after the 4th flip.

Can someone please show me how to fix this?

[FJCC]

Your variable count_coins counts the number of times a coin is flipped, not the number of times it is flipped until it returns a head. For example, count_coins[1] is 10 because there are 10 values in

Sequence[[1]]
     [1]  0 -1 -1  1 -1  0  1  0 -1 -1 -1 -1  0 -1 -1  1 -1  0  0 -1 -1 -1  1 -1

that are not -1. You can put

count_coins[i] <- count_coins[i] + 1

inside of an if() that checks if head_seen_coins[i] is FALSE. Or, I think you can use

count_coins[i] <- count_coins[i] + !head_seen_coins[i]

so that zero will be added if head_seen_coins[i] is TRUE.

[technocrat]

It's going to be different each round. Sometimes all coins might turn up heads on the first round if it eventuates that all ten coins were chosen and all came up heads (p = \frac{1}{2^{10}}) and sometimes only one coin is selected and it comes up tails. So, this repeats the process many times to estimate the mean number of turns required to achieve the 10 heads and to put a confidence interval around it.

num_coins = 10

simulate = function() {
  coins = rep(FALSE, num_coins)
  turns = 0
  while (!all(coins)) {
    n = sample(1:num_coins, 1) # Random number of coins to flip
    flip_results = runif(n) < 0.5 # Assuming fair coins
    coins[sample(num_coins, n)] = flip_results | coins[sample(num_coins, n)]
    turns = turns + 1
  }
  return(turns)
}

# Run the simulation many times

sim_results = replicate(10000, simulate())

# Calculate mean and confidence interval
mean_turns = mean(sim_results)
conf_interval = quantile(sim_results, c(0.025, 0.975)) # 95% confidence interval

list(mean = mean_turns, conf_interval = conf_interval)
#> $mean
#> [1] 8.5746
#> 
#> $conf_interval
#>  2.5% 97.5% 
#>     3    18

^{Created on 2023-11-29 with reprex v2.0.2}

[swaheera]

@FJCC : thank you so much for your answer! If you have time, can you please show me how I can integrate your suggestions into the final code just to make sure that I am understanding this correctly? Thanks!

[swaheera]

@technocrat : Thank you so much for your answer! Is it possible to modify your answer to display the results of all coin flips (whether selected or non-selected) until at least one head is seen in all coins?

[swaheera]

I think I was able to come up with an answer myself?

multi_coins_flip_until_first_head <- function(n) {
    count_coins <- numeric(n)
    head_seen_coins <- logical(n)
    flips_coins <- vector("list", n)
    while(any(!head_seen_coins)) {
        selected_coins <- sample(seq_len(n), sample(seq_len(n), 1))
        for (i in seq_len(n)) {
            if (i %in% selected_coins) {
                flip <- sample(c(1, 0), 1)
                flips_coins[[i]] <- c(flips_coins[[i]], flip)
                if (flip == 1 && !head_seen_coins[i]) {
                    head_seen_coins[i] <- TRUE
                    count_coins[i] <- length(flips_coins[[i]])
                }
            } else {
                flips_coins[[i]] <- c(flips_coins[[i]], -1)
            }
        }
    }
    return(list("Number of Flips for First Head" = count_coins, "Sequence" = flips_coins))
}