5.1

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.2.1     ✔ readr     2.2.0
✔ forcats   1.0.1     ✔ stringr   1.6.0
✔ ggplot2   4.0.3     ✔ tibble    3.3.1
✔ lubridate 1.9.5     ✔ tidyr     1.3.2
✔ purrr     1.2.2     

── 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

N <- 10000

first_head <- \(tosses) if (any(tosses == 1)) which(tosses == 1)[1] else -1

(coin_sim <- purrrfect::replicate(N, rbinom(3, size = 1, prob = 0.5), .as = tosses)
  %>% mutate(X = map_int(tosses, sum),
             Y = map_dbl(tosses, first_head))
)

# A tibble: 10,000 × 4
   .trial tosses        X     Y
    <dbl> <list>    <int> <dbl>
 1      1 <int [3]>     1     1
 2      2 <int [3]>     2     1
 3      3 <int [3]>     0    -1
 4      4 <int [3]>     2     2
 5      5 <int [3]>     0    -1
 6      6 <int [3]>     1     3
 7      7 <int [3]>     0    -1
 8      8 <int [3]>     2     2
 9      9 <int [3]>     1     3
10     10 <int [3]>     1     1
# ℹ 9,990 more rows

#a
(coin_sim
  %>% summarize(cnt = n(), .by = c(X, Y))
  %>% mutate(joint_prob = cnt/N)
  %>% arrange(X)
  %>% pivot_wider(names_from = X,
                  values_from = joint_prob,
                  names_prefix = 'x=',
                  id_cols = Y,
                  values_fill = 0)
  %>% arrange(Y)
)

# A tibble: 4 × 5
      Y `x=0` `x=1` `x=2` `x=3`
  <dbl> <dbl> <dbl> <dbl> <dbl>
1    -1 0.123 0     0     0    
2     1 0     0.131 0.246 0.122
3     2 0     0.127 0.123 0    
4     3 0     0.128 0     0    

#b
ggplot(data = coin_sim) +
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 = c(-1, 1, 2, 3)) +
  theme_classic(base_size = 20)

#c
(coin_sim
  %>% filter(Y == 1)
  %>% summarize(cnt = n(), .by = X)
  %>% mutate(p_X_given_Y = cnt/sum(cnt))
  %>% arrange(X)
)

# A tibble: 3 × 3
      X   cnt p_X_given_Y
  <int> <int>       <dbl>
1     1  1310       0.263
2     2  2456       0.492
3     3  1223       0.245

library(purrrfect)
library(tidyverse)

N <- 10000

execs <- c(rep("married", 4), rep("never", 3), rep("divorced", 2))

(exec_sim <- purrrfect::replicate(N, sample(execs, 3), .as = promoted)
  %>% mutate(X = map_int(promoted, \(p) sum(p == "married")),
             Y = map_int(promoted, \(p) sum(p == "never")))
)

# A tibble: 10,000 × 4
   .trial promoted      X     Y
    <dbl> <list>    <int> <int>
 1      1 <chr [3]>     1     1
 2      2 <chr [3]>     0     2
 3      3 <chr [3]>     1     2
 4      4 <chr [3]>     2     1
 5      5 <chr [3]>     0     2
 6      6 <chr [3]>     1     1
 7      7 <chr [3]>     2     1
 8      8 <chr [3]>     1     1
 9      9 <chr [3]>     3     0
10     10 <chr [3]>     1     1
# ℹ 9,990 more rows

#a
(exec_sim
  %>% summarize(cnt = n(), .by = c(X, Y))
  %>% mutate(joint_prob = cnt/N)
  %>% arrange(X)
  %>% pivot_wider(names_from = X,
                  values_from = joint_prob,
                  names_prefix = 'x=',
                  id_cols = Y,
                  values_fill = 0)
  %>% arrange(Y)
)

# A tibble: 4 × 5
      Y  `x=0`  `x=1` `x=2`  `x=3`
  <int>  <dbl>  <dbl> <dbl>  <dbl>
1     0 0      0.0504 0.141 0.0472
2     1 0.0354 0.286  0.209 0     
3     2 0.071  0.147  0     0     
4     3 0.013  0      0     0     

#b
ggplot(data = exec_sim) +
  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 = 0:3) +
  theme_classic(base_size = 20)

#c
(exec_sim
  %>% filter(Y == 2)
  %>% summarize(cnt = n(), .by = X)
  %>% mutate(p_X_given_Y = cnt/sum(cnt))
  %>% arrange(X)
)

# A tibble: 2 × 3
      X   cnt p_X_given_Y
  <int> <int>       <dbl>
1     0   710       0.326
2     1  1468       0.674