Verifica se una moneta è giusta

Mi è stata posta la seguente domanda da un amico. Non ho potuto darle una mano, ma spero che qualcuno me lo possa spiegare. Non sono riuscito a trovare alcun esempio simile. Grazie per qualsiasi aiuto e spiegazione.

Q: I risultati di 100 esperimenti di lancio della moneta sono registrati come 0 = "Coda" e 1 = "Testa". L'output x è una stringa di 0 e 1 di lunghezza 100. E viene calcolato il numero di volte in cui otteniamo 1-0-0 in x ed è 20 (es: se x = (001001110100), 1-0-0 si verifica 2 volte). Pensi che questa sia una moneta giusta?

Risolvere il problema mediante simulazione

Il mio primo tentativo sarebbe quello di simulare questo su un computer, che può lanciare molte monete giuste molto velocemente. Di seguito è riportato un esempio con un milione di prove. L'evento 'che il numero di volte $X$ del modello' 1-0-0 'si verifica in $n=100$ lanci di monete è 20 o più' si verifica all'incirca una volta ogni tremila prove, quindi ciò che hai osservato non è molto probabile (per una fiera moneta).

Si noti che il histrogram è per la simulazione e la linea è l'esatto calcolo spiegato più avanti.

set.seed(1)

# number of trials
n <- 10^6

# flip coins
q <- matrix(rbinom(100*n, 1, 0.5),n)

# function to compute number of 100 patterns
npattern <- function(x) {
  sum((1-x[-c(99,100)])*(1-x[-c(1,100)])*x[-c(1,2)])
}

# apply function on data 
counts <- sapply(1:n, function(x) npattern(q[x,]))
hist(counts, freq = 0) 

# estimated probability
sum(counts>=20)/10^6
10^6/sum(counts>=20)

---

Risolvere il problema con un calcolo esatto

Per un approccio analitico puoi usare il fatto che 'la probabilità di osservare 20 o più sequenze' 1-0-0 'in 100 lanci di monete è uguale a 1 meno la probabilità che occorrano più di 100 lanci per fare 20 sequenze' . Questo è risolto nei seguenti passaggi:

Tempo di attesa per probabilità di lanciare '1-0-0'

La distribuzione, $f_{N,x=1}(n)$ , del numero di volte che devi capovolgere finché non ottieni esattamente una sequenza '1-0-0' può essere calcolata come segue:

Analizziamo i modi per arrivare a '1-0-0' come una catena di Markov. Seguiamo gli stati descritti dal suffisso della stringa di lanci: '1', '1-0' o '1-0-0'. Ad esempio, se hai i seguenti otto lanci 10101100, hai passato, nell'ordine, i seguenti otto stati: '1', '1-0', '1', '1-0', '1', '1', '1-0', '1-0-0' e ci sono voluti otto lanci per raggiungere '1-0-0'. Nota che non hai la stessa probabilità di raggiungere lo stato '1-0-0' in ogni lancio. Quindi non puoi modellarlo come una distribuzione binomiale . Invece dovresti seguire un albero di probabilità. Lo stato '1' può entrare in '1' e '1-0', lo stato '1-0' può andare in '1' e '1-0-0', e lo stato '1-0-0' è uno stato assorbente. Puoi scriverlo come:

           number of flips
           1   2   3   4   5   6   7   8   9   ....   n

'1'        1   1   2   3   5   8  13  21  34   ....   F_n
'1-0'      0   1   1   2   3   5   8  13  21          F_{n-1}
'1-0-0'    0   0   1   2   4   7   12 20  33          sum_{x=1}^{n-2} F_{x}

$n$$n-1$

$$f_{N_c,x=1}(n) = \frac{F_{n-2}}{2^{n-1}}$$

$F_i$$i$

$$f_{N,x=1}(n) = \sum_{k=1}^{n-2} 0.5^{k} f_{N_c,x=1}(1+(n-k)) = 0.5^{n} \sum_{k=1}^{n-2} F_{k}$$

$k$

Questo è possibile calcolare da una convoluzione.

$$f_{N,x=k}(n) = \sum_{l=1}^{n} f_{N,x=1}(l)f_{N,x=1}(n-l)$$

