Lab 6:Inference for categorical data

library(tidyverse)
library(openintro)
library(infer)

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?

# Insert code for Exercise 1 here
yrbss

## # A tibble: 13,583 x 13
##      age gender grade hispanic race  height weight helmet_12m text_while_driv~
##    <int> <chr>  <chr> <chr>    <chr>  <dbl>  <dbl> <chr>      <chr>           
##  1    14 female 9     not      Blac~  NA      NA   never      0               
##  2    14 female 9     not      Blac~  NA      NA   never      <NA>            
##  3    15 female 9     hispanic Nati~   1.73   84.4 never      30              
##  4    15 female 9     not      Blac~   1.6    55.8 never      0               
##  5    15 female 9     not      Blac~   1.5    46.7 did not r~ did not drive   
##  6    15 female 9     not      Blac~   1.57   67.1 did not r~ did not drive   
##  7    15 female 9     not      Blac~   1.65  132.  did not r~ <NA>            
##  8    14 male   9     not      Blac~   1.88   71.2 never      <NA>            
##  9    15 male   9     not      Blac~   1.75   63.5 never      <NA>            
## 10    15 male   10    not      Blac~   1.37   97.1 did not r~ <NA>            
## # ... with 13,573 more rows, and 4 more variables: physically_active_7d <int>,
## #   hours_tv_per_school_day <chr>, strength_training_7d <int>,
## #   school_night_hours_sleep <chr>

table (yrbss$text_while_driving_30d)

## 
##             0           1-2         10-19         20-29           3-5 
##          4792           925           373           298           493 
##            30           6-9 did not drive 
##           827           311          4646

0: 4792 1-2: 925 10-19: 373 20-29: 298 3-5: 493 30: 827 6-9: 311 did not drive: 4646

Exercise 2

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

# Insert code for Exercise 2 here

yrbss %>%filter(text_while_driving_30d =="30" & helmet_12m =="never") %>%nrow()/nrow(yrbss)

## [1] 0.03408673

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

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?

# Insert code for Exercise 3 here

p <-yrbss %>%filter(text_while_driving_30d =="30" & yrbss$helmet_12m =="never") %>%nrow()/nrow(yrbss)

ME<-1.96*sqrt(p*(1-p)/nrow(yrbss))
ME

## [1] 0.003051546

Margin of error = 0.003051546

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. Interpret the interval in context of the data. It may be helpful to create new data sets for each of the two countries first, and then use these data sets to construct the confidence intervals.

# Insert code for Exercise 4 here

table(yrbss$physically_active_7d)

## 
##    0    1    2    3    4    5    6    7 
## 2172  962 1270 1451 1265 1728  840 3622

n1 <-yrbss %>%filter( physically_active_7d > 6) %>%nrow(); n1

## [1] 3622

n = nrow(yrbss); n

## [1] 13583

p <- n1/n; p

## [1] 0.2666569

ME<-1.96*sqrt(p*(1-p)/nrow(yrbss))
ME

## [1] 0.007436836

c(p - ME, p + ME)

## [1] 0.2592200 0.2740937

We are testing how many people exercise everyday (success). The confidence interval for the proportion of the population who exercises every day is [ p - ME, p + ME] = 0.259 to 0.274; We are 95% confident that the true population proportion of individuals that exercise everyday is between 25.9% and 27.4%.

table(yrbss$strength_training_7d)

## 
##    0    1    2    3    4    5    6    7 
## 3632 1012 1305 1468 1059 1333  513 2085

n1 <-yrbss %>%filter( strength_training_7d > 3) %>%nrow(); n1

## [1] 4990

n = nrow(yrbss); n

## [1] 13583

p <- n1/n; p

## [1] 0.367371

ME<-1.96*sqrt(p*(1-p)/nrow(yrbss))
ME

## [1] 0.008107467

c(p - ME, p + ME)

## [1] 0.3592635 0.3754784

We are testing how many people do strength training more than 3 times a week (success). The confidence interval for the proportion of the population who exercises more than 3 times a week is [ p - ME, p + ME] = 0.359 to 0.375; We are 95% confident that the true population proportion of individuals that exercise everyday is between 35.9% and 37.5%.

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?

# Insert code for Exercise 5 here
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")

n <- 10
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")

The plot is symmetric and unimodal. It shows that the margin of error is maximized at 0.5 population proportion. The margin of error also vanishes if the population proportion is near to 0 or 1. The margin of error is inversely proportional to the square root of the sample size.

Exercise 6

Describe the sampling distribution of sample proportions at n=300 and p=0.1. Be sure to note the center, spread, and shape.

