[Esteartigofoipublicadopelaprimeiravezem[Thisarticlewasfirstpublishedon Brian Callander, e gentilmente contribuiu para os R-blogueiros]. (Você pode relatar um problema sobre o conteúdo desta página aqui)
Deseja compartilhar seu conteúdo com R-blogueiros? clique aqui se você tiver um blog ou aqui se não tiver.
Aqui estão minhas soluções para os exercícios médios no capítulo 2 do Repensar Estatístico de McElreath, 1ª edição. Minha intenção é passar para a 1ª edição, quando sair no próximo mês.
( DeclareMathOperator { dbinomial} {Binomial} DeclareMathOperator { dbernoulli} {Bernoulli} DeclareMathOperator { dpoisson} {Poisson} DeclareMathOperator { dnormal} {Normal} DeclareMathOperator { dnormal} {Normal} DeclareMathOperator { dnormalom { dcauchy} {Cauchy} DeclareMathOperator { dexponential} {Exp} DeclareMathOperator { duniform} {Uniforme} DeclareMathOperator { dgamma} {Gamma} DeclareMathOperator { dinvpamma} {Invpamma} {InvpathmaO} Logit } DeclareMathOperator { logit} {Logit} DeclareMathOperator { ddirichlet} {Dirichlet} DeclareMathOperator { dbeta} {Beta} )
Lançamento do globo
Comece criando uma grade e a função posterior que usamos para vários cálculos. Isso é análogo ao código fornecido no capítulo.
p_true 0.7 # assumed ground truth
granularity 1000 # number of points on grid
grid1 tibble(p = seq(, 1, length.out = granularity)) %>%
mutate(prior = 1)
posterior function(data, grid) {
grid %>%
mutate(
likelihood = dbinom(sum(data == 'W'), length(data), p),
unstd_posterior = prior * likelihood,
posterior = unstd_posterior / sum(unstd_posterior)
)
}O exercício nos pede para aproximar o posterior de cada um dos três conjuntos de dados a seguir. Para fazer isso, apenas aplicamos nossa posterior função acima para cada um deles.
data list(
'1' = c('W', 'W', 'L'),
'2' = c('W', 'W', 'W', 'L'),
'3' = c('L', 'W', 'W', 'L', 'W', 'W', 'W')
)
m1 data %>%
map_dfr(posterior, grid1, .id = 'dataset')
O posterior torna-se gradualmente mais concentrado em torno da verdade do solo.
Para a segunda pergunta, simplesmente fazemos o mesmo, mas com um anterior diferente. Mais especificamente, para qualquer p abaixo de 0,5, definimos o anterior como zero e, em seguida, mapeamos nosso posterior sobre cada um dos conjuntos de dados com essa nova grade.
grid2 grid1 %>%
mutate(prior = if_else(p 0.5, , prior))
m2 data %>%
map_dfr(posterior, grid2, .id = 'dataset')
Novamente, vemos o posterior se concentrar mais em torno da verdade do solo. Além disso, a distribuição é mais alta (em ~ 0,003) do que com o uniforme anterior, que atinge o pico em torno de (~ 0,0025). O primeiro conjunto de dados já fica bem próximo desse pico, ou seja, esse prévio mais informativo nos permite inferências melhores mais cedo.
Para a pergunta final sobre o lançamento do globo, podemos apenas usar o método de contagem em vez da aproximação da grade. Enumeramos todos os eventos possíveis na proporção da probabilidade de ocorrência: 10 L para Marte, 3 L e 7 W para a Terra. Em seguida, filtramos nossos inconsistentes com nossa observação da terra e resumimos as possibilidades restantes.
m3 tibble(mars = rep('L', 10)) %>%
mutate(earth = if_else(row_number() 3, 'L', 'W')) %>%
gather(planet, observation) %>% # all possible events
filter(observation == 'L') %>% # only those events consistent with observation
summarise(mean(planet == 'earth')) %>% # fraction of possible events that are earth
pull()
m3[1] 0.2307692Temos cerca de 23%.
Desenho de cartão
Fazemos uma lista de todos os lados, filtramos qualquer inconsistência com a observação de um lado preto e, em seguida, resumimos as possibilidades restantes de cartões.
m4_events tibble(card = c("BB", "BW", "WW")) %>% # all the cards
separate(card, into = c('side1', 'side2'), sep = 1, remove = F) %>%
gather(side, colour, -card) # all the sides
m4_possibilities m4_events %>%
filter(colour == 'B') # just the possible events where there is a black side
m4 m4_possibilities %>%
summarise(mean(card == 'BB')) %>%
pull() # which fraction of possible events is a double black?
m4[1] 0.6666667O próximo exercício é o mesmo que o anterior, mas com mais cartões. Observe que isso equivale a usar os três cartões como antes, mas com uma probabilidade anterior maior no cartão BB.
m5_events tibble(card = c("BB", "BW", "WW", "BB")) %>%
separate(card, into = c('side1', 'side2'), sep = 1, remove = F) %>%
gather(side, colour, -card)
m5_possibilities m5_events %>%
filter(colour == 'B')
m5 m5_possibilities %>%
summarise(mean(card == 'BB')) %>%
pull()
m5[1] 0.8Colocar o anterior nos cartões é equivalente a ter os cartões na proporção do seu anterior. O restante do cálculo é o mesmo.
m6_events c("BB", "BW", "WW") %>% # cards
rep(c(1, 2, 3)) %>% # prior: repeat each card the given number of times
tibble(card = .) %>%
separate(card, into = c('side1', 'side2'), sep = 1, remove = F) %>%
gather(side, colour, -card)
m6_possibilities m6_events %>% # sides
filter(colour == 'B')
m6 m6_possibilities %>% # sides consistent with observation
summarise(mean(card == 'BB')) %>% # proportion of possible events that are BB
pull()
m6[1] 0.5Este último exercício de desenho de cartas é um pouco mais complicado, pois podemos observar qualquer um dos dois lados de uma carta e qualquer um dos dois lados da outra. Assim, primeiro geramos a lista de todos os pares possíveis de cartões, expandimos isso para uma lista de todos os lados possíveis que podem ser observados para cada cartão, filtramos qualquer evento não consistente com nossas observações e resumimos o que resta.
m7_card_pairs tibble(card = c("BB", "BW", "WW")) %>% # all the cards
crossing(., other_card = .$card) %>%
filter(card != other_card) # all card pairs (can't draw the same card twice)
m7_events m7_card_pairs %>%
separate(card, into = c('side1', 'side2'), sep = 1, remove = F) %>%
separate(other_card, into = c('other_side1', 'other_side2'), sep = 1, remove = F) %>%
gather(side, colour, side1, side2) %>% # all the sides for card of interest
gather(other_side, other_colour, other_side1, other_side2) # all sides of other card
m7_possibilities m7_events %>%
filter(
colour == 'B', # we observe that card of interest has a black side
other_colour == 'W' # we observe that the other card has a white side
)
m7 m7_possibilities %>%
summarise(mean(card == 'BB')) %>% # which fraction of possible events is a double black?
pull()
m7[1] 0.75Relacionado
Se você chegou até aqui, por que não inscreva-se para atualizações do site? Escolha seu sabor: e-mail, Twitter, RSS ou facebook …
