Analyzing College Major & Income Data

Data Introduction

recent_grads <- read_csv("https://raw.githubusercontent.com/fivethirtyeight/data/master/college-majors/recent-grads.csv")
recent_grads <- janitor::clean_names(recent_grads)
head(recent_grads)

## # A tibble: 6 x 21
##    rank major_code major            total   men women major_category share_women
##   <dbl>      <dbl> <chr>            <dbl> <dbl> <dbl> <chr>                <dbl>
## 1     1       2419 PETROLEUM ENGIN~  2339  2057   282 Engineering          0.121
## 2     2       2416 MINING AND MINE~   756   679    77 Engineering          0.102
## 3     3       2415 METALLURGICAL E~   856   725   131 Engineering          0.153
## 4     4       2417 NAVAL ARCHITECT~  1258  1123   135 Engineering          0.107
## 5     5       2405 CHEMICAL ENGINE~ 32260 21239 11021 Engineering          0.342
## 6     6       2418 NUCLEAR ENGINEE~  2573  2200   373 Engineering          0.145
## # ... with 13 more variables: sample_size <dbl>, employed <dbl>,
## #   full_time <dbl>, part_time <dbl>, full_time_year_round <dbl>,
## #   unemployed <dbl>, unemployment_rate <dbl>, median <dbl>, p25th <dbl>,
## #   p75th <dbl>, college_jobs <dbl>, non_college_jobs <dbl>,
## #   low_wage_jobs <dbl>

skimr::skim(recent_grads)

Variable type: character

Variable type: numeric

This is a relatively small dataset with only 173 rows and rather clean one with only 4 missing values. Some data cleaning is still needed now and later as we visualize data. One thing we have noticed is that major column is all caps and it is difficult to read, especially when putting all majors on a plot. There is a nifty function from stringr called str_to_title() that can transform all caps to title format with the first letter of each word capitalized only.

recent_grads$major <- str_to_title(recent_grads$major)

Data Visualization

Which majors are the most popular ones?

The following bar charts can convey vividly the 30 most popular and 30 least popular majors.

recent_grads %>%
  filter(!is.na(total)) %>%
  mutate(major = fct_lump(major, n = -30, w = total),
         major = fct_reorder(major, total, .desc = TRUE)) %>%
  filter(major != "Other") %>%
  ggplot(aes(total, major, fill = major)) +
  geom_col() +
  theme_bw() +
  theme(
    axis.title.y = element_blank(),
    legend.position = "none",
    axis.text = element_text(size = 13),
    axis.title = element_text(size = 16),
    plot.title = element_text(size = 18)
  ) +
  scale_x_continuous(labels = comma) +
   labs(x = "# of graduates", title = "The 30 Least Most Popular Majors") +

recent_grads %>%
  filter(!is.na(total)) %>%
  mutate(major = fct_lump(major, n = 30, w = total),
         major = fct_reorder(major, total)) %>%
  filter(major != "Other") %>%
  ggplot(aes(total, major, fill = major)) +
  geom_col() +
  theme_bw() +
  theme(
    axis.title.y = element_blank(),
    legend.position = "none",
    axis.text = element_text(size = 13),
    axis.title = element_text(size = 16),
    plot.title = element_text(size = 18)
  ) +
  scale_x_continuous(labels = comma) +
   labs(x = "# of graduates", title = "The 30 Most Popular Majors") 

Based on the dataset, Psychology, Business and Biology are the 3 most popular majors, yet on the opposite of coin, Military Technologies, Math & CS and Soil Science are the least popular ones. It is a tad puzzling that both Math and CS are in the list of the top 30 popular-major list, so I believe it is rare for students to have both Math and CS major at the same time.

Employment Status

Having a major that can help students do well in job search is consequential, and students and parents should be prudent when it comes to choosing a college major. Hopefully, the following bar charts can shed some light on major choice in terms of employment situation.

recent_grads %>%
  slice_min(unemployment_rate, n = 30) %>%
  mutate(major = fct_reorder(major, unemployment_rate, .desc = TRUE)) %>%
  ggplot(aes(unemployment_rate, major, fill = unemployment_rate)) +
  geom_col() +
  theme_bw() +
  theme(
    axis.title.y = element_blank(),
    legend.position = "none"
  ) +
  scale_x_continuous(labels = percent) +
  labs(x = "Unemployment Rate", title = "The 30 Highest Employment Majors") +
