Final Project: Undergraduate Student Diversity

For my final project, I chose to explore the diversity composition of the undergradute student population in the United States. Below are the different elements of the project broken out on each tab.

Final Project Components

Synopsis

For this analysis, I am investigating the demographic information of the undergraduate student population in the United States as defined by the Department of Education. From this data, I am trying to understand if the population is becoming more diverse, more homogeneous, or a mixture of the two. I will begin by looking for trends at a high level (national and state level) before delving into specific data for the University of Cincinnati.

The results of this analysis were quite interesting. Over the last 10 years, the diversity of the undergraduate student population within the United States has changed dramatically. In 2004, only 37.8% of students were classified as minorities. However, by 2013, that figure had increased to 46.8%, representing a nearly 24% relative increase. Interestingly, no single state or collection of states appear to be driving this change; alternatively, the change has been driven through systematic increases throughout the entire country.

Perhaps the most interesting portion of the analysis was the data specific to the University of Cincinnati. Although the national trend has been towards a more diverse student population, UC’s mix has remained relatively unchanged with only about 23% of its students being classified as minorities. This mix has remained the same despite Ohio seeing an overall increase in minority students. Within UC’s population, the biggest change has been the African American population with its relative mix within the student population dropping from 14% in 2004 to less than 8% in 2013.

These findings were quite interesting, and actually, they were quite different than I expected, especially regarding UC. Completing this project gave me a better understanding of how to work with data in R, and it also gave me a better understanding of the changing demographics within the college student population.

Packages Required

For this project, the majority of packages used are the standard ones for collecting, tidying, and analyzing data. The one unique package used is the “RScorecard” package. This package enables the user to directly interact with the College Scorecard API (data source). This API is quite messy, so this package handles the API interaction on behalf of the user.

Most users would need to install this package prior to working with the College Scorecard data.

## Load Required Packages ##
library(rscorecard) ## Accessing the College Scorecard API
library(dplyr) ## Manipulating data
library(tidyverse) ## Tidying data
library(ggplot2) ## Visualizing data
library(ggrepel) ## Labelling data
library(DT) ## Output data in nice format
library(magrittr) ## Pipe operators

Data Preparation

For this project, I used open-source data from the Department of Education titled the “College Scorecard”. This data set was initiated nearly 20 years ago and tracks a myriad of different statistics on every accredited college within the United States. It reports data on such metrics as graduation rate, average cost, student demographic information, etc. The full data and documentation can be found here.

To begin the data extraction and preparation, I began by setting the API key, creating a function to extract the data I need based on a given year, and a for loop to extract 10 years worth of the data. The one major limitation of the RScorecard Package is that it can only extract 1 year of data at a time.

## Initiate key for API usage ##
sc_key("JV4KLNjlODA8KU5ZDCNWDOCq6kLMuUcklZZO045s")

## Create function to be used for extracting demographical data ##
scorecard_data <- function(year) {
  sc_init() %>%
    sc_filter(main == 1) %>%
    sc_select(instnm, city, stabbr, zip,longitude, latitude,
              ugds, ugds_white, ugds_black, ugds_hisp, ugds_asian, ugds_aian,
              ugds_nhpi, ugds_2mor, ugds_nra, ugds_unkn, ugds_whitenh, ugds_blacknh,
              ugds_api, UGDS_AIANOld, UGDS_HISPOld) %>%
    sc_year(year) %>%
    sc_get()
}


## Download last 10 years of raw data ##
years <- c(2004:2013)

raw_data <- vector("list", length(years))
for (i in seq_along(years)) {
  raw_data[[i]] <- scorecard_data(years[i])
}

raw_data <- bind_rows(raw_data)

I also created a dataframe of geographic references to be used in mapping visualizations later on. The main purpose of this dataframe was to match state abbreviations with state names as well as geographic positionings.

