Admission Data 2021-24

Data Import

# Load updated data
admissions_data <- read_csv("LongFormat_Admissions_Data.csv")
head(admissions_data)

Pr_Code	Pr_Name	Count	Type	Year	Place
52L8	Sociology and Data Analytics	8	Applications	2021	Home
C856	Criminology and Data Analytics	11	Applications	2021	Home
LL23	Politics and Sociology	165	Applications	2021	Home
LL26	Politics and Social Anthropology	60	Applications	2021	Home
LL63	Social Anthropology and Sociology	100	Applications	2021	Home
LM29	Politics and Criminology	45	Applications	2021	Home

Summary Table with Filtering

admissions_summary <- admissions_data %>%
  group_by(Year, Type, Place) %>%
  summarise(Total = sum(Count, na.rm = TRUE), .groups = "drop")

DT::datatable(admissions_summary, 
              filter = "top", 
              options = list(pageLength = 10, autoWidth = TRUE))

Interactive Plot: Admissions by Year and Type

# Summarise data
plot_data <- admissions_data %>%
  group_by(Year, Type, Place) %>%
  summarise(Total = sum(Count, na.rm = TRUE), .groups = "drop") %>%
  mutate(Year = factor(Year),
         Group = interaction(Type, Place))

# Basic colour scheme by Type (lighter/darker difference left out for simplicity)
colour_map <- c(
  "Applications.Home" = "#1b7837",
  "Applications.Overseas" = "#a6dba0",
  "Offers.Home" = "#e66101",
  "Offers.Overseas" = "#fdb863",
  "Registrations.Home" = "#2166ac",
  "Registrations.Overseas" = "#92c5de"
)

# Plot
plot_ly(data = plot_data,
        x = ~Year,
        y = ~Total,
        type = 'bar',
        color = ~Type,
        barmode = 'stack',
        marker = list(line = list(width = 1, color = 'black'))) %>%
  layout(title = 'Admissions by Year and Type',
         legend = list(orientation = 'h', x = 0.5, xanchor = 'center', y = -0.3),
         yaxis = list(title = "Total"))

Full Data Table

datatable(admissions_data, options = list(pageLength = 10), filter = "top")

Trends in Home vs Overseas Applications by Programme

Understanding how interest in each programme shifts between Home and Overseas applicants can reveal whether programmes are becoming more internationally attractive or consolidating domestic appeal. This analysis breaks down the application numbers by Home vs Overseas and shows how these shift over time, allowing for comparisons within each programme.

library(plotly)

# Summarised data for bar heights
home_overseas_trend <- admissions_data %>%
  filter(Type == "Applications") %>%
  group_by(Year, Pr_Name, Place) %>%
  summarise(Applications = sum(Count, na.rm = TRUE), .groups = "drop")

# Total applications per bar (needed for geom_text)
totals <- home_overseas_trend %>%
  group_by(Year, Pr_Name) %>%
  summarise(Total = sum(Applications), .groups = "drop")

# Plot
p <- ggplot(home_overseas_trend, aes(x = Year, y = Applications, fill = Place,
                                     text = paste0("Programme: ", Pr_Name,
                                                   "<br>Year: ", Year,
                                                   "<br>Place: ", Place,
                                                   "<br>Applications: ", Applications))) +
  geom_bar(stat = "identity", position = "stack") +
  geom_text(data = totals, aes(x = Year, y = Total, label = Total),
            inherit.aes = FALSE, vjust = -0.5, size = 3.3) +
  facet_wrap(~ Pr_Name, ncol = 3, scales = "free_y") +
  labs(title = "Applications by Programme and Place (Home vs Overseas)",
       x = "Year", y = "Number of Applications", fill = "Applicant Type") +
  theme_minimal() +
  theme(legend.position = "bottom",
        axis.text.x = element_text(angle = 45, hjust = 1),
        strip.text = element_text(size = 10))

ggplotly(p, tooltip = "text") %>%
  layout(legend = list(orientation = "h", x = 0.5, xanchor = "center", y = -0.15))

library(tidyverse)

# Filter to Applications only
apps_split <- admissions_data %>%
  filter(Type == "Applications") %>%
  group_by(Year, Pr_Name, Place) %>%
  summarise(Apps = sum(Count, na.rm = TRUE), .groups = "drop")

# Create line plot with Place split
ggplot(apps_split, aes(x = Year, y = Apps, colour = Place, linetype = Place)) +
  geom_line(linewidth = 1) +
  facet_wrap(~ Pr_Name, scales = "free_y", ncol = 3) +
  labs(
    title = "Applications by Programme, Split by Home and Overseas",
    x = "Year", y = "Number of Applications"
  ) +
  scale_colour_manual(values = c("Home" = "#1f78b4", "Overseas" = "#a6cee3")) +
  theme_minimal() +
  theme(
    legend.position = "bottom",
    strip.text = element_text(size = 9),
    axis.text.x = element_text(angle = 45, hjust = 1)
  )

Changes in Relative Popularity (Share of Total BASS Applications)

This view helps surface programmes that are gaining relevance within BASS, even if they don’t have the highest number of applicants. Programmes like Sociology and Data Analytics may start small but gain share over time a strong indicator of appeal or successful targeting.

For each programme, we calculate its percentage share of total BASS applications in a given year. This figure helps identify how a programme is performing relative to the whole BASS portfolio, not just in raw numbers.

library(plotly)

# Total BASS applications per year
bass_totals <- admissions_data %>%
  filter(Type == "Applications") %>%
  group_by(Year) %>%
  summarise(BASS_Total = sum(Count, na.rm = TRUE), .groups = "drop")

