【问题标题】:Estimating Probabilities in Perudo在 Perudo 中估计概率
【发布时间】:2021-03-14 20:33:24
【问题描述】:

我是编码和使用 R 的新手。我正在做一个项目来模拟游戏 Liar's Dice,也称为 Perudo,并且对创建模拟有一些疑问。

基本上,该游戏由两名或多名玩家在一个杯子中掷五个骰子,将其翻转,然后对他们认为桌上有多少特定方进行出价。您可以查看自己的骰子,但不能查看其他人的骰子。要出价,轮到你说“两个 5”,这意味着至少有两个骰子落在 5 上。每次出价都会增加边数或数量。所以,如果你说“两个 5”,那么轮到我说“两个 6”或“三个 3”。

当你认为最后的出价不正确时,你会在轮到你时说“骗子”,然后每个人都亮出他们的骰子。如果你错了,你失去一个骰子,但如果你是对的,最后出价者失去一个骰子。这种情况一直持续到只剩下一个有骰子的玩家。

首先,我决定创建一个名为 cup() 的函数,它可以掷出一个由五个六面骰子组成的杯子。

cup <- function(sides = 6, dice = 5){
  sample(1:sides, size = dice, replace = TRUE)
}

接下来,在一些帮助下,我创建了一个名为 cups() 的新函数,它为三个玩家滚动三个杯子。

cups <- function(players = 3, sides = 6, dice = 5){
  out <- cup(sides, dice)
  for(i in 2:players){
    out <- rbind(out, cup(sides, dice))
  }
  rownames(out) <- 1:players
  rownames(out) <- c("P1", "P2", "P3")
  return(out)
}

接下来我想要完成的是创建一个可能的骰子结果概率表。换句话说,游戏中有 15 个骰子(每个玩家 5 个)至少有两个一方的概率是多少?然后在这种情况下,有 3、4、5 等的概率一直到 15。

我的问题是我将如何在 R 中执行此操作?在得到R中的概率后我应该往哪个方向发展?

【问题讨论】:

  • 我想你会发现这样一个宽泛而不具体的问题你不会得到答案。我建议您将问题分解为更容易解决的具体问题。

标签: r probability dice


【解决方案1】:

这是一个经验过程,用于确定所有相同的百分比结果,4 相同,3 相同,2 相同,在滚动 5 个骰子时不一样:

library(gtools) # package with permutations function
allcombos <- permutations(6, 5, repeats.allowed = TRUE) # all 6 choose 5 with replacment combos
alluniques <- apply(allcombos, 1, unique) # uniques for each combo
alllengths <- sapply(alluniques, length) # lengths for each combo imputes num repeats
alllengths2 <- as.factor(alllengths) # convert to factor to count unique
allsum <- summary(alllengths2) # sum by num uniques
allsum
1    2    3    4    5  # 1=all same, 2=4 same, 3=3 same, 4=2 same, 5=all different
6  450 3000 3600  720 
totsum <- sum(allsum)
allfrac <- allsum / totsum
allpercent <- allfrac * 100
allpercent
1           2           3           4           5 
0.07716049  5.78703704 38.58024691 46.29629630  9.25925926 # percentage breakout

毫无疑问,解析解是什么,但我不知道它是什么。您可以使用标准概率计算来估计多个参与者之间的特定结果。例如。 P(至少 1 4-same | 3 名玩家)或运行一些模拟。