avrai la probabilità di osservare 20 o più schemi '1-0-0' (sulla base dell'ipotesi che la moneta sia giusta)

> # exact computation
> 1-Fx[20]
[1] 0.0003247105
> # estimated from simulation
> sum(counts>=20)/10^6
[1] 0.000337

Ecco il codice R per calcolarlo:

# fibonacci numbers
fn <- c(1,1)
for (i in 3:99) {
  fn <- c(fn,fn[i-1]+fn[i-2])
}

# matrix to contain the probabilities
ps <- matrix(rep(0,101*33),33)

# waiting time probabilities to flip one pattern
ps[1,] <- c(0,0,cumsum(fn))/2^(c(1:101))

#convoluting to get the others
for (i in 2:33) {
  for (n in 3:101) {
     for (l in c(1:(n-2))) {
       ps[i,n] = ps[i,n] + ps[1,l]*ps[i-1,n-l]
     }  
  }
}

# cumulative probabilities to get x patterns in n flips
Fx <- 1-rowSums(ps[,1:100])

# probabilities to get x patterns in n flips
fx <- Fx[-1]-Fx[-33]

#plot in the previous histogram
lines(c(1:32)-0.5,fx)

---

Informatica per monete ingiuste

$x$$n$$p$

Ora usiamo una generalizzazione dei numeri di Fibonacci:

$$F_{n}(x) = \begin{cases} 1 & \quad \text{if $n=1$} \\ x & \quad \text{if $n=2$} \\ x(F_{n-1}+ F_{n-2}) & \quad \text{if $n>2$} \end{cases}$$

le probabilità sono ora come:

$$f_{N_c,x=1,p}(n) = (1-p)^{n-1} F_{n-2}((1-p)^{-1}-1)$$

e

$$f_{N,x=1,p}(n) = \sum_{k=1}^{n-2} p(1-p)^{k-1} f_{N_c,x=1,p}(1+n-k) = p(1-p)^{n-1}\sum_{k=1}^{n-2} F_{k}((1-p)^{-1}-1)$$

Quando lo tracciamo, ottieni:

$p=0.5$$p=0.33$

Quindi se prima dell'esperimento pensavi che la moneta fosse improbabile ingiusta, allora dovresti ancora pensare che la moneta sia improbabile ingiusta.

---

$p_{heads} = p_{tails}$

Si potrebbe testare molto più facilmente la probabilità di una moneta giusta contando il numero di teste e code e utilizzare una distribuzione binomiale per modellare queste osservazioni e verificare se l'osservazione è particolare o meno.

Tuttavia, è possibile che la moneta stia lanciando, in media, un numero uguale di teste e code, ma non è giusto riguardo a determinati schemi. Ad esempio, la moneta potrebbe avere una certa correlazione per il successivo lancio della moneta (immagino un meccanismo con cavità all'interno del metallo della moneta che sono riempite di sabbia che scorrerà come una clessidra verso l'estremità opposta del lancio della moneta precedente, che sta caricando la moneta cadere più probabilmente dallo stesso lato del lato precedente).

$p$

$p=0.45$$p$$p$

# number of trials
set.seed(1)
n <- 10^6

p <- seq(0.3,0.6,0.02)
np <- length(p)
mcounts <- matrix(rep(0,33*np),33)

pb <- txtProgressBar(title = "progress bar", min = 0,
                     max = np, style=3)
for (i in 1:np) {
  # flip first coins
  qfirst <- matrix(rbinom(n, 1, 0.5),n)*2-1
  # flip the changes of the sign of the coin
  qrest <- matrix(rbinom(99*n, 1, p[i]),n)*2-1
  # determining the sign of the coins
  qprod <- t(sapply(1:n, function(x) qfirst[x]*cumprod(qrest[x,])))
  # representing in terms of 1s and 0s
  qcoins <- cbind(qfirst,qprod)*0.5+0.5
  counts <- sapply(1:n, function(x) npattern(qcoins[x,]))

  mcounts[,i] <- sapply(1:33, function(x) sum(counts==x))
  setTxtProgressBar(pb, i)
}
close(pb)

plot(p,colSums(mcounts[c(20:33),]),
     type="l", xlab="p same flip", ylab="counts/million trials", 
     main="observation of 20 or more times '1-0-0' pattern \n for coin with correlated flips")
points(p,colSums(mcounts[c(20:33),]))

---

Usare la matematica nelle statistiche

Quanto sopra va bene, ma non è una risposta diretta alla domanda

"pensi che questa sia una moneta giusta?"

Per rispondere a questa domanda si può usare la matematica di cui sopra, ma si dovrebbe davvero prima descrivere molto bene la situazione, gli obiettivi, la definizione di equità, ecc. Senza alcuna conoscenza dello sfondo e delle circostanze, qualsiasi calcolo sarà solo un esercizio di matematica e non una risposta a la domanda esplicita.

Una domanda aperta è perché e come stiamo cercando il modello "1-0-0".

• Ad esempio, forse questo modello non era un obiettivo, che è stato deciso prima di fare le indagini. Forse era solo qualcosa che "spiccava" nei dati ed era qualcosa che ha attirato l' attenzione dopo l'esperimento. In tal caso, è necessario considerare che si stanno effettivamente effettuando confronti multipli .
• Un altro problema è che la probabilità calcolata sopra è un valore p. Il significato di un valore p deve essere considerato attentamente. E ' non è la probabilità che la moneta è giusto. È invece la probabilità di osservare un risultato particolare se la moneta è giusta. Se si ha un ambiente in cui si conosce una certa distribuzione dell'equità delle monete, oppure si può fare un presupposto ragionevole, allora si può tenerne conto e usare un'espressione bayesiana .
• Ciò che è giusto, ciò che è ingiusto. Alla fine, date le prove sufficienti, si potrebbe riscontrare qualche piccola ingiustizia. Ma è rilevante e tale ricerca non è di parte? Quando ci atteniamo ad un approccio frequentista, allora dovremmo descrivere qualcosa come un limite sopra il quale consideriamo una moneta giusta (alcune dimensioni di effetto rilevanti). Quindi si potrebbe usare qualcosa di simile al test t a due facciate per decidere se la moneta è giusta o meno (rispetto al modello '1-0-0').