Verificando se uma moeda é justa

Foi-me feita a seguinte pergunta por um amigo. Não pude ajudá-la, mas espero que alguém possa me explicar. Não encontrei nenhum exemplo semelhante. Obrigado por qualquer ajuda e explicação.

P: Os resultados de 100 experimentos de sorteio são registrados como 0 = "Cauda" e 1 = "Cabeça". A saída x é uma sequência de 0 e 1 de comprimento 100. E o número de vezes que obtemos 1-0-0 em x é calculado e é 20 (ex: se x = (001001110100), 1-0-0 ocorre 2 vezes). Você acha que essa é uma moeda justa?

Resolvendo o problema por simulação

Minha primeira tentativa seria simular isso em um computador, que pode jogar muitas moedas justas muito rapidamente. Abaixo está um exemplo com um milhão de tentativas. O evento 'que o número de vezes o padrão '1-0-0' ocorre em coin flips é de 20 ou mais' ocorre aproximadamente uma vez a cada três mil ensaios, de modo que você observou não é muito provável (para uma feira moeda).$X$$n=100$

Observe que o histrograma é para a simulação e a linha é o cálculo exato explicado mais adiante.

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)

---

Resolvendo o problema com um cálculo exato

Para uma abordagem analítica, você pode usar o fato de que 'a probabilidade de observar 20 ou mais seqüências' 1-0-0 'em 100 lançamentos de moedas é igual a 1 menos a probabilidade de que são necessários mais de 100 lançamentos para fazer 20 sequências' . Isso é resolvido nas seguintes etapas:

Tempo de espera pela probabilidade de virar '1-0-0'

A distribuição, , do número de vezes que você precisa inverter até obter exatamente uma sequência '1-0-0' pode ser calculada da seguinte forma:$f_{N,x=1}(n)$

Vamos analisar as maneiras de chegar ao '1-0-0' como uma cadeia de Markov. Seguimos os estados descritos pelo sufixo da sequência de lançamentos: '1', '1-0' ou '1-0-0'. Por exemplo, se você tiver os oito lançamentos a seguir 10101100, passou por oito estados seguintes: '1', '1-0', '1', '1-0', '1', '1', '1-0', '1-0-0' e foram necessários oito movimentos para chegar a '1-0-0'. Observe que você não tem a mesma probabilidade de atingir o estado '1-0-0' em cada jogada. Portanto, você não pode modelar isso como uma distribuição binomial . Em vez disso, você deve seguir uma árvore de probabilidades. O estado '1' pode entrar em '1' e '1-0', o estado '1-0' pode entrar em '1' e '1-0-0', e o estado '1-0-0' é um estado absorvente. Você pode anotá-lo como:

           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}

e a probabilidade de atingir o padrão '1-0-0', depois de rolar o primeiro '1' (você começa com o estado '0', ainda não tendo virado a cabeça), dentro de flips é metade da probabilidade estar no estado '1-0' dentro de invertidos:$n$$n-1$

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

onde é o ésimo número da Fibonnaci. A probabilidade não condicional é uma soma$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}$$

Tempo de espera pela probabilidade de virar vezes '1-0-0'$k$

Isso você pode calcular por uma convolução.

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

você terá a probabilidade de observar 20 ou mais padrões '1-0-0' (com base na hipótese de que a moeda é justa)

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

Aqui está o código R para calculá-lo:

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

---

Computando para moedas injustas

Podemos generalizar o cálculo acima da probabilidade de observar padrões em , quando a probabilidade de '1 = cabeça' é e os movimentos são independentes.$x$$n$$p$

Agora usamos uma generalização dos números de 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}$$

as probabilidades são agora como:

$$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 traçamos isso, você obtém:

Portanto, embora o valor-p seja pequeno para uma moeda justa 0,0003247, devemos observar que não é muito melhor (apenas uma única ordem) para diferentes moedas injustas. A razão de verossimilhança, ou fator de Bayes , é de cerca de 11 quando a hipótese nula ( ) é comparada com a hipótese alternativa . Isso significa que o odds ratio posterior é apenas dez vezes maior que o odds ratio anterior.$p=0.5$$p=0.33$

Portanto, se você pensou antes do experimento que a moeda era improvável injusta, agora você ainda deve pensar que a moeda é improvável injusta.

---

Uma moeda com mas injustiça em relação a ocorrências '1-0-0'$p_{heads} = p_{tails}$

Poder-se-ia testar muito mais facilmente a probabilidade de uma moeda justa contando o número de caras e coroas e usar uma distribuição binomial para modelar essas observações e testar se a observação é particular ou não.

No entanto, pode ser que a moeda esteja lançando, em média, um número igual de cara e coroa, mas não é justo em relação a certos padrões. Por exemplo, a moeda pode ter alguma correlação para lançamentos sucessivos de moedas (imagino algum mecanismo com cavidades no interior do metal da moeda que são preenchidas com areia que flui como uma ampulheta em direção à extremidade oposta do lançamento anterior da moeda, que está carregando a moeda cair mais provavelmente no mesmo lado que o lado anterior).

Seja a primeira moeda lançada com igual probabilidade de cara e coroa e os lançamentos subsequentes terão a probabilidade do mesmo lado que o lançamento anterior. Em seguida, uma simulação semelhante ao início deste post fornecerá as seguintes probabilidades para o número de vezes que o padrão '1-0-0' excede 20:$p$

Você pode ver que é possível aumentar ligeiramente a probabilidade de observar o padrão '1-0-0' (algo em torno de uma moeda que tem alguma correlação negativa), mas mais dramático é que se pode torná-lo muito menos provável que supere o padrão '1-0-0'. Para baixo, você obtém muitas vezes as caudas após as cabeças, a primeira parte '1-0' do padrão '1-0-0', mas você não recebe tantas vezes duas caudas seguidas no '0-0' parte do padrão. O oposto é verdadeiro para os altos valores de .$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),]))

---

Usando a matemática em estatística

O acima exposto está bem, mas não é uma resposta direta à pergunta

"você acha que esta é uma moeda justa?"

Para responder a essa pergunta, pode-se usar a matemática acima, mas deve-se primeiro descrever muito bem a situação, os objetivos, a definição de justiça, etc. a pergunta explícita.

Uma questão em aberto é por que e como estamos procurando o padrão '1-0-0'.

• Por exemplo, talvez esse padrão não fosse um alvo, que foi decidido antes de fazer a investigação. Talvez tenha sido apenas algo que 'se destacou' nos dados e tenha sido algo que chamou atenção após o experimento. Nesse caso, é preciso considerar que efetivamente se faz múltiplas comparações .
• Outra questão é que a probabilidade calculada acima é um valor-p. O significado de um valor-p precisa ser considerado com cuidado. É não a probabilidade de que a moeda é honesta. Em vez disso, é a probabilidade de observar um resultado específico se a moeda é justa. Se alguém tem um ambiente em que conhece alguma distribuição da justiça das moedas ou pode fazer uma suposição razoável, pode-se levar isso em conta e usar uma expressão bayesiana .
• O que é justo, o que é injusto. Eventualmente, dadas as tentativas suficientes, pode-se encontrar um pouco de injustiça. Mas é relevante e essa pesquisa não é tendenciosa? Quando adotamos uma abordagem freqüentista, deve-se descrever algo como um limite acima do qual consideramos uma moeda justa (algum tamanho de efeito relevante). Então, pode-se usar algo semelhante ao teste t unilateral para decidir se a moeda é justa ou não (em relação ao padrão '1-0-0').