Anomaly detection through credit hour using Lof and iforest model

Executive Summary

This analysis embarked on investigating anomalies within institutional data spanning from 2019 to 2022, focusing on credit hours . Utilizing advanced anomaly detection algorithms, Local Outlier Factor (LOF) and Isolation Forest (iForest), identified Georgia Institute of Technology-Main Campus and Kennesaw State University as significant outliers. The subsequent in-depth examination aimed to unravel the characteristics and potential reasons behind their anomalous behavior, leveraging a comprehensive dataset detailing various institutional attributes.

Methodology

Data Preparation

The initial dataset, “EducationDataPortal_04.03.2024_level_of_study.csv,” provided yearly credit hours and enrollment data across multiple institutions. A secondary dataset, “EducationDataPortal_04.03.2024_College.csv,” offered extensive institutional characteristics, including control type, degree-granting status, and Title IV participation.

Anomaly Detection

Two distinct anomaly detection models were employed:

Local Outlier Factor (LOF): This model identified anomalies by measuring the local deviation of density of a given data point with respect to its neighbors. It is particularly effective in pinpointing anomalies that are not extreme but are inconsistent with the surrounding data context.

Isolation Forest (iForest): iForest isolates observations by randomly selecting a feature and then randomly selecting a split value between the maximum and minimum values of the selected feature. This method is highly efficient for identifying anomalies in high-dimensional data.

Both models flagged Georgia Institute of Technology-Main Campus and Kennesaw State University as anomalies based on the trends in credit hours.

Detailed code

library(readr)
library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(tidyr)

# Load the dataset
data <- read_csv("/Users/Chris_Hu/Desktop/drive-download-20240406T014856Z-001/EducationDataPortal_04.03.2024_level_of_study.csv")

## Warning: One or more parsing issues, call `problems()` on your data frame for details,
## e.g.:
##   dat <- vroom(...)
##   problems(dat)

## Rows: 1269 Columns: 11

## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): inst_name, state_abbr, level_of_study, acttype
## dbl (7): year, unitid, credit_hours, contact_hours, est_fte, rep_fte, enroll...
## 
## ℹ 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.

# Filter for relevant years and columns
filtered_data <- data %>%
  select(unitid, year, credit_hours) %>%
  filter(year %in% c(2019, 2020, 2021))

# Sum credit_hours for each unitid and year combination
aggregated_data <- filtered_data %>%
  group_by(unitid, year) %>%
  summarise(credit_hours = sum(credit_hours, na.rm = TRUE)) %>%
  ungroup()

## `summarise()` has grouped output by 'unitid'. You can override using the
## `.groups` argument.

# Pivot data for yearly comparison
yearly_data <- aggregated_data %>%
  pivot_wider(names_from = year, values_from = credit_hours, names_prefix = "year_")

# Calculate changes between years
yearly_data <- yearly_data %>%
  mutate(change_2019_2020 = year_2020 - year_2019,
         change_2020_2021 = year_2021 - year_2020)
# NA rows
num_rows_with_na_anywhere <- sum(rowSums(is.na(yearly_data)) > 0)
print(paste("Number of rows with NA in any column:", num_rows_with_na_anywhere))

## [1] "Number of rows with NA in any column: 11"

# Simple imputation with median
yearly_data$change_2019_2020 <- ifelse(is.na(yearly_data$change_2019_2020), median(yearly_data$change_2019_2020, na.rm = TRUE), yearly_data$change_2019_2020)

yearly_data$change_2020_2021 <- ifelse(is.na(yearly_data$change_2020_2021), median(yearly_data$change_2020_2021, na.rm = TRUE), yearly_data$change_2020_2021)

library(dbscan)

## 
## Attaching package: 'dbscan'

## The following object is masked from 'package:stats':
## 
##     as.dendrogram

# Model building
lof_scores <- lof(yearly_data[, c("change_2019_2020", "change_2020_2021")], k = 2)

## Warning in lof(yearly_data[, c("change_2019_2020", "change_2020_2021")], : lof:
## k is now deprecated. use minPts = 3 instead .

yearly_data$lof_scores <- lof_scores

# Set a threshold to identify outliers using the 95th percentile of LOF scores
threshold <- quantile(lof_scores, 0.95)

# Identify outliers
outliers <- yearly_data[lof_scores > threshold,]

# Extract unitids of the outliers
anomaly_ids <- outliers$unitid

library(ggplot2)

ggplot(yearly_data, aes(x = change_2019_2020, y = change_2020_2021)) +
  geom_point(aes(color = lof_scores)) + 
  scale_color_gradientn(colors = rainbow(5)) +
  geom_text(data = subset(yearly_data, unitid %in% anomaly_ids), aes(label = unitid), vjust = -1) +
  labs(title = "Anomalies in Year-over-Year Credit Hour Changes", x = "Change 2019-2020", y = "Change 2020-2021", color = "LOF Score")

