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

Exercise 1

There are 13 cases in the data set.

glimpse(yrbss)
## Rows: 13,583
## Columns: 13
## $ age                      <int> 14, 14, 15, 15, 15, 15, 15, 14, 15, 15, 15, 1~
## $ gender                   <chr> "female", "female", "female", "female", "fema~
## $ 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 Africa~
## $ height                   <dbl> NA, NA, 1.73, 1.60, 1.50, 1.57, 1.65, 1.88, 1~
## $ weight                   <dbl> NA, NA, 84.37, 55.79, 46.72, 67.13, 131.54, 7~
## $ helmet_12m               <chr> "never", "never", "never", "never", "did not ~
## $ text_while_driving_30d   <chr> "0", NA, "30", "0", "did not drive", "did not~
## $ 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

We are missing 1004 weights from this set.

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

The median for those are physically active for more than two day is higher than those who are not active. The quartiles for the “yes” are distributed more evenly than the “no”. Also, there is less outliers for the “yes” than the “no”.

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

ggplot(yrbss, aes(x=weight, y=physical_3plus)) +geom_boxplot()

Exercise 4

All conditions are satisfied there are three categories (yes,no,na-but we ignore this variable) and the box plots look almost symmetric.

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
count<-yrbss %>%count(physical_3plus) 
print(count)
## # A tibble: 3 x 2
##   physical_3plus     n
##   <chr>          <int>
## 1 no              4404
## 2 yes             8906
## 3 <NA>             273

Exercise 5

H0: The weights are different from those who work out 3+ a week from those who don’t HA:There is no difference in weights from those who out 3+ a week from those who don’t

Exercise 6

None as the null distance stats are larger than the obs_stats. They had to be close to zero.

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

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

ggplot(data = null_dist, aes(x = stat)) +geom_histogram()
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

null_dist %>%filter(stat >= obs_diff)
## Response: weight (numeric)
## Explanatory: physical_3plus (factor)
## Null Hypothesis: independence
## # A tibble: 0 x 2
## # ... with 2 variables: replicate <int>, stat <dbl>
null_dist %>%
  get_p_value(obs_stat = obs_diff, direction = "two_sided")
## # A tibble: 1 x 1
##   p_value
##     <dbl>
## 1       0

Exercise 7

Let’s figure out the confident levels. The confident level of 95% for the differences in weights/Exercise daily are(0.661, 0.677)

