02 - The Garden of Forking Data

Homework - demonstration

Book question 2M4

Suppose you have a deck with only three cards. Each card has two sides, and each side is either black or white. One card has two black sides. The second card has one black and one white side. The third card has two white sides. Now suppose all three cards are placed in a bag and shuffled. Someone reaches into the bag and pulls out a card and places it flat on a table. A black side is shown facing up, but you don’t know the color of the side facing down. Show that the probability that the other side is also black is 2/3. Use the counting method (Section 2 of the chapter) to approach this problem. This means counting up the ways that each card could produce the observed data (a black side facing up on the table).

Solution: Directly

With given cards and their sides (BB, BW, WW) there are 3 possibilities how to see black side on top: 3B of 6 (BB, BB, BW).

Two of these options have also black facing down (BB, BB), this gives 2 options out of 3 possibilities, i.e. 2/3 probability.

Also demonstrated with counting:

# BW means B on top, W down
d <- crossing(card = c("BB", "BW", "WW"), top_side = 1:2)
d <- d %>% 
  mutate(
    # is the top face black?
    top_black = 
      if_else(card == "BB" | (card == "BW" & top_side == 1), T, F),
    # is the bottom face black? (irrespective of the top)
    bottom_black =
      if_else(card == "BB" | (card == "BW" & top_side == 2), T, F)
  )
d

# A tibble: 6 × 4
  card  top_side top_black bottom_black
  <chr>    <int> <lgl>     <lgl>       
1 BB           1 TRUE      TRUE        
2 BB           2 TRUE      TRUE        
3 BW           1 TRUE      FALSE       
4 BW           2 FALSE     TRUE        
5 WW           1 FALSE     FALSE       
6 WW           2 FALSE     FALSE       

d %>% filter(top_black) %>% summarise(p = mean(bottom_black))

# A tibble: 1 × 1
      p
  <dbl>
1 0.667

Solution: Likelihood

This may be convenient in homeworks with extra limitations (some card or face is heavier, more common etc.).

# how many ways a card can yield black on top?
card_bb_likelihood <- 2
card_bw_likelihood <- 1
card_ww_likelihood <- 0

# remember the order: BB, BW, WW
likelihood <- c(card_bb_likelihood, card_bw_likelihood, card_ww_likelihood)
prior <- c(1, 1, 1)
posterior <- prior * likelihood
# now normalize to probability
posterior <- posterior / sum(posterior)
# the first card is BB, the only option with BB facing also down
posterior[1]

[1] 0.6666667