Lab Name

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

Exercise 1

Based on the explanation of the data set each case represents a high schooler between grade 9 and 12. There are 13,583 cases in the dataset.

data('yrbss', package='openintro')

glimpse(yrbss)

## Rows: 13,583
## Columns: 13
## $ age                      <int> 14, 14, 15, 15, 15, 15, 15, 14, 15, 15, 15, …
## $ gender                   <chr> "female", "female", "female", "female", "fem…
## $ grade                    <chr> "9", "9", "9", "9", "9", "9", "9", "9", "9",…
## $ hispanic                 <chr> "not", "not", "hispanic", "not", "not", "not…
## $ race                     <chr> "Black or African American", "Black or Afric…
## $ height                   <dbl> NA, NA, 1.73, 1.60, 1.50, 1.57, 1.65, 1.88, …
## $ weight                   <dbl> NA, NA, 84.37, 55.79, 46.72, 67.13, 131.54, …
## $ helmet_12m               <chr> "never", "never", "never", "never", "did not…
## $ text_while_driving_30d   <chr> "0", NA, "30", "0", "did not drive", "did no…
## $ physically_active_7d     <int> 4, 2, 7, 0, 2, 1, 4, 4, 5, 0, 0, 0, 4, 7, 7,…
## $ hours_tv_per_school_day  <chr> "5+", "5+", "5+", "2", "3", "5+", "5+", "5+"…
## $ strength_training_7d     <int> 0, 0, 0, 0, 1, 0, 2, 0, 3, 0, 3, 0, 0, 7, 7,…
## $ school_night_hours_sleep <chr> "8", "6", "<5", "6", "9", "8", "9", "6", "<5…

Exercise 2

Using the summary function we see 1,004 missing values for weight.

summary(yrbss$weight)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##   29.94   56.25   64.41   67.91   76.20  180.99    1004

Exercise 3

Based on the boxplot the distributions are pretty similar. My instinct told me that students that are more physically active would have lower weight, but it does not look like these variables are related.

yrbss <- yrbss %>% 
  mutate(physical_3plus = ifelse(yrbss$physically_active_7d > 2, "yes", "no"))

boxplot(yrbss$weight~yrbss$physical_3plus)

yrbss %>%
  group_by(physical_3plus) %>%
  summarise(mean_weight = mean(weight, na.rm = TRUE))

## # A tibble: 3 x 2
##   physical_3plus mean_weight
## * <chr>                <dbl>
## 1 no                    66.7
## 2 yes                   68.4
## 3 <NA>                  69.9

Exercise 4

Random: I don’t know much about how the researchers obtained their sample, but I am going to assume it’s random.

Normal: We have more then 10 successes and 10 failures

yrbss %>%
  group_by(physical_3plus) %>%
  summarise(count = n())

## # A tibble: 3 x 2
##   physical_3plus count
## * <chr>          <int>
## 1 no              4404
## 2 yes             8906
## 3 <NA>             273

Independent: We have a total of 13k students surveryed. This isn’t above 10% of the total population of high schoolers.

All Conditions are satisfied.

Exercise 5

Our null hypothesis is that the mean weight of physically active students equals that of non phyically active students. Our alternative hypothesis is that they’re different.

obs_diff <- yrbss %>%
  specify(weight ~ physical_3plus) %>%
  calculate(stat = "diff in means", order = c("yes", "no"))

## Warning: Removed 1219 rows containing missing values.

null_dist <- yrbss %>%
  specify(weight ~ physical_3plus) %>%
  hypothesize(null = "independence") %>%
  generate(reps = 1000, type = "permute") %>%
  calculate(stat = "diff in means", order = c("yes", "no"))

## Warning: Removed 1219 rows containing missing values.

ggplot(data = null_dist, aes(x = stat)) +
  geom_histogram()

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

### Exercise 6

0 of our null values have difference of at least our observed value.

null_dist %>%
  filter(stat >= obs_diff)

## # A tibble: 0 x 2
## # … with 2 variables: replicate <int>, stat <dbl>

Exercise 7

We are 95% confident the difference in proportions between the physically active cohorts are -2.4 and -1.15. Since 0 is not included in the confidence interval we can be confident there is a true difference in the population.

yrbss %>%
  group_by(physical_3plus) %>%
  summarise(count = n(),
            mean = mean(weight, na.rm = TRUE),
            sd = sd(weight, na.rm = TRUE))

