私はこの問題に頭を抱えようとしています。
サイコロを100回振る。顔が20回以上表示されない確率はどれくらいですか？私の最初の考えは、二項分布P（x）= 1-6 cmf（100、1/6、20）を使用することでしたが、いくつかのケースを複数回カウントするため、これは明らかに間違っています。私の2番目のアイデアは、可能なすべてのロールx1 + x2 + x3 + x4 + x5 + x6 = 100を列挙して、xi <= 20とし、多項式を合計することですが、これは計算が集中しすぎるようです。近似解も私にとってはうまくいきます。

これは有名な誕生日問題の一般化です可能性のセットの中でランダムに均一に分布する「誕生日」を持つ個人が与えられた、誕生日が超える個人で共有されない可能性は何ですか？$n=100$$d=6$$m=20$

正確に計算すると、答えは（倍精度）になります。理論をスケッチし、一般的なコードを提供します コードの漸近的なタイミングはあり、非常に多数の誕生日に適し、が数千になるまで妥当なパフォーマンスを提供します。その時点で、誕生日のパラドックスを2人以上に拡張するで説明したポアソン近似は、ほとんどの場合にうまく機能するはずです。$0.267\,747\,907\,805\,267$$n, m, d.$$O(n^2\log(d))$$d$$n$

---

解決策の説明

サイコロの独立したロールの結果の確率生成関数（pgf）は、$n$$d$

$$d^{-n}f_n(x_1,x_2,\ldots,x_d) = d^{-n}(x_1+x_2+ \cdots + x_d)^n.$$

この多項式の展開におけるの係数は、面が正確に回、$x_1^{e_1}x_2^{e_2}\cdots x_d^{e_d}$$i$$e_i$$i=1, 2, \ldots, d.$

私たちの関心を任意の面で外観に制限することは、によって生成された理想的な法としてを評価することと同じです この評価を実行するには、二項定理を再帰的に使用して$m$$f_n$$\mathcal I$$x_1^{m+1}, x_2^{m+1}, \ldots, x_d^{m+1}.$

$$\eqalign{ f_n(x_1, \ldots, x_d) &= ((x_1+\cdots+x_r) + (x_{r+1}+x_{r+2} + \cdots + x_{2r}))^n \\ &= \sum_{k=0}^n \binom{n}{k} (x_1+\cdots+x_r)^k (x_{r+1}+\cdots+x_{2r})^{n-k} \\ &= \sum_{k=0}^n \binom{n}{k} f_k(x_1, \ldots, x_r) f_{n-k}(x_{r+1}, \ldots, x_{2r}) }$$

ときさえあります。（項）と書くと、$d=2r$$f_n^{(d)} = f_n(1,1,\ldots, 1)$$d$

$$f_n^{(2r)} = \sum_{k=0}^n \binom{n}{k} f_k^{(r)} f_{n-k}^{(r)}.\tag{a}$$

場合奇数である、類似の分解を使用$d=2r+1$

$$\eqalign{ f_n(x_1, \ldots, x_d) &= ((x_1+\cdots+x_{2r}) + x_{2r+1})^n \\ &= \sum_{k=0}^n \binom{n}{k} f_k(x_1, \ldots, x_{2r}) f_{n-k}(x_{2r+1}), }$$

与える

$$f_n^{(2r+1)} = \sum_{k=0}^n \binom{n}{k} f_k^{(2r)} f_{n-k}^{(1)}.\tag{b}$$

どちらの場合も、法としてすべてを削減することもできます。これは、$\mathcal I$