## Create dataframe for state geographic locations. To be used for geographic plotting ##
geo_ref <- data.frame(stabbr = state.abb,
                      stabbr_long = state.center$y,
                      stabbr_lat = state.center$x,
                      region= tolower(state.name))

Next, I began the cleaning process for the data. In 2008, the names of some of the demographical classifications changed. However, it is inconsistent over the years if the data was placed in the old or new classification. Thus, I will replace all NA’s with 0’s and then manually combine the old and new classifications together. The resulting dataframe is tidy with 10 different classifications for the demographic of a given student: White, Black, Hispanic, Asian, American Indian and Alaska Native, Native Hawaiian and Pacific Islander, Two or More Demographics, Non-Resident Aliens, and Unknown. The values for these variables will be their respective proportions of the undergraduate studeny body.

## Replace NA's with 0. Inconsistency in data classification requires this approach rather than removing NA's ##
raw_data[is.na(raw_data)] <- 0

## Clean data to consolidate demographical data categories ##
clean_data <- raw_data %>% 
  mutate(ugds_white_new = ugds_white + ugds_whitenh,
         ugds_black_new = ugds_black + ugds_blacknh,
         ugds_hisp_new = ugds_hisp + ugds_hispold,
         ugds_asian_new = ugds_asian + ugds_api,
         ugds_aian_new = ugds_aian + ugds_aianold) %>% 
  select(-ugds_white, -ugds_whitenh, -ugds_black, -ugds_blacknh,
         -ugds_hisp, -ugds_hispold, -ugds_asian, -ugds_api,
         -ugds_aian, -ugds_aianold)

The below tibble depicts the final tidy dataset.

datatable(clean_data, caption = "Table 1: Tidy Data Set")

Exploratory Data Analysis

To begin my analysis, I simply wanted to plot the proportion of minority and non-minority students for each of the ten years. Throughout this analysis, any non-white student was grouped into the minority category. The below plot depicts the outcome of this analysis. As one can see, the difference between minority and non-minority students has decreased dramatically over the past 10 years, and one could surmise that they would actually switch positions in the next couple of years.

## Plot Total Nonminority and minority proportions for last ten years ##
clean_data %>%
  mutate(ugds_minority = ugds_black_new + ugds_hisp_new
                        + ugds_asian_new + ugds_aian_new
                        + ugds_nhpi + ugds_2mor 
                        + ugds_nra + ugds_unkn) %>%
  mutate(ugds_minority_total = ugds_minority*ugds,
         ugds_white_total = ugds_white_new*ugds) %>% 
  select(-instnm, -city, -zip, -longitude, -latitude,
         -ugds_black_new, -ugds_hisp_new, -ugds_asian_new, -ugds_aian_new,
         -ugds_nhpi, -ugds_2mor, -ugds_nra, -ugds_unkn, -ugds_white_new,
         -stabbr, -ugds_minority) %>% 
  group_by(year) %>%
  summarize(total_minority = sum(ugds_minority_total),
            total_nonminority = sum(ugds_white_total),
            total_ugds = total_minority + total_nonminority,
            minority_prop = total_minority / total_ugds,
            nonminority_prop = total_nonminority / total_ugds) %>% 
  ggplot(aes(x = year)) + 
  geom_line(aes(y = minority_prop, group = 1), color = "blue") +
  geom_line(aes(y = nonminority_prop, group =1), color = "red") +
  geom_ribbon(aes(ymin = minority_prop, ymax = nonminority_prop, group = 1), 
              fill = "red2", alpha = .1) +
  annotate("text", x = 2003, y = 0.62, label = "Nonminority: 62.2%", 
           color = "red", hjust = 1, size = 3) +
  annotate("text", x = 2003, y = 0.38, label = "Minority: 37.8%", 
           color = "blue", hjust = 1, size = 3) +
  annotate("text", x = 2003, y = 0.5, label = "Delta: 24.4%", 
           color = "red2", hjust = 1, size = 3) +
  annotate("text", x = 2014, y = 0.54, label = "Nonminority: 53.2%", 
           color = "red", hjust = 0, size = 3) +
  annotate("text", x = 2014, y = 0.46, label = "Minority: 46.8%", 
           color = "blue", hjust = 0, size = 3) +
  annotate("text", x = 2014, y = 0.5, label = "Delta: 6.4%", 
           color = "red2", hjust = 0, size = 3) +
  scale_x_continuous("Year", limits = c(2001, 2016), breaks = seq(2004, 2013, by = 4)) +
  scale_y_continuous("Proportion of Undergraduate Students", labels = scales::percent) +
  ggtitle("Figure 1: Change in Minority and NonMinority Undergraduate Enrollment")