recent_grads %>%
  slice_max(unemployment_rate, n = 30) %>%
  mutate(major = fct_reorder(major, unemployment_rate)) %>%
  ggplot(aes(unemployment_rate, major, fill = unemployment_rate)) +
  geom_col() +
  theme_bw() +
  scale_x_continuous(labels = percent) +
  theme(
    axis.title.y = element_blank(),
    legend.position = "none"
  ) +
  labs(x = "Unemployment Rate", title = "The 30 Lowest Employment Majors")

Ironically, the top 3 employment majors are the ones with the least popularity. Nuclear Engineering is the major having the highest unemployment rate.

Major Category

Besides each specific major, major category is the meta-major that includes a number of individual majors.

major_category <- recent_grads %>%
  group_by(major_category) %>%
  summarize(total_grad = sum(total, na.rm = TRUE),
            male = sum(men, na.rm = TRUE), 
            female = sum(women, na.rm = TRUE),
            total_employed = sum(employed)) %>%
  mutate(employment_rate = total_employed/total_grad,
         major_category = fct_reorder(major_category, employment_rate))

major_category %>%
  ggplot(aes(employment_rate, major_category, fill = major_category)) +
  geom_col() +
  theme_bw() +
  theme(
    legend.position = "none",
    axis.title = element_text(size = 15),
    axis.text = element_text(size = 13),
    plot.title = element_text(size = 17)
  ) +
  scale_x_continuous(labels = percent) +
  labs(x = "weighted employment rate", y = "major category", title = "Major Category Employment Rate") 

major_category %>%
  pivot_longer(cols = c("male", "female"),
               names_to = "gender",
               values_to = "count") %>%
  mutate(major_category = reorder_within(major_category, count, gender)) %>%
  ggplot(aes(count, major_category, fill = major_category)) +
  scale_y_reordered() +
  geom_col() +
  theme_bw() +
  theme(
    legend.position = "none",
    strip.text = element_text(size = 15, face = "bold"),
    axis.title = element_text(size = 15),
    axis.text = element_text(size = 13),
    plot.title = element_text(size = 17)
  ) +
  facet_wrap(~gender, scales = "free_y") +
  scale_x_continuous(labels = comma) +
  labs(x = "# of graduates", y = "major category", title = "Popular Major Categories between Male and Female")

The following bar chart conveys the same information as the one right above.

recent_grads %>%
  group_by(major_category) %>%
  summarize_at(vars(men, women), sum, na.rm = TRUE) %>%
  pivot_longer(cols = c(men, women), names_to = "gender", values_to = "count") %>%
  mutate(major_category = fct_reorder(major_category, count)) %>%
  ggplot(aes(count, major_category, fill = gender)) +
  geom_col() +
  theme_bw() +
  theme(
    axis.title.y = element_blank()
  ) +
  scale_x_continuous(labels = comma) +
  labs(x = "# of graduates", title = "Major Category Male and Female Graduate Counts")

recent_grads %>%
  ggplot(aes(median, share_women, color = major_category, size = sample_size)) +
  geom_point() +
  geom_smooth(aes(group = 1), method = "lm") +
  scale_x_continuous(labels = dollar) +
  scale_y_continuous(labels = percent, limits = c(0,1)) +
  labs(y = "women percent", x = "median salary", title = "Median Salary V.S. Women Percent with respect to sample size")

Functional Programming with nest() and unnest()

The following little chunk of code is borrowed from the link with some minor change. The reason why I include this part of anlaysis is that nest() and unnest() functions are a bit difficult to comprehend and to use, and some practice on using them with map() is necessary, strengthening my own understanding of using them.

recent_grads %>%
  nest(-major_category) %>%
  mutate(model = map(data, ~ lm(median ~ share_women, data = ., weights = sample_size)),
         tidied = map(model, tidy)) %>%
  unnest(tidied) %>%
  filter(term == "share_women") %>%
  arrange(estimate) %>%
  mutate(fdr = p.adjust(p.value, method = "fdr"))