# Insert code for Exercise 6 here
set.seed(12)
n <- 300 
p <- 0.1
reps = 1000
samples <- replicate(reps, rbinom(1,n,p))
hist(samples,
     #ylim = c(0, 1.4),
     col = "steelblue",
     freq = F,
     breaks = 25)
curve(dnorm(x, mean=n*p, sd=sqrt(p*(1-p)*n)),
      col = "red",
      lwd = "2",
      add = T)

sample.proportions <- samples / n
hist(sample.proportions,
     #ylim = c(0, 1.4),
     col = "steelblue",
     freq = F,
     breaks = 25)
curve(dnorm(x, mean=p, sd=sqrt(p*(1-p)/n)),
      col = "red",
      lwd = "2",
      add = T)

With reps = 1000, It is somewhat normally distributed. It’s center is about 0.1 or the p value.

Exercise 7

Keep n constant and change p. How does the shape, center, and spread of the sampling distribution vary as p changes. You might want to adjust min and max for the x-axis for a better view of the distribution.

# Insert code for Exercise 7 here
set.seed(1)
n <- 300 
p <- 0.5
samples <- replicate(reps, rbinom(1,n,p))
hist(samples,
     #ylim = c(0, 1.4),
     col = "steelblue",
     freq = F,
     breaks = 25)
curve(dnorm(x, mean=n*p, sd=sqrt(p*(1-p)*n)),
      col = "red",
      lwd = "2",
      add = T)

sample.proportions <- samples / n
hist(sample.proportions,
     #ylim = c(0, 1.4),
     col = "steelblue",
     freq = F,
     breaks = 25)
curve(dnorm(x, mean=p, sd=sqrt(p*(1-p)/n)),
      col = "red",
      lwd = "2",
      add = T)

With reps = 1000, changing the p value to 0.5 creates a more normally distributed histogram. The center changes to the new p value.

Exercise 8

Now also change n. How does n appear to affect the distribution of p^?

# Insert code for Exercise 8 here
set.seed(2)
n <- 1000 
p <- 0.1
samples <- replicate(reps, rbinom(1,n,p))
hist(samples,
     #ylim = c(0, 1.4),
     col = "steelblue",
     freq = F,
     breaks = 25)
curve(dnorm(x, mean=n*p, sd=sqrt(p*(1-p)*n)),
      col = "red",
      lwd = "2",
      add = T)

sample.proportions <- samples / n
hist(sample.proportions,
     #ylim = c(0, 1.4),
     col = "steelblue",
     freq = F,
     breaks = 25)
curve(dnorm(x, mean=p, sd=sqrt(p*(1-p)/n)),
      col = "red",
      lwd = "2",
      add = T)

with reps = 1000, making n larger made the histogram more bell shaped. The center is still 0.1 or the p value. A larger sample size makes p hat’s distribution smoother.

Exercise 9

Is there convincing evidence that those who sleep 10+ hours per day are more likely to strength train every day of the week? As always, write out the hypotheses for any tests you conduct and outline the status of the conditions for inference. If you find a significant difference, also quantify this difference with a confidence interval.

# Insert code for Exercise 9 here
yrbss %>%filter(school_night_hours_sleep >= 10 & strength_training_7d > 6) %>%nrow()/nrow(yrbss)

## [1] 0.1389973

HO: Those who sleep 10+ hours per day are more likely to strength train everyday of the week. HA: Those who sleep 10+ hours per day are not more likely to strength train everyday of the week.

Based on the p-value of 0.1389973 we would not reject the null hypothesis as it is greater than 0.05. Therefore, we can conclude that people who sleep 10+ hours per day are not more likely to strength train everyday of the week.

Exercise 10

Let’s say there has been no difference in likeliness to strength train every day of the week for those who sleep 10+ hours. What is the probability that you could detect a change (at a significance level of 0.05) simply by chance? Hint: Review the definition of the Type 1 error.

# Insert code for Exercise 10 here
#No code needed

A type I error is a false positive where we reject a true null hypothesis. 5% for alpha=0.05.

Exercise 11

Suppose you’re hired by the local government to estimate the proportion of residents that attend a religious service on a weekly basis. According to the guidelines, the estimate must have a margin of error no greater than 1% with 95% confidence. You have no idea what to expect for p. How many people would you have to sample to ensure that you are within the guidelines? Hint: Refer to your plot of the relationship between p and margin of error. This question does not require using a data set.

# Insert code for Exercise 11 here
P <-0.5
Z.alpha <-1.96
ME <-0.01
N<- Z.alpha^2*P*(1-P)/ME^2
N

## [1] 9604

A sample size of at least 9604.