Next, I tried to identify geographic sources of this change with the theory that border states would more than likely have seen a larger increase than interior states. The plot below depicts the percentage of minority students for each state for each of the past ten years. As one can see, it appears that the Southwestern states and states along the East Coast have seen the greatest change over the past ten years, which would somewhat support the theory. However, I will next plot the percentage of minority students in each state over the course of the ten years to determine if there have been any singular states that have seen dramatic change in its student demographics.

## Plot Nonminority proportion of undergraduate students by state for each year ##
clean_data %>%
  mutate(ugds_minority = ugds_black_new + ugds_hisp_new
         + ugds_asian_new + ugds_aian_new
         + ugds_nhpi + ugds_2mor 
         + ugds_nra + ugds_unkn) %>%
  mutate(ugds_minority_total = ugds_minority*ugds,
         ugds_white_total = ugds_white_new*ugds) %>% 
  select(-instnm, -city, -zip, -longitude, -latitude,
         -ugds_black_new, -ugds_hisp_new, -ugds_asian_new, -ugds_aian_new,
         -ugds_nhpi, -ugds_2mor, -ugds_nra, -ugds_unkn, -ugds_white_new,
         -ugds_minority) %>% 
  group_by(stabbr, year) %>%
  summarize(total_minority = sum(ugds_minority_total),
            total_nonminority = sum(ugds_white_total),
            total_ugds = total_minority + total_nonminority,
            minority_prop = total_minority / total_ugds,
            nonminority_prop = total_nonminority / total_ugds) %>% 
  left_join(geo_ref, by = "stabbr") %>%
  left_join(map_data("state")) %>%
  select(-subregion) %>% 
  na.omit() %>% 
  ggplot(aes(x = long, y = lat, group = group)) + 
  geom_polygon(aes(fill = minority_prop)) +
  facet_wrap(~ year, ncol = 2) +
  scale_fill_gradient(name = "Minority %",
                      labels = scales::percent) +
  ggtitle("Figure 2: Minority Population Changes Over Time") +
  expand_limits() +
  theme_void() +
  theme(strip.text.x = element_text(size = 10),
        text = element_text(family = "Times New Roman"),
        plot.title = element_text(size = 14, margin = margin(b = 10)))

The below chart depicts the percentage of minority for each state over the course of the ten years from 2004 to 2013. I’ve highlighted the top five (Hawaii, California, New Mexico, Texas, and Washington D.C., respectively) and bottom five states (North Dakota, Vermont, South Dakota, Maine, and Wyoming, respectively) for diversity level for 2013. As one can see, there has been relatively little shake up among the top five and bottom five, and no particular state appears to have undergone dramatic change. Rather, the overall increase in diversity highlighted in previous charts is attributable to steady diversity increases across virtually every state in the continental United States.