## # A tibble: 16 x 9
##    major_category     data    model term   estimate std.error statistic  p.value
##    <chr>              <list>  <lis> <chr>     <dbl>     <dbl>     <dbl>    <dbl>
##  1 Biology & Life Sc~ <tibbl~ <lm>  share~  -43735.    20982.   -2.08    0.0592 
##  2 Engineering        <tibbl~ <lm>  share~  -33912.    15418.   -2.20    0.0366 
##  3 Social Science     <tibbl~ <lm>  share~  -33667.     7248.   -4.65    0.00236
##  4 Computers & Mathe~ <tibbl~ <lm>  share~  -28694.    18552.   -1.55    0.156  
##  5 Business           <tibbl~ <lm>  share~  -28171.     9810.   -2.87    0.0152 
##  6 Industrial Arts &~ <tibbl~ <lm>  share~  -17827.     6835.   -2.61    0.0478 
##  7 Psychology & Soci~ <tibbl~ <lm>  share~  -16425.     8312.   -1.98    0.0887 
##  8 Agriculture & Nat~ <tibbl~ <lm>  share~  -16263.     5975.   -2.72    0.0297 
##  9 Physical Sciences  <tibbl~ <lm>  share~  -12820.    13349.   -0.960   0.365  
## 10 Education          <tibbl~ <lm>  share~   -1996.     3084.   -0.647   0.528  
## 11 Humanities & Libe~ <tibbl~ <lm>  share~   -1814.     4128.   -0.439   0.668  
## 12 Arts               <tibbl~ <lm>  share~   -1025.    13416.   -0.0764  0.942  
## 13 Law & Public Poli~ <tibbl~ <lm>  share~    2456.    34987.    0.0702  0.948  
## 14 Communications & ~ <tibbl~ <lm>  share~    9612.     4045.    2.38    0.141  
## 15 Health             <tibbl~ <lm>  share~   54721.    23427.    2.34    0.0416 
## 16 Interdisciplinary  <tibbl~ <lm>  share~      NA        NA    NA      NA      
## # ... with 1 more variable: fdr <dbl>

When looking at fdr column, almost all corrected p-values are greater than 0.05, which means share_women is not a useful predictor for median salary. However, we set weights to be sample_size, and that whether the sample size in each major_category is large enough to draw such a conclusion is still a question.

Income

The following data analysis is inspired by this YouTube R screencast link

recent_grads %>%
  mutate(major_category = fct_reorder(major_category, median)) %>%
  ggplot(aes(median, major_category, fill = major_category)) +
  geom_boxplot() +
  theme_bw() +
  theme(
    legend.position = "none"
  ) +
  scale_x_continuous(labels = dollar) +
  labs(x = "median salary", y = "", title = "Major Category Median Salary")

recent_grads %>%
  arrange(desc(median)) %>%
  head(20) %>%
  mutate(major = fct_reorder(major, median)) %>%
  ggplot(aes(median, major, color = major_category)) +
  geom_point(aes(size = sample_size)) +
  geom_errorbar(aes(xmin = p25th, xmax = p75th)) +
  theme_bw() +
  theme(
    axis.text = element_text(size = 12)
  ) +
  labs(size = "sample size", color = "major category", x = "median salary", y = "", title = "Top 20 Median Salary Majors", subtitle = "Error bars refer to the 25th and 75th percentile") +
  scale_x_continuous(labels = dollar)

recent_grads %>%
  arrange(median) %>%
  head(20) %>%
  mutate(major = fct_reorder(major, median)) %>%
  ggplot(aes(median, major, color = major_category)) +
  geom_point(aes(size = sample_size)) +
  geom_errorbar(aes(xmin = p25th, xmax = p75th)) +
  theme_bw() +
  theme(
    axis.text = element_text(size = 12)
  ) +
  labs(size = "sample size", color = "major category", x = "median salary", y = "", title = "Bottom 20 Median Salary Majors", subtitle = "Error bars refer to the 25th and 75th percentile") +
  scale_x_continuous(labels = dollar)

College-degree Required Jobs

recent_grads %>%
  mutate(college_job_rate = college_jobs/employed) %>%
  arrange(desc(college_job_rate)) %>%
  head(30) %>% 
  mutate(major = fct_reorder(major, college_job_rate)) %>%
  ggplot(aes(college_job_rate, major, color = major)) +
  geom_point() +
  scale_x_continuous(labels = percent, limits = c(0.5, 1)) +
  theme_bw() +
  theme(legend.position = "none") +
  labs(x = "job rates requiring college degree", y = "", title = "Top 30 Majors Finding Degree-related Jobs")

recent_grads %>%
  mutate(college_job_rate = college_jobs/employed) %>%
  arrange(college_job_rate) %>%
  head(30) %>% 
  mutate(major = fct_reorder(major, college_job_rate)) %>%
  ggplot(aes(college_job_rate, major, color = major)) +
  geom_point() +
  scale_x_continuous(labels = percent) +
  theme_bw() +
  theme(legend.position = "none") +
  labs(x = "job rates requiring college degree", y = "", title = "Bottom 30 Majors Finding Degree-related Jobs")

Unsurprisingly, Nursing is a professional field that needs a college degree the most. Hospitality Management, Culinary Arts and Accounting are the ones having the least college-degree requirement.