Sto cercando di avvolgere la testa attorno a questo problema.
Un dado viene lanciato 100 volte. Qual è la probabilità che nessun volto appaia più di 20 volte? Il mio primo pensiero è stato quello di utilizzare la distribuzione binomiale P (x) = 1 - 6 cmf (100, 1/6, 20) ma questo è ovviamente sbagliato poiché contiamo alcuni casi più di una volta. La mia seconda idea è quella di elencare tutti i possibili rotoli x1 + x2 + x3 + x4 + x5 + x6 = 100, in modo che xi <= 20 e sommando i multinomi ma questo sembra troppo intenso dal punto di vista computazionale. Le soluzioni approssimative funzioneranno anche per me.

Questa è una generalizzazione del famoso problema del compleanno : dati $n=100$ individui che hanno "compleanni" casuali distribuiti uniformemente in una serie di possibilità $d=6$ , qual è la possibilità che nessun compleanno sia condiviso da più di $m=20$ individui?

Un calcolo esatto produce la risposta (per raddoppiare la precisione). Traccerò la teoria e fornirò il codice per il generale n , m , d . Il tempismo asintotico del codice è O ( n 2 log ( d ) ) che lo rende adatto a un numero molto elevato di compleanni d e fornisce prestazioni ragionevoli fino a quando n è tra le migliaia. A quel punto, l'approssimazione di Poisson discussa inEstensione del paradosso del compleanno a più di 2 personedovrebbe funzionare bene nella maggior parte dei casi.$0.267\,747\,907\,805\,267$$n, m, d.$$O(n^2\log(d))$$d$$n$

---

Spiegazione della soluzione

La funzione generatrice di probabilità (pgf) per gli esiti di tiri indipendenti di un dado con lato d è$n$$d$

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

Il coefficiente di nell'espansione di questo multinomiale fornisce il numero di modi in cui la faccia i può apparire esattamente e i volte, i = 1 , 2 , … , d $x_1^{e_1}x_2^{e_2}\cdots x_d^{e_d}$$i$$e_i$$i=1, 2, \ldots, d.$

Limitare il nostro interesse a non più di aspetti da qualsiasi faccia equivale a valutare f n modulo l'ideale che ho generato da x m + 1 1 , x m + 1 2 , … , x m + 1 d . Per eseguire questa valutazione, utilizzare il Teorema binomiale ricorsivamente per ottenere$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}) }$$

quando è pari. Scrivendo f ( d ) n = f n ( 1 , 1 , … , 1 ) ( d termini), abbiamo$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}$$

Quando è dispari, utilizzare una decomposizione analoga$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}), }$$

dando

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

In entrambi i casi, possiamo anche ridurre tutto il modulo , che può essere facilmente eseguito a partire da$\mathcal I$

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

fornendo i valori di partenza per la ricorsione,

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

Ciò che rende questo efficiente è che suddividendo le variabili in due gruppi uguali di variabili r ciascuna e impostando tutti i valori delle variabili su 1 , dobbiamo valutare tutto una sola volta per un gruppo e quindi combinare i risultati. Ciò richiede il calcolo fino a n + 1 termini, ognuno dei quali necessita del calcolo O ( n ) per la combinazione. Non abbiamo nemmeno bisogno di un array 2D per memorizzare f ( r ) n , perché quando si calcola f ( d ) n , solo $d$$r$$1,$$n+1$$O(n)$$f_n^{(r)}$$f_n^{(d)},$ eF ( 1 ) n sono richiesti.$f_n^{(r)}$$f_n^{(1)}$

Il numero totale di passaggi è uno in meno del numero di cifre nell'espansione binaria di (che conta le divisioni in gruppi uguali nella formula ( a ) ) più il numero di cifre nell'espansione (che conta tutte le volte un dispari viene rilevato un valore, che richiede l'applicazione della formula ( b ) ). Sono ancora solo i passaggi O ( log ( d ) ) .$d$$(a)$$(b)$$O(\log(d))$

In Runa workstation vecchia di dieci anni il lavoro è stato svolto in 0,007 secondi. Il codice è elencato alla fine di questo post. Utilizza i logaritmi delle probabilità, piuttosto che le probabilità stesse, per evitare possibili trabocchi o accumulare troppi scarichi. Questo rende possibile rimuovere il fattore nella soluzione in modo da poter calcolare i conteggi che sono alla base delle probabilità.$d^{-n}$

Si noti che questa procedura comporta il calcolo dell'intera sequenza di probabilità in una volta, il che ci consente facilmente di studiare come cambiano le possibilità con n .$f_0, f_1, \ldots, f_n$$n$

---

applicazioni

tmultinom.full$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)
}

$798$birthday(7)

---

$365$

---

Codice

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

La risposta si ottiene con

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

,267747907805267

Metodo di campionamento casuale

Ho eseguito questo codice in R replicando 100 tiri di dado per un milione di volte:

y <- replicate (1000000, all (tabella (campione (1: 6, dimensione = 100, sostituisci = VERO)) <= 20))

L'output del codice all'interno della funzione di replica è vero se tutte le facce appaiono inferiori o uguali a 20 volte. y è un vettore con 1 milione di valori di vero o falso.

Il totale no. dei valori reali in y divisi per 1 milione dovrebbe essere approssimativamente uguale alla probabilità desiderata. Nel mio caso era 266872/1000000, il che suggerisce una probabilità di circa il 26,6%

Calcolo della forza bruta

Questo codice richiede alcuni secondi sul mio laptop

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

uscita: 0,2677479

Tuttavia, potrebbe essere interessante trovare un metodo più diretto nel caso in cui si desideri eseguire molti di questi calcoli o utilizzare valori più alti, o semplicemente per ottenere un metodo più elegante.

Almeno questo calcolo fornisce un numero calcolato in modo semplicistico, ma valido, per controllare altri metodi (più complicati).