SemesterProject.qmd

---
title: "Semester Project"
subtitle: "Obesity Rates in the U.S."
execute:
  keep-md: true
  df-print: paged
  warning: false
format:
  html:
    code-fold: true
    code-line-numbers: true
---

```{r}
library(readxl)
library(tidyverse)
library(openxlsx)
library(janitor)
library(directlabels)
library(ggrepel)
```
# Data and Data Wrangling

My data came from the CDC. It can be found at this [link](https://www.cdc.gov/nchs/hus/data-finder.htm). It is the 2019, Table 026 and Table 027, Excel sheets. Table 026 includes data on "Normal weight, overweight, and obesity among adults aged 20 and over, by selected characteristics: United States, selected years 1988-1994 through 2015-2018" and table 027 includes data on "Obesity among children and adolescents aged 2-19 years, by selected characteristics: United States, selected years 1988-1994 through 2015-2018".

```{r}
norm20 <- read.xlsx("~/DS350_SemesterProjectData/table026.xlsx", rows = 5:69)

over20 <- read.xlsx("~/DS350_SemesterProjectData/table026.xlsx", rows = 71:135)

obese20 <- read.xlsx("~/DS350_SemesterProjectData/table026.xlsx", rows = 137:201)

grade1_20 <- read.xlsx("~/DS350_SemesterProjectData/table026.xlsx", rows = 203:267)

grade2_20 <- read.xlsx("~/DS350_SemesterProjectData/table026.xlsx", rows = 269:333)

grade3_20 <- read.xlsx("~/DS350_SemesterProjectData/table026.xlsx", rows = 335:399)

under <- read.xlsx("~/DS350_SemesterProjectData/table027.xlsx", rows = 4:112)

# another way to read the data
# library(readxl)
# twonorm20 <- read_excel("~/DS350_SemesterProjectData/table026.xlsx", range = "A4:U69")
```

```{r}
colnames(norm20) <- make.names(colnames(norm20), unique = TRUE)

colnames(over20) <- make.names(colnames(over20), unique = TRUE)

colnames(obese20) <- make.names(colnames(obese20), unique = TRUE)

colnames(grade1_20) <- make.names(colnames(grade1_20), unique = TRUE)

colnames(grade2_20) <- make.names(colnames(grade2_20), unique = TRUE)

colnames(grade3_20) <- make.names(colnames(grade3_20), unique = TRUE)

colnames(under) <- make.names(colnames(under), unique = TRUE)

```

```{r}
clean_data <- function(data, bmi_age_type){
  data_tidy <- data %>% 
  mutate(age_adj = ifelse(seq_len(nrow(data)) < 26, "age adjusted", "crude"),
         X1 = ifelse(seq_len(nrow(data)) > 21 & seq_len(nrow(data)) < 26 | seq_len(nrow(data)) > 46 & seq_len(nrow(data)) < 51, str_glue("poverty level: {X1}"), X1),
         X1 = ifelse(seq_len(nrow(data)) > 51 & seq_len(nrow(data)) < 58, str_glue("Male: {X1}"), X1),
         X1 = ifelse(seq_len(nrow(data)) > 58, str_glue("Female: {X1}"), X1),
         X1 = ifelse(X1 == "Both sexes\\4", "Both sexes", X1)) %>% 
  slice(-c(1, 5, 21, 26, 30, 46, 51, 58)) %>%  
  mutate(
    x_1988.1994 =  as.numeric(ifelse(gsub("\\*", "", X1988.1994)>=0, gsub("\\*", "", X1988.1994), NA)),
    
    se_1988.1994 =  as.numeric(ifelse(gsub("\\*", "", SE)>=0, gsub("\\*", "", SE), NA)),
    
    x_1999.2002 =  as.numeric(ifelse(gsub("\\*", "", X1999.2002)>=0, gsub("\\*", "", X1999.2002), NA )),
    
    se_1999.2002 =  as.numeric(ifelse(gsub("\\*", "", SE.1) >=0, gsub("\\*", "", SE.1), NA )),
    
    x_2001.2004 =  as.numeric(ifelse(gsub("\\*", "", X2001.2004) >=0, gsub("\\*", "", X2001.2004), NA )),
    
    se_2001.2004 =  as.numeric(ifelse(gsub("\\*", "", SE.2) >=0, gsub("\\*", "", SE.2), NA )),
    
    x_2003.2006 =  as.numeric(ifelse(gsub("\\*", "", X2003.2006) >=0, gsub("\\*", "", X2003.2006), NA )),
    
    se_2003.2006 =  as.numeric(ifelse(gsub("\\*", "", SE.3) >=0, gsub("\\*", "", SE.3), NA )),
    
    x_2005.2008 =  as.numeric(ifelse(gsub("\\*", "", X2005.2008) >=0, gsub("\\*", "", X2005.2008), NA )),
    
    se_2005.2008 =  as.numeric(ifelse(gsub("\\*", "", SE.4) >=0, gsub("\\*", "", SE.4), NA )),
    
    x_2007.2010 =  as.numeric(ifelse(gsub("\\*", "", X2007.2010) >=0, gsub("\\*", "", X2007.2010), NA )),
    
    se_2007.2010 =  as.numeric(ifelse(gsub("\\*", "", SE.5) >=0, gsub("\\*", "", SE.5), NA )),
    
    x_2009.2012 =  as.numeric(ifelse(gsub("\\*", "", X2009.2012) >=0, gsub("\\*", "", X2009.2012), NA )),
    
    se_2009.2012 =  as.numeric(ifelse(gsub("\\*", "", SE.6) >=0, gsub("\\*", "", SE.6), NA )),
    
    x_2011.2014 = as.numeric(ifelse(gsub("\\*", "", X2011.2014)>=0, gsub("\\*", "", X2011.2014), NA)),
    
    se_2011.2014 = as.numeric(ifelse(gsub("\\*", "", SE.7)>=0, gsub("\\*", "", SE.7), NA)),
    
    x_2013.2016 = as.numeric(ifelse(gsub("\\*", "", X2013.2016>=0), gsub("\\*", "", X2013.2016), NA)),
    
    se_2013.2016 = as.numeric(ifelse(gsub("\\*", "", SE.8)>=0, gsub("\\*", "", SE.8), NA)),
    
    x_2015.2018 = as.numeric(ifelse(gsub("\\*", "", X2015.2018)>=0, gsub("\\*", "", X2015.2018), NA)),
    
    se_2015.2018 = as.numeric(ifelse(gsub("\\*", "", SE.9)>=0, gsub("\\*", "", SE.9), NA))
    ) %>% 
  select(X1, age_adj, starts_with("x_"), starts_with("se_")) %>% 
  rename(category = "X1") %>% 
  pivot_longer(
    cols = starts_with("x") | starts_with("se"),
    names_to = c("type", "year"),
    names_sep = "_",
    values_to = "value"
  ) %>% 
  pivot_wider(names_from = "type",
              values_from = "value") %>% 
  mutate(bmi_age = bmi_age_type) %>% 
    select(category, bmi_age, year, x, se, age_adj) 
  
  return(data_tidy)
}

clean_data_2 <- function(data){
  data_tidy <- data %>% 
      rename(category = "Sex..age..race.and.Hispanic.origin.1..and.percent.of.poverty.level") %>% 
  mutate(age_adj =  "under 20", 
         bmi_age = ifelse(seq_len(nrow(data)) > 1 & seq_len(nrow(data)) < 28, "2-19 years", NA),
         bmi_age = ifelse(seq_len(nrow(data)) > 28 & seq_len(nrow(data)) < 55, "2-5 years", bmi_age),
         bmi_age = ifelse(seq_len(nrow(data)) > 55 & seq_len(nrow(data)) < 82, "6-11 years", bmi_age),
         bmi_age = ifelse(seq_len(nrow(data)) > 82, "12-19 years", bmi_age),
         
         category = ifelse(seq_len(nrow(data)) > 23 & seq_len(nrow(data)) < 28 | seq_len(nrow(data)) > 50 & seq_len(nrow(data)) < 55 | seq_len(nrow(data)) > 77 & seq_len(nrow(data)) < 82 | seq_len(nrow(data)) > 104, str_glue("poverty level: {category}"), category),
         # category = ifelse(seq_len(nrow(data)) > 2 & seq_len(nrow(data)) < 9 | seq_len(nrow(data)) > 29 & seq_len(nrow(data)) < 36 | seq_len(nrow(data)) > 56 & seq_len(nrow(data)) < 63 | seq_len(nrow(data)) > 83 & seq_len(nrow(data)) < 90, str_glue("Both sexes: {category}"), category),
         category = ifelse(seq_len(nrow(data)) > 9 & seq_len(nrow(data)) < 16 | seq_len(nrow(data)) > 36 & seq_len(nrow(data)) < 43 | seq_len(nrow(data)) > 63 & seq_len(nrow(data)) < 70 | seq_len(nrow(data)) > 90 & seq_len(nrow(data)) < 97, str_glue("{category}, male"), category),
         category = ifelse(seq_len(nrow(data)) > 16 & seq_len(nrow(data)) < 23 | seq_len(nrow(data)) > 43 & seq_len(nrow(data)) < 50 | seq_len(nrow(data)) > 70 & seq_len(nrow(data)) < 77 | seq_len(nrow(data)) > 97 & seq_len(nrow(data)) < 104, str_glue("{category}, female"), category),
         category = ifelse(category == "Boys", "Male", category),
         category = ifelse(category == "Both sexes\\2", "Both sexes", category),
         category = ifelse(category == "Girls", "Female", category)
         ) %>% 
  slice(-c(1, 3, 10, 17, 23, 28, 30, 37, 44, 50, 55, 57, 64, 71, 77, 82, 84, 91, 98, 104)) %>% 
  select(category, bmi_age, everything()) %>%  
  mutate(
    x_1988.1994 =  as.numeric(ifelse(gsub("\\*", "", X1988.1994)>=0, gsub("\\*", "", X1988.1994), NA)),
    
    se_1988.1994 =  as.numeric(ifelse(gsub("\\*", "", SE)>=0, gsub("\\*", "", SE), NA)),
    
    x_1999.2002 =  as.numeric(ifelse(gsub("\\*", "", X1999.2002)>=0, gsub("\\*", "", X1999.2002), NA )),
    
    se_1999.2002 =  as.numeric(ifelse(gsub("\\*", "", SE.1) >=0, gsub("\\*", "", SE.1), NA )),
    
    x_2001.2004 =  as.numeric(ifelse(gsub("\\*", "", X2001.2004) >=0, gsub("\\*", "", X2001.2004), NA )),
    
    se_2001.2004 =  as.numeric(ifelse(gsub("\\*", "", SE.2) >=0, gsub("\\*", "", SE.2), NA )),
    
    x_2003.2006 =  as.numeric(ifelse(gsub("\\*", "", X2003.2006) >=0, gsub("\\*", "", X2003.2006), NA )),
    
    se_2003.2006 =  as.numeric(ifelse(gsub("\\*", "", SE.3) >=0, gsub("\\*", "", SE.3), NA )),
    
    x_2005.2008 =  as.numeric(ifelse(gsub("\\*", "", X2005.2008) >=0, gsub("\\*", "", X2005.2008), NA )),
    
    se_2005.2008 =  as.numeric(ifelse(gsub("\\*", "", SE.4) >=0, gsub("\\*", "", SE.4), NA )),
    
    x_2007.2010 =  as.numeric(ifelse(gsub("\\*", "", X2007.2010) >=0, gsub("\\*", "", X2007.2010), NA )),
    
    se_2007.2010 =  as.numeric(ifelse(gsub("\\*", "", SE.5) >=0, gsub("\\*", "", SE.5), NA )),
    
    x_2009.2012 =  as.numeric(ifelse(gsub("\\*", "", X2009.2012) >=0, gsub("\\*", "", X2009.2012), NA )),
    
    se_2009.2012 =  as.numeric(ifelse(gsub("\\*", "", SE.6) >=0, gsub("\\*", "", SE.6), NA )),
    
    x_2011.2014 = as.numeric(ifelse(gsub("\\*", "", X2011.2014)>=0, gsub("\\*", "", X2011.2014), NA)),
    
    se_2011.2014 = as.numeric(ifelse(gsub("\\*", "", SE.7)>=0, gsub("\\*", "", SE.7), NA)),
    
    x_2013.2016 = as.numeric(ifelse(gsub("\\*", "", X2013.2016>=0), gsub("\\*", "", X2013.2016), NA)),
    
    se_2013.2016 = as.numeric(ifelse(gsub("\\*", "", SE.8)>=0, gsub("\\*", "", SE.8), NA)),
    
    x_2015.2018 = as.numeric(ifelse(gsub("\\*", "", X2015.2018)>=0, gsub("\\*", "", X2015.2018), NA)),
    
    se_2015.2018 = as.numeric(ifelse(gsub("\\*", "", SE.9)>=0, gsub("\\*", "", SE.9), NA))
    ) %>% 
  select(category, age_adj, starts_with("x_"), starts_with("se_"), bmi_age) %>% 
  pivot_longer(
    cols = starts_with("x") | starts_with("se"),
    names_to = c("type", "year"),
    names_sep = "_",
    values_to = "value"
  ) %>% 
  pivot_wider(names_from = "type",
              values_from = "value") %>% 
    select(category, bmi_age, year, x, se, age_adj)
  
  return(data_tidy)
}
```

```{r}
norm <- clean_data(norm20, "normal")

over <- clean_data(over20, "overweight")

obese <- clean_data(obese20, "obesity")

grade1 <- clean_data(grade1_20, "grade 1")

grade2 <- clean_data(grade2_20, "grade 2")

grade3 <- clean_data(grade3_20, "grade 3")

under20 <- clean_data_2(under)

clean <- bind_rows(under20, norm, over, obese, grade1, grade2, grade3) %>%
  mutate(year = str_replace_all(year, "\\.", "-")) %>% 
  rename(pct_pop = "x")
```

# Introduction

Weight issues have been a consistent issue throughout my life, both for me personally and for my family. All my life I have heard constant reports about how obesity rates are rising in the United States. During the pandemic I kept hearing about how weight was related to higher rates of infection. And most recently, there has been all kinds of news about new drugs to help with weight loss, such as Ozempic. As a statistician, I now have the skill and ability to look at the data for myself to help me better understand what is going on in the US in relation to obesity.

# Overall Obesity Rates

To start, I wanted to just look over the overall rates of obesity in the United States. Below is a graph that compares different percentages of the population over time. The "overweight" group represents all adults with a BMI that is greater than or equal to 25 and the "obesity" group represents all adults with a BMI that is greater than or equal to 30. The "obesity" group is broken down into smaller subgroups in groups "grade 1", "grade 2", and "grade 3", with "grade 3" being the highest BMI values. The data did not include any adults with a BMI that was lower than 18.5. The "2-19 years" includes the 2-19 year olds whose BMI is in the 95th percentile according to age and sex.

```{r}
ages <- clean %>% 
  filter(category=="Both sexes") %>% 
  filter(age_adj != "crude") %>% 
  filter(!bmi_age %in% c("2-5 years", "6-11 years", "12-19 years"))

last_points <- ages %>%
  group_by(bmi_age) %>%
  filter(year == max(year))
  

ggplot(ages, aes(y=pct_pop, x=year, group = bmi_age, color=fct_relevel(bmi_age, "2-19 years", "normal", "overweight", "obesity", "grade 1", "grade 2", "grade 3"))) +
  geom_line() +
  geom_point() +
  labs(title = "Percentage of Overweight Population over Time", x="Time Period", y="Percentage of Population", color="BMI group") +
  ggrepel::geom_label_repel(data=last_points, aes(label = fct_relevel(bmi_age, "2-19 years", "normal", "overweight", "obesity", "grade 1", "grade 2", "grade 3"), fill=fct_relevel(bmi_age, "2-19 years", "normal", "overweight", "obesity", "grade 1", "grade 2", "grade 3")), color="white", fontface="bold", box.padding = unit(0.5, "points"), nudge_x = 1, nudge_y = 0.75) +
  theme(axis.text.x = element_text(angle=25),
        panel.background = element_rect(fill="white"),
        panel.grid = element_line(color = "gray", linetype = "dotted"),
        legend.position = "none")
```

Obesity has risen over time while the "normal" group has been decreased over time. The difference between the "overweight" group and "normal" group is also quite large. I'm glad to see that the "2-19 years" group is lower than quite a few of the other groups.

```{r}
weight <- clean %>% 
  filter(category=="Both sexes") %>% 
  filter(age_adj != "crude") %>% 
  filter(!bmi_age %in% c("2-5 years", "6-11 years", "12-19 years", "overweight", "obesity"))

last_points <- weight %>%
  group_by(bmi_age) %>%
  filter(year == max(year))
  

ggplot(weight, aes(y=pct_pop, x=year, group = bmi_age, color=fct_relevel(bmi_age, "2-19 years", "normal", "grade 1", "grade 2", "grade 3"))) +
  geom_line() +
  geom_point() +
  labs(title = "Percentage of Overweight Population over Time", x="Time Period", y="Percentage of Population", color="BMI group") +
  ggrepel::geom_label_repel(data=last_points, aes(label = fct_relevel(bmi_age, "2-19 years", "normal", "grade 1", "grade 2", "grade 3"), fill=fct_relevel(bmi_age, "2-19 years", "normal", "grade 1", "grade 2", "grade 3")), color="white", fontface="bold", box.padding = unit(0.5, "points"), nudge_x = 1, nudge_y = 0.75) +
  theme(axis.text.x = element_text(angle=25),
        panel.background = element_rect(fill="white"),
        panel.grid = element_line(color = "gray", linetype = "dotted"),
        legend.position = "none")
```
To better see what is happening in each group, I have removed the overall groups "overweight" and "obesity". We can see that the only group that has been decreasing in the last few years is the "normal" group, confirming that overall weights are rising in the United States.

# Obesity by Gender

Does gender affect obesity rates?

```{r}
weight_fem <- clean %>% 
  filter(category%in% c("Female","Male")) %>% 
  filter(age_adj != "crude") %>% 
  filter(!bmi_age %in% c("2-5 years", "6-11 years", "12-19 years", "overweight", "obesity"))

last_points_fem <- weight_fem %>%
  group_by(bmi_age) %>%
  filter(year == max(year))
  

ggplot(weight_fem, aes(y=pct_pop, x=year, group = bmi_age, color=fct_relevel(bmi_age, "2-19 years", "normal", "grade 1", "grade 2", "grade 3"))) +
  geom_line() +
  geom_point() +
  labs(title = "Percentage of Overweight Population over Time", subtitle = "Male vs Female", x="Time Period", y="Percentage of Population", color="BMI group") +
  ggrepel::geom_label_repel(data=last_points_fem, aes(label = fct_relevel(bmi_age, "2-19 years", "normal", "grade 1", "grade 2", "grade 3"), fill=fct_relevel(bmi_age, "2-19 years", "normal", "grade 1", "grade 2", "grade 3")), color="white", fontface="bold", box.padding = unit(0.5, "points"), nudge_x = 1, nudge_y = 0.75) +
  theme(axis.text.x = element_text(angle=35),
        panel.background = element_rect(fill="white"),
        panel.grid = element_line(color = "gray", linetype = "dotted"),
        legend.position = "none") +
  facet_wrap(~category)
```

It appears that is does! Though we still see an overall trend of the "normal" group decreasing and the other groups increasing in both graphs, the women tend to have a higher population of people at a "normal" weight than men do. I find this a little surprising, because I tend to see more fat-shaming on the internet directed at women compared to men, but perhaps that has more to do with what the algorithm shows me as a women and what I am more likely to pay attention to.

# Obesity and Poverty

How does poverty effect obesity? We have four levels in poverty. Those with the lowest income fall in the "Below 100%" group and those with the highest income fall within the "400% or more". 

```{r}
poverty <- clean %>% 
  filter(str_detect(category, "poverty")) %>%
  filter(age_adj != "crude") %>% 
  filter(!bmi_age %in% c("2-5 years", "6-11 years", "12-19 years", "overweight", "obesity"))

last_points <- poverty %>%
  group_by(bmi_age) %>%
  filter(year == max(year))
  

ggplot(poverty, aes(y=pct_pop, x=year, group = bmi_age, color=fct_relevel(bmi_age, "2-19 years", "normal", "grade 1", "grade 2", "grade 3"))) +
  geom_line() +
  geom_point() +
  labs(title = "Percentage of Overweight Population over Time", subtitle = "Poverty Level", x="Time Period", y="Percentage of Population", color="BMI group") +
  theme(axis.text.x = element_text(angle=50, hjust = 1),
        panel.background = element_rect(fill="white"),
        panel.grid = element_line(color = "gray", linetype = "dotted")) +
  facet_wrap(~fct_relevel(category, "poverty level: Below 100%", "poverty level: 100%–199%", "poverty level: 200%–399%", "poverty level: 400% or more"))
```

Within each poverty level, we see similar trends to what we have seen in the other graphs, but something interesting pops out when we look within each BMI group...

```{r}
poverty <- clean %>% 
  filter(str_detect(category, "poverty")) %>%
  filter(age_adj != "crude") %>% 
  filter(!bmi_age %in% c("2-5 years", "6-11 years", "12-19 years", "overweight", "obesity"))

last_points <- poverty %>%
  group_by(bmi_age) %>%
  filter(year == max(year))
  

ggplot(poverty, aes(y=pct_pop, x=year, group = category, color=fct_relevel(category, "poverty level: Below 100%", "poverty level: 100%–199%", "poverty level: 200%–399%", "poverty level: 400% or more"))) +
  geom_line() +
  geom_point() +
  labs(title = "Percentage of Overweight Population over Time", subtitle = "Poverty Level", x="Time Period", y="Percentage of Population", color="Poverty Level") +
  theme(axis.text.x = element_text(angle=50, hjust = 1),
        panel.background = element_rect(fill="white"),
        panel.grid = element_line(color = "gray", linetype = "dotted")) +
  facet_wrap(~fct_relevel(bmi_age, "2-19 years", "normal", "grade 1", "grade 2", "grade 3"))
```

Notice how within each group except the "normal" group, the purple line representing "400% or more" is at the bottom and in the "normal" group it is at the top. This indicates that those with the highest incomes tend to struggle with being overweight the most. What could cause this? I have heard some theorize that it could be related to healthier foods tending to be more expensive and having the income to sometimes hire someone else prepare food for you and your family. Being able to access healthier foods more easily could explain the noticeable difference in poverty level.

# Obesity and Ethnicity

Ethnicity is harder to analyze as the categories that have been included and used in surveys have changed with time.

```{r}
race <- clean %>% 
  filter(!str_detect(str_to_lower(category), "female")) %>%
  filter(!str_detect(str_to_lower(category), "male")) %>%
  filter(!str_detect(str_to_lower(category), "poverty")) %>%
  filter(age_adj != "crude") %>% 
  filter(!bmi_age %in% c("2-5 years", "6-11 years", "12-19 years", "overweight", "obesity")) %>% 
  drop_na()

last_points <- race %>%
  group_by(bmi_age) %>%
  filter(year == max(year))
  

ggplot(race, aes(y=pct_pop, x=year, group = bmi_age, color=fct_relevel(bmi_age, "2-19 years", "normal", "grade 1", "grade 2", "grade 3"))) +
  geom_line() +
  geom_point() +
  labs(title = "Percentage of Overweight Population over Time", subtitle = "Ethnicity", x="Time Period", y="Percentage of Population", color="BMI group") +
  theme(axis.text.x = element_text(angle=50, hjust = 1),
        panel.background = element_rect(fill="white"),
        panel.grid = element_line(color = "gray", linetype = "dotted")) +
  facet_wrap(~fct_relevel(category, "Both sexes"))
```

```{r}
race <- clean %>% 
  filter(!str_detect(str_to_lower(category), "female")) %>%
  filter(!str_detect(str_to_lower(category), "male")) %>%
  filter(!str_detect(str_to_lower(category), "poverty")) %>%
  filter(age_adj != "crude") %>% 
  filter(!bmi_age %in% c("2-5 years", "6-11 years", "12-19 years", "overweight", "obesity")) %>% 
  drop_na()

last_points <- race %>%
  group_by(bmi_age) %>%
  filter(year == max(year))
  

ggplot(race, aes(y=pct_pop, x=year, group = category, color=fct_relevel(category, "Both sexes"))) +
  geom_line() +
  geom_point() +
  labs(title = "Percentage of Overweight Population over Time", subtitle = "Ethnicity", x="Time Period", y="Percentage of Population", color="Ethnicity") +
  theme(axis.text.x = element_text(angle=50, hjust = 1),
        panel.background = element_rect(fill="white"),
        panel.grid = element_line(color = "gray", linetype = "dotted")) +
  facet_wrap(~fct_relevel(bmi_age, "2-19 years", "normal", "grade 1", "grade 2", "grade 3"))
```

Both tell a similar story, where those that are White only or Asian only generally have lower weights compared to those who are Black or African American only, Hispanic or Latino, or of Mexican origin. One thing to consider here though is that our current BMI system is based on data collected on white males. Many times weight issues are connected to someone's genetics, so it is possible that what we are observing is a combination of lifestyle and genetics. 

# Obesity in Teens and Kids

Lastly, I wanted to look into the individual age groups of those under 20.

```{r}
kids <- clean %>% 
  filter(age_adj == "under 20") %>% 
  filter(bmi_age!="2-19 years") %>% 
  filter(category == "Both sexes") 

last_points <- kids %>%
  group_by(bmi_age) %>%
  filter(year == max(year))

ggplot(kids, aes(x= year, y=pct_pop, group=fct_relevel(bmi_age, "2-5 years", "6-11 years", "12-19 years"), color=fct_relevel(bmi_age, "2-5 years", "6-11 years", "12-19 years"))) +
  geom_line() +
  geom_point() +
  labs(title = "Percentage of Children and Teens in the 95th precentile over Time", x="Time Period", y="Percentage of Population", color="Age group") +
  ggrepel::geom_label_repel(data=last_points, aes(label = fct_relevel(bmi_age, "2-5 years", "6-11 years", "12-19 years"), fill=fct_relevel(bmi_age, "2-5 years", "6-11 years", "12-19 years")), color="white", fontface="bold", box.padding = unit(0.5, "points"), nudge_x = 1, nudge_y = 0.75) +
  theme(axis.text.x = element_text(angle=25),
        panel.background = element_rect(fill="white"),
        panel.grid = element_line(color = "gray", linetype = "dotted"),
        legend.position = "none")
```

We can see that as these kids and teens get older, they tend to have more issues with weight. This does raise some questions on how much this is caused by normal growing and how much of this should be a cause for concern. There is also the fact that as kids get older, they tend to have more freedom in what they choose to eat and are more likely to choose foods that taste good versus are nutritious. 

# Conclusion

Overall, it does seem to be a true statement that obesity rates are rising in the United States. But there are some definite correlations between weight issues and privilege. This privileges include better access to healthier food, healthcare, perhaps better education and potentially less overall stress. If we hope to slow down and change the direction these rates are going, we need to focus on ways to make these privileges better available to more of the general public.