r - 鱿鱼游戏第 7 集与模拟

Question

昨晚我看了鱿鱼游戏电视连续剧的第7集。这一集在桥上有一个二项式分布的游戏。

具体有16名球员和18副眼镜的桥梁(一个纯玻璃和一个安全玻璃)。如果一个玩家碰巧选择了纯玻璃，那么玻璃就不能承受玩家的重量，玻璃就碎了。下一个玩家的优势是他/她从最后一个玩家的位置开始并继续二项式搜索。最后 3 名玩家碰巧过桥。
所以我想知道:这就像，我口袋里有 16 欧元，我用 p = 1/2 玩正面或反面。 .每次我赌头。如果硬币翻转是正面，那么我赚 0，如果是反面我输 1 欧元。击中 18 次(连续与否)正面并在我的口袋里剩下 3 欧元的概率是多少。
我试图在 R 中模拟这个问题:

squid_bridge = function(a,n,p) {
  players = a
  while (position > 0 & position < n) {
    jump  =  sample(c(0,1),1,prob=c(1-p,p))
    position = position + jump
  }
  if (position == 0) 
    return(1) 
  else 
    return(0)
}   

n = 18
trials = 100000
a = 16
p = 1/2
set.seed(1)
simlist = replicate(trials, squid_bridge(a, n, p))

它似乎不起作用。有什么帮助吗？

Answer 1

以下是我认为您可以在 R 中对游戏进行建模的方式。第一个版本与您所拥有的类似:有 50% 的机会猜对，如果猜对了，玩家前进一个瓷砖。否则不进行，玩家人数减1。如果玩家人数达到0，或者他们前进到最后，游戏结束。这显示在 squid_bridge1() 中.

squid_bridge1 <- function(players, n, prob) {
  if (players == 0 | n == 18) {
    # All players have died or we have reached the end
    return(players)
  }
  
  jump <- rbinom(1, 1, prob)
  
  if (jump == 0) {
    # Player died
    return(squid_bridge1(players - 1, n, prob))
  }

  if (jump == 1 & n < 18) {
    # Player lives and advances 1 space
    return(squid_bridge1(players, n + 1, prob))
  } 
}

然而，这并不能准确地描述游戏，因为错误的猜测会给剩余的玩家提供额外的信息。如果玩家选错了，下一次猜对的概率不是50%，而是100%。但是，在那之后，正确猜测的概率降低到 50%。这可以用另一个参数来解释，以跟踪先前猜测的正确性。

squid_bridge2 <- function(players, n, prob, previous) {
  if (players == 0 | n == 18) {
    # The game ends if there are no players or they have reached the end
    return(players)
  }
  
  if (previous == 0) {
    # The previous guess was wrong, but now the players know where to go next
    return(squid_bridge2(players, n + 1, prob, previous = 1))
  }
  
  jump <- rbinom(1, 1, prob)
  
  if (jump == 0) {
    # Player died
    return(squid_bridge2(players - 1, n, prob, previous = 0))
  }
  
  if (jump == 1 & n < 18) {
    # Move is correct. Advance 1 space
    return(squid_bridge2(players, n + 1, prob, previous = 1))
  } 
}

但是，有一个问题。节目中并没有那么简单，玩家摔倒的原因不是猜测错误(被推，故意跳跃等)。我不知道做这样的事情的合理概率是多少，但它可能很低，比如说 10%。

not_stupid <- function() {
  x <- runif(1, 0, 1)
  if (x <= 0.1) {
    return(FALSE)
  } else {
    return(TRUE)
  }
}

由于情绪在每次移动之前都会飙升，因此我们将在每次移动之前对其进行测试。

squid_bridge3 <- function(players, n, prob, previous) {
  if (players == 0 | n == 18) {
    # The game is over because there are no players left or they reached the end
    return(players)
  }
        
  if (previous == 0) {
    # The previous guess was wrong, but now the players know where to go next
    return(squid_bridge3(players, n + 1, prob, previous = 1))
  }
  
  if (!not_stupid()) {
    return(squid_bridge3(players - 1, n, prob, previous = 1))
  }
  
  jump <- rbinom(1, 1, prob)
  
  if (jump == 0) {
    # Player died because of either choosing wrong or a self-inflicted loss
    return(squid_bridge3(players - 1, n, prob, previous = 0))
  }
  
  if (jump == 1 & n < 18) {
    # Move is correct. Advance 1 space
    return(squid_bridge3(players, n + 1, prob, previous = 1))
  } 
}

然后运行一些模拟:

set.seed(123)
trials <- 10000
players <- 16
squid1 <- replicate(trials, squid_bridge1(players, 0, 0.5))
squid2 <- replicate(trials, squid_bridge2(players, 0, 0.5, 1))
squid3 <- replicate(trials, squid_bridge3(16, 0, 0.5, 1))

df <- tibble(squid1 = squid1,
             squid2 = squid2,
             squid3 = squid3) %>%
  pivot_longer(cols = c(squid1, squid2, squid3))

ggplot(data = df,
       aes(x = value)) +
  geom_histogram(bins = 10,
                 binwidth = 1,
                 fill = "cornflowerblue",
                 color = "black") +
  facet_wrap(~name,
             nrow = 3) +
  xlab("# of players to make it to the end") +
  scale_x_continuous(breaks = seq(0, 16, by = 1),
                     labels = seq(0, 16, by = 1))

正如您在下面看到的，第一种情况严重偏向左侧。由于玩家基本上是在每张牌上“盲目猜测”，因此任何人都不太可能走到最后。然而，在考虑到从错误猜测中获得的信息后，平均大约有 7 名玩家成功。通过增加因其他原因掉落的随机机会，分布会向左倾斜一些。

第一种情况的平均值:1.45

第二种情况的平均值:7.01

第三种情况的平均值:4.99

为了回答只有 3 个玩家成功的概率问题，最后一种情况我得到 ~ 10.8%
编辑:根据要求，这里是生成图的代码。我还修复了有一些命名问题的各种函数(在我制作它们时经历了几个不同的名称)。看起来它导致了第三个函数的一个小错误，但我已经修复了它。