Lab 6 Inference for categorical data

library(tidyverse)
library(openintro)
library(infer)
 library(dplyr)
data("yrbss",package="openintro")

Exercise 1

Overall there was 4792 students that don’t text while driving and 7873 students that text while driving in the past 30 days.

yrbss%>%count(text_while_driving_30d)

## # A tibble: 9 x 2
##   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

There were 463 students that have text while driving and do not wear helmets.

no_helmet <- yrbss %>%filter(helmet_12m == "never")
no_helmet <- no_helmet %>%
  mutate(text_ind = ifelse(text_while_driving_30d == "30", "yes", "no"))
ind_text<-no_helmet %>%count(text_ind) %>%mutate(p_hat = n/sum(n))
print(ind_text)

## # A tibble: 3 x 3
##   text_ind     n  p_hat
##   <chr>    <int>  <dbl>
## 1 no        6040 0.866 
## 2 yes        463 0.0664
## 3 <NA>       474 0.0679

Exercise 3

The margin of error for non-helmet wearers who text and drive is ~.006.

no_helmet %>%
  specify(response = text_ind, success = "yes") %>%
  generate(reps = 1000, type = "bootstrap") %>%
  calculate(stat = "prop") %>%
  get_ci(level = 0.95)

## # A tibble: 1 x 2
##   lower_ci upper_ci
##      <dbl>    <dbl>
## 1   0.0658   0.0780

x<-ind_text$p_hat
SE.ME<-function(x){
  x<-(x*(1-x))/5000
  x<- sqrt(x)
  x<-1.95*x
  return(x)
}
ME<-SE.ME(x)
print(ME[2])

## [1] 0.006864284

Exercise 4

Let’s find the calculate the confident levels if those who do text while driving get a full night rest and if students who always wear helmets are physically active. For both senarios, we will run with 95% confident for the ME calculations.

text.drive <- yrbss %>%filter(text_while_driving_30d == "30")
safety.acv <- yrbss %>%filter(helmet_12m == "always")

text.drive <- text.drive %>%
  mutate(sleep_ind = ifelse(school_night_hours_sleep == "9"|school_night_hours_sleep=="10+", "yes", "no"))

safety.acv <- safety.acv %>%
  mutate(work_ind = ifelse(physically_active_7d=="7", "yes", "no"))

sleep_ind<-text.drive%>%count(sleep_ind) %>%mutate(p_hat = n/sum(n))

work_ind<-safety.acv%>%count(work_ind) %>%mutate(p_hat = n/sum(n))

text.drive %>%
  specify(response = sleep_ind, success = "yes") %>%
  generate(reps = 1000, type = "bootstrap") %>%
  calculate(stat = "prop") %>%
  get_ci(level = 0.95)

## # A tibble: 1 x 2
##   lower_ci upper_ci
##      <dbl>    <dbl>
## 1   0.0561   0.0949

safety.acv %>%
  specify(response = work_ind, success = "yes") %>%
  generate(reps = 1000, type = "bootstrap") %>%
  calculate(stat = "prop") %>%
  get_ci(level = 0.95)

## # A tibble: 1 x 2
##   lower_ci upper_ci
##      <dbl>    <dbl>
## 1    0.266    0.355

y<-sleep_ind$p_hat
z<-work_ind$p_hat

ME_a<-SE.ME(y)
ME_b<-SE.ME(z)
print(ME_a[2])

## [1] 0.006928916

print(ME_b[2])

## [1] 0.01264647

Exercise 5

It appears that the population proportion and the marign of error have a quadratic relationship. There is a exponential increase both variables before it hits the vertex at .50

Exercise 6

For the graph created, it is bimodal and symmetric. The center appears to be .10 and the spread is small.

Exercise 7

When we increased P to 0.5, it shifted the histogram down for the center to be 0.5. There was a increase in spread from the increment as well. The increment did change the shape, a as it became unimodal.

Exercise 8

Surprisingly, when the sample size increased to 1000, the shape of the histogram became narrower and formed back to a bi modal.

Exercise 9

Students who get 10+ hours of sleep are more likely to workout every day of the week. Let’s set the confident level to 93% for the example.It appears that only 24% of students that sleep over 10+ hours work out daily. The CL was determine to be (0.236,0.294)

sleep_10<-yrbss%>%filter(school_night_hours_sleep=="10+")
sleep.train <- text.drive %>%
  mutate(strength_ind = ifelse(strength_training_7d == "7", "yes", "no"))

strength_ind<-sleep.train%>%count(strength_ind) %>%mutate(p_hat = n/sum(n))

set.seed(1000)
sleep.train%>%
  specify(response = strength_ind, success = "yes") %>%
  generate(reps = 1000, type = "bootstrap") %>%
  calculate(stat = "prop") %>%
  get_ci(level = 0.93)

## # A tibble: 1 x 2
##   lower_ci upper_ci
##      <dbl>    <dbl>
## 1    0.236    0.294

Exercise 10

There is only a 5% chance that the hypothesis is correct but the data shown the wrong answer. It can mean more students did train daily with 10+ hours of sleep but report incorrectly.

Exercise 11

ME is 1% with 95% confidence. Find n, if p is ~0.2 (given by chart) ME=zSE 0.1 <=1.96sqrt(.2(1-.2)/n) (0.1/1.96)^ (2)<= (sqrt(.16/n))^2 (0.1/1.96)^2<=.16/n (1.0/1.96)^2n<.16 n<=.16/(1.0/1.96)^(2)