AE 17: Diving back into Paris 2024

Suggested answers

In this application exercise, we will use bootstrapping to construct confidence intervals.

Packages

We will use tidyverse and tidymodels for data exploration and modeling and the knitr package for formatting tables. The dataset was scraped from Wikipedia and the Olympics website.

Data

The data represent the scores of every dive during the final rounds of the 2024 Paris Olympic games diving events. Each diver performs six dives. Suppose we are interested in how well we can predict a diver’s last round dive score from his running total of five dives (i.e. is there a “streak” in diving.)

diving_raw <- read_csv("data/diving.csv")
Rows: 240 Columns: 8
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (5): athlete, country, country_code, event, note
dbl (3): dive_number, points, final_rank

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
diving <- diving_raw |> 
  mutate(dive_number = str_c("Dive_", dive_number)) |> 
  select(athlete, country, event, dive_number, points) |> 
  pivot_wider(
    names_from = dive_number,
    values_from = points
  ) |> 
  mutate(running_total = Dive_1 + Dive_2 + Dive_3 + Dive_4 + Dive_5)

glimpse(diving)
Rows: 40
Columns: 10
$ athlete       <chr> "Xie Siyi", "Wang Zongyuan", "Osmar Olvera", "Carson Tyl…
$ country       <chr> "China", "China", "Mexico", "United States", "Great Brit…
$ event         <chr> "3m Springboard", "3m Springboard", "3m Springboard", "3…
$ Dive_1        <dbl> 86.7, 81.6, 79.9, 76.5, 76.5, 49.3, 74.8, 73.1, 76.5, 65…
$ Dive_2        <dbl> 79.20, 91.00, 89.25, 67.50, 64.60, 71.40, 84.00, 81.60, …
$ Dive_3        <dbl> 97.20, 95.55, 63.00, 69.75, 68.25, 79.95, 35.70, 67.50, …
$ Dive_4        <dbl> 91.00, 89.25, 75.85, 72.00, 74.10, 72.20, 72.15, 68.25, …
$ Dive_5        <dbl> 88.80, 70.20, 98.80, 64.75, 70.20, 72.00, 74.10, 57.75, …
$ Dive_6        <dbl> 100.70, 102.60, 93.60, 78.75, 74.10, 77.00, 70.20, 47.50…
$ running_total <dbl> 442.90, 427.60, 406.80, 350.50, 353.65, 344.85, 340.75, …

Model

diving_fit <- linear_reg() |>
  fit(Dive_6 ~ running_total, data = diving)

tidy(diving_fit) |>
  kable(digits = 2)
term estimate std.error statistic p.value
(Intercept) 13.33 14.47 0.92 0.36
running_total 0.19 0.04 4.57 0.00

Bootstrap confidence interval

1. Calculate the observed fit (slope)

observed_fit <- diving |>
  specify(Dive_6 ~ running_total) |>
  fit()

observed_fit
# A tibble: 2 × 2
  term          estimate
  <chr>            <dbl>
1 intercept       13.3  
2 running_total    0.189

2. Take n bootstrap samples and fit models to each one.

Fill in the code, then set eval: true .

n = 100
set.seed(24601)

boot_fits <- diving |>
  specify(Dive_6 ~ running_total) |>
  generate(reps = n, type = "bootstrap") |>
  fit()

boot_fits
# A tibble: 200 × 3
# Groups:   replicate [100]
   replicate term          estimate
       <int> <chr>            <dbl>
 1         1 intercept       -1.54 
 2         1 running_total    0.238
 3         2 intercept       31.0  
 4         2 running_total    0.143
 5         3 intercept       11.0  
 6         3 running_total    0.201
 7         4 intercept       23.0  
 8         4 running_total    0.161
 9         5 intercept       27.9  
10         5 running_total    0.144
# ℹ 190 more rows
  • Why do we set a seed before taking the bootstrap samples?

Each bootstrap sample is a random sample from the original dataset. We are trying to “freeze” this randomness in time for reproducibility.

  • Make a histogram of the bootstrap samples to visualize the bootstrap distribution.
boot_fits |>
  ggplot(aes(x = estimate)) +
  geom_histogram(bins = 20) +
  facet_wrap(~ term, scale = "free_x")

3. Compute the 95% confidence interval as the middle 95% of the bootstrap distribution

Fill in the code, then set eval: true .

get_confidence_interval(
  boot_fits, 
  point_estimate = observed_fit, 
  level = .95,
  type = "percentile"
)
# A tibble: 2 × 3
  term          lower_ci upper_ci
  <chr>            <dbl>    <dbl>
1 intercept      -12.7     41.0  
2 running_total    0.107    0.262

Changing confidence level

Modify the code from Step 3 to create a 90% confidence interval.

get_confidence_interval(
  boot_fits, 
  point_estimate = observed_fit, 
  level = .90,
  type = "percentile"
)
# A tibble: 2 × 3
  term          lower_ci upper_ci
  <chr>            <dbl>    <dbl>
1 intercept       -8.99    38.7  
2 running_total    0.114    0.252

Modify the code from Step 3 to create a 99% confidence interval.

get_confidence_interval(
  boot_fits, 
  point_estimate = observed_fit, 
  level = .99,
  type = "percentile"
)
# A tibble: 2 × 3
  term          lower_ci upper_ci
  <chr>            <dbl>    <dbl>
1 intercept     -27.0      45.7  
2 running_total   0.0979    0.302
  • Which confidence level produces the most accurate confidence interval (90%, 95%, 99%)?

99% confidence interval

  • Which confidence level produces the most precise confidence interval (90%, 95%, 99%)?

90% confidence interval

  • If we want to be very certain that we capture the population parameter, should we use a wider or a narrower interval? What drawbacks are associated with using a wider interval?

A wider interval; the drawback is it’s less precise