Analysis of University Enrollment

Project Proposal

The primary goal of this project was to identify prospective students who will most likely enroll as freshman in the upcoming school year for a mid-size university that enrolls 2400 to 2800 new freshman each year.

The dataset was built over a period of several months in consultation with Enrollment Management. The data contained many missing values that were dealt with in a few different ways depending on the variable. In total, it consisted of 106767 missing values across 56237 observations.

The results of this analysis can be used in the future to determine probabilities of enrollment for a given student.

Required Packages

install.packages("randomForest")

trying URL 'https://cran.rstudio.com/bin/windows/contrib/3.4/randomForest_4.6-14.zip'
Content type 'application/zip' length 180935 bytes (176 KB)
downloaded 176 KB

package ‘randomForest’ successfully unpacked and MD5 sums checked

The downloaded binary packages are in
    C:\Users\morga\AppData\Local\Temp\Rtmpgd5hdy\downloaded_packages

library(tidyverse)
library(lubridate)
library(dummy)
library(rpart)
library(randomForest)

package <U+393C><U+3E31>randomForest<U+393C><U+3E32> was built under R version 3.4.4

library(plyr)
library(dplyr)
library(caret)
library(survival)
library(splines)
library(parallel)

Data Import

setwd("C:/Users/morga/OneDrive/Documents/Predictive Analytics & Data Mining - BAN 6025")

school_data <- read_csv("inq05_samp.csv")
#school_data_dict <- read_csv("inq05_data_dict.csv")

Data Cleaning

Dropping Variables

I chose to drop some variables present in my dataset. These included ACADEMIC_INTEREST_1, ACADEMIC_INTEREST_2, IRSCHOOL, and LEVEL_YEAR. I dropped the first of those three because they were replaced by INT1RAT, INT2RAT, and hscrat respectively. This controls for population at each of these levels. I dropped LEVEL_YEAR because this variable only consists of one level since we are considering only one year’s worth of applicants. I also dropped the variables ETHN_CODE and sex since ethnicity and sex cannot be used by universities during admissions decisions.

dropped_vars <- c("ACADEMIC_INTEREST_1", "ACADEMIC_INTEREST_2", "IRSCHOOL", 
                  "ETHN_CODE", "sex", "LEVEL_YEAR")
full_set <- school_data %>%
   select(-one_of(dropped_vars))

For mailq, telecq, and interest, I operated under the assumption that they should not be treated as purely numeric but rather as categorical. For instance, the difference between a 2 and a 3 when rating interest in the school is not the same as the difference between a 4 and a 5 Therefore I ran a chi-square test on each of the variables and considered their p-values. Since each of the chi-square tests showed statistical significance across groups, I chose to convert each of the three variables to factors.

ordered_factor_vars <- c("mailq", "telecq", "interest")
for (i in ordered_factor_vars){
  full_set[[i]] <- factor(full_set[[i]])
  print(chisq.test(table(full_set[[i]], full_set$Enroll)))
}

    Pearson's Chi-squared test

data:  table(full_set[[i]], full_set$Enroll)
X-squared = 693.63, df = 4, p-value < 2.2e-16


    Pearson's Chi-squared test

data:  table(full_set[[i]], full_set$Enroll)
X-squared = 1965.6, df = 3, p-value < 2.2e-16


    Pearson's Chi-squared test

data:  table(full_set[[i]], full_set$Enroll)
X-squared = 2963.2, df = 3, p-value < 2.2e-16

I converted the time variable CONTACT_DATE1 to a proper time format using the lubridate package as such:

full_set$CONTACT_DATE1 <- dmy(full_set$CONTACT_DATE1)

I chose to drop the CONTACT_CODE1 variable due to its high number of categories and low proportion of students across each category.

full_set <- full_set %>%
  select(-CONTACT_CODE1)

I converted the indicator variable for Enroll from being “Y” and “N” to a 1 and 0 respectively.

full_set$Instate[full_set$Instate == "Y"] <- 1
full_set$Instate[full_set$Instate == "N"] <- 0
full_set$Instate <- as.numeric(full_set$Instate)

For RECR_CODE, I used my best judgment and chose to convert values of 000, N, and A to be NA. There were 3815 such values.

full_set$RECR_CODE[full_set$RECR_CODE %in% c("000", "N", "A")] <- NA

This left 3816 NA values for the RECR_CODE variable. Under the assumption that these were not missing at random, I chose to generate bins for each possible value of RECR_CODE, with NA values having their own respective bin. I ran a chisquare test across the different values of RECR_CODE to see if I was justified in doing this.

