Inference Lab.

Author

Asher

Categorical Data.

Exercise 1.

What are the counts within each category for the amount of days these students have texted while driving within the past 30 days?

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.1     ✔ tibble    3.2.1
✔ lubridate 1.9.3     ✔ tidyr     1.3.1
✔ purrr     1.0.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

library(openintro)

Loading required package: airports
Loading required package: cherryblossom
Loading required package: usdata

library(infer)

data("yrbss")

yrbss |>
  group_by(text_while_driving_30d) |>
  count()

# A tibble: 9 × 2
# Groups:   text_while_driving_30d [9]
  text_while_driving_30d     n
  <chr>                  <int>
1 0                       4792
2 1-2                      925
3 10-19                    373
4 20-29                    298
5 3-5                      493
6 30                       827
7 6-9                      311
8 did not drive           4646
9 <NA>                     918

Exercise 2.

What is the proportion of people who have texted while driving every day in the past 30 days and never wear helmets?

no_helmet <- yrbss |>
  filter(helmet_12m == "never")

 no_helmet1 <- no_helmet |>
  mutate(text_ind = ifelse(text_while_driving_30d == "30", "yes", "no")) |>
 filter(!is.na(text_ind))

no_helmet1 |>
  summarise(prop_text_no_helmet = mean(text_ind == "yes")) |>
  pull()

[1] 0.07119791

Bootstrap.

boot_helmet <- no_helmet1 |>
  specify(response = text_ind, success = "yes") |>
  generate(reps = 1000, type = "bootstrap") |>
  calculate(stat = "prop")
boot_helmet

Response: text_ind (factor)
# A tibble: 1,000 × 2
   replicate   stat
       <int>  <dbl>
 1         1 0.0704
 2         2 0.0734
 3         3 0.0678
 4         4 0.0724
 5         5 0.0741
 6         6 0.0701
 7         7 0.0704
 8         8 0.0681
 9         9 0.0687
10        10 0.0680
# ℹ 990 more rows

Confidence level.

boot_helmet |>
   get_ci(level = 0.95)

# A tibble: 1 × 2
  lower_ci upper_ci
     <dbl>    <dbl>
1   0.0649   0.0775

boot_helmet

Response: text_ind (factor)
# A tibble: 1,000 × 2
   replicate   stat
       <int>  <dbl>
 1         1 0.0704
 2         2 0.0734
 3         3 0.0678
 4         4 0.0724
 5         5 0.0741
 6         6 0.0701
 7         7 0.0704
 8         8 0.0681
 9         9 0.0687
10        10 0.0680
# ℹ 990 more rows

Exercise 3.

What is the margin of error for the estimate of the proportion of non-helmet wearers that have texted while driving each day for the past 30 days based on this survey?

se <- boot_helmet |>
  summarise(se = sd(stat)) |>
  pull()
se

[1] 0.003217189

me <- 1.96*se
me

[1] 0.00630569

Exercise 4.

Using the infer package, calculate confidence intervals for two other categorical variables (you’ll need to decide which level to call “success”, and report the associated margins of error.

what proportion of the population is Asian and wears a helmet.

unique(yrbss$race)

[1] "Black or African American"                
[2] "Native Hawaiian or Other Pacific Islander"
[3] NA                                         
[4] "American Indian or Alaska Native"         
[5] "White"                                    
[6] "Asian"

always_ride <- yrbss |>
  filter(helmet_12m == "always")

always_ride1 <- always_ride |>
  mutate(always_asian = ifelse(race == "Asian", "yes", "no")) |>
 filter(!is.na(always_asian))

always_ride1 |>
  summarise(prop_always_asian = mean(always_asian == "yes")) |>
  pull()

[1] 0.06990881

Bootstrap.

boot_asian <- always_ride1 |>
  specify(response = always_asian, success = "yes") |>
  generate(reps = 1000, type = "bootstrap") |>
  calculate(stat = "prop")
boot_asian

Response: always_asian (factor)
# A tibble: 1,000 × 2
   replicate   stat
       <int>  <dbl>
 1         1 0.109 
 2         2 0.0729
 3         3 0.0395
 4         4 0.0669
 5         5 0.0699
 6         6 0.0699
 7         7 0.0729
 8         8 0.0578
 9         9 0.0638
10        10 0.0578
# ℹ 990 more rows

Confidence Interval.

boot_asian |>
   get_ci(level = 0.95)

# A tibble: 1 × 2
  lower_ci upper_ci
     <dbl>    <dbl>
1   0.0426    0.100

boot_asian

Response: always_asian (factor)
# A tibble: 1,000 × 2
   replicate   stat
       <int>  <dbl>
 1         1 0.109 
 2         2 0.0729
 3         3 0.0395
 4         4 0.0669
 5         5 0.0699
 6         6 0.0699
 7         7 0.0729
 8         8 0.0578
 9         9 0.0638
10        10 0.0578
# ℹ 990 more rows

Standard and marginal error.

se <- boot_asian |>
  summarise(se = sd(stat)) |>
  pull()
se

[1] 0.01450958

me <- 1.96*se
me

[1] 0.02843878

Interpret the interval in context of the data.

answer: Based on this survey, with a standard error of 0.014 and a marginal error of 0.028 we are 95% sure that the proportion of people who are Asian and always wear a helmet is between 0.043 and 0.097.

Exercise 5.

Describe the relationship between p and me. Include the margin of error vs. population proportion plot you constructed in your answer. For a given sample size, for which value of p is margin of error maximized?

n <- 1000
p <- seq(from = 0, to = 1, by = 0.01)
me <- 2 * sqrt(p * (1 - p)/n)

dd <- data.frame(p = p, me = me)
ggplot(data = dd, aes(x = p, y = me)) + 
  geom_line() +
  labs(x = "Population Proportion", y = "Margin of Error")

answer: Me decreses towards 0 as P goes to its highest and lowest values. It reaches it’s maximum when P is 0.50