## Top 5 in 2013 (for line graph) ##
mostdiverse <- clean_data %>%
  mutate(ugds_minority = ugds_black_new + ugds_hisp_new
         + ugds_asian_new + ugds_aian_new
         + ugds_nhpi + ugds_2mor 
         + ugds_nra + ugds_unkn) %>%
  mutate(ugds_minority_total = ugds_minority*ugds,
         ugds_white_total = ugds_white_new*ugds) %>% 
  select(-instnm, -city, -zip, -longitude, -latitude,
         -ugds_black_new, -ugds_hisp_new, -ugds_asian_new, -ugds_aian_new,
         -ugds_nhpi, -ugds_2mor, -ugds_nra, -ugds_unkn, -ugds_white_new,
         -ugds_minority) %>% 
  group_by(stabbr, year) %>%
  summarize(total_minority = sum(ugds_minority_total),
            total_nonminority = sum(ugds_white_total),
            total_ugds = total_minority + total_nonminority,
            minority_prop = total_minority / total_ugds,
            nonminority_prop = total_nonminority / total_ugds) %>%
  arrange(desc(minority_prop)) %>% 
  filter(year == 2013, stabbr != "AS" & stabbr != "FM" & stabbr != "GU"
         & stabbr != "MH" & stabbr != "MP" & stabbr != "PW" & stabbr != "PR"
         & stabbr != "VI") %>% 
  head(5)

## Bottom 5 in 2013 (for line graph) ##
leastdiverse <- clean_data %>%
  mutate(ugds_minority = ugds_black_new + ugds_hisp_new
         + ugds_asian_new + ugds_aian_new
         + ugds_nhpi + ugds_2mor 
         + ugds_nra + ugds_unkn) %>%
  mutate(ugds_minority_total = ugds_minority*ugds,
         ugds_white_total = ugds_white_new*ugds) %>% 
  select(-instnm, -city, -zip, -longitude, -latitude,
         -ugds_black_new, -ugds_hisp_new, -ugds_asian_new, -ugds_aian_new,
         -ugds_nhpi, -ugds_2mor, -ugds_nra, -ugds_unkn, -ugds_white_new,
         -ugds_minority) %>% 
  group_by(stabbr, year) %>%
  summarize(total_minority = sum(ugds_minority_total),
            total_nonminority = sum(ugds_white_total),
            total_ugds = total_minority + total_nonminority,
            minority_prop = total_minority / total_ugds,
            nonminority_prop = total_nonminority / total_ugds) %>%
  arrange(desc(minority_prop)) %>% 
  filter(year == 2013, stabbr != "AS" & stabbr != "FM" & stabbr != "GU"
         & stabbr != "MH" & stabbr != "MP" & stabbr != "PW" & stabbr != "PR"
         & stabbr != "VI") %>% 
  tail(5)

## Line Graph Data ##
linegraph <- clean_data %>%
  mutate(ugds_minority = ugds_black_new + ugds_hisp_new
         + ugds_asian_new + ugds_aian_new
         + ugds_nhpi + ugds_2mor 
         + ugds_nra + ugds_unkn) %>%
  mutate(ugds_minority_total = ugds_minority*ugds,
         ugds_white_total = ugds_white_new*ugds) %>% 
  select(-instnm, -city, -zip, -longitude, -latitude,
         -ugds_black_new, -ugds_hisp_new, -ugds_asian_new, -ugds_aian_new,
         -ugds_nhpi, -ugds_2mor, -ugds_nra, -ugds_unkn, -ugds_white_new,
         -ugds_minority) %>% 
  group_by(stabbr, year) %>%
  summarize(total_minority = sum(ugds_minority_total),
            total_nonminority = sum(ugds_white_total),
            total_ugds = total_minority + total_nonminority,
            minority_prop = total_minority / total_ugds,
            nonminority_prop = total_nonminority / total_ugds) %>% 
  filter(stabbr != "AS" & stabbr != "FM" & stabbr != "GU"
         & stabbr != "MH" & stabbr != "MP" & stabbr != "PW" & stabbr != "PR"
         & stabbr != "VI")