chisq.test(table(full_set$RECR_CODE, full_set$Enroll))

    Pearson's Chi-squared test

data:  table(full_set$RECR_CODE, full_set$Enroll)
X-squared = 394.06, df = 7, p-value < 2.2e-16

The low p-value led me to feel reassured in doing so. Although the values for RECR_CODE extend up to 8, I chose to treat each value as having a separate category in order to maintain the rows containing NA observations in my dataset for my later model implementations.

full_set$RECR_CODE[is.na(full_set$RECR_CODE)] <- "missing"
full_set$RECR_CODE <- factor(full_set$RECR_CODE)

Note that I imputed these values to “missing” rather than purely NA. I did this so that these values might receive their own factor level when I generate dummy variables for each category later in the analysis.

NA Values

SAT Score

There were 38786 missing SAT score values in the dataset. Since these were likely not missing at random (those who choose not to disclose their SAT scores likely scored poorly), I decided to bin the SAT scores by proportionality, with NA values receiving their own bin. I binned based on the quintiles of the observed SAT scores, thus generating 5 bins for the actually reported SAT scores and one additional bin for the NA values. I chose the value of 5 bins arbitrarily.

sat_splits <- c(0, quantile(full_set$satscore, c(.2, .4, .6, .8), 
                       na.rm = TRUE), Inf)
full_set <- cbind(full_set,  sat_group = cut(full_set$satscore,
                                         breaks = sat_splits))
levels(full_set$sat_group) <- c(levels(full_set$sat_group), "missing")
full_set$sat_group[is.na(full_set$sat_group)] <- "missing"
## Removing initial satscore variable
full_set <- full_set %>%
  select(-satscore)

Telecq

There were 43190 missing telephone interest scores in the dataset. Since these were likely not missing at random (somebody who hangs up the phone is more likely to not be interested than interested in enrollment), I chose to provide a separate bin for those observations with missing telecq values.

levels(full_set$telecq) <- c("Missing", levels(full_set$telecq))
full_set$telecq[is.na(full_set$telecq)] <- "Missing"
full_set$telecq <- factor(full_set$telecq)

Average Income

There were 12801 missing income values in the dataset. I assumed that these were missing at random and that average income did not have an immediate impact on enrollment at the university. I therefore imputed the mean for these values.

avg_avg_income <- mean(full_set$avg_income, na.rm = TRUE)
full_set$avg_income[is.na(full_set$avg_income)] <- avg_avg_income

Distance

There were 11905 missing distance values in the dataset. I operated under the assumption that these were missing because the school might not know exact distance to a given prospective student’s hometown. I therefore chose to put bin the distance values similarly to how I binned SAT scores, binning by quintiles, with NA values getting a separate bin.

distance_splits <- c(0, quantile(full_set$distance, c(0.2, 0.4, 0.6, 0.8), 
                            na.rm = TRUE), Inf)
full_set <- cbind(full_set, distance_group = cut(full_set$distance, 
                                     breaks = distance_splits))
levels(full_set$distance_group) <- c(levels(full_set$distance_group), "missing")
full_set$distance_group[is.na(full_set$distance_group)] <- "missing"
## Removing initial distance variable
full_set <- full_set %>%
  select(-distance)

These imputations and binnings left 0 NA observations remaining in the dataset.

Dummy Variable Generation

I used the dummy package to generate dummy variables for each of my subsequent factor variables. This gave each level within a factor its own dummy variable. For example, SAT scores, since they are comprised of 6 bins, are now split across 6 dummy variables.

full_set <- cbind(full_set, dummy(full_set))
## Dropping initial factor variables used to generate the dummies
full_set <- full_set %>%
  select(-c(mailq, telecq, interest, sat_group, distance_group, RECR_CODE))

Splitting into Training and Validation

Note that for the potential students in the dataset, only 5% actually enrolled. Since I am focusing my analysis on discovering which factors seeem to be influencing students’ decisions to enroll in the university, I chose to weight the model so that it errs to Type I errors rather than Type II. I would prefer to predict that a student enrolled who actually didn’t rather than not predict a student to enroll who actually went on to enroll. To increase the relative proportion of enrollment within my dataset, I chose to subset the data so that I am taking all observations in the enrolled category, and a smaller proportion of the observations in the not enrolled category.

I then split this subsetted data into 70% training and 30% validation sets.

enrolled_set <- full_set %>%
  filter(Enroll == 1)
non_enrolled_set <- full_set %>%
  filter(Enroll == 0)
