SR2 Capítulo 2 Médio | R-bloggers

cupom com desconto - o melhor site de cupom de desconto cupomcomdesconto.com.br


[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')
Solução 2M1
Solução 2M1

O posterior torna-se gradualmente mais concentrado em torno da verdade do solo.

Leia Também  Verasity se une à Tokeny para a OIC

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')
Solução 2M2
Solução 2M2

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.2307692

Temos 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.

cupom com desconto - o melhor site de cupom de desconto cupomcomdesconto.com.br
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.6666667

O 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.8

Colocar 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.5

Este ú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.75

Leia Também  Simulate! Simulate! – Part 4: A binomial generalized linear mixed model



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 …



cupom com desconto - o melhor site de cupom de desconto cupomcomdesconto.com.br