## Line Graph ##
ggplot(data = linegraph, aes(year, minority_prop, group = stabbr)) +
  geom_line(color = "blue", alpha = .1) +
  geom_line(data = filter(linegraph, stabbr %in% mostdiverse$stabbr), 
            aes(year, minority_prop, group = stabbr), color = "green") +
  geom_line(data = filter(linegraph, stabbr %in% leastdiverse$stabbr), 
            aes(year, minority_prop, group = stabbr), color = "red") +
  scale_x_continuous(NULL, limits = c(2004, 2013), breaks = seq(2004, 2013, by = 2)) +
  scale_y_continuous(NULL, labels = scales::percent) +
  ggtitle("Figure 3: Minority Proportion of Students Over Time by State")

Now that I had a sense for the overall trend of the United States undergraduate student population, I began dialing in on Ohio and the University of Cincinnati. First, I plotted the percentage of minority students for Ohio for the past ten years. As one can see, Ohio follows the national trend for increasing diversity. However, in 2013, it is still well behind the national average of 46.8%.

## Ribbon Chart for Ohio ##
clean_data %>%
  mutate(ugds_minority = ugds_black_new + ugds_hisp_new
         + ugds_asian_new + ugds_aian_new
         + ugds_nhpi + ugds_2mor 
         + ugds_nra + ugds_unkn) %>%
  mutate(ugds_minority_total = ugds_minority*ugds,
         ugds_white_total = ugds_white_new*ugds) %>% 
  select(-city, -zip, -longitude, -latitude,
         -ugds_black_new, -ugds_hisp_new, -ugds_asian_new, -ugds_aian_new,
         -ugds_nhpi, -ugds_2mor, -ugds_nra, -ugds_unkn, -ugds_white_new, 
         -ugds_minority) %>%
  filter(stabbr == "OH") %>% 
  group_by(year) %>%
  summarize(total_minority = sum(ugds_minority_total),
            total_nonminority = sum(ugds_white_total),
            total_ugds = total_minority + total_nonminority,
            minority_prop = total_minority / total_ugds,
            nonminority_prop = total_nonminority / total_ugds) %>% 
  ggplot(aes(x = year)) + 
  geom_line(aes(y = minority_prop, group = 1), color = "blue") +
  geom_line(aes(y = nonminority_prop, group =1), color = "red") +
  geom_ribbon(aes(ymin = minority_prop, ymax = nonminority_prop, group = 1), 
              fill = "red2", alpha = .1) +
  annotate("text", x = 2003, y = 0.79, label = "Nonminority: 79.0%", 
           color = "red", hjust = 1, size = 3) +
  annotate("text", x = 2003, y = 0.21, label = "Minority: 21.0%", 
           color = "blue", hjust = 1, size = 3) +
  annotate("text", x = 2003, y = 0.58, label = "Delta: 58%", 
           color = "red2", hjust = 1, size = 3) +
  annotate("text", x = 2014, y = 0.72, label = "Nonminority: 72.3%", 
           color = "red", hjust = 0, size = 3) +
  annotate("text", x = 2014, y = 0.28, label = "Minority: 27.7%", 
           color = "blue", hjust = 0, size = 3) +
  annotate("text", x = 2014, y = 0.46, label = "Delta: 45.5%", 
           color = "red2", hjust = 0, size = 3) +
  scale_x_continuous("Year", limits = c(2001, 2016), breaks = seq(2004, 2013, by = 4)) +
  scale_y_continuous("Proportion of Undergraduate Students", labels = scales::percent) +
  ggtitle("Figure 5: Change in Ohio Minority and NonMinority Undergraduate Enrollment")

Next, I created the same chart for the University of Cincinnati. Interestingly, UC doesn’t follow the national trend or the Ohio trend as one can see that UC’s student population has remained virtually unchanged in terms of its diversity mix. I found this piece to be a bit surprising since UC is an urban school and accessible to multiple different population groups.