# Only selecting 20% of values among those who didn't enroll so that the split 
# of enrolled:not enrolled is approximately 20:80
set.seed(123)
sample_non_enrolled_set <- sample(c(TRUE, FALSE), nrow(non_enrolled_set),
                                  replace = T, prob = c(0.15, 0.85))
included_non_enrolled <- non_enrolled_set[sample_non_enrolled_set, ]
not_included_non_enrolled <- non_enrolled_set[!sample_non_enrolled_set, ]
balanced_full_set <- rbind(enrolled_set, included_non_enrolled)
## creating training-validation sets; in future, want to explore bootstrap
## methodologies, k-fold techniques, and Leave-one-out cross-validation
## THESE WILL NOT BE USED UNTIL MODEL BUILDING
sample <- sample(c(TRUE, FALSE), nrow(balanced_full_set),
                 replace = T, prob = c(0.7, 0.3))
train <- balanced_full_set[sample, ]
validation <- balanced_full_set[!sample, ]

Models

The variable of interest is the binary enrollment variable. Given that this is a classification problem, I implemented multiple logistic regression, decision tree, random forest, and boosting models.

Multiple Logistic Regression

I generated null and full models so that I could implement a stepwise selection methodology to ultimately pick my final logistic model. When implementing the full model, I left out the variable mailq_4 since there were only 0’s present among my training dataset for that variable. I also left out TOTAL_CONTACTS since it is linearly dependent with the other contacts variables. Given that I have a dummy variable for each possible value of satscore and distance, I left out one indicator for each respectively, again to prevent perfect linear dependencies among my x variables.

# Null model
logit_null <- glm(Enroll ~ 1, data = train, family = binomial(link = "logit"))
# Full model
logit_full <- glm(Enroll ~ CONTACT_DATE1 + SELF_INIT_CNTCTS 
                  + TRAVEL_INIT_CNTCTS + SOLICITED_CNTCTS + REFERRAL_CNTCTS 
                  + CAMPUS_VISIT + premiere + stuemail + init_span + int1rat 
                  + int2rat + hscrat + avg_income + Instate + RECR_CODE_2 
                  + RECR_CODE_3 + RECR_CODE_4 + RECR_CODE_5 
                  + RECR_CODE_6 + RECR_CODE_7 + RECR_CODE_8 + RECR_CODE_missing 
                  + mailq_2 + mailq_3  + mailq_5 
                  + telecq_Missing + telecq_2 + telecq_3 + interest_0 
                  + interest_2 + interest_3 + sat_group_.920.1.04e.03.
                  + sat_group_.1.04e.03.1.14e.03. 
                  + sat_group_.1.14e.03.1.24e.03. + sat_group_.1.24e.03.Inf.  
                  + sat_group_missing + distance_group_.0.101. 
                  + distance_group_.160.290. 
                  + distance_group_.290.620. + distance_group_.620.Inf. 
                  + distance_group_missing, data = train, 
                  family = binomial(link = "logit"))
step(logit_null, scope = list(upper = logit_full),
     direction = "both", test = "Chisq", data = train)
logit_final <- glm(formula = Enroll ~ SELF_INIT_CNTCTS + hscrat + 
                     sat_group_missing + stuemail + premiere + telecq_3 + 
                     int2rat + CAMPUS_VISIT + init_span + 
                     sat_group_.1.14e.03.1.24e.03. + 
                     sat_group_.1.04e.03.1.14e.03. + RECR_CODE_5 + mailq_5 + 
                     TRAVEL_INIT_CNTCTS + int1rat + sat_group_.1.24e.03.Inf. + 
                     sat_group_.920.1.04e.03. + telecq_Missing + RECR_CODE_2 + 
                     interest_0 + distance_group_missing + REFERRAL_CNTCTS + 
                     Instate + avg_income + telecq_2, 
                   family = binomial(link = "logit"),
                   data = train)
test_predicted_logit_final <- predict(logit_final, newdata = validation,
                                      type = "response")
logit_conf_matrix <- table(validation$Enroll, 
                           test_predicted_logit_final > 0.5) %>%
  prop.table()
rownames(logit_conf_matrix) <- c("Didn't Enroll", "Enrolled")
colnames(logit_conf_matrix) <- c("Predicted Non-enrollment", 
                                  "Predicted Enrollment")

Decision Tree

tree_fit <- rpart(Enroll ~ ., data = train, method = "class")
test_predicted_tree <- predict(tree_fit, validation, type = "class")
tree_conf_matrix <- table(validation$Enroll, test_predicted_tree) %>%
  prop.table()
rownames(tree_conf_matrix) <- c("Didn't Enroll", "Enrolled")
colnames(tree_conf_matrix) <- c("Predicted Non-enrollment", 
                                  "Predicted Enrollment")