$$f_n(x_j) \cong \left\{ \matrix{x^n & n \le m \\ 0 & n \gt m} \right. \mod \mathcal{I},$$

再帰の開始値を提供する、

$$f_n^{(1)} = \left\{ \matrix{1 & n \le m \\ 0 & n \gt m} \right.$$

これを効率的にするのは、変数を変数の同じサイズの2つのグループに分割し、すべての変数の値を設定することで、1つのグループについてすべてを一度評価し、結果を組み合わせるだけです。これには、項までの計算が必要であり、それぞれの組み合わせに対して計算が必要です。私たちも格納する2次元アレイを必要としない計算するときので、のみとが要求されます。$d$$r$$1,$$n+1$$O(n)$$f_n^{(r)}$$f_n^{(d)},$$f_n^{(r)}$$f_n^{(1)}$

ステップの総数は、のバイナリ展開の桁数（式等しいグループへの分割をカウント）に、展開の1の数（奇数のすべての回数をカウント）を足したものより1少ない数です。値に遭遇し、式適用が必要です）。それはまだステップだけです。$d$$(a)$$(b)$$O(\log(d))$

ではR10年の古いワークステーション上の作業は0.007秒で行いました。コードはこの投稿の最後にリストされています。オーバーフローやアンダーフローの蓄積を回避するために、確率そのものではなく、確率の対数を使用します。これにより、ソリューションの因子を削除できるため、確率の根底にあるカウントを計算できます。$d^{-n}$

注確率の全配列を計算する際に、この手順の結果があること簡単にチャンスがでどのように変化するかを研究することが可能となっており、一度に。$f_0, f_1, \ldots, f_n$$n$

---

用途

一般化された誕生日問題の分布は、関数によって計算されますtmultinom.full。唯一の課題は、衝突の可能性が大きくなりすぎる前に立ち会わなければならない人数の上限を見つけることです。次のコードは、これをブルートフォースで実行します。小さなから始めて、十分な大きさになるまで2倍にします。したがって、計算全体で時間がかかりは解です。までの人数の確率の分布全体が計算されます。$m+1$$n$$O(n^2\log(n)\log(d))$$n$$n$

#
# The birthday problem: find the number of people where the chance of
# a collision of `m+1` birthdays first exceeds `alpha`.
#
birthday <- function(m=1, d=365, alpha=0.50) {
  n <- 8
  while((p <- tmultinom.full(n, m, d))[n] > alpha) n <- n * 2
  return(p)
}

一例として、少なくとも8人が誕生日を共有する可能性を高くするために群集に必要な最小人数はで、計算でわかります。ほんの数秒かかります。これは出力の一部のプロットです：$798$birthday(7)

---

この問題の特別なバージョンは、誕生日のパラドックスを2人以上に拡張するで対処されています。これは、非常に多くの回数転がされるサイコロの場合に関係しています。$365$

---

コード

# Compute the chance that in `n` independent rolls of a `d`-sided die, 
# no side appears more than `m` times.
#
tmultinom <- function(n, m, d, count=FALSE) tmultinom.full(n, m, d, count)[n+1]
#
# Compute the chances that in 0, 1, 2, ..., `n` independent rolls of a
# `d`-sided die, no side appears more than `m` times.
#
tmultinom.full <- function(n, m, d, count=FALSE) {
  if (n < 0) return(numeric(0))
  one <- rep(1.0, n+1); names(one) <- 0:n
  if (d <= 0 || m >= n) return(one)

  if(count) log.p <- 0 else log.p <- -log(d)
  f <- function(n, m, d) {                   # The recursive solution
    if (d==1) return(one)                    # Base case
    r <- floor(d/2)
    x <- double(f(n, m, r), m)               # Combine two equal values
    if (2*r < d) x <- combine(x, one, m)     # Treat odd `d`
    return(x)
  }
  one <- c(log.p*(0:m), rep(-Inf, n-m))      # Reduction modulo x^(m+1)
  double <- function(x, m) combine(x, x, m)
  combine <- function(x, y, m) {             # The Binomial Theorem
    z <- sapply(1:length(x), function(n) {   # Need all powers 0..n
      z <- x[1:n] + lchoose(n-1, 1:n-1) + y[n:1]
      z.max <- max(z)
      log(sum(exp(z - z.max), na.rm=TRUE)) + z.max
    })
    return(z)
  }
  x <- exp(f(n, m, d)); names(x) <- 0:n
  return(x)
}

答えは

print(tmultinom(100,20,6), digits=15)

0.267747907805267

ランダムサンプリング法

私はこのコードをRで実行し、100ダイススローを100万回複製しました。

y <-replicate（1000000、all（table（sample（1：6、size = 100、replace = TRUE））<= 20））

すべての面が20回以下表示される場合、replicate関数内のコードの出力はtrueです。yは、真または偽の100万個の値を持つベクトルです。

合計なし。yの真の値を100万で割った値は、希望する確率とほぼ同じになります。私の場合、それは266872/1000000であり、約26.6％の確率を示唆しています。

ブルートフォース計算

このコードは私のラップトップで数秒かかります

total = 0
pb <- txtProgressBar(min = 0, max = 20^2, style = 3)
for (i in 0:20) {
  for (j in 0:20) {
    for (k in 0:20) { 
      for (l in 0:20) {
        for (m in 0:20) {
          n = 100-sum(i,j,k,l,m)
          if (n<=20) {
            total = total+dmultinom(c(i,j,k,l,m,n),100,prob=rep(1/6,6))
          }
        }
      }
    }
    setTxtProgressBar(pb, i*20+j) # update progression bar            
  }
}
total

出力：0.2677479

しかし、これらの計算を多数実行したり、より高い値を使用したりする場合、またはよりエレガントなメソッドを取得するためだけに、より直接的なメソッドを見つけることは興味深いかもしれません。

少なくともこの計算は、他の（より複雑な）メソッドをチェックするために単純に計算された有効な数値を与えます。