For this weeks submission I created several animations. The comparative time series data provided is perfect for this type of visualization.

library(tidyverse)
library(readxl)
library(glue)
library(viridis)
library(hrbrthemes)
library(gganimate)

Load and clean the data for the visualizations:

hbcu_all <- read_excel("tabn313.20.xls", sheet = 1)

#make the names easier to work with
hbcu_all <- hbcu_all %>%
  rename('Public2Year' = `2-year - Public` ,
         'Private2Year' = `2-year - Private`,
         'Public4Year' = `4-year - Public`,
         'Private4Year' = `4-year - Private`)

hbcu_colleges_perc <- hbcu_all %>%
  select(Year,Public2Year,Private2Year,Public4Year,Private4Year) %>%
  pivot_longer(cols = c(Public2Year,Private2Year,Public4Year,Private4Year), 
               names_to = "College Type", 
               values_to = "Total")

hbcu_colleges_perc_area <- hbcu_colleges_perc %>%
  group_by(Year,`College Type`) %>%
  summarise(n = sum(Total)) %>%
  mutate(Percentage = n / sum(n)) %>%
  select(-n)

First animation will show the attendance to each university type over time using facet_wrap plots:

q <- ggplot(hbcu_colleges_perc, aes(x = Year, y = Total, fill = `College Type`)) +
  facet_wrap(~ `College Type`) +
  geom_area(alpha=0.6 , size=.5, colour="black") +
  scale_fill_viridis(discrete = T) +
  theme_ipsum() +
  theme(legend.position="bottom") +
  labs(x="Year", y="Total",
       subtitle="Annual Attendance By University Type 1976 to 2015",
       caption="SeanPJ.com") +
  ggtitle("Historically Black Colleges and Universities") +
  transition_reveal(Year) 

animate(q,end_pause = 10)

Next animation shows the total attendance counts for all HBCUs in a stacked area chart:

t <- ggplot(hbcu_colleges_perc, aes(x = Year, y = Total, fill = `College Type`)) +
  geom_area(alpha=0.6 , size=.5, colour="black") +
  scale_fill_viridis(discrete = T) +
  scale_y_continuous(breaks = c(0,50000,100000,150000,200000,250000,300000,350000) )+
  theme_ipsum() +
  theme(legend.position="bottom") +
  labs(x="Year", y="Total",
       subtitle="Annual Attendance By University Type 1976 to 2015",
       caption="SeanPJ.com") +
  ggtitle("Historically Black Colleges and Universities") +
  transition_reveal(Year) 

animate(t,end_pause = 10)

And the final animation shows the proprtional percentage share of total attendance for each college type over time.

p <- ggplot(hbcu_colleges_perc_area, aes(x = Year, y = Percentage*100, fill = `College Type`)) +
  geom_area(alpha=0.6 , size=.5, colour="black") +
  scale_fill_viridis(discrete = T) +
  theme_ipsum() +
  theme(legend.position="bottom") +
  labs(x="Year", y="Percent",
       subtitle="Annual Attendance By University Type 1976 to 2015",
       caption="SeanPJ.com") +
  ggtitle("Historically Black Colleges and Universities") +
  transition_reveal(Year)
  
animate(p, end_pause = 10)

Bonus: Population College Attendance

bach_students <- read_excel("104.10.xlsx", 
                            sheet = 2
                            ,col_names = c("Year",
                                           "Total",
                                           "SE_Total",
                                           "White",
                                           "SE_White",
                                           "Black",
                                           "SE_Black",
                                           "Hispanic",
                                           "SE_Hispanic",
                                           "Total_API",
                                           "SE_Total_API",
                                           "Asian",
                                           "SE_Asian",
                                           "PacIslander",
                                           "SE_PacIslander",
                                           "AmericanIndian",
                                           "SE_AI",
                                           "Multiethnic",
                                           "SE_Multiethnic"))

bach_students <- bach_students[-1,]

bach_clean <- bach_students %>%
  select(Year,Total,White,Black,Hispanic,Asian,PacIslander,AmericanIndian,Multiethnic) %>%
  pivot_longer(cols = c(Total,White,Black,Hispanic,Asian,PacIslander,AmericanIndian,Multiethnic),
               names_to="Ethnicity",
               values_to="Percentages") %>% 
  mutate((across(c(Year,Percentages),as.numeric))) 

# no data in first 21 rows (starts in 1940)
bach_clean <- bach_clean[-c(1:20),]

anim <- ggplot(bach_clean, aes(x = Year, y = Percentages, color = Ethnicity)) +
  geom_line() +
  geom_point() +
  theme_ipsum() +
  theme(legend.position="bottom") +
  labs(x="Year", y="Percent All Persons Age 25 and Older",
       title = "Percent Population Attended College",
       subtitle="1930 to 2016",
       caption="SeanPJ.com") +
  transition_reveal(Year)

animate(anim, end_pause = 10)