yrbss%>%
  specify(response =physical_3plus , 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.661    0.678

Exercise 8

The calculated height is 1.697054. To calculate the confident level of the average height. Lets use infer. The confident interval range is ( 1.69,1.70).

yrbss<-yrbss%>%na.omit(yrbss$height)
mean(yrbss$height)
## [1] 1.697054
set.seed(1000)
yrbss%>%
  specify(response =height ) %>%
  generate(reps = 1000, type = "bootstrap") %>%
  calculate(stat = "mean") %>%
  get_ci(level = 0.95)
## # A tibble: 1 x 2
##   lower_ci upper_ci
##      <dbl>    <dbl>
## 1     1.69     1.70

Exercise 9

The confident interval got narrower as the range is (1.695216 ,1.698853)~(1.70,1.70)

yrbss%>%
  specify(response =height ) %>%
  generate(reps = 1000, type = "bootstrap") %>%
  calculate(stat = "mean") %>%
  get_ci(level = 0.90)
## # A tibble: 1 x 2
##   lower_ci upper_ci
##      <dbl>    <dbl>
## 1     1.70     1.70

Exercise 10

H0:There is a difference in average height for those who exercise at least three times a week and those who don’t HA: There is a difference in average height for those who exercise at least three times a week and those who don’t

obs_diff <- yrbss %>%
  specify(height ~ physical_3plus) %>%
  calculate(stat = "diff in means", order = c("yes", "no"))
null_dist <- yrbss %>%
  specify(height ~ physical_3plus) %>%
  hypothesize(null = "independence") %>%
  generate(reps = 1000, type = "permute") %>%
  calculate(stat = "diff in means", order = c("yes", "no"))
ggplot(data = null_dist, aes(x = stat)) +geom_histogram()
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Exercise 11

There are seven options for the hour_tv_per_school_day column.

count<-yrbss %>%count(hours_tv_per_school_day)  
print(count)
## # A tibble: 7 x 2
##   hours_tv_per_school_day     n
##   <chr>                   <int>
## 1 <1                       1407
## 2 1                        1172
## 3 2                        1738
## 4 3                        1309
## 5 4                         627
## 6 5+                        966
## 7 do not watch             1132

Exercise 12

H0: There is no difference in the means between a student’s average height and the average hours of sleep

HA: There is a difference in the mean between a student’s average height and the average hours of sleep

yrbss %>%
  group_by(school_night_hours_sleep) %>%
  summarise(mean_height = mean(height, na.rm = TRUE))
## # A tibble: 7 x 2
##   school_night_hours_sleep mean_height
##   <chr>                          <dbl>
## 1 <5                              1.69
## 2 10+                             1.69
## 3 5                               1.69
## 4 6                               1.70
## 5 7                               1.70
## 6 8                               1.70
## 7 9                               1.69
ggplot(yrbss, aes(x=height, y=school_night_hours_sleep)) +geom_boxplot()

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


null_dist %>%
  get_p_value(obs_stat = obs_diff, direction = "two_sided")
## Warning: Please be cautious in reporting a p-value of 0. This result is an
## approximation based on the number of `reps` chosen in the `generate()` step. See
## `?get_p_value()` for more information.
## # A tibble: 1 x 1
##   p_value
##     <dbl>
## 1       0
LS0tDQp0aXRsZTogIkxhYiA3IEluZmVyZW5jZSBmb3IgbnVtZXJpY2FsIGRhdGEiDQphdXRob3I6ICJWeWFubmEgSGlsbCINCmRhdGU6ICJgciBTeXMuRGF0ZSgpYCINCm91dHB1dDogb3BlbmludHJvOjpsYWJfcmVwb3J0DQotLS0NCg0KYGBge3IgbG9hZC1wYWNrYWdlcywgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0NCmxpYnJhcnkodGlkeXZlcnNlKQ0KbGlicmFyeShvcGVuaW50cm8pDQpsaWJyYXJ5KGluZmVyKQ0KbGlicmFyeShnZ3Bsb3QyKQ0KbGlicmFyeShkcGx5cikNCmRhdGEoJ3lyYnNzJywgcGFja2FnZT0nb3BlbmludHJvJykNCg0KYGBgDQoNCiMjIyBFeGVyY2lzZSAxDQoNClRoZXJlIGFyZSAxMyBjYXNlcyBpbiB0aGUgZGF0YSBzZXQuDQoNCmBgYHtyIGNvZGUtY2h1bmstbGFiZWx9DQpnbGltcHNlKHlyYnNzKQ0KYGBgDQoNCiMjIyBFeGVyY2lzZSAyDQoNCldlIGFyZSBtaXNzaW5nIDEwMDQgd2VpZ2h0cyBmcm9tIHRoaXMgc2V0Lg0KDQpgYGB7cn0NCnN1bW1hcnkoeXJic3Mkd2VpZ2h0KQ0KDQpgYGANCg0KIyMjIEV4ZXJjaXNlIDMNCg0KVGhlIG1lZGlhbiBmb3IgdGhvc2UgYXJlIHBoeXNpY2FsbHkgYWN0aXZlIGZvciBtb3JlIHRoYW4gdHdvIGRheSBpcyBoaWdoZXIgdGhhbiB0aG9zZSB3aG8gYXJlIG5vdCBhY3RpdmUuIFRoZSBxdWFydGlsZXMgZm9yIHRoZSAieWVzIiBhcmUgZGlzdHJpYnV0ZWQgbW9yZSBldmVubHkgdGhhbiB0aGUgIm5vIi4gQWxzbywgdGhlcmUgaXMgbGVzcyBvdXRsaWVycyBmb3IgdGhlICJ5ZXMiIHRoYW4gdGhlICJubyIuDQoNCmBgYHtyIHdhcm5pbmc9RkFMU0V9DQp5cmJzcyA8LSB5cmJzcyAlPiUgDQogIG11dGF0ZShwaHlzaWNhbF8zcGx1cyA9IGlmZWxzZSh5cmJzcyRwaHlzaWNhbGx5X2FjdGl2ZV83ZCA+IDIsICJ5ZXMiLCAibm8iKSkNCg0KZ2dwbG90KHlyYnNzLCBhZXMoeD13ZWlnaHQsIHk9cGh5c2ljYWxfM3BsdXMpKSArZ2VvbV9ib3hwbG90KCkNCg0KYGBgDQoNCiMjIyBFeGVyY2lzZSA0DQoNCkFsbCBjb25kaXRpb25zIGFyZSBzYXRpc2ZpZWQgdGhlcmUgYXJlIHRocmVlIGNhdGVnb3JpZXMgKHllcyxubyxuYS1idXQgd2UgaWdub3JlIHRoaXMgdmFyaWFibGUpIGFuZCB0aGUgYm94IHBsb3RzIGxvb2sgYWxtb3N0IHN5bW1ldHJpYy4gDQoNCmBgYHtyIHdhcm5pbmc9RkFMU0V9DQp5cmJzcyAlPiUNCiAgZ3JvdXBfYnkocGh5c2ljYWxfM3BsdXMpICU+JQ0KICBzdW1tYXJpc2UobWVhbl93ZWlnaHQgPSBtZWFuKHdlaWdodCwgbmEucm0gPSBUUlVFKSkNCg0KY291bnQ8LXlyYnNzICU+JWNvdW50KHBoeXNpY2FsXzNwbHVzKSANCnByaW50KGNvdW50KQ0KYGBgDQoNCiMjIyBFeGVyY2lzZSA1DQpIMDogVGhlIHdlaWdodHMgYXJlIGRpZmZlcmVudCBmcm9tIHRob3NlIHdobyB3b3JrIG91dCAzKyBhIHdlZWsgZnJvbSB0aG9zZSB3aG8gZG9uJ3QNCkhBOlRoZXJlIGlzIG5vIGRpZmZlcmVuY2UgaW4gd2VpZ2h0cyBmcm9tIHRob3NlIHdobyBvdXQgMysgYSB3ZWVrIGZyb20gdGhvc2Ugd2hvIGRvbid0IA0KDQoNCiMjIyBFeGVyY2lzZSA2DQoNCk5vbmUgYXMgdGhlIG51bGwgZGlzdGFuY2Ugc3RhdHMgYXJlIGxhcmdlciB0aGFuIHRoZSBvYnNfc3RhdHMuIFRoZXkgaGFkIHRvIGJlIGNsb3NlIHRvIHplcm8uDQoNCmBgYHtyIHdhcm5pbmc9RkFMU0V9DQpvYnNfZGlmZiA8LSB5cmJzcyAlPiUNCiAgc3BlY2lmeSh3ZWlnaHQgfiBwaHlzaWNhbF8zcGx1cykgJT4lDQogIGNhbGN1bGF0ZShzdGF0ID0gImRpZmYgaW4gbWVhbnMiLCBvcmRlciA9IGMoInllcyIsICJubyIpKQ0KDQpudWxsX2Rpc3QgPC0geXJic3MgJT4lDQogIHNwZWNpZnkod2VpZ2h0IH4gcGh5c2ljYWxfM3BsdXMpICU+JQ0KICBoeXBvdGhlc2l6ZShudWxsID0gImluZGVwZW5kZW5jZSIpICU+JQ0KICBnZW5lcmF0ZShyZXBzID0gMTAwMCwgdHlwZSA9ICJwZXJtdXRlIikgJT4lDQogIGNhbGN1bGF0ZShzdGF0ID0gImRpZmYgaW4gbWVhbnMiLCBvcmRlciA9IGMoInllcyIsICJubyIpKQ0KDQpnZ3Bsb3QoZGF0YSA9IG51bGxfZGlzdCwgYWVzKHggPSBzdGF0KSkgK2dlb21faGlzdG9ncmFtKCkNCg0KbnVsbF9kaXN0ICU+JWZpbHRlcihzdGF0ID49IG9ic19kaWZmKQ0KDQpudWxsX2Rpc3QgJT4lDQogIGdldF9wX3ZhbHVlKG9ic19zdGF0ID0gb2JzX2RpZmYsIGRpcmVjdGlvbiA9ICJ0d29fc2lkZWQiKQ0KYGBgDQoNCiMjIyBFeGVyY2lzZSA3DQoNCkxldCdzIGZpZ3VyZSBvdXQgdGhlIGNvbmZpZGVudCBsZXZlbHMuIFRoZSBjb25maWRlbnQgbGV2ZWwgb2YgOTUlIGZvciB0aGUgZGlmZmVyZW5jZXMgaW4gd2VpZ2h0cy9FeGVyY2lzZSBkYWlseSBhcmUoMC42NjEsIDAuNjc3KQ0KDQpgYGB7ciB3YXJuaW5nPUZBTFNFfQ0KeXJic3MlPiUNCiAgc3BlY2lmeShyZXNwb25zZSA9cGh5c2ljYWxfM3BsdXMgLCBzdWNjZXNzID0gInllcyIpICU+JQ0KICBnZW5lcmF0ZShyZXBzID0gMTAwMCwgdHlwZSA9ICJib290c3RyYXAiKSAlPiUNCiAgY2FsY3VsYXRlKHN0YXQgPSAicHJvcCIpICU+JQ0KICBnZXRfY2kobGV2ZWwgPSAwLjk1KQ0KDQpgYGANCg0KIyMjIEV4ZXJjaXNlIDgNCg0KVGhlIGNhbGN1bGF0ZWQgaGVpZ2h0IGlzIDEuNjk3MDU0LiBUbyBjYWxjdWxhdGUgdGhlIGNvbmZpZGVudCBsZXZlbCBvZiB0aGUgYXZlcmFnZSBoZWlnaHQuIExldHMgdXNlIGluZmVyLiBUaGUgY29uZmlkZW50IGludGVydmFsIHJhbmdlIGlzICggMS42OSwxLjcwKS4NCg0KYGBge3J9DQp5cmJzczwteXJic3MlPiVuYS5vbWl0KHlyYnNzJGhlaWdodCkNCm1lYW4oeXJic3MkaGVpZ2h0KQ0Kc2V0LnNlZWQoMTAwMCkNCnlyYnNzJT4lDQogIHNwZWNpZnkocmVzcG9uc2UgPWhlaWdodCApICU+JQ0KICBnZW5lcmF0ZShyZXBzID0gMTAwMCwgdHlwZSA9ICJib290c3RyYXAiKSAlPiUNCiAgY2FsY3VsYXRlKHN0YXQgPSAibWVhbiIpICU+JQ0KICBnZXRfY2kobGV2ZWwgPSAwLjk1KQ0KDQpgYGANCg0KIyMjIEV4ZXJjaXNlIDkNCg0KVGhlIGNvbmZpZGVudCBpbnRlcnZhbCBnb3QgbmFycm93ZXIgYXMgdGhlIHJhbmdlIGlzICgxLjY5NTIxNgksMS42OTg4NTMpfigxLjcwLDEuNzApDQoNCmBgYHtyfQ0KeXJic3MlPiUNCiAgc3BlY2lmeShyZXNwb25zZSA9aGVpZ2h0ICkgJT4lDQogIGdlbmVyYXRlKHJlcHMgPSAxMDAwLCB0eXBlID0gImJvb3RzdHJhcCIpICU+JQ0KICBjYWxjdWxhdGUoc3RhdCA9ICJtZWFuIikgJT4lDQogIGdldF9jaShsZXZlbCA9IDAuOTApDQoNCmBgYA0KDQojIyMgRXhlcmNpc2UgMTANCg0KSDA6VGhlcmUgaXMgYSBkaWZmZXJlbmNlIGluIGF2ZXJhZ2UgaGVpZ2h0IGZvciB0aG9zZSB3aG8gZXhlcmNpc2UgYXQgbGVhc3QgdGhyZWUgdGltZXMgYSB3ZWVrIGFuZCB0aG9zZSB3aG8gZG9u4oCZdA0KSEE6IFRoZXJlIGlzIGEgZGlmZmVyZW5jZSBpbiBhdmVyYWdlIGhlaWdodCBmb3IgdGhvc2Ugd2hvIGV4ZXJjaXNlIGF0IGxlYXN0IHRocmVlIHRpbWVzIGEgd2VlayBhbmQgdGhvc2Ugd2hvIGRvbuKAmXQNCg0KYGBge3J9DQpvYnNfZGlmZiA8LSB5cmJzcyAlPiUNCiAgc3BlY2lmeShoZWlnaHQgfiBwaHlzaWNhbF8zcGx1cykgJT4lDQogIGNhbGN1bGF0ZShzdGF0ID0gImRpZmYgaW4gbWVhbnMiLCBvcmRlciA9IGMoInllcyIsICJubyIpKQ0KbnVsbF9kaXN0IDwtIHlyYnNzICU+JQ0KICBzcGVjaWZ5KGhlaWdodCB+IHBoeXNpY2FsXzNwbHVzKSAlPiUNCiAgaHlwb3RoZXNpemUobnVsbCA9ICJpbmRlcGVuZGVuY2UiKSAlPiUNCiAgZ2VuZXJhdGUocmVwcyA9IDEwMDAsIHR5cGUgPSAicGVybXV0ZSIpICU+JQ0KICBjYWxjdWxhdGUoc3RhdCA9ICJkaWZmIGluIG1lYW5zIiwgb3JkZXIgPSBjKCJ5ZXMiLCAibm8iKSkNCmdncGxvdChkYXRhID0gbnVsbF9kaXN0LCBhZXMoeCA9IHN0YXQpKSArZ2VvbV9oaXN0b2dyYW0oKQ0KYGBgDQoNCiMjIyBFeGVyY2lzZSAxMQ0KDQpUaGVyZSBhcmUgc2V2ZW4gb3B0aW9ucyBmb3IgdGhlIGhvdXJfdHZfcGVyX3NjaG9vbF9kYXkgY29sdW1uLg0KYGBge3J9DQpjb3VudDwteXJic3MgJT4lY291bnQoaG91cnNfdHZfcGVyX3NjaG9vbF9kYXkpICANCnByaW50KGNvdW50KQ0KYGBgDQoNCiMjIyBFeGVyY2lzZSAxMg0KDQpIMDogVGhlcmUgaXMgbm8gZGlmZmVyZW5jZSBpbiB0aGUgbWVhbnMgYmV0d2VlbiBhIHN0dWRlbnQncyBhdmVyYWdlIGhlaWdodCBhbmQgdGhlIGF2ZXJhZ2UgaG91cnMgb2Ygc2xlZXANCg0KSEE6IFRoZXJlIGlzIGEgZGlmZmVyZW5jZSBpbiB0aGUgbWVhbiBiZXR3ZWVuIGEgc3R1ZGVudCdzIGF2ZXJhZ2UgaGVpZ2h0IGFuZCB0aGUgYXZlcmFnZSBob3VycyBvZiBzbGVlcA0KDQpgYGB7cn0NCnlyYnNzICU+JQ0KICBncm91cF9ieShzY2hvb2xfbmlnaHRfaG91cnNfc2xlZXApICU+JQ0KICBzdW1tYXJpc2UobWVhbl9oZWlnaHQgPSBtZWFuKGhlaWdodCwgbmEucm0gPSBUUlVFKSkNCg0KZ2dwbG90KHlyYnNzLCBhZXMoeD1oZWlnaHQsIHk9c2Nob29sX25pZ2h0X2hvdXJzX3NsZWVwKSkgK2dlb21fYm94cGxvdCgpDQoNCm9ic19kaWZmIDwtIHlyYnNzICU+JQ0KICAgICBzcGVjaWZ5KGhlaWdodCB+IHBoeXNpY2FsXzNwbHVzKSAlPiUNCiAgICAgY2FsY3VsYXRlKHN0YXQgPSAiZGlmZiBpbiBtZWFucyIsIG9yZGVyID0gYygieWVzIiwgIm5vIikpDQoNCg0KbnVsbF9kaXN0ICU+JQ0KICBnZXRfcF92YWx1ZShvYnNfc3RhdCA9IG9ic19kaWZmLCBkaXJlY3Rpb24gPSAidHdvX3NpZGVkIikNCg0KYGBg