In a recent research presentation, I looked at predicting and understanding student success as a function of higher education transfer paths. Specifically, I looked at how moving between colleges and majors corresponds to graduation. One big challenge in this work is transforming raw data into useful as well as substantively meaningful variables. For these predictive models, the base set of variables are very purposefully defined.
We specifically examine the colleges students transfer from and to, as well as the majors or degree plans involved. To build the model, we must generate variables that represent combinations of these factors. For example, we might look at paths defined like "sending college 1 × sending major 1" or "sending major 1 × receiving major 1."
However with many categories across our four original categorical variables, their combinations become very high-dimensional. As such filtering based on numbers of students corresponding to each transfer path combination or based on variable correlations prevents the number of generated variables from quickly becoming computationally overwhelming.
Below is R code containing several utility functions. They take one or two categorical variables and transform them into a single set of indicator variables; they create 2- and 4-way interaction indicator variables from arrays of indicator variables; and they filter variables based on correlations. The functions are very helpful for generating a set of interaction and combination variables necessary for this type of transfer path research. Each function is heavily commented to make them useful and understandable for somebody interested in conducting similar research.
Below is R code containing several utility functions. They take one or two categorical variables and transform them into a single set of indicator variables; they create 2- and 4-way interaction indicator variables from arrays of indicator variables; and they filter variables based on correlations. The functions are very helpful for generating a set of interaction and combination variables necessary for this type of transfer path research. Each function is heavily commented to make them useful and understandable for somebody interested in conducting similar research.
# ==============================================================================
# UTILITY FUNCTIONS FOR TRANSFER PATH RESEARCH DATA PREPROCESSING & FEATURE ENGINEERING
# ==============================================================================
# This file contains helper functions designed for working with large datasets
# (using the 'data.table' package).
#
# Key Capabilities:
# 1. Converting categorical text variables spanning multiple columns into binary "dummy" variables.
# 2. Creating (2-way & 4-way) interaction features from sparse numeric data (e.g., co-occurrence).
# 3. Removing highly correlated features to prevent predictor multicollinearity.
#
# Prerequisites:
# Ensure the 'data.table' package is installed and loaded before running these.
library(data.table)
# ------------------------------------------------------------------------------
# Function: create_multi_cat_dummies
# ------------------------------------------------------------------------------
# Purpose:
# Converts one or two categorical columns into a set of dichotomous variable (0/1) columns.
#
# Why use this?
# Turns categories like "Humanities", "STEM", "Social Sciences" listed across up to 2 columns
# into separate columns for each category where 1 means "Yes", and 0 means "No".
#
# Arguments:
# dt : Your data (can be a data.frame or data.table).
# col1 : Name of the first categorical column to encode.
# col2 : (Optional) Name of a second column to merge with col1.
# Useful if you have related categories split across two fields.
# prefix : (Optional) Custom prefix for the new column names.
# Defaults to the column name(s).
# thresh : (Optional) Minimum number of occurrences required to keep a category.
# Helps remove rare "noise" categories (e.g., ignore categories appearing < 5 times).
# remove_original : (Optional) If TRUE, deletes the original text columns after encoding.
# verbose : (Optional) If TRUE, prints progress messages.
#
# Returns:
# A data.table with the original columns (unless removed) plus new binary columns.
create_multi_cat_dummies <- function(
dt,
col1,
col2 = NULL,
prefix = NULL,
thresh = NULL,
remove_original = FALSE,
verbose = TRUE
) {
# Convert input to data.table for fast operations
dt <- as.data.table(dt)
# Extract the first column and treat empty strings as missing values (NA)
v1 <- dt[[col1]]
v1[v1 == ""] <- NA
# Handle optional second column
if (!is.null(col2)) {
v2 <- dt[[col2]]
v2[v2 == ""] <- NA
# Combine both vectors to find unique categories across both columns
combined <- c(v1, v2)
} else {
v2 <- NULL
combined <- v1
}
# Get unique categories, remove NAs, and sort alphabetically for consistency
cats <- unique(combined)
cats <- cats[!is.na(cats)]
cats <- sort(cats)
# Safety check: if no valid data exists, warn and return original data
if (length(cats) == 0) {
warning("No valid categories found.")
return(dt)
}
# Determine the prefix for new column names (e.g., "AA_Major_")
if (is.null(prefix)) {
prefix <- if (!is.null(col2)) {
paste0(col1, "_", col2)
} else {
col1
}
}
if (verbose) {
message(sprintf("Creating %d dummy columns", length(cats)))
}
created_cols <- character(0)
# Loop through every unique category to create a binary column
for (cat in cats) {
# Create a logical vector: TRUE if the row matches the category
if (is.null(v2)) {
indicator <- (!is.na(v1) & v1 == cat)
} else {
# If using two columns, match if EITHER column has the category
indicator <- (!is.na(v1) & v1 == cat) |
(!is.na(v2) & v2 == cat)
}
# Optional: Skip categories that appear too rarely (below threshold)
if (!is.null(thresh)) {
if (sum(indicator) < thresh) next
}
# Construct the new column name (e.g., "AA_Major_STEM")
cname <- paste(prefix, cat, sep = "_")
# Add the new column to the table (1 for match, 0 for no match)
dt[, (cname) := as.integer(indicator)]
created_cols <- c(created_cols, cname)
}
# Reorder columns: Put the new dummy columns at the very end for clarity
if (length(created_cols) > 0) {
setcolorder(dt, c(setdiff(names(dt), created_cols), created_cols))
}
# Optionally delete the original text columns to save space
if (remove_original) {
if (is.null(col2)) {
dt[, (col1) := NULL]
} else {
dt[, c(col1, col2) := NULL]
}
}
return(dt)
}
# ------------------------------------------------------------------------------
# Function: create_sparse_two_way_indicators
# ------------------------------------------------------------------------------
# Purpose:
# Creates interaction features (AND logic) between two sets of numeric columns.
# Specifically designed for "sparse" data (matrices with many zeros).
#
# Why use this?
# These variables indicate specific path characteristics like:
# Student transferred from Community College 1 to Major Category 1.
# This function efficiently finds
# pairs that co-occur frequently enough to be meaningful.
#
# Arguments:
# dt : Your data (data.table or data.frame).
# v1.1_colnums : Vector of column indices (numbers) for the first group.
# v2.1_colnums : Vector of column indices (numbers) for the second group.
# thresh : Minimum count of non-zero co-occurrences required to keep the feature.
# (Filters out rare combinations).
# verbose : Prints progress messages.
#
# Returns:
# A data.frame with new columns named "ColA_ColB" where 1 means both were non-zero.
create_sparse_two_way_indicators <- function(
dt,
v1.1_colnums,
v2.1_colnums,
thresh = 15,
verbose = TRUE
) {
dt <- as.data.table(dt)
# Step 1: Pruning (Speed Optimization)
# Count how many non-zero values exist in every column.
# If a column has fewer non-zeros than 'thresh', it can't possibly form a valid pair.
nz_counts <- dt[, lapply(.SD, function(x) sum(x != 0, na.rm = TRUE))]
nz_counts <- as.numeric(nz_counts)
# Filter the input column lists to only include "active" columns
valid_cols <- which(nz_counts >= thresh)
v1.1_colnums <- intersect(v1.1_colnums, valid_cols)
v2.1_colnums <- intersect(v2.1_colnums, valid_cols)
if (verbose) {
message(sprintf("Candidate columns after pruning: %d", length(valid_cols)))
}
# Step 2: Nested Loop to find pairs
for (i in v1.1_colnums) {
xi <- dt[[i]]
xi_nz <- xi != 0 # Logical vector: TRUE where non-zero
for (j in v2.1_colnums) {
xj <- dt[[j]]
# Quick check: Do these two columns ever overlap in non-zero values?
nz_ij <- xi_nz & (xj != 0)
if (sum(nz_ij) < thresh) next # Skip if overlap is too small
# Create the interaction: 1 if BOTH are non-zero, 0 otherwise
new_col <- as.integer(nz_ij)
# Name the new column: "OriginalName1_OriginalName2"
cname <- paste(
names(dt)[i],
names(dt)[j],
sep = "_"
)
# Add to table
dt[, (cname) := new_col]
if (verbose) {
message("Added: ", cname)
}
}
}
# Clean up memory
invisible(gc())
return(as.data.frame(dt))
}
# ------------------------------------------------------------------------------
# Function: create_sparse_four_way_indicators
# ------------------------------------------------------------------------------
# Purpose:
# Similar to the two-way function, but creates interactions between FOUR groups of columns.
# Finds rows where ONE column from Group A, ONE from Group B, ONE from Group C,
# and ONE from Group D are ALL non-zero simultaneously.
#
# Why use this?
# For models predicting based on very specific higher education
# student transfer paths such as:
# Transfer from Community College 1 with Associate Major 1 to
# Bachelor's College 1 with Bachelor's Major 1
#
# Arguments:
# dt : Your data.
# v1.1_colnums : Column indices for Group 1.
# v1.2_colnums : Column indices for Group 2.
# v2.1_colnums : Column indices for Group 3.
# v2.2_colnums : Column indices for Group 4.
# thresh : Minimum co-occurrence count to keep the feature.
# verbose : Prints progress.
#
# Returns:
# A data.frame with new 4-way interaction columns.
create_sparse_four_way_indicators <- function(
dt,
v1.1_colnums, v1.2_colnums,
v2.1_colnums, v2.2_colnums,
thresh = 15,
verbose = TRUE
) {
dt <- as.data.table(dt)
# Step 1: Pruning (Optimization)
# Calculate non-zero counts for all columns to skip useless ones early
nz_counts <- dt[, lapply(.SD, function(x) sum(x != 0, na.rm = TRUE))]
nz_counts <- as.numeric(nz_counts)
valid_cols <- which(nz_counts >= thresh)
# Filter all four input lists against valid columns
v1.1_colnums <- intersect(v1.1_colnums, valid_cols)
v1.2_colnums <- intersect(v1.2_colnums, valid_cols)
v2.1_colnums <- intersect(v2.1_colnums, valid_cols)
v2.2_colnums <- intersect(v2.2_colnums, valid_cols)
if (verbose) {
message(sprintf("Candidate columns after pruning: %d", length(valid_cols)))
}
# Step 2: Four-level nested loop
# We progressively filter to avoid calculating unnecessary intersections
for (i in v1.1_colnums) {
xi <- dt[[i]]
nz_i <- xi != 0
for (j in v1.2_colnums) {
xj <- dt[[j]]
nz_ij <- nz_i & (xj != 0)
if (sum(nz_ij) < thresh) next # Prune early
for (k in v2.1_colnums) {
xk <- dt[[k]]
nz_ijk <- nz_ij & (xk != 0)
if (sum(nz_ijk) < thresh) next # Prune early
for (l in v2.2_colnums) {
xl <- dt[[l]]
nz_all <- nz_ijk & (xl != 0)
# Final check: Does this 4-way combo happen often enough?
if (sum(nz_all) < thresh) next
# Create the indicator
new_col <- as.integer(nz_all)
cname <- paste(
names(dt)[i],
names(dt)[j],
names(dt)[k],
names(dt)[l],
sep = "_"
)
dt[, (cname) := new_col]
if (verbose) {
message("Added: ", cname)
}
}
}
}
}
invisible(gc())
return(as.data.frame(dt))
}
# ------------------------------------------------------------------------------
# Function: filter_high_corr
# ------------------------------------------------------------------------------
# Purpose:
# Removes redundant features by dropping columns that are highly correlated
# with another column.
# Ordering matters, the first listed variable of correlated variables is retained
#
# Why use this?
# If Feature A and Feature B are 95% correlated, they provide almost the same
# information. Keeping both can confuse statistical or machine learning models (multicollinearity).
# This function keeps A and drops B
#
# Arguments:
# df : Your data (data.frame or data.table).
# thresh : Correlation threshold (0 to 1). Columns with |corr| > thresh are flagged.
# Default is 0.85 (85%).
# use : How to handle missing values in correlation calculation.
# Options: "everything", "complete.obs", "pairwise.complete.obs".
# verbose : Prints which columns are being dropped.
#
# Returns:
# A subset of the original data frame with redundant columns removed.
filter_high_corr <- function(
df,
thresh = 0.85,
use = "pairwise.complete.obs",
verbose = FALSE
) {
# Step 1: Isolate only numeric columns (correlation only works on numbers)
is_num <- vapply(df, is.numeric, logical(1))
df_num <- df[, is_num, drop = FALSE]
# If fewer than 2 numeric columns, nothing to correlate
if (ncol(df_num) < 2) return(df)
# Step 2: Calculate the correlation matrix
# We take the absolute value because we care about strong relationships, positive or negative
cor_mat <- abs(stats::cor(df_num, use = use))
# Initialize a "keep" vector (TRUE for all initially)
keep <- rep(TRUE, ncol(cor_mat))
col_names <- colnames(cor_mat)
# Step 3: Iterate through the matrix to find high correlations
for (i in seq_len(ncol(cor_mat))) {
# If column i was already marked for deletion, skip it
if (!keep[i]) next
# Skip the last column (no need to compare it with itself or future columns)
if (i == ncol(cor_mat)) next
for (j in (i + 1):ncol(cor_mat)) {
if (!keep[j]) next
corr_ij <- cor_mat[i, j]
# If correlation is higher than threshold, mark column j for deletion
if (!is.na(corr_ij) && corr_ij > thresh) {
keep[j] <- FALSE
if (verbose) {
message(sprintf(
"Dropping '%s' (corr = %.3f) with '%s'",
col_names[j], corr_ij, col_names[i]
))
}
}
}
}
# Step 4: Reconstruct the final dataframe
# Keep the surviving numeric columns
keep_num <- col_names[keep]
# Combine with the original non-numeric columns (which were never touched)
keep_all <- c(colnames(df)[!is_num], keep_num)
return(df[, keep_all, drop = FALSE])
}