抛硬币游戏中的无限循环

Infinite loop in 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.

这是我应该回答的问题,这是我的尝试

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()

但我认为这给了我一个无限循环,有人可以帮忙吗?

您正在根据 headstails 的当前值在循环的每次迭代中重新计算 w。但是这些值将始终 为 1 和 0(或 0 和 1)。所以 w 总是 -1 或 1,而不是任何其他值。

您的代码中的另一个错误是您仅在正面领先 4 时才停止。但根据规则,当尾巴领先4时,游戏也应该停止:只有绝对差异才是最重要的。

您的代码逻辑可以修复,但可以采用更简单的逻辑(请注意,以下代码使用 self-explanatory 变量名称,这使得生成的代码 更具可读性):

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)
    }
}

你可以进一步简化这个,因为硬币面的标签实际上并不重要。您只关心抛硬币,return 是两个结果之一。

我们可以将其实现为一个单独的函数。函数的return值不是很重要,只要我们有一个固定的约定即可:它可以是c('H', 'T'),或者c(FALSE, TRUE),或者c(0L, 1L),等等. 出于我们的目的,return -1L1L 会很方便,这样我们的函数 h 可以直接将该值添加到 diff:

coin_toss = function () {
    sample(c(-1L, 1L), 1L)
}

但是有一种不同的掷硬币方法:大小为 1 的 Bernoulli trial。使用伯努利试验有一个很好的 属性:我们可以简单地扩展我们的功能以允许不公平(有偏见的)抛硬币。所以这是相同的函数,但有一个可选的 bias 参数(默认情况下掷硬币是公平的):

coin_toss = function (bias = 0.5) {
    rbinom(1L, 1L, prob = bias) * 2L - 1L
}

(rbinom(…) returns 0L1L。要将值域转换为 c(-1L, 1L),我们乘以 2 并减去 1 .)

现在让我们改变h来使用这个函数:

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() 是 0 或 1,但根据其值,我们可以是

我想回答您的问题,包括 a) 和 b) 部分。我将使用我的代码来节省我的时间。

这是一款很酷的游戏,软件模拟可能会非常有用。 游戏的核心是“永无止境的循环”,当正面和反面的绝对差等于 4 时,最终结束。然后记录收益。正如康拉德鲁道夫提到的,这场比赛是伯努利类型的。使用以下代码模拟游戏:

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
    }
  }
}

有大量 运行,例如在这个循环上的另一个循环,我们了解到,期望值非常接近 -6。因此,该游戏具有负期望值。它遵循以下代码:

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))

图形:

现在让我们用另一个模拟来看问题的b)部分。循环已被包装到一个函数中,在 sapply 的帮助下,我们 运行 处理一系列概率:

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))

图形:

检查 expected_value_record 数据框表明,当概率值在以下范围内时游戏是公平的:0.32-0.33 或 0.68-0.69

很容易调整最后的代码,从中挤出 更稳健的数字。