## Ribbon Chart for University of Cincinnati ##
clean_data %>%
  mutate(ugds_minority = ugds_black_new + ugds_hisp_new
         + ugds_asian_new + ugds_aian_new
         + ugds_nhpi + ugds_2mor 
         + ugds_nra + ugds_unkn) %>%
  mutate(ugds_minority_total = ugds_minority*ugds,
         ugds_white_total = ugds_white_new*ugds) %>% 
  select(-city, -zip, -longitude, -latitude,
         -ugds_black_new, -ugds_hisp_new, -ugds_asian_new, -ugds_aian_new,
         -ugds_nhpi, -ugds_2mor, -ugds_nra, -ugds_unkn, -ugds_white_new,
         -stabbr, -ugds_minority) %>%
  filter(instnm == "University of Cincinnati-Main Campus") %>% 
  group_by(year) %>%
  summarize(total_minority = sum(ugds_minority_total),
            total_nonminority = sum(ugds_white_total),
            total_ugds = total_minority + total_nonminority,
            minority_prop = total_minority / total_ugds,
            nonminority_prop = total_nonminority / total_ugds) %>% 
  ggplot(aes(x = year)) + 
  geom_line(aes(y = minority_prop, group = 1), color = "blue") +
  geom_line(aes(y = nonminority_prop, group =1), color = "red") +
  geom_ribbon(aes(ymin = minority_prop, ymax = nonminority_prop, group = 1), 
              fill = "red2", alpha = .1) +
  annotate("text", x = 2003, y = 0.76, label = "Nonminority: 76.6%", 
           color = "red", hjust = 1, size = 3) +
  annotate("text", x = 2003, y = 0.23, label = "Minority: 23.4%", 
           color = "blue", hjust = 1, size = 3) +
  annotate("text", x = 2003, y = 0.53, label = "Delta: 53.2%", 
           color = "red2", hjust = 1, size = 3) +
  annotate("text", x = 2014, y = 0.76, label = "Nonminority: 76.5%", 
           color = "red", hjust = 0, size = 3) +
  annotate("text", x = 2014, y = 0.24, label = "Minority: 23.5%", 
           color = "blue", hjust = 0, size = 3) +
  annotate("text", x = 2014, y = 0.53, label = "Delta: 53%", 
           color = "red2", hjust = 0, size = 3) +
  scale_x_continuous("Year", limits = c(2001, 2016), breaks = seq(2004, 2013, by = 4)) +
  scale_y_continuous("Proportion of Undergraduate Students", labels = scales::percent) +
  ggtitle("Figure 5: Change in UC Minority and NonMinority Undergraduate Enrollment")

Furthermore, to round out the analysis, I plotted the percentage of UC’s undergraduate population attributable to each demographic with the goal of identifying any trends within individual demographic groups. While individual minority groups (Hispanic and Asian in particular) have seen some moderate increases, the most notable takeway is the decreasing percentage of African-American students at the University of Cincinnati.