library(ggplot2)

# Visulization of LOF Scores
ggplot(data.frame(lof_scores), aes(x = lof_scores)) +
  geom_histogram(bins = 30, fill = "skyblue", color = "black") +
  labs(title = "Distribution of LOF Scores", x = "LOF Score", y = "Frequency")

## Warning: Removed 5 rows containing non-finite outside the scale range
## (`stat_bin()`).

# Print anomaly IDs
print(anomaly_ids)

## [1] 138600 139348 139746 139755 141325 141361 442435 486840

outlier_ids_lof <- outliers$unitid

library(solitude)
library(dplyr)

# Isolation Forest model
iso_forest <- isolationForest$new(sample_size = nrow(yearly_data), num_trees = 100, seed = 42)
iso_forest$fit(yearly_data[, c("change_2019_2020", "change_2020_2021")])

## INFO  [21:11:58.691] dataset has duplicated rows
## INFO  [21:11:58.707] Building Isolation Forest ...
## INFO  [21:11:59.120] done
## INFO  [21:11:59.120] Computing depth of terminal nodes ...
## INFO  [21:11:59.278] done
## INFO  [21:11:59.283] Completed growing isolation forest

scores <- iso_forest$predict(yearly_data[, c("change_2019_2020", "change_2020_2021")])

# Add anomaly scores to dataset
yearly_data$anomaly_score <- scores$anomaly_score

# Identifying outliers 
threshold <- quantile(yearly_data$anomaly_score, 0.95) # For example, top 5% highest anomaly scores
outliers <- yearly_data %>% filter(anomaly_score >= threshold)
outlier_ids_iforest <- outliers$unitid

# outlier IDs
print(outlier_ids_iforest)

## [1] 139755 140951 141264 244437 458919 475121 485111 486840

common_outliers <- Reduce(intersect, list(outlier_ids_iforest, outlier_ids_lof))

# Print common outliers
print(common_outliers)

## [1] 139755 486840

## Anomalies detected by both models are likely to be genuine outliers with distinct characteristics from both global and local perspectives. This dual detection can be particularly useful for further investigation or for taking preemptive actions, as it may indicate a data point that is significantly different from the rest of the dataset.

Yearly Trends

A comparative analysis between the identified institutions and the general dataset revealed that while most institutions faced fluctuating enrollment and credit hours, the two outliers demonstrated distinct trends contrary to the overall patterns.

# Load datasets
data <- read_csv("/Users/Chris_Hu/Desktop/drive-download-20240406T014856Z-001/EducationDataPortal_04.03.2024_level_of_study.csv")

## Warning: One or more parsing issues, call `problems()` on your data frame for details,
## e.g.:
##   dat <- vroom(...)
##   problems(dat)

## Rows: 1269 Columns: 11
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): inst_name, state_abbr, level_of_study, acttype
## dbl (7): year, unitid, credit_hours, contact_hours, est_fte, rep_fte, enroll...
## 
## ℹ 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.

# Filter for years of interest
filtered_data <- data %>% 
  filter(year %in% c(2019, 2020, 2021))

aggregated_data <- filtered_data %>%
  group_by(unitid, year) %>%
  summarise(total_credit_hours = sum(credit_hours, na.rm = TRUE), .groups = 'drop')

# Overall trend of credit hours over years
ggplot(aggregated_data, aes(x = year, y = total_credit_hours)) +
  geom_line(stat = "summary", fun = "mean") +
  labs(title = "Average Credit Hours Trend (2019-2021)", x = "Year", y = "Average Credit Hours")

aggregated_data <- filtered_data %>%
  group_by(unitid, year) %>%
  summarise(total_enrollment_hours = sum(rep_fte, na.rm = TRUE), .groups = 'drop')

# Overall trend of credit hours over years
ggplot(aggregated_data, aes(x = year, y = total_enrollment_hours)) +
  geom_line(stat = "summary", fun = "mean") +
  labs(title = "Average Credit Hours Trend (2019-2021)", x = "Year", y = "Average Credit Hours")

anomalies’ trend in Credit hour and Enrollment

# Load necessary libraries
library(ggplot2)
library(dplyr)
library(readr)

# Filter for the specific unitids
filtered_data <- data %>% filter(unitid %in% c(139755, 486840))

# Plot for Credit Hours Trend
ggplot(filtered_data, aes(x = year, y = credit_hours, group = factor(unitid))) +
  geom_line(aes(color = factor(unitid))) +
  geom_smooth(method = "lm", aes(color = factor(unitid)), se = FALSE) +
  labs(title = "Trend of Credit Hours", x = "Year", y = "Credit Hours", color = "Institution ID") +
  theme_minimal()