# Programme-level totals and share
programme_shares <- admissions_data %>%
  filter(Type == "Applications") %>%
  group_by(Year, Pr_Name) %>%
  summarise(Programme_Apps = sum(Count, na.rm = TRUE), .groups = "drop") %>%
  left_join(bass_totals, by = "Year") %>%
  mutate(SharePercent = round(100 * Programme_Apps / BASS_Total, 2),
         Label = paste0(Pr_Name, "<br>Share: ", SharePercent, "%"))

# Interactive plot
plot_ly(programme_shares,
        x = ~as.integer(Year),
        y = ~SharePercent,
        color = ~Pr_Name,
        text = ~Label,
        hoverinfo = "text",
        type = 'scatter',
        mode = 'lines+markers') %>%
  layout(title = "Share of Total BASS Applications by Programme",
         xaxis = list(title = "Year", tickmode = "linear"),
         yaxis = list(title = "Share of BASS (%)"),
         legend = list(orientation = "h", x = 0.5, xanchor = "center", y = -0.25))

Tracking Programme Rank Over Time

To understand shifts in programme popularity, we compute the rank of each programme based on application counts for each year.

• Rank 1 means the most popular programme that year.
• Lower ranks (e.g., Rank 10) indicate fewer applications.
• We track these ranks year-by-year to show volatility or stability.

What This Tells Us:

• Programmes climbing in rank are gaining traction.
• Stable top-rank programmes reflect consistent popularity.
• Declining rank may indicate waning interest or growing competition from other disciplines.

The bump chart below visualises these movements clearly.

# Prepare and rank data
programme_ranks <- admissions_data %>%
  filter(Type == "Applications") %>%
  group_by(Year, Pr_Name) %>%
  summarise(Applications = sum(Count, na.rm = TRUE), .groups = "drop") %>%
  group_by(Year) %>%
  mutate(Rank = rank(-Applications, ties.method = "min")) %>%
  ungroup() %>%
  # Add abbreviations for display
  mutate(Abbr = Pr_Name %>%
           str_replace_all("Social Anthropology", "SOAN") %>%
           str_replace_all("Sociology", "SOCY") %>%
           str_replace_all("Politics", "PLOI") %>%
           str_replace_all("Philosophy", "PHIL") %>%
           str_replace_all("Criminology", "CRIM") %>%
           str_replace_all("Data Analytics", "DA"))

# Plot bump chart using abbreviations
ggplot(programme_ranks, aes(x = as.integer(Year), y = Rank, colour = Abbr)) +
  geom_bump(size = 1.5) +
  geom_point(size = 3) +
  scale_y_reverse(breaks = 1:max(programme_ranks$Rank)) +
  labs(
    title = "Programme Rank Volatility by Applications (2021–2024)",
    x = "Year", y = "Rank (1 = Most Popular)",
    colour = "Programme"
  ) +
  theme_minimal() +
  theme(
    legend.position = "bottom",
    legend.text = element_text(size = 8),
    legend.title = element_text(size = 9),
    legend.key.width = unit(1.5, "cm")
  ) +
  guides(colour = guide_legend(nrow = 3, byrow = TRUE))

# Prepare rank table with abbreviations
rank_table_abbr <- admissions_data %>%
  filter(Type == "Applications", !is.na(Count)) %>%
  group_by(Year, Pr_Name) %>%
  summarise(Apps = sum(Count), .groups = "drop") %>%
  group_by(Year) %>%
  arrange(desc(Apps)) %>%
  mutate(Rank = row_number()) %>%
  ungroup() %>%
  # Apply the same abbreviations
  mutate(Abbr = Pr_Name %>%
           str_replace_all("Social Anthropology", "SOAN") %>%
           str_replace_all("Sociology", "SOCY") %>%
           str_replace_all("Politics", "PLOI") %>%
           str_replace_all("Philosophy", "PHIL") %>%
           str_replace_all("Criminology", "CRIM") %>%
           str_replace_all("Data Analytics", "DA")) %>%
  select(Year, Abbr, Rank) %>%
  pivot_wider(names_from = Year, values_from = Rank)

# Display the table
rank_table_abbr %>%
  kable(caption = "Programme Rankings by Applications (1 = Most Popular)", align = "lcccc") %>%
  kable_styling(full_width = FALSE, bootstrap_options = c("striped", "hover"))

Programme Rankings by Applications (1 = Most Popular)

Abbr	2022	2023	2024	2021
SOCY and CRIM	1	1	2	1
PLOI and SOCY	2	2	1	2
PHIL and PLOI	3	3	3	3
SOCY and DA	9	6	4	10
SOAN and SOCY	4	4	5	4
PLOI and SOAN	5	5	6	5
SOCY and PHIL	6	7	8	6
PLOI and CRIM	7	8	7	8
PHIL and CRIM	8	11	12	7
SOAN and PHIL	10	9	11	9
SOAN and CRIM	11	13	13	11
PLOI and DA	13	12	9	13
CRIM and DA	12	10	10	12
SOAN and DA	14	14	14	14
PHIL and DA	15	15	15	15

---

Interactive Dashboard: Explore the Data Yourself

An interactive Shiny app is available to explore BASS application data in greater detail.

You can:

• Filter and compare programmes over time
• Analyse trends by year, application type, and applicant origin (Home/Overseas)
• View programme-specific trajectories alongside total BASS trends

Launch the app: https://sisteranalyst.shinyapps.io/BASSApplications/

(Best viewed on a desktop browser for full functionality.)