Every two years, the Centers for Disease Control and Prevention conduct the Youth Risk Behavior Surveillance System (YRBSS) survey, where it takes data from high schoolers (9th through 12th grade), to analyze health patterns. You will work with a selected group of variables from a random sample of observations during one of the years the YRBSS was conducted.
Load the data
This data is part of the openintro textbook and we can load and inspect it. There are observations on 13 different variables, some categorical and some numerical. The meaning of each variable can be found by bringing up the help file:
library(vroom)
library(mosaic)
library(skimr)
library(leaflet)
library(tidyverse)
library(ggthemes)
library(GGally)
library(here)
library(janitor)
library(broom)
library(tidyquant)
library(infer)
library(tidyquant)
library(scales)
library(ggfortify)
library (ggplot2)
library(openintro)
data(yrbss)
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.4, 55.8, 46.7, 67.1, 131.5, 71.2,…
## $ 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…
Before you carry on with your analysis, it’s is always a good idea to check with skimr::skim() to get a feel for missing values, summary statistics of numerical variables, and a very rough histogram.
Exploratory Data Analysis
You will first start with analyzing the weight of participants in kilograms. Using visualization and summary statistics, describe the distribution of weights. How many observations are we missing weights from?
We are missing 1,004 observations for weight in the data set.
yrbss_weights <- yrbss %>%
filter(!weight %in% NA) %>%
summarise(mean = mean(weight),
median = median(weight),
max = max(weight),
min = min(weight),
sd = sd(weight))
yrbss_weights
| mean | median | max | min | sd |
|---|---|---|---|---|
| 67.9 | 64.4 | 181 | 29.9 | 16.9 |
ggplot(yrbss, aes(x = weight)) +
geom_histogram() +
theme_bw() +
labs(title = "Weighty Children",
subtitle = "Distribution of Weights for American High Schoolers",
x = "Weight (kg)",
y = "Count",
caption = "Source: CDC")

Next, consider the possible relationship between a high schooler’s weight and their physical activity. Plotting the data is a useful first step because it helps us quickly visualize trends, identify strong associations, and develop research questions.
Let’s create a new variable physical_3plus, which will be yes if they are physically active for at least 3 days a week, and no otherwise.
yrbss <- yrbss %>%
mutate(physical_3plus = ifelse(physically_active_7d >= 3, "yes", "no"))
yrbss %>% filter(!is.na(physical_3plus)) %>%
group_by(physical_3plus) %>%
summarise(count = n()) %>%
mutate(prop= count/sum(count))
| physical_3plus | count | prop |
|---|---|---|
| no | 4404 | 0.331 |
| yes | 8906 | 0.669 |
Can you provide a 95% confidence interval for the population proportion of high schools that are NOT active 3 or more days per week?
weight_ci <- yrbss %>%
specify(response = physical_3plus, success = "no") %>%
generate(reps = 1000, type = "bootstrap") %>%
calculate(stat = "prop") %>%
get_confidence_interval(level = 0.95, type = "percentile")
weight_ci
| lower_ci | upper_ci |
|---|---|
| 0.323 | 0.339 |
Make a boxplot of physical_3plus vs. weight. Is there a relationship between these two variables? What did you expect and why?
weight_box <- yrbss %>%
filter(!physical_3plus %in% NA) %>%
ggplot(aes(x = weight, y = physical_3plus)) +
geom_boxplot() +
theme_bw() +
labs(title = "Muscle Mass?",
subtitle = "Distribution of Weights for American High Schoolers by Physical Activity",
x = "Weight (kg)",
y = "3+ Hours of Physcical Activity per Day",
caption = "Source: CDC")
weight_box

Confidence Interval
Boxplots show how the medians of the two distributions compare, but we can also compare the means of the distributions using either a confidence interval or a hypothesis test. Note that when we calculate the mean/SD, etc weight in these groups using the mean function, we must ignore any missing values by setting the na.rm = TRUE.
yrbss %>%
group_by(physical_3plus) %>%
filter(!is.na(physical_3plus)) %>%
summarise(mean_weight = mean(weight, na.rm = TRUE),
sd_weight = sd(weight, na.rm=TRUE),
count = n(),
se_weight = sd_weight/sqrt(count),
t_critical = qt(0.975, count-1),
margin_of_error = t_critical * se_weight,
lower = mean_weight - t_critical * se_weight,
upper = mean_weight + t_critical * se_weight
)
| physical_3plus | mean_weight | sd_weight | count | se_weight | t_critical | margin_of_error | lower | upper |
|---|---|---|---|---|---|---|---|---|
| no | 66.7 | 17.6 | 4404 | 0.266 | 1.96 | 0.521 | 66.2 | 67.2 |
| yes | 68.4 | 16.5 | 8906 | 0.175 | 1.96 | 0.342 | 68.1 | 68.8 |
There is an observed difference of about 1.77kg (68.44 - 66.67), and we notice that the two confidence intervals do not overlap. It seems that the difference is at least 95% statistically significant. Let us also conduct a hypothesis test.
Hypothesis test with formula
Write the null and alternative hypotheses for testing whether mean weights are different for those who exercise at least times a week and those who don’t. * Null hypothesis: true difference in means is equal to 0 * Alternative hypothesis: true difference in means is not equal to 0
t.test(weight ~ physical_3plus, data = yrbss)
##
## Welch Two Sample t-test
##
## data: weight by physical_3plus
## t = -5, df = 7479, p-value = 9e-08
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -2.42 -1.12
## sample estimates:
## mean in group no mean in group yes
## 66.7 68.4
Hypothesis test with infer
Next, we will introduce a new function, hypothesize, that falls into the infer workflow. You will use this method for conducting hypothesis tests.
But first, we need to initialize the test, which we will save as obs_diff.
obs_diff <- yrbss %>%
specify(weight ~ physical_3plus) %>%
calculate(stat = "diff in means", order = c("yes", "no"))
Notice how you can use the functions specify and calculate again like you did for calculating confidence intervals. Here, though, the statistic you are searching for is the difference in means, with the order being yes - no != 0.
After you have initialized the test, you need to simulate the test on the null distribution, which we will save as null.
null_dist <- yrbss %>%
specify(weight ~ physical_3plus) %>%
hypothesize(null = "independence") %>%
generate(reps = 1000, type = "permute") %>%
calculate(stat = "diff in means", order = c("yes", "no"))
Here, hypothesize is used to set the null hypothesis as a test for independence, i.e., that there is no difference between the two population means. In one sample cases, the null argument can be set to point to test a hypothesis relative to a point estimate.
Also, note that the type argument within generate is set to permute, which is the argument when generating a null distribution for a hypothesis test.
We can visualize this null distribution with the following code:
ggplot(data = null_dist, aes(x = stat)) +
geom_histogram()

Now that the test is initialized and the null distribution formed, we can visualise to see how many of these null permutations have a difference of at least obs_stat of 1.77?
We can also calculate the p-value for your hypothesis test using the function infer::get_p_value().
null_dist %>% visualize() +
shade_p_value(obs_stat = obs_diff, direction = "two-sided")

null_dist %>%
get_p_value(obs_stat = obs_diff, direction = "two_sided")
| p_value |
|---|
| 0 |
This the standard workflow for performing hypothesis tests.