SoJSM Employment Outlook code

Code for producing the SoJSM Employment Outlook.

# ============================================================
# Communication & Media BA-level Jobs — BLS Projections
# ============================================================

library(tidyverse)
library(plotly)
library(scales)
options(scipen = 999)

# ------------------------------------------------------------
# 1) Read & filter data
# ------------------------------------------------------------
AllData <- read.csv("Employment Projections.csv")

BAjobs <- AllData %>%
  filter(
    Typical.Entry.Level.Education == "Bachelor's degree",
    # Include "5 years or more" so those occupations can be flagged
    Work.Experience.in.a.Related.Occupation %in% c("None", "Less than 5 years", "5 years or more")
  )

# ------------------------------------------------------------
# 2) Clean fields
# ------------------------------------------------------------
BAjobs <- BAjobs %>%
  mutate(
    Pay = parse_number(Median.Annual.Wage.2024),
    
    # BLS annual openings already in *thousands*
    Openings_thousands = as.numeric(Occupational.Openings..2024.2034.Annual.Average),
    
    # SOC cleanup
    Occupation.Code = str_replace_all(Occupation.Code, "[^0-9-]", ""),
    
    # Flag occupations requiring 5+ years in a related occupation
    requires_5plus = Work.Experience.in.a.Related.Occupation == "5 years or more"
  )

MedianPay      <- median(BAjobs$Pay, na.rm = TRUE)
MedianOpenings <- median(BAjobs$Openings_thousands, na.rm = TRUE)

# ------------------------------------------------------------
# 3) SOC list for SoJSM media-oriented jobs
# ------------------------------------------------------------
soc_media <- c(
  "11-2032",
  "11-2033",
  "11-2011",
  "27-1011",
  "27-3041",
  "27-3042",
  "27-3043",
  "27-3031",
  "27-3023",
  "27-1024",
  "15-1254",
  "15-1255",
  "27-2012",
  "27-3011",
  "27-4032",
  "27-4031"
)

Mediajobs <- BAjobs %>%
  filter(Occupation.Code %in% soc_media) %>%
  mutate(
    Job_base = str_remove(Occupation.Title, "[ ]{2,}.*$"),
    Job = if_else(requires_5plus, paste0(Job_base, " *"), Job_base)
  )

# ------------------------------------------------------------
# 4) Create tables for each metric
# ------------------------------------------------------------
PayChart <- Mediajobs %>%
  select(Job, Pay) %>%
  add_row(Job = "Median", Pay = MedianPay) %>%
  arrange(desc(Pay))

OpeningsChart <- Mediajobs %>%
  select(Job, Openings_thousands) %>%
  add_row(Job = "Median", Openings_thousands = MedianOpenings) %>%
  arrange(desc(Openings_thousands))

# ============================================================
# 5) PAY CHART (smart inside/outside labels)
# ============================================================

pay_max  <- max(PayChart$Pay, na.rm = TRUE)
pay_xlim <- c(0, pay_max * 1.10)
switch_thr_pay <- pay_max * 0.20

PayFig <- PayChart %>%
  mutate(
    Job       = fct_reorder(Job, Pay),
    too_small = Pay < switch_thr_pay,
    label_x     = if_else(too_small, Pay + 0.02 * pay_max, Pay - 0.02 * pay_max),
    label_hjust = if_else(too_small, 0, 1),
    label_color = if_else(too_small, "#384B70", "white")
  ) %>%
  ggplot(aes(x = Pay, y = Job)) +
  geom_col(aes(fill = Job != "Median")) +
  scale_fill_manual(values = c("#FF7F3E", "#384B70"), guide = "none") +
  geom_text(aes(x = label_x, label = dollar(Pay),
                hjust = label_hjust, color = label_color),
            size = 3.8) +
  scale_color_identity() +
  scale_x_continuous(
    name = "Median annual pay",
    limits = pay_xlim,
    labels = label_dollar(big.mark = ",", accuracy = 1),
    breaks = pretty_breaks(6),
    expand = expansion(mult = c(0, 0.03))
  ) +
  labs(caption = "* Requires 5+ years of related work experience") +
  theme_minimal(base_size = 13) +
  theme(
    axis.title.y = element_blank(),
    axis.text.x = element_blank(),
    axis.ticks.x = element_blank(),
    plot.caption = element_text(hjust = 0)
  )

# ============================================================
# 6) OPENINGS CHART 
# ============================================================

OpeningsChart <- OpeningsChart %>%
  mutate(Openings_actual = Openings_thousands * 1000)

open_max  <- max(OpeningsChart$Openings_actual, na.rm = TRUE)
open_xlim <- c(0, open_max * 1.10)
switch_thr_open <- open_max * 0.20

OpeningsFig <- OpeningsChart %>%
  mutate(
    Job       = fct_reorder(Job, Openings_actual),
    too_small = Openings_actual < switch_thr_open,
    label_x     = if_else(too_small, Openings_actual + 0.02 * open_max,
                          Openings_actual - 0.02 * open_max),
    label_hjust = if_else(too_small, 0, 1),
    label_color = if_else(too_small, "#384B70", "white")
  ) %>%
  ggplot(aes(x = Openings_actual, y = Job)) +
  geom_col(aes(fill = Job != "Median")) +
  scale_fill_manual(values = c("#FF7F3E", "#384B70"), guide = "none") +
  geom_text(aes(x = label_x, label = comma(Openings_actual),
                hjust = label_hjust, color = label_color),
            size = 3.8) +
  scale_color_identity() +
  scale_x_continuous(
    name = "Annual openings (count)",
    limits = open_xlim,
    labels = comma,
    breaks = pretty_breaks(6),
    expand = expansion(mult = c(0, 0.03))
  ) +
  labs(caption = "* Requires 5+ years of related work experience") +
  theme_minimal(base_size = 13) +
  theme(
    axis.title.y = element_blank(),
    axis.text.x = element_blank(),
    axis.ticks.x = element_blank(),
    plot.caption = element_text(hjust = 0)
  )

# ------------------------------------------------------------
# 8) Output
# ------------------------------------------------------------
PayFig
OpeningsFig