PS 5.1

6c

library(purrrfect)

Attaching package: 'purrrfect'

The following objects are masked from 'package:base':

    replicate, tabulate

library(tidyverse)

── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.4     ✔ readr     2.1.5
✔ forcats   1.0.0     ✔ stringr   1.5.1
✔ ggplot2   3.5.2     ✔ tibble    3.3.0
✔ lubridate 1.9.4     ✔ tidyr     1.3.1
✔ purrr     1.1.0     

── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

#F(3,4)
ppois(3,2)

[1] 0.8571235

#F(4,2)
Q6 <- (parameters(~x, ~y,
c(0:4), 0:2
) %>% mutate(p_X = dpois(x,2),
p_Y_given_X = dbinom(y, x, .5),
p_XY = p_X*p_Y_given_X
)
)
sum(Q6$p_XY)

[1] 0.8965963

7

library(tidyverse)
library(purrrfect)  
N <- 10000
coin <- c('H','T')
one_game <- \() sample(coin, 3, replace = TRUE)
many_games <- replicate(N, one_game(), .as = flips) %>%
  mutate(
    X = map_int(flips, \(x) sum(x == 'H')),
    Y = map_int(flips, \(x) {               
      if (x[1] == 'H') {
        1
      } else if (x[2] == 'H') {
        2
      } else if (x[3] == 'H') {
        3
      } else {
        -1
      }
    })
  )
(many_games
%>% summarize(cnt = n(),
.by = c(X,Y))
%>% mutate(joint_prob = cnt/N,
prob_X_given_Y = cnt/sum(cnt), .by = Y)
%>% pivot_wider(names_from = X,
values_from = prob_X_given_Y,
names_prefix = 'x=',
id_cols = Y)
)

# A tibble: 4 × 5
      Y  `x=2`  `x=1` `x=0`  `x=3`
  <int>  <dbl>  <dbl> <dbl>  <dbl>
1     1  0.497  0.258    NA  0.245
2     2  0.495  0.505    NA NA    
3    -1 NA     NA         1 NA    
4     3 NA      1        NA NA    

ggplot(data = many_games) +
geom_jitter(aes(x = X, y = Y), width=.1, height=.3, size = .4, alpha = .8) +
scale_x_continuous(breaks = 0:3) +
scale_y_continuous(breaks = -1:3) +
theme_classic(base_size = 20)

(many_games
%>% summarize(cnt = n(),
.by = c(X,Y))
%>% mutate(joint_prob = cnt/N,
prob_X_given_Y = cnt/sum(cnt), .by = Y)
%>% filter(Y == 1)
%>%mutate(prob = cnt / sum(cnt))
)

# A tibble: 3 × 6
      X     Y   cnt joint_prob prob_X_given_Y  prob
  <int> <int> <int>      <dbl>          <dbl> <dbl>
1     2     1  2458      0.246          0.497 0.497
2     1     1  1274      0.127          0.258 0.258
3     3     1  1212      0.121          0.245 0.245

8

library(tidyverse)
library(purrrfect)  
N <- 10000
executives <- c('D','D','NM','NM','NM','M','M','M','M')
one_hire <- \() sample(executives, 3, replace = FALSE)
many_hires <- replicate(N, one_hire(), .as = hires) %>%
  mutate(
    X = map_int(hires, \(x) sum(x == 'M')),
    Y = map_int(hires, \(x) sum(x == 'NM')),
)
(many_hires
%>% summarize(cnt = n(),
.by = c(X,Y))
%>% mutate(joint_prob = cnt/N,
prob_X_given_Y = cnt/sum(cnt), .by = Y)
%>% pivot_wider(names_from = X,
values_from = prob_X_given_Y,
names_prefix = 'x=',
id_cols = Y)
)

# A tibble: 4 × 5
      Y  `x=1`  `x=2`   `x=0`  `x=3`
  <int>  <dbl>  <dbl>   <dbl>  <dbl>
1     1  0.543  0.392  0.0651 NA    
2     0  0.203  0.595 NA       0.202
3     2  0.681 NA      0.319  NA    
4     3 NA     NA      1      NA    

ggplot(data = many_hires) +
geom_jitter(aes(x = X, y = Y), width=.1, height=.3, size = .4, alpha = .8) +
scale_x_continuous(breaks = 0:3) +
scale_y_continuous(breaks = -1:3) +
theme_classic(base_size = 20)

(many_hires
%>% summarize(cnt = n(),
.by = c(X,Y))
%>% mutate(joint_prob = cnt/N,
prob_X_given_Y = cnt/sum(cnt), .by = Y)
%>% filter(Y == 2)
%>%mutate(prob = cnt / sum(cnt))
)

# A tibble: 2 × 6
      X     Y   cnt joint_prob prob_X_given_Y  prob
  <int> <int> <int>      <dbl>          <dbl> <dbl>
1     0     2   678     0.0678          0.319 0.319
2     1     2  1450     0.145           0.681 0.681