【讨论】:

    【解决方案2】:

    这里可能比您要求的要多,但重点关注骰子的面数、骰子的总数以及滚动Nrolled 或更多的概率

    dicegame <- function(Nsides = 6,
                         Ndice = 5,
                         Nrolled = 1,
                         verbose = FALSE)
    {
       total_possible_outcomes <- choose(Nsides + Ndice - 1, Ndice)
    
       outcomes_matrix <- t(combn(Nsides + Ndice - 1,
                                  Ndice,
                                  sort)) - matrix(rep(c(0:(Ndice - 1)),
                                                      each = total_possible_outcomes),
                                                  nrow = total_possible_outcomes)
    
       chances <- sum(apply(outcomes_matrix, 1,  function(x) sum(x==2)) >= Nrolled) / total_possible_outcomes
    
       if(verbose) {
          cat(paste("Number of dice", 
                    Ndice,
                    "each with", Nsides, "sides",
                    "chances of rolling", Nrolled, 
                    "\n or more of any one side are:\n"))
       }
       return(chances)
    #   return(total_possible_outcomes)
    #   return(outcomes_matrix)
    }
    
    dicegame(verbose = TRUE)
    #> Number of dice 5 each with 6 sides chances of rolling 1 
    #>  or more of any one side are:
    #> [1] 0.5
    
    dicegame(6, 15, 10)
    #> [1] 0.01625387
    

    【讨论】:

      【解决方案3】:

      使用概率我们可以证明得到一个值 n 次的概率等于:

      我们可以轻松地将其写入 R 函数:

      prob_get_n <- function(ntimes, players=3, dice=5, sides=6){
          if(missing(ntimes)) ntimes <- 0:(players*dice)
          choose(players*dice,ntimes)*(1-1/sides)^((players*dice)-ntimes)*sides^(-ntimes)
      }
      

      请注意,此函数是通过构造向量化的,即它接受1:2c(9,5) 作为有效输入。

      prob_get_n() -> probs
      data.frame(ntimes=1:length(probs)-1, probs=probs,or_more= rev(cumsum(rev(probs))))
         ntimes        probs      or_more
      1       0 6.490547e-02 1.000000e+00
      2       1 1.947164e-01 9.350945e-01
      3       2 2.726030e-01 7.403781e-01
      4       3 2.362559e-01 4.677751e-01
      5       4 1.417535e-01 2.315192e-01
      6       5 6.237156e-02 8.976567e-02
      7       6 2.079052e-02 2.739411e-02
      8       7 5.346134e-03 6.603585e-03
      9       8 1.069227e-03 1.257451e-03
      10      9 1.663242e-04 1.882242e-04
      11     10 1.995890e-05 2.190005e-05
      12     11 1.814445e-06 1.941153e-06
      13     12 1.209630e-07 1.267076e-07
      14     13 5.582909e-09 5.744548e-09
      15     14 1.595117e-10 1.616385e-10
      16     15 2.126822e-12 2.126822e-12
      

      编辑

      或者我们可以使用R内置的dbinom函数得到分布,pbinom得到累积概率函数:

      probs <- function(ntimes, players=3, dice=5, sides=6){
          if(missing(ntimes)) ntimes <- 0:(players*dice)
          data.frame(ntimes=ntimes, probs=dbinom(ntimes, players*dice, 1/sides), or_more=1-pbinom(ntimes-1, players*dice, 1/sides))
      }
         ntimes        probs      or_more
      1       0 6.490547e-02 1.000000e+00
      2       1 1.947164e-01 9.350945e-01
      3       2 2.726030e-01 7.403781e-01
      4       3 2.362559e-01 4.677751e-01
      5       4 1.417535e-01 2.315192e-01
      6       5 6.237156e-02 8.976567e-02
      7       6 2.079052e-02 2.739411e-02
      8       7 5.346134e-03 6.603585e-03
      9       8 1.069227e-03 1.257451e-03
      10      9 1.663242e-04 1.882242e-04
      11     10 1.995890e-05 2.190005e-05
      12     11 1.814445e-06 1.941153e-06
      13     12 1.209630e-07 1.267076e-07
      14     13 5.582909e-09 5.744548e-09
      15     14 1.595117e-10 1.616385e-10
      16     15 2.126822e-12 2.126743e-12
      

      【讨论】:

      • 不要争论,但你的算法是关闭的。以最简单的情况为例。 1 名玩家,2 个 6 面的骰子。 OP 想知道掷出两个(或更多)六的概率是多少。这两个骰子有 21 种独特的掷骰方式,我们可以用 t(combn(6 + 2 - 1, 2, sort)) - matrix(rep(c(0:(2 - 1)), each = choose(6 + 2 - 1, 2)), nrow = choose(6 + 2 - 1, 2)) 制作一个包含所有 21 种可能性的矩阵。在 21 行中,只有 1 行匹配两个六。所以概率是 1/21 = 0.04761905,这是我的代码呈现的。您的 probs(2, 1, 2, 6) 给出的 0.02777778 0.02777778 不正确。
      • FWIW 我考虑添加一个 players 参数,但 OP 表示玩家会随着游戏的进行“失去”骰子,因此任何函数都必须考虑到不同玩家可能拥有不同数量的骰子这一事实这就是为什么我坚持掷骰子的总数。
      • @ChuckP 在您的评论中,您没有检查所有组合,这就是为什么您得到错误结果的原因我们有 36 个组合,其中只有一个是两个 6 => 1/36 = .027777778。你没有考虑订单
      • 在游戏中顺序和玩家都不重要。这只是计数。无论是 6 & 1 还是 1 & 6 仍然只有一个显示。
      猜你喜欢
      • 2014-08-11
      • 2014-04-07
      • 1970-01-01
      • 2015-07-29
      • 1970-01-01
      • 2010-11-01
      • 2020-07-28
      • 2018-06-19
      • 2014-03-28
      相关资源
      最近更新 更多