Assignment 4

Quarto

Quarto enables you to weave together content and executable code into a finished document. To learn more about Quarto see https://quarto.org.

Running Code

When you click the Render button a document will be generated that includes both content and the output of embedded code. You can embed code like this:

library(tidyverse)

Warning: package 'readr' was built under R version 4.5.2

── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.4     ✔ readr     2.1.6
✔ forcats   1.0.0     ✔ stringr   1.5.1
✔ ggplot2   3.5.2     ✔ tibble    3.3.0
✔ lubridate 1.9.4     ✔ tidyr     1.3.1
✔ purrr     1.1.0     
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(lubridate)
library(dplyr)
library(stringr)
library(readr)
library(skimr)

You can add options to executable code like this

xavier_peers <- 
  read_csv("https://asayanalytics.com/xavier_peers-csv")

Rows: 220 Columns: 17
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (7): name, wiki, city, state, filing_updated, total_exec_comp, total_oth...
dbl (8): ein, tax_file_yr, pres_comp, total_revenue, total_tuition_revenue, ...
lgl (2): ajcu, big_east

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

#2.2


xavier_peers <- xavier_peers %>%

  mutate(filing_updated = as.Date(filing_updated, format = "%Y-%m-%d"),
    
    total_exec_comp  = as.numeric(ifelse(total_exec_comp == "NULL", NA, total_exec_comp)),
    total_other_comp = as.numeric(ifelse(total_other_comp == "NULL", NA, total_other_comp))
  )

# 2.3
xavier_peers <- xavier_peers %>%
  mutate(
    OER = total_fun_expenses / (total_tuition_revenue + total_gifts)
  )

xavier_peers <- xavier_peers %>%
  group_by(name) %>%
  mutate(
    avg_OER = mean(OER, na.rm = TRUE),                 
    better_than_avg = ifelse(OER < avg_OER, TRUE, FALSE) 
  ) %>%
  ungroup()

# 3.1

library(ggplot2)

ggplot(xavier_peers, aes(x = total_exec_comp, y = total_other_comp, color = ajcu)) +
  geom_point() +
  labs(
    title = "Total Executive Compensation vs Total Other Compensation",
    x = "Total Executive Compensation ($)",
    y = "Total Other Compensation ($)",
    color = "AJCU Institution"
  )

Warning: Removed 6 rows containing missing values or values outside the scale range
(`geom_point()`).

# There appears to be no real correlation between total executive compensation and total other compensation when grouped by AJCU institutions.

# 3.2

library(dplyr)
library(ggplot2)

xavier_plot <- xavier_peers %>%
  mutate(
    total_exec_comp  = as.numeric(ifelse(total_exec_comp == "NULL", NA, total_exec_comp)),
    total_other_comp = as.numeric(ifelse(total_other_comp == "NULL", NA, total_other_comp)),
    exec_to_other_ratio = total_exec_comp / total_other_comp
  )

xavier_plot %>%
  filter(ajcu == TRUE & big_east == TRUE) %>%
  ggplot(aes(x = name, y = exec_to_other_ratio)) +
  geom_boxplot(fill = "lightblue") +
  labs(
    title = "Variance in Exec/Other Compensation Ratio (AJCU & Big East)",
    x = "Institution",
    y = "Executive / Other Compensation Ratio"
  ) 

Warning: Removed 2 rows containing non-finite outside the scale range
(`stat_boxplot()`).

# most of these universities have relatively small variances in compensation with one outlier on top. However, Marquette has a much larger variance. 

library(dplyr)
library(ggplot2)


revenue_summary <- xavier_peers %>%
  group_by(tax_file_yr) %>%
  summarise(
    median_revenue = median(total_revenue, na.rm = TRUE)
  ) %>%
  ungroup()


ggplot(revenue_summary, aes(x = tax_file_yr, y = median_revenue)) +
  geom_line(color = "red") +  
  geom_point(color = "blue") +   
  labs(
    title = "Median Total Revenue Over Time",
    x = "Tax Filing Year",
    y = "Total Revenue ($)"
  ) 

# Median total revenue was increasing slowly for a while before spiking around 2023. Since then, it has been declining. 

#4.2

library(dplyr)
library(ggplot2)

revenue_exp_summary <- xavier_peers %>%
  group_by(tax_file_yr) %>%
  summarise(
    avg_tuition = mean(total_tuition_revenue, na.rm = TRUE),
    avg_gifts    = mean(total_gifts, na.rm = TRUE),
    avg_expenses = mean(total_fun_expenses, na.rm = TRUE)
  ) %>%
  ungroup()

ggplot(revenue_exp_summary, aes(x = tax_file_yr)) +
  geom_line(aes(y = avg_tuition, color = "Tuition Revenue")) +
  geom_line(aes(y = avg_gifts, color = "Gifts & Contributions")) +
  geom_line(aes(y = avg_expenses, color = "Total Functional Expenses")) +
  labs(
    title = "Average Tuition, Gifts, and Functional Expenses Over Time",
    x = "Tax Filing Year",
    y = "Amount ($)",
    color = "Legend"
  )

# Gifts and contributions has remained relatively steady while tuition revenue and total functional expenses continues to grow

The echo: false option disables the printing of code (only output is displayed).