Random Forest

I had to first convert the target variable Enroll to a factor so that the randomForest() function would know to implement CART when generating the decision trees.

train$Enroll <- as.factor(train$Enroll)
forest_fit <- randomForest(Enroll ~ ., data = train, ntree = 500)
test_predicted_forest <- predict(forest_fit, validation, type = "class")
forest_conf_matrix <- table(validation$Enroll, test_predicted_forest) %>% 
  prop.table()
rownames(forest_conf_matrix) <- c("Didn't Enroll", "Enrolled")
colnames(forest_conf_matrix) <- c("Predicted Non-enrollment", 
                                  "Predicted Enrollment")

Gradient Boosting

fit_control <- trainControl(method = "cv", number = 10)
tune_grid <- expand.grid(interaction.depth = 2, n.trees = 500, shrinkage = 0.1,
                         n.minobsinnode = 10)                            
boost_fit <- train(Enroll ~ ., data = train, method = "gbm", 
                   trControl = fit_control, verbose = FALSE, 
                   tuneGrid = tune_grid)

1 package is needed for this model and is not installed. (gbm). Would you like to try to install it now?
1: yes
2: no

My logistic regression had a misclassification rate of 6.7%. My decision tree had a misclassification rate of 6.8%. My random forest had a misclassification rate of 5.75%. And lastly, my gradient boosting model had a misclassification rate of 5.78%.

More interesting from the models is actually the percentage of students who enrolled that the model actually predicted correctly, since this goal is more in line with that of the project. The logistic regression correctly identified 91.67% of the students who enrolled. The decision tree correctly identified 98.32% of the students who enrolled. The random forest correctly identified 94.05% of the students who enrolled. And lastly, my gradient boosing model correctly identified 93.15% of students who enrolled.

Executive Summary

The results of my analysis show that a simple decision tree does the best job modeling whether or not a student will enroll. Overall it correctly classified 92.2% percent of all potential students as to whether or not they enrolled. More importantly, it predicted 98% percent of the students who actually enrolled correctly.

Given that the purpose of this analysis was to most accurately identify those students who would enroll in the school, I subsetted the data so that I was taking all students who ultimately enrolled, but only a proportion of the students who did not enroll. On this subset, decision tree performed the best. This seems odd from a statistical perspective, but given that the random forest and the boosting model were tasked with lowering the overall misclassification rate (which they successfully did), they actually lost predictive power when selecting the students who were going to enroll in exchange for more accurately correctly identifying students who were not going to enroll.

Therefore my final model is the decision tree.

The foremost variable in determining whether or not a student would enroll was the number of self-initiated contacts. If the student reached out to 3 or more people, then that was the greatest indicator that that student would enroll. Of those who did not reach out to 3 or more people, if they also did not provide their SAT scores, then they did not enroll in the fall. This is true for all 3923 such potential students.

Of those who self-initiated contact with three or more people, the next greatest differentiator was their high school’s historical enrollment rate. If the high school typically sent less than 1.2% of its students to the university, then that student was much less likely to enroll in the school.

The least effective node in the model was the one where students did not self initiate three or more contacts, were not missing their sat scores, had a student email, and whose high schools sent more than 3.9% to the university. For those falling into this category, our model only accurately assessed 191/(116 + 191) of these students correctly.

The node where we identified the most students to not enroll who actually ended up enrolling was the node consisting of students who self-initiated 3 or more contacts and whose high schools sent fewer than 1.2% of its students to the university. There were ten students falling into this category who ultimately enrolled that were classified as not enrolling.

This model will enable the university to more accurately assess the factors that ultimately drive students to enroll. The number of self-initiated contacts, whether the student had submitted the SAT, whether the student had an email, and the rate of enrollment from each student’s high school all played important rolls in whether or not a student ultimately enrolled.

From a business perspective, the university likely wants to know which students are on the fringes of enrollment. The university can then divy out remaining scholarship funds accordingly in order to encourage certain students on the edge to enroll. Based on this analysis, the school knows to target scholarship funds to those who chose not to submit their sat scores, who have emails, and whose high schools typically don’t send many students to the university.

If the university wants to improve its global footprint, then it should target the same group of students with more advertising and events in their respective geographic areas, thereby increasing the number of students enrolling from different areas of the country and likely boosting public perception of the university.

Perhaps most surprising from the analysis is that whether or not a student is in-state did not have a major impact on whether or not they would enroll in the university. This likely indicates that the school in question does not provide in-state tuition and is therefore probably a small liberal arts school.