## `geom_smooth()` using formula = 'y ~ x'

## Warning: Removed 6 rows containing non-finite outside the scale range
## (`stat_smooth()`).

## Warning: Removed 2 rows containing missing values or values outside the scale range
## (`geom_line()`).

# Plot for Enrollments Trend
ggplot(filtered_data, aes(x = year, y = rep_fte, group = factor(unitid))) +
  geom_line(aes(color = factor(unitid))) +
  geom_smooth(method = "lm", aes(color = factor(unitid)), se = FALSE) +
  labs(title = "Trend of Enrollments", x = "Year", y = "Fall Enrollments", color = "Institution ID") +
  theme_minimal()

## `geom_smooth()` using formula = 'y ~ x'

## Warning: Removed 6 rows containing non-finite outside the scale range (`stat_smooth()`).
## Removed 2 rows containing missing values or values outside the scale range
## (`geom_line()`).

Institutional Characteristics

Subsequent analysis focused on characteristics such as institution control, degree-granting status, and Title IV participation, filtered for the most recent year (2022) to maintain relevance and accuracy.

data <- read_csv("/Users/Chris_Hu/Desktop/drive-download-20240406T014856Z-001/EducationDataPortal_04.03.2024_College.csv")

## Rows: 582 Columns: 70
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (51): inst_name, state_abbr, inst_control, institution_level, inst_statu...
## dbl (19): year, unitid, student_faculty_ratio, geo_longitude, geo_latitude, ...
## 
## ℹ 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.

data_2022 <- data[data$year == 2022,]

# Plot for Institution Control
library(ggplot2)

ggplot(data_2022, aes(x = inst_control)) +
  geom_bar(aes(fill = inst_control), show.legend = FALSE) +
  labs(title = "Institution Control (2022)", x = "Control Type", y = "Count") +
  theme_minimal()

# Plot for Degree Granting
ggplot(data_2022, aes(x = degree_granting)) +
  geom_bar(aes(fill = degree_granting), show.legend = FALSE) +
  labs(title = "Degree Granting Status (2022)", x = "Degree Granting", y = "Count") +
  theme_minimal()

data_2022$title_iv_simplified <- ifelse(grepl("Participates", data_2022$title_iv_indicator), "Participates", "Does Not Participate")

# Plot for Title IV Participation
ggplot(data_2022, aes(x = title_iv_simplified)) +
  geom_bar(aes(fill = title_iv_simplified), show.legend = FALSE) +
  labs(title = "Title IV Participation (2022)", x = "Title IV Participation", y = "Count") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1), # Adjusting the x-axis labels for better readability
        plot.title = element_text(size = 14), # Making the title larger
        axis.title = element_text(size = 12)) # Making axis titles larger

Characteristics of the Two Institutions of Interest:

Institution Control: Both institutions are public, which is notable given that the most common category across all institutions is ‘Private for-profit’. Degree Granting: Both institutions grant degrees, aligning with the majority of the dataset. Title IV Participation: Both institutions participate in Title IV federal financial aid programs, which is consistent with the general trend.

Comparative Insight

The comparison revealed that while the anomalous institutions align with the majority in degree-granting and Title IV participation, their public control status sets them apart. This distinction suggests that the anomalies in credit hours and enrollments might be influenced by factors unique to public institutions, such as state funding changes, policy shifts, or demographic trends.

Insight

The anomaly detection analysis utilizing LOF and iForest models successfully identified two institutions with atypical trends in credit hours. Despite thorough examination, institutional characteristics provided in the dataset did not directly explain the anomalies. Future investigations could benefit from incorporating additional data points, such as program offerings, online vs. in-person enrollment options, and external economic or policy changes, to further elucidate the underlying causes of these anomalies.

Implications

For Policy and Decision Makers: Resource Allocation: Insights from further analysis can guide more strategic allocation of resources towards programs or initiatives demonstrating growth or strategic importance.

For Future Research: The identification of data gaps and the proposal for additional analyses pave the way for comprehensive future research endeavors. Researchers are encouraged to explore program-specific data, student demographics and behaviors, financial factors, external influences, and qualitative insights to build a more nuanced understanding of credit hour and enrollment trends and their implications.

For Institutional Strategy: Online Education: Institutions might consider strategies for enhancing their online education offerings in response to changing preferences and external challenges such as public health crises. Student Support Services: Understanding the factors behind enrollment trends can inform the development of targeted support services, improving retention and success rates among diverse student populations.

Recommendations for Action: Data Collection and Analysis: Institutions should invest in robust data collection and analysis capabilities to monitor trends, uncover anomalies, and inform decision-making.