## Plot Change in Individual Demographics at UC ##
clean_data %>%
  mutate(ugds_white_total = ugds_white_new*ugds,
         ugds_black_total = ugds_black_new*ugds,
         ugds_hisp_total = ugds_hisp_new*ugds,
         ugds_asian_total = ugds_asian_new*ugds,
         ugds_aian_total = ugds_aian_new*ugds,
         ugds_nhpi_total = ugds_nhpi*ugds,
         ugds_2mor_total = ugds_2mor*ugds,
         ugds_nra_total = ugds_nra*ugds,
         ugds_unkn_total = ugds_unkn*ugds) %>% 
  select(-city, -zip, -longitude, -latitude,
         -ugds_black_new, -ugds_hisp_new, -ugds_asian_new, -ugds_aian_new,
         -ugds_nhpi, -ugds_2mor, -ugds_nra, -ugds_unkn, -ugds_white_new,
         -stabbr) %>%
  filter(instnm == "University of Cincinnati-Main Campus") %>% 
  group_by(year) %>%
  summarize(total_ugds = ugds_white_total + ugds_black_total
            +ugds_hisp_total + ugds_asian_total + ugds_aian_total
            +ugds_nhpi_total + ugds_2mor_total + ugds_nra_total
            +ugds_unkn_total,
            White = ugds_white_total / total_ugds,
            Black = ugds_black_total / total_ugds,
            Hisp = ugds_hisp_total / total_ugds,
            Asian = ugds_asian_total / total_ugds,
            Aian = ugds_aian_total / total_ugds,
            Nhpi = ugds_nhpi_total / total_ugds,
            Twomor = ugds_2mor_total / total_ugds,
            Nra = ugds_nra_total / total_ugds,
            Unkn = ugds_unkn_total / total_ugds) %>% 
  gather(White:Unkn, key = "Demographic", value = "Proportion") %>% 
  ggplot(aes(year, Proportion, group = Demographic, color = Demographic)) +
  geom_line(alpha = .5) +
  geom_point(alpha = .5) +
  scale_x_continuous(NULL, limits = c(2004, 2013), breaks = seq(2004, 2013, by = 2)) +
  scale_y_continuous(NULL, labels = scales::percent) +
  ggtitle("Figure 6: UC Student Population Over Time")

However, the decreasing proportion of African-American students could be due to a rapidly expanding student population. Thus, the graph below represents the raw number of undergraduate students within each demographic. As one can see, the overall population is rapidly growing, but the African-American student population is declining. I believe this factor significantly contributes to UC not following the national or state trend.

## Raw Number of Students ##
clean_data %>%
  mutate(ugds_white_total = ugds_white_new*ugds,
         ugds_black_total = ugds_black_new*ugds,
         ugds_hisp_total = ugds_hisp_new*ugds,
         ugds_asian_total = ugds_asian_new*ugds,
         ugds_aian_total = ugds_aian_new*ugds,
         ugds_nhpi_total = ugds_nhpi*ugds,
         ugds_2mor_total = ugds_2mor*ugds,
         ugds_nra_total = ugds_nra*ugds,
         ugds_unkn_total = ugds_unkn*ugds) %>% 
  select(-city, -zip, -longitude, -latitude,
         -ugds_black_new, -ugds_hisp_new, -ugds_asian_new, -ugds_aian_new,
         -ugds_nhpi, -ugds_2mor, -ugds_nra, -ugds_unkn, -ugds_white_new,
         -stabbr) %>%
  filter(instnm == "University of Cincinnati-Main Campus") %>% 
  group_by(year) %>%
  summarize(White = ugds_white_total,
            Black = ugds_black_total,
            Hisp = ugds_hisp_total,
            Asian = ugds_asian_total,
            Aian = ugds_aian_total,
            Nhpi = ugds_nhpi_total,
            Twomor = ugds_2mor_total,
            Nra = ugds_nra_total,
            Unkn = ugds_unkn_total,
            Total = White + Black + Hisp + Asian +
                    Aian + Nhpi + Twomor + Nra +
                    Unkn) %>% 
  gather(White:Total, key = "Demographic", value = "Proportion") %>% 
  ggplot(aes(year, Proportion, group = Demographic, color = Demographic)) +
  geom_line(alpha = .5) +
  geom_point(alpha = .5) +
  scale_x_continuous(NULL, limits = c(2004, 2013), breaks = seq(2004, 2013, by = 2)) +
  scale_y_continuous(NULL) +
  ggtitle("Figure 7: UC Diversity Mix Over Time")

This concludes the analysis portion of this project. Please see the “Summary” for my final thoughts and comments.

Summary

Thus, as one can see, the provided analysis contains a foundational view of the changing demographics within the US, Ohio, and University of Cincinnati undergraduate student populations. It was certainly interesting to understand the stark differences between the national student population and our local student population here at UC. Those who surround you often help shape one’s worldviews, and it’s entirely possible that here at UC, we are surrounded by a fundamentally different population of people than the majority of students in the nation.