## # A tibble: 3 x 4
##   physical_3plus count  mean    sd
## * <chr>          <int> <dbl> <dbl>
## 1 no              4404  66.7  17.6
## 2 yes             8906  68.4  16.5
## 3 <NA>             273  69.9  17.6

sd1 <- 17.663805
sd2 <- 16.47832

n1 <- 4404
n2 <- 8906

x1 <- 66.67389
x2 <- 68.44847

SE <- sqrt( ((sd1^2)/n1) + ((sd2^2)/n2))

xhat <- x1-x2
t <- 1.96

c(xhat - (t*SE), xhat + (t*SE))

## [1] -2.398513 -1.150647

Exercise 8

We have a 95% confidence interval of 1.689 and 1.692 meters.

yrbss %>%
  summarise(count = n(),
            mean = mean(height, na.rm = TRUE),
            sd = sd(height, na.rm = TRUE))

## # A tibble: 1 x 3
##   count  mean    sd
##   <int> <dbl> <dbl>
## 1 13583  1.69 0.105

t <- 1.96
c(1.691241 - (t*((0.1)/sqrt(13583))), 1.691241 + (t*((0.1)/sqrt(13583))))

## [1] 1.689559 1.692923

Exercise 9

With a 90% confidence level our interval becomse smaller between each bound. This is becase we don’t have to be as confident.

t <- 1.645
c(1.691241 - (t*((0.1)/sqrt(13583))), 1.691241 + (t*((0.1)/sqrt(13583))))

## [1] 1.689830 1.692652

Exercise 10

The null hypothesis would be that the height is the same between those who exercise 3+ days per week and those who do not.

height_values <- yrbss %>%
  group_by(physical_3plus) %>%
  summarise(count = n(),
            mean = mean(height, na.rm = TRUE),
            sd = sd(height, na.rm = TRUE))



sd1 <- (filter(height_values, physical_3plus == 'yes')$sd)
sd2 <- (filter(height_values, physical_3plus == 'no')$sd)

n1 <- (filter(height_values, physical_3plus == 'yes')$count)
n2 <- (filter(height_values, physical_3plus == 'no')$count)

x1 <- (filter(height_values, physical_3plus == 'yes')$mean)
x2 <- (filter(height_values, physical_3plus == 'no')$mean)

SE <- sqrt( ((sd1^2)/n1) + ((sd2^2)/n2))

xhat <- x1-x2
t <- 1.96

c(xhat - (t*SE), xhat + (t*SE))

## [1] 0.03390685 0.04134492

We calculate a confidence interval of 0.034 and 0.41. Since 0 is not within the confidence interval we can be sure there is a difference between the 2 proportions.

Exercise 11

There are 7 possible values (8 if you consider N/A a value)

yrbss %>%
  group_by(hours_tv_per_school_day) %>%
  summarise(count = n())

## # A tibble: 8 x 2
##   hours_tv_per_school_day count
## * <chr>                   <int>
## 1 <1                       2168
## 2 1                        1750
## 3 2                        2705
## 4 3                        2139
## 5 4                        1048
## 6 5+                       1595
## 7 do not watch             1840
## 8 <NA>                      338

Exercise 12

I think there is a relationship betweeen how many hours a student sleeps and how much they way. I will test this by constructing a null hypothesis that there is no significant difference between the 2 groups.

yrbss <- yrbss %>% 
  mutate(enough_sleep = ifelse(yrbss$school_night_hours_sleep %in% c('<5','5','6','7'), "no", "yes"))

sleep_values <- yrbss %>%
  group_by(enough_sleep) %>%
  summarise(count = n(),
            mean = mean(weight, na.rm = TRUE),
            sd = sd(weight, na.rm = TRUE))

I split the cohort into two groups. Sudents getting 7 hours or less do not get enough sleep and 8 and over do. No let’s calculate if there is significant difference in height.

sd1 <- (filter(sleep_values, enough_sleep == 'yes')$sd)
sd2 <- (filter(sleep_values, enough_sleep == 'no')$sd)

n1 <- (filter(sleep_values, enough_sleep == 'yes')$count)
n2 <- (filter(sleep_values, enough_sleep == 'no')$count)

x1 <- (filter(sleep_values, enough_sleep == 'yes')$mean)
x2 <- (filter(sleep_values, enough_sleep == 'no')$mean)

SE <- sqrt( ((sd1^2)/n1) + ((sd2^2)/n2))

xhat <- x1-x2
t <- 1.96

c(xhat - (t*SE), xhat + (t*SE))

## [1] -1.3660019 -0.1980573

The 95% confidence interval shows that the 2 groups are different.