Student Dropout
Christian Eisinger
2026-06-30
library(paws)
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, unionlibrary(ggplot2)
library(car)## Loading required package: carData##
## Attaching package: 'car'## The following object is masked from 'package:dplyr':
##
## recodelibrary(caret)## Loading required package: latticelibrary(forcats)
library(pROC)## Type 'citation("pROC")' for a citation.##
## Attaching package: 'pROC'## The following objects are masked from 'package:stats':
##
## cov, smooth, varlibrary(corrplot)## corrplot 0.95 loadedlibrary(tidymodels)## ── Attaching packages ────────────────────────────────────── tidymodels 1.5.0 ──## ✔ broom 1.0.13 ✔ rsample 1.3.2
## ✔ dials 1.4.4 ✔ tailor 0.1.0
## ✔ infer 1.1.0 ✔ tidyr 1.3.2
## ✔ modeldata 1.5.1 ✔ tune 2.1.0
## ✔ parsnip 1.6.0 ✔ workflows 1.3.0
## ✔ purrr 1.2.2 ✔ workflowsets 1.1.1
## ✔ recipes 1.3.3 ✔ yardstick 1.4.0## ── Conflicts ───────────────────────────────────────── tidymodels_conflicts() ──
## ✖ rsample::calibration() masks caret::calibration()
## ✖ purrr::discard() masks scales::discard()
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ✖ purrr::lift() masks caret::lift()
## ✖ yardstick::precision() masks caret::precision()
## ✖ yardstick::recall() masks caret::recall()
## ✖ car::recode() masks dplyr::recode()
## ✖ yardstick::sensitivity() masks caret::sensitivity()
## ✖ purrr::some() masks car::some()
## ✖ yardstick::specificity() masks caret::specificity()
## ✖ recipes::step() masks stats::step()
## ✖ parsnip::translate() masks paws::translate()library(kknn)##
## Attaching package: 'kknn'## The following object is masked from 'package:caret':
##
## contr.dummylibrary(ranger)
library(xgboost)
library(reticulate)Data from from UC-Irvine Machine Learning Repository at: https://archive.ics.uci.edu/dataset/697/predict+students+dropout+and+academic+success
s3 <- paws::s3()
s3Object <- s3$get_object(
Bucket = "wgu-ml-demo",
Key = "raw/dropout-ml-data.csv" # Red in data from AWS bucket
)
rawData <- read.csv(
text = rawToChar(s3Object$Body),
sep = ";",
stringsAsFactors = TRUE
)
rawData <- rawData %>%
mutate(across(
c(
Marital.status, Application.mode, Application.order, Course,
Daytime.evening.attendance., Previous.qualification, Nacionality,
Mother.s.qualification, Father.s.qualification, Mother.s.occupation,
Father.s.occupation, Displaced, Educational.special.needs, Debtor,
Tuition.fees.up.to.date, Gender, Scholarship.holder, International,
Target
),
as.factor
))
head(rawData)## Marital.status Application.mode Application.order Course
## 1 1 17 5 171
## 2 1 15 1 9254
## 3 1 1 5 9070
## 4 1 17 2 9773
## 5 2 39 1 8014
## 6 2 39 1 9991
## Daytime.evening.attendance. Previous.qualification
## 1 1 1
## 2 1 1
## 3 1 1
## 4 1 1
## 5 0 1
## 6 0 19
## Previous.qualification..grade. Nacionality Mother.s.qualification
## 1 122.0 1 19
## 2 160.0 1 1
## 3 122.0 1 37
## 4 122.0 1 38
## 5 100.0 1 37
## 6 133.1 1 37
## Father.s.qualification Mother.s.occupation Father.s.occupation
## 1 12 5 9
## 2 3 3 3
## 3 37 9 9
## 4 37 5 3
## 5 38 9 9
## 6 37 9 7
## Admission.grade Displaced Educational.special.needs Debtor
## 1 127.3 1 0 0
## 2 142.5 1 0 0
## 3 124.8 1 0 0
## 4 119.6 1 0 0
## 5 141.5 0 0 0
## 6 114.8 0 0 1
## Tuition.fees.up.to.date Gender Scholarship.holder Age.at.enrollment
## 1 1 1 0 20
## 2 0 1 0 19
## 3 0 1 0 19
## 4 1 0 0 20
## 5 1 0 0 45
## 6 1 1 0 50
## International Curricular.units.1st.sem..credited.
## 1 0 0
## 2 0 0
## 3 0 0
## 4 0 0
## 5 0 0
## 6 0 0
## Curricular.units.1st.sem..enrolled. Curricular.units.1st.sem..evaluations.
## 1 0 0
## 2 6 6
## 3 6 0
## 4 6 8
## 5 6 9
## 6 5 10
## Curricular.units.1st.sem..approved. Curricular.units.1st.sem..grade.
## 1 0 0.00000
## 2 6 14.00000
## 3 0 0.00000
## 4 6 13.42857
## 5 5 12.33333
## 6 5 11.85714
## Curricular.units.1st.sem..without.evaluations.
## 1 0
## 2 0
## 3 0
## 4 0
## 5 0
## 6 0
## Curricular.units.2nd.sem..credited. Curricular.units.2nd.sem..enrolled.
## 1 0 0
## 2 0 6
## 3 0 6
## 4 0 6
## 5 0 6
## 6 0 5
## Curricular.units.2nd.sem..evaluations. Curricular.units.2nd.sem..approved.
## 1 0 0
## 2 6 6
## 3 0 0
## 4 10 5
## 5 6 6
## 6 17 5
## Curricular.units.2nd.sem..grade.
## 1 0.00000
## 2 13.66667
## 3 0.00000
## 4 12.40000
## 5 13.00000
## 6 11.50000
## Curricular.units.2nd.sem..without.evaluations. Unemployment.rate
## 1 0 10.8
## 2 0 13.9
## 3 0 10.8
## 4 0 9.4
## 5 0 13.9
## 6 5 16.2
## Inflation.rate GDP Target
## 1 1.4 1.74 Dropout
## 2 -0.3 0.79 Graduate
## 3 1.4 1.74 Dropout
## 4 -0.8 -3.12 Graduate
## 5 -0.3 0.79 Graduate
## 6 0.3 -0.92 GraduateThe dataset is organized such that each row represents a single student. It documents information about the student’s demographics (sex, age), family background (parents’ education and occupation), financial status (scholarship status, tuition payment, debtor status), academic path (how they applied, degree program, prior qualifications), and actual performance across two semesters. The final column, Target, records the outcome: whether the student ultimately graduated, dropped out, or was enrolled at the time of observation. This dataset helps identify students at risk quickly (Semesters 1 and 2) rather than after a theoretical “tipping point”. Unrealistically, this dataset is flawlessly organized with 0 missing data. Real-world data would require more cleaning and/or data imputation.
table(rawData$Target)##
## Dropout Enrolled Graduate
## 1421 794 2209prop.table(table(rawData$Target)) * 100##
## Dropout Enrolled Graduate
## 32.12025 17.94756 49.93219ggplot(rawData, aes(x = Target)) +
geom_bar(fill = "#003057") +
theme_minimal() +
labs(
title = "Student Outcome Distribution",
x = "Outcome",
y = "Count"
)
modelData <- rawData |>
filter(Target != "Enrolled") |>
droplevels() # Enrolled students are not a final outcome and add noise to model
modelData$Target <- relevel(modelData$Target, ref = "Graduate") # The goal is to "flag" those at risk for drop out. For this reason, I am setting the reference as Graduate
str(modelData)## 'data.frame': 3630 obs. of 37 variables:
## $ Marital.status : Factor w/ 6 levels "1","2","3","4",..: 1 1 1 1 2 2 1 1 1 1 ...
## $ Application.mode : Factor w/ 18 levels "1","2","5","7",..: 8 6 1 8 12 12 1 9 1 1 ...
## $ Application.order : Factor w/ 7 levels "0","1","2","3",..: 6 2 6 3 2 2 2 5 4 2 ...
## $ Course : Factor w/ 17 levels "33","171","8014",..: 2 11 5 15 3 17 12 11 10 10 ...
## $ Daytime.evening.attendance. : Factor w/ 2 levels "0","1": 2 2 2 2 1 1 2 2 2 2 ...
## $ Previous.qualification : Factor w/ 17 levels "1","2","3","4",..: 1 1 1 1 1 12 1 1 1 1 ...
## $ Previous.qualification..grade. : num 122 160 122 122 100 ...
## $ Nacionality : Factor w/ 19 levels "1","2","6","11",..: 1 1 1 1 1 1 1 1 14 1 ...
## $ Mother.s.qualification : Factor w/ 29 levels "1","2","3","4",..: 13 1 22 23 22 22 13 22 1 1 ...
## $ Father.s.qualification : Factor w/ 34 levels "1","2","3","4",..: 10 3 27 27 28 27 28 27 1 14 ...
## $ Mother.s.occupation : Factor w/ 29 levels "0","1","2","3",..: 6 4 10 6 10 10 8 10 10 5 ...
## $ Father.s.occupation : Factor w/ 42 levels "0","1","2","3",..: 10 4 10 4 10 8 11 10 10 8 ...
## $ Admission.grade : num 127 142 125 120 142 ...
## $ Displaced : Factor w/ 2 levels "0","1": 2 2 2 2 1 1 2 2 1 2 ...
## $ Educational.special.needs : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
## $ Debtor : Factor w/ 2 levels "0","1": 1 1 1 1 1 2 1 1 1 2 ...
## $ Tuition.fees.up.to.date : Factor w/ 2 levels "0","1": 2 1 1 2 2 2 2 1 2 1 ...
## $ Gender : Factor w/ 2 levels "0","1": 2 2 2 1 1 2 1 2 1 1 ...
## $ Scholarship.holder : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 2 1 2 1 ...
## $ Age.at.enrollment : int 20 19 19 20 45 50 18 22 21 18 ...
## $ International : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 2 1 ...
## $ Curricular.units.1st.sem..credited. : int 0 0 0 0 0 0 0 0 0 0 ...
## $ Curricular.units.1st.sem..enrolled. : int 0 6 6 6 6 5 7 5 6 6 ...
## $ Curricular.units.1st.sem..evaluations. : int 0 6 0 8 9 10 9 5 8 9 ...
## $ Curricular.units.1st.sem..approved. : int 0 6 0 6 5 5 7 0 6 5 ...
## $ Curricular.units.1st.sem..grade. : num 0 14 0 13.4 12.3 ...
## $ Curricular.units.1st.sem..without.evaluations.: int 0 0 0 0 0 0 0 0 0 0 ...
## $ Curricular.units.2nd.sem..credited. : int 0 0 0 0 0 0 0 0 0 0 ...
## $ Curricular.units.2nd.sem..enrolled. : int 0 6 6 6 6 5 8 5 6 6 ...
## $ Curricular.units.2nd.sem..evaluations. : int 0 6 0 10 6 17 8 5 7 14 ...
## $ Curricular.units.2nd.sem..approved. : int 0 6 0 5 6 5 8 0 6 2 ...
## $ Curricular.units.2nd.sem..grade. : num 0 13.7 0 12.4 13 ...
## $ Curricular.units.2nd.sem..without.evaluations.: int 0 0 0 0 0 5 0 0 0 0 ...
## $ Unemployment.rate : num 10.8 13.9 10.8 9.4 13.9 16.2 15.5 15.5 16.2 8.9 ...
## $ Inflation.rate : num 1.4 -0.3 1.4 -0.8 -0.3 0.3 2.8 2.8 0.3 1.4 ...
## $ GDP : num 1.74 0.79 1.74 -3.12 0.79 -0.92 -4.06 -4.06 -0.92 3.51 ...
## $ Target : Factor w/ 2 levels "Graduate","Dropout": 2 1 2 1 1 1 1 2 1 2 ...table(modelData$Target)##
## Graduate Dropout
## 2209 1421prop.table(table(modelData$Target)) * 100##
## Graduate Dropout
## 60.85399 39.14601numericCols <- modelData |>
select(where(is.numeric))
corrMatrix <- cor(numericCols)
corrplot(corrMatrix,
method = "color",
type = "lower",
tl.cex = .7,
tl.col = "black"
) # Notice high correlation in columns beginning with "curricular". These have to do with early semester success
# Logistic Regression
set.seed(8247)
data_split <- initial_split(modelData, prop = .8, strata = Target) # Split data with 80% in traininng data. Note Target is given to strata. To quote the documentation, "This can help ensure that the resamples have equivalent proportions as the original data set."
train_lr <- training(data_split)
test_lr <- testing(data_split)
fullLogistic <- glm(Target ~ .,
data = train_lr,
family = binomial
) # Starting with the fully saturated model
summary(fullLogistic) # High cardinality categorical variables lead to sparse, unstable, and in the worst case, perfectly separated data. The simplest solution is to remove some of these variables (eg. Mother's and Father's qualifications have a negligible effect and introduce dozens of levels). However, I will opt to group sparse factors together to avoid missing a real signal. Another solution is regularization, but given this is supposed to be a basic model, I will skip that for now##
## Call:
## glm(formula = Target ~ ., family = binomial, data = train_lr)
##
## Coefficients: (8 not defined because of singularities)
## Estimate Std. Error z value
## (Intercept) 2.732e+00 6.754e+03 0.000
## Marital.status2 7.771e-02 4.198e-01 0.185
## Marital.status3 -1.716e+01 6.523e+03 -0.003
## Marital.status4 -1.293e+00 7.871e-01 -1.642
## Marital.status5 -8.814e-01 1.101e+00 -0.800
## Marital.status6 -5.021e-01 4.268e+00 -0.118
## Application.mode2 -1.552e+01 6.523e+03 -0.002
## Application.mode5 2.166e+00 1.553e+00 1.394
## Application.mode7 -7.903e-02 8.932e-01 -0.088
## Application.mode10 4.206e+00 1.718e+00 2.448
## Application.mode15 -7.806e-01 1.297e+00 -0.602
## Application.mode16 -7.340e-01 8.274e-01 -0.887
## Application.mode17 4.266e-01 2.281e-01 1.871
## Application.mode18 1.050e-01 5.707e-01 0.184
## Application.mode26 1.726e+01 6.523e+03 0.003
## Application.mode27 2.141e+01 6.523e+03 0.003
## Application.mode39 6.832e-01 3.820e-01 1.788
## Application.mode42 -9.168e-02 6.756e-01 -0.136
## Application.mode43 -1.797e-01 4.170e-01 -0.431
## Application.mode44 2.308e-01 1.614e+00 0.143
## Application.mode51 6.766e-01 7.160e-01 0.945
## Application.mode53 -1.555e+01 6.523e+03 -0.002
## Application.mode57 -1.594e+01 6.523e+03 -0.002
## Application.order1 1.236e+01 6.523e+03 0.002
## Application.order2 1.202e+01 6.523e+03 0.002
## Application.order3 1.248e+01 6.523e+03 0.002
## Application.order4 1.233e+01 6.523e+03 0.002
## Application.order5 1.208e+01 6.523e+03 0.002
## Application.order6 1.239e+01 6.523e+03 0.002
## Course171 -1.468e+01 1.751e+03 -0.008
## Course8014 -1.497e+01 1.751e+03 -0.009
## Course9003 -1.501e+01 1.751e+03 -0.009
## Course9070 -1.374e+01 1.751e+03 -0.008
## Course9085 -1.428e+01 1.751e+03 -0.008
## Course9119 -1.239e+01 1.751e+03 -0.007
## Course9130 -1.314e+01 1.751e+03 -0.008
## Course9147 -1.378e+01 1.751e+03 -0.008
## Course9238 -1.460e+01 1.751e+03 -0.008
## Course9254 -1.433e+01 1.751e+03 -0.008
## Course9500 -1.363e+01 1.751e+03 -0.008
## Course9556 -1.298e+01 1.751e+03 -0.007
## Course9670 -1.367e+01 1.751e+03 -0.008
## Course9773 -1.335e+01 1.751e+03 -0.008
## Course9853 -1.193e+01 1.751e+03 -0.007
## Course9991 -1.339e+01 1.751e+03 -0.008
## Daytime.evening.attendance.1 NA NA NA
## Previous.qualification2 1.407e+00 1.130e+00 1.245
## Previous.qualification3 8.910e-01 7.626e-01 1.168
## Previous.qualification4 2.762e+00 1.457e+00 1.895
## Previous.qualification5 5.497e+00 6.523e+03 0.001
## Previous.qualification6 1.300e+00 1.159e+00 1.122
## Previous.qualification9 1.187e+01 1.791e+03 0.007
## Previous.qualification10 -1.899e+00 1.875e+01 -0.101
## Previous.qualification12 -6.699e-01 1.241e+00 -0.540
## Previous.qualification14 1.060e+01 6.523e+03 0.002
## Previous.qualification15 -5.102e+00 4.977e+00 -1.025
## Previous.qualification19 -1.887e-03 5.364e-01 -0.004
## Previous.qualification38 -1.912e+00 2.710e+00 -0.705
## Previous.qualification39 -3.590e-01 1.597e+00 -0.225
## Previous.qualification40 2.132e-01 1.020e+00 0.209
## Previous.qualification42 1.520e+01 6.523e+03 0.002
## Previous.qualification43 -5.179e+00 1.342e+01 -0.386
## Previous.qualification..grade. 9.135e-04 8.093e-03 0.113
## Nacionality2 -1.438e+01 4.601e+03 -0.003
## Nacionality6 -2.927e+00 3.186e+00 -0.919
## Nacionality11 -1.581e+01 4.522e+03 -0.003
## Nacionality13 -1.268e+01 6.523e+03 -0.002
## Nacionality14 -1.576e+01 6.523e+03 -0.002
## Nacionality17 1.381e+01 6.523e+03 0.002
## Nacionality21 1.717e+01 6.523e+03 0.003
## Nacionality22 -6.410e+00 5.200e+00 -1.233
## Nacionality24 -6.531e+00 1.844e+00 -3.541
## Nacionality25 -8.684e+00 6.523e+03 -0.001
## Nacionality26 -2.071e+01 2.184e+03 -0.009
## Nacionality41 2.985e-01 8.227e-01 0.363
## Nacionality62 -1.408e+01 6.523e+03 -0.002
## Nacionality100 1.057e+01 6.523e+03 0.002
## Nacionality101 1.910e+01 6.523e+03 0.003
## Nacionality103 -1.561e+01 6.523e+03 -0.002
## Nacionality105 1.247e+01 6.523e+03 0.002
## Nacionality109 2.204e+01 6.523e+03 0.003
## Mother.s.qualification2 -3.402e-01 6.775e-01 -0.502
## Mother.s.qualification3 7.634e-02 3.916e-01 0.195
## Mother.s.qualification4 -1.076e+00 1.080e+00 -0.996
## Mother.s.qualification5 1.979e-01 1.208e+00 0.164
## Mother.s.qualification6 -6.395e-01 5.691e+03 0.000
## Mother.s.qualification9 8.797e-01 2.345e+00 0.375
## Mother.s.qualification10 -2.133e+00 8.494e+00 -0.251
## Mother.s.qualification11 1.721e+01 2.486e+03 0.007
## Mother.s.qualification12 7.863e-01 7.522e-01 1.045
## Mother.s.qualification18 1.679e+01 6.523e+03 0.003
## Mother.s.qualification19 1.613e-01 2.615e-01 0.617
## Mother.s.qualification22 -2.452e+01 9.224e+03 -0.003
## Mother.s.qualification26 -2.862e+01 9.224e+03 -0.003
## Mother.s.qualification27 1.561e+01 6.523e+03 0.002
## Mother.s.qualification29 -1.663e+01 3.772e+03 -0.004
## Mother.s.qualification30 7.033e-01 5.410e+00 0.130
## Mother.s.qualification34 1.288e+00 1.266e+00 1.017
## Mother.s.qualification35 -1.620e+01 6.523e+03 -0.002
## Mother.s.qualification36 -9.252e-01 2.382e+00 -0.388
## Mother.s.qualification37 3.189e-01 3.260e-01 0.978
## Mother.s.qualification38 -1.031e-01 3.322e-01 -0.310
## Mother.s.qualification39 2.852e+00 1.730e+00 1.649
## Mother.s.qualification40 2.432e+00 1.514e+00 1.606
## Mother.s.qualification41 -8.454e-01 1.510e+00 -0.560
## Mother.s.qualification42 5.758e+00 2.872e+03 0.002
## Mother.s.qualification43 3.553e+01 1.598e+04 0.002
## Father.s.qualification2 1.477e+00 6.438e-01 2.294
## Father.s.qualification3 -4.371e-01 4.397e-01 -0.994
## Father.s.qualification4 3.364e-01 8.533e-01 0.394
## Father.s.qualification5 -5.933e-02 1.555e+00 -0.038
## Father.s.qualification6 1.156e+01 5.275e+03 0.002
## Father.s.qualification9 -2.406e+00 4.375e+00 -0.550
## Father.s.qualification11 -1.653e+01 2.486e+03 -0.007
## Father.s.qualification12 -1.172e+00 8.356e-01 -1.403
## Father.s.qualification14 -6.710e-01 2.321e+00 -0.289
## Father.s.qualification18 NA NA NA
## Father.s.qualification19 -4.655e-01 2.629e-01 -1.771
## Father.s.qualification20 1.153e+01 6.523e+03 0.002
## Father.s.qualification22 1.368e+01 4.101e+03 0.003
## Father.s.qualification25 1.632e+01 6.523e+03 0.003
## Father.s.qualification26 -3.784e+00 1.947e+01 -0.194
## Father.s.qualification27 1.236e+01 8.656e+03 0.001
## Father.s.qualification29 1.475e+01 2.877e+03 0.005
## Father.s.qualification30 1.080e+01 6.523e+03 0.002
## Father.s.qualification34 1.329e-01 1.333e+00 0.100
## Father.s.qualification35 3.244e+01 7.750e+03 0.004
## Father.s.qualification36 -2.214e-01 1.896e+00 -0.117
## Father.s.qualification37 -3.876e-01 3.122e-01 -1.241
## Father.s.qualification38 -3.066e-01 3.077e-01 -0.996
## Father.s.qualification39 2.252e+00 1.173e+00 1.921
## Father.s.qualification40 1.198e+00 1.599e+00 0.750
## Father.s.qualification41 6.394e+00 6.523e+03 0.001
## Father.s.qualification42 -1.892e+01 6.523e+03 -0.003
## Father.s.qualification43 -2.024e+01 4.214e+03 -0.005
## Mother.s.occupation1 -2.585e-01 1.042e+00 -0.248
## Mother.s.occupation2 -3.089e-01 1.005e+00 -0.308
## Mother.s.occupation3 -5.151e-01 9.621e-01 -0.535
## Mother.s.occupation4 -4.436e-01 9.187e-01 -0.483
## Mother.s.occupation5 -3.817e-01 9.238e-01 -0.413
## Mother.s.occupation6 -5.863e-01 1.167e+00 -0.502
## Mother.s.occupation7 -7.640e-02 9.641e-01 -0.079
## Mother.s.occupation8 -1.670e-01 1.250e+00 -0.134
## Mother.s.occupation9 -4.765e-01 9.172e-01 -0.520
## Mother.s.occupation10 1.021e+01 6.523e+03 0.002
## Mother.s.occupation90 5.543e-03 1.370e+00 0.004
## Mother.s.occupation99 3.071e-01 1.066e+01 0.029
## Mother.s.occupation123 2.076e+01 1.130e+04 0.002
## Mother.s.occupation125 -2.345e+01 7.127e+03 -0.003
## Mother.s.occupation132 -1.582e+01 1.130e+04 -0.001
## Mother.s.occupation134 -3.172e+01 1.171e+04 -0.003
## Mother.s.occupation141 -1.396e+01 8.432e+03 -0.002
## Mother.s.occupation143 -1.398e+01 6.523e+03 -0.002
## Mother.s.occupation144 4.383e+01 1.510e+04 0.003
## Mother.s.occupation151 -1.409e+01 1.047e+04 -0.001
## Mother.s.occupation152 -1.335e+01 1.030e+04 -0.001
## Mother.s.occupation153 -1.396e+01 6.523e+03 -0.002
## Mother.s.occupation171 1.035e+01 1.341e+04 0.001
## Mother.s.occupation175 -1.519e+01 6.523e+03 -0.002
## Mother.s.occupation191 -1.556e+01 6.523e+03 -0.002
## Mother.s.occupation193 4.275e+01 1.341e+04 0.003
## Mother.s.occupation194 1.237e+01 9.728e+03 0.001
## Father.s.occupation1 1.081e+00 1.036e+00 1.043
## Father.s.occupation2 1.304e+00 1.048e+00 1.244
## Father.s.occupation3 7.355e-01 9.695e-01 0.759
## Father.s.occupation4 1.624e+00 9.728e-01 1.669
## Father.s.occupation5 6.420e-01 9.657e-01 0.665
## Father.s.occupation6 2.651e-01 1.050e+00 0.252
## Father.s.occupation7 1.015e+00 9.570e-01 1.060
## Father.s.occupation8 9.889e-01 9.850e-01 1.004
## Father.s.occupation9 1.374e+00 9.527e-01 1.442
## Father.s.occupation10 1.024e+00 9.901e-01 1.034
## Father.s.occupation90 1.433e+00 1.428e+00 1.004
## Father.s.occupation99 -8.431e-01 1.060e+01 -0.080
## Father.s.occupation101 -5.989e+01 1.491e+04 -0.004
## Father.s.occupation102 6.492e-01 9.224e+03 0.000
## Father.s.occupation103 -7.044e-01 9.224e+03 0.000
## Father.s.occupation112 4.746e+01 1.341e+04 0.004
## Father.s.occupation122 -3.486e+01 1.305e+04 -0.003
## Father.s.occupation124 NA NA NA
## Father.s.occupation131 -2.901e+01 1.171e+04 -0.002
## Father.s.occupation135 -3.622e+01 1.305e+04 -0.003
## Father.s.occupation141 -6.047e+01 1.645e+04 -0.004
## Father.s.occupation143 1.446e+00 9.224e+03 0.000
## Father.s.occupation144 -6.056e+01 1.504e+04 -0.004
## Father.s.occupation151 -3.858e-01 1.057e+04 0.000
## Father.s.occupation153 NA NA NA
## Father.s.occupation154 -2.571e-01 9.224e+03 0.000
## Father.s.occupation163 -2.955e+01 1.171e+04 -0.003
## Father.s.occupation171 5.224e-01 7.972e+03 0.000
## Father.s.occupation172 NA NA NA
## Father.s.occupation174 -1.712e-01 9.224e+03 0.000
## Father.s.occupation175 -1.175e+00 8.320e+03 0.000
## Father.s.occupation181 -5.735e+01 1.428e+04 -0.004
## Father.s.occupation182 -9.920e-01 9.224e+03 0.000
## Father.s.occupation183 NA NA NA
## Father.s.occupation192 -2.666e-01 8.012e+03 0.000
## Father.s.occupation193 -1.123e-02 7.218e+03 0.000
## Father.s.occupation194 -2.952e+01 1.171e+04 -0.003
## Father.s.occupation195 NA NA NA
## Admission.grade -3.382e-03 7.660e-03 -0.441
## Displaced1 4.094e-01 2.050e-01 1.997
## Educational.special.needs1 -3.568e-01 6.616e-01 -0.539
## Debtor1 1.720e+00 3.285e-01 5.236
## Tuition.fees.up.to.date1 -3.045e+00 3.949e-01 -7.711
## Gender1 5.838e-01 1.888e-01 3.092
## Scholarship.holder1 -7.552e-01 2.143e-01 -3.524
## Age.at.enrollment 1.854e-02 2.061e-02 0.900
## International1 NA NA NA
## Curricular.units.1st.sem..credited. 2.249e-01 1.459e-01 1.541
## Curricular.units.1st.sem..enrolled. 2.834e-01 2.110e-01 1.343
## Curricular.units.1st.sem..evaluations. 5.540e-02 5.316e-02 1.042
## Curricular.units.1st.sem..approved. -6.740e-01 1.109e-01 -6.077
## Curricular.units.1st.sem..grade. 1.226e-01 6.834e-02 1.795
## Curricular.units.1st.sem..without.evaluations. -3.599e-01 2.400e-01 -1.499
## Curricular.units.2nd.sem..credited. -3.750e-02 1.496e-01 -0.251
## Curricular.units.2nd.sem..enrolled. 8.542e-01 2.090e-01 4.087
## Curricular.units.2nd.sem..evaluations. 2.833e-02 4.830e-02 0.587
## Curricular.units.2nd.sem..approved. -1.015e+00 9.904e-02 -10.244
## Curricular.units.2nd.sem..grade. -2.048e-01 7.245e-02 -2.827
## Curricular.units.2nd.sem..without.evaluations. -2.923e-01 1.955e-01 -1.495
## Unemployment.rate 1.022e-01 3.835e-02 2.664
## Inflation.rate -1.040e-01 6.289e-02 -1.654
## GDP 3.857e-02 4.356e-02 0.885
## Pr(>|z|)
## (Intercept) 0.999677
## Marital.status2 0.853144
## Marital.status3 0.997901
## Marital.status4 0.100540
## Marital.status5 0.423551
## Marital.status6 0.906350
## Application.mode2 0.998102
## Application.mode5 0.163242
## Application.mode7 0.929492
## Application.mode10 0.014345 *
## Application.mode15 0.547438
## Application.mode16 0.375041
## Application.mode17 0.061372 .
## Application.mode18 0.853967
## Application.mode26 0.997889
## Application.mode27 0.997381
## Application.mode39 0.073725 .
## Application.mode42 0.892052
## Application.mode43 0.666506
## Application.mode44 0.886280
## Application.mode51 0.344668
## Application.mode53 0.998097
## Application.mode57 0.998050
## Application.order1 0.998488
## Application.order2 0.998529
## Application.order3 0.998473
## Application.order4 0.998492
## Application.order5 0.998522
## Application.order6 0.998484
## Course171 0.993310
## Course8014 0.993178
## Course9003 0.993163
## Course9070 0.993738
## Course9085 0.993493
## Course9119 0.994353
## Course9130 0.994013
## Course9147 0.993723
## Course9238 0.993347
## Course9254 0.993469
## Course9500 0.993788
## Course9556 0.994087
## Course9670 0.993771
## Course9773 0.993917
## Course9853 0.994564
## Course9991 0.993897
## Daytime.evening.attendance.1 NA
## Previous.qualification2 0.213094
## Previous.qualification3 0.242644
## Previous.qualification4 0.058044 .
## Previous.qualification5 0.999328
## Previous.qualification6 0.261662
## Previous.qualification9 0.994711
## Previous.qualification10 0.919338
## Previous.qualification12 0.589474
## Previous.qualification14 0.998703
## Previous.qualification15 0.305380
## Previous.qualification19 0.997192
## Previous.qualification38 0.480608
## Previous.qualification39 0.822163
## Previous.qualification40 0.834487
## Previous.qualification42 0.998141
## Previous.qualification43 0.699553
## Previous.qualification..grade. 0.910133
## Nacionality2 0.997505
## Nacionality6 0.358195
## Nacionality11 0.997211
## Nacionality13 0.998449
## Nacionality14 0.998072
## Nacionality17 0.998311
## Nacionality21 0.997899
## Nacionality22 0.217741
## Nacionality24 0.000398 ***
## Nacionality25 0.998938
## Nacionality26 0.992433
## Nacionality41 0.716729
## Nacionality62 0.998277
## Nacionality100 0.998707
## Nacionality101 0.997663
## Nacionality103 0.998090
## Nacionality105 0.998475
## Nacionality109 0.997304
## Mother.s.qualification2 0.615582
## Mother.s.qualification3 0.845434
## Mother.s.qualification4 0.319055
## Mother.s.qualification5 0.869931
## Mother.s.qualification6 0.999910
## Mother.s.qualification9 0.707508
## Mother.s.qualification10 0.801749
## Mother.s.qualification11 0.994475
## Mother.s.qualification12 0.295896
## Mother.s.qualification18 0.997947
## Mother.s.qualification19 0.537395
## Mother.s.qualification22 0.997879
## Mother.s.qualification26 0.997525
## Mother.s.qualification27 0.998090
## Mother.s.qualification29 0.996481
## Mother.s.qualification30 0.896563
## Mother.s.qualification34 0.309173
## Mother.s.qualification35 0.998019
## Mother.s.qualification36 0.697677
## Mother.s.qualification37 0.327843
## Mother.s.qualification38 0.756342
## Mother.s.qualification39 0.099190 .
## Mother.s.qualification40 0.108243
## Mother.s.qualification41 0.575622
## Mother.s.qualification42 0.998400
## Mother.s.qualification43 0.998226
## Father.s.qualification2 0.021767 *
## Father.s.qualification3 0.320146
## Father.s.qualification4 0.693401
## Father.s.qualification5 0.969561
## Father.s.qualification6 0.998252
## Father.s.qualification9 0.582404
## Father.s.qualification11 0.994694
## Father.s.qualification12 0.160661
## Father.s.qualification14 0.772494
## Father.s.qualification18 NA
## Father.s.qualification19 0.076604 .
## Father.s.qualification20 0.998590
## Father.s.qualification22 0.997338
## Father.s.qualification25 0.998004
## Father.s.qualification26 0.845890
## Father.s.qualification27 0.998860
## Father.s.qualification29 0.995908
## Father.s.qualification30 0.998679
## Father.s.qualification34 0.920574
## Father.s.qualification35 0.996660
## Father.s.qualification36 0.907007
## Father.s.qualification37 0.214468
## Father.s.qualification38 0.319045
## Father.s.qualification39 0.054788 .
## Father.s.qualification40 0.453537
## Father.s.qualification41 0.999218
## Father.s.qualification42 0.997685
## Father.s.qualification43 0.996168
## Mother.s.occupation1 0.804139
## Mother.s.occupation2 0.758427
## Mother.s.occupation3 0.592383
## Mother.s.occupation4 0.629212
## Mother.s.occupation5 0.679456
## Mother.s.occupation6 0.615475
## Mother.s.occupation7 0.936834
## Mother.s.occupation8 0.893678
## Mother.s.occupation9 0.603360
## Mother.s.occupation10 0.998751
## Mother.s.occupation90 0.996771
## Mother.s.occupation99 0.977021
## Mother.s.occupation123 0.998534
## Mother.s.occupation125 0.997374
## Mother.s.occupation132 0.998883
## Mother.s.occupation134 0.997839
## Mother.s.occupation141 0.998679
## Mother.s.occupation143 0.998290
## Mother.s.occupation144 0.997684
## Mother.s.occupation151 0.998926
## Mother.s.occupation152 0.998966
## Mother.s.occupation153 0.998293
## Mother.s.occupation171 0.999384
## Mother.s.occupation175 0.998141
## Mother.s.occupation191 0.998097
## Mother.s.occupation193 0.997455
## Mother.s.occupation194 0.998986
## Father.s.occupation1 0.296834
## Father.s.occupation2 0.213574
## Father.s.occupation3 0.448076
## Father.s.occupation4 0.095057 .
## Father.s.occupation5 0.506180
## Father.s.occupation6 0.800754
## Father.s.occupation7 0.288971
## Father.s.occupation8 0.315401
## Father.s.occupation9 0.149311
## Father.s.occupation10 0.300935
## Father.s.occupation90 0.315501
## Father.s.occupation99 0.936578
## Father.s.occupation101 0.996795
## Father.s.occupation102 0.999944
## Father.s.occupation103 0.999939
## Father.s.occupation112 0.997175
## Father.s.occupation122 0.997868
## Father.s.occupation124 NA
## Father.s.occupation131 0.998023
## Father.s.occupation135 0.997784
## Father.s.occupation141 0.997067
## Father.s.occupation143 0.999875
## Father.s.occupation144 0.996787
## Father.s.occupation151 0.999971
## Father.s.occupation153 NA
## Father.s.occupation154 0.999978
## Father.s.occupation163 0.997987
## Father.s.occupation171 0.999948
## Father.s.occupation172 NA
## Father.s.occupation174 0.999985
## Father.s.occupation175 0.999887
## Father.s.occupation181 0.996796
## Father.s.occupation182 0.999914
## Father.s.occupation183 NA
## Father.s.occupation192 0.999973
## Father.s.occupation193 0.999999
## Father.s.occupation194 0.997989
## Father.s.occupation195 NA
## Admission.grade 0.658889
## Displaced1 0.045870 *
## Educational.special.needs1 0.589746
## Debtor1 1.64e-07 ***
## Tuition.fees.up.to.date1 1.25e-14 ***
## Gender1 0.001986 **
## Scholarship.holder1 0.000425 ***
## Age.at.enrollment 0.368277
## International1 NA
## Curricular.units.1st.sem..credited. 0.123201
## Curricular.units.1st.sem..enrolled. 0.179344
## Curricular.units.1st.sem..evaluations. 0.297296
## Curricular.units.1st.sem..approved. 1.22e-09 ***
## Curricular.units.1st.sem..grade. 0.072724 .
## Curricular.units.1st.sem..without.evaluations. 0.133786
## Curricular.units.2nd.sem..credited. 0.802100
## Curricular.units.2nd.sem..enrolled. 4.36e-05 ***
## Curricular.units.2nd.sem..evaluations. 0.557464
## Curricular.units.2nd.sem..approved. < 2e-16 ***
## Curricular.units.2nd.sem..grade. 0.004702 **
## Curricular.units.2nd.sem..without.evaluations. 0.134904
## Unemployment.rate 0.007713 **
## Inflation.rate 0.098051 .
## GDP 0.375958
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 3886.2 on 2902 degrees of freedom
## Residual deviance: 1105.3 on 2687 degrees of freedom
## AIC: 1537.3
##
## Number of Fisher Scoring iterations: 17train_simplified <- train_lr |>
mutate(
Marital.status = fct_lump_prop(Marital.status, prop = .05),
Application.mode = fct_lump_prop(Application.mode, prop = .05),
Course = fct_lump_prop(Course, prop = .05),
Previous.qualification = fct_lump_prop(Previous.qualification, prop = .05),
Nacionality = fct_lump_prop(Nacionality, prop = .05),
Mother.s.occupation = fct_lump_prop(Mother.s.occupation, prop = .05),
Father.s.occupation = fct_lump_prop(Father.s.occupation, prop = .05),
Mother.s.qualification = fct_lump_prop(Mother.s.qualification, prop = .05),
Father.s.qualification = fct_lump_prop(Father.s.qualification, prop = .05)
) # This helps with sparse data. Categories with few datapoins (<.05) are regarded as Other rather than taking up degrees of freedom
lump_levels <- list(
Marital.status = levels(train_simplified$Marital.status),
Application.mode = levels(train_simplified$Application.mode),
Course = levels(train_simplified$Course),
Previous.qualification = levels(train_simplified$Previous.qualification),
Nacionality = levels(train_simplified$Nacionality),
Mother.s.occupation = levels(train_simplified$Mother.s.occupation),
Father.s.occupation = levels(train_simplified$Father.s.occupation),
Mother.s.qualification = levels(train_simplified$Mother.s.qualification),
Father.s.qualification = levels(train_simplified$Father.s.qualification)
)
simplifiedLogistic <- glm(Target ~ .,
data = train_simplified,
family = binomial
)
summary(simplifiedLogistic) # Notably, Marital.status, Application.order, and anything about parent occupation/qualification yield no significance. Too further simplify, I will remove these entirely (Although, I could see an argument to be made to retain marital status. Gut instinct tells me it could have a larger and more persistent effect on academic success than the model currently identifies.) Also, alias(simplifiedLogistic) reveals that Daytime.evening.attendance and International are redundant from oher columns, this makes estimates of variance unreliable (or in tthis case, not able to be estimatetd at all). Removing.##
## Call:
## glm(formula = Target ~ ., family = binomial, data = train_simplified)
##
## Coefficients: (2 not defined because of singularities)
## Estimate Std. Error z value
## (Intercept) -6.894e+00 3.247e+02 -0.021
## Marital.status2 1.291e-01 3.684e-01 0.351
## Marital.statusOther -5.909e-01 5.885e-01 -1.004
## Application.mode17 4.751e-01 2.111e-01 2.251
## Application.mode39 3.938e-01 3.301e-01 1.193
## Application.mode43 -2.284e-01 3.728e-01 -0.613
## Application.modeOther -1.417e-01 2.879e-01 -0.492
## Application.order1 7.523e+00 3.247e+02 0.023
## Application.order2 7.345e+00 3.247e+02 0.023
## Application.order3 7.781e+00 3.247e+02 0.024
## Application.order4 7.567e+00 3.247e+02 0.023
## Application.order5 7.342e+00 3.247e+02 0.023
## Application.order6 7.522e+00 3.247e+02 0.023
## Course9085 7.930e-01 5.389e-01 1.471
## Course9147 1.137e+00 4.958e-01 2.294
## Course9238 2.464e-01 5.266e-01 0.468
## Course9254 6.691e-01 5.288e-01 1.265
## Course9500 1.233e+00 5.069e-01 2.433
## Course9670 1.144e+00 5.043e-01 2.269
## Course9773 1.470e+00 4.977e-01 2.954
## Course9991 1.717e+00 5.117e-01 3.355
## CourseOther 1.626e+00 4.530e-01 3.589
## Daytime.evening.attendance.1 NA NA NA
## Previous.qualificationOther 1.817e-01 2.716e-01 0.669
## Previous.qualification..grade. 5.964e-04 7.190e-03 0.083
## NacionalityOther -9.902e-01 5.672e-01 -1.746
## Mother.s.qualification3 2.666e-01 3.405e-01 0.783
## Mother.s.qualification19 1.450e-01 2.416e-01 0.600
## Mother.s.qualification37 1.866e-01 2.967e-01 0.629
## Mother.s.qualification38 -1.313e-01 3.049e-01 -0.431
## Mother.s.qualificationOther 3.257e-01 3.369e-01 0.967
## Father.s.qualification3 -2.087e-01 3.641e-01 -0.573
## Father.s.qualification19 -3.437e-01 2.430e-01 -1.414
## Father.s.qualification37 -2.988e-01 2.842e-01 -1.051
## Father.s.qualification38 -1.983e-01 2.832e-01 -0.700
## Father.s.qualificationOther 3.693e-01 3.396e-01 1.087
## Mother.s.occupation3 -1.302e-01 4.106e-01 -0.317
## Mother.s.occupation4 -1.263e-01 3.894e-01 -0.324
## Mother.s.occupation5 -9.243e-02 4.264e-01 -0.217
## Mother.s.occupation7 1.907e-01 4.994e-01 0.382
## Mother.s.occupation9 -1.646e-01 4.029e-01 -0.409
## Mother.s.occupationOther -2.493e-01 4.100e-01 -0.608
## Father.s.occupation4 6.096e-01 3.494e-01 1.745
## Father.s.occupation5 -7.120e-02 3.505e-01 -0.203
## Father.s.occupation6 -5.761e-01 4.772e-01 -1.207
## Father.s.occupation7 2.678e-01 3.292e-01 0.814
## Father.s.occupation8 1.179e-01 3.898e-01 0.302
## Father.s.occupation9 5.119e-01 3.138e-01 1.632
## Father.s.occupation10 2.474e-02 4.038e-01 0.061
## Father.s.occupationOther 7.922e-02 3.550e-01 0.223
## Admission.grade -1.052e-02 6.724e-03 -1.565
## Displaced1 3.393e-01 1.858e-01 1.827
## Educational.special.needs1 -5.356e-02 5.891e-01 -0.091
## Debtor1 1.235e+00 2.809e-01 4.397
## Tuition.fees.up.to.date1 -2.781e+00 3.301e-01 -8.424
## Gender1 2.825e-01 1.658e-01 1.704
## Scholarship.holder1 -7.045e-01 1.980e-01 -3.557
## Age.at.enrollment 2.611e-02 1.807e-02 1.445
## International1 NA NA NA
## Curricular.units.1st.sem..credited. 2.550e-01 1.262e-01 2.021
## Curricular.units.1st.sem..enrolled. 2.847e-01 1.772e-01 1.607
## Curricular.units.1st.sem..evaluations. 5.046e-02 4.669e-02 1.081
## Curricular.units.1st.sem..approved. -6.770e-01 9.886e-02 -6.848
## Curricular.units.1st.sem..grade. 1.415e-01 5.588e-02 2.533
## Curricular.units.1st.sem..without.evaluations. -3.252e-01 2.092e-01 -1.554
## Curricular.units.2nd.sem..credited. -1.640e-02 1.336e-01 -0.123
## Curricular.units.2nd.sem..enrolled. 8.753e-01 1.693e-01 5.171
## Curricular.units.2nd.sem..evaluations. -5.691e-05 4.348e-02 -0.001
## Curricular.units.2nd.sem..approved. -1.028e+00 8.786e-02 -11.706
## Curricular.units.2nd.sem..grade. -1.173e-01 5.569e-02 -2.106
## Curricular.units.2nd.sem..without.evaluations. -2.462e-01 1.748e-01 -1.409
## Unemployment.rate 6.228e-02 3.348e-02 1.860
## Inflation.rate -6.024e-02 5.728e-02 -1.052
## GDP 1.835e-02 3.892e-02 0.471
## Pr(>|z|)
## (Intercept) 0.983063
## Marital.status2 0.725931
## Marital.statusOther 0.315272
## Application.mode17 0.024408 *
## Application.mode39 0.232817
## Application.mode43 0.540126
## Application.modeOther 0.622505
## Application.order1 0.981518
## Application.order2 0.981956
## Application.order3 0.980885
## Application.order4 0.981411
## Application.order5 0.981962
## Application.order6 0.981520
## Course9085 0.141165
## Course9147 0.021778 *
## Course9238 0.639828
## Course9254 0.205789
## Course9500 0.014963 *
## Course9670 0.023252 *
## Course9773 0.003139 **
## Course9991 0.000792 ***
## CourseOther 0.000333 ***
## Daytime.evening.attendance.1 NA
## Previous.qualificationOther 0.503615
## Previous.qualification..grade. 0.933895
## NacionalityOther 0.080845 .
## Mother.s.qualification3 0.433663
## Mother.s.qualification19 0.548396
## Mother.s.qualification37 0.529445
## Mother.s.qualification38 0.666748
## Mother.s.qualificationOther 0.333716
## Father.s.qualification3 0.566586
## Father.s.qualification19 0.157337
## Father.s.qualification37 0.293031
## Father.s.qualification38 0.483825
## Father.s.qualificationOther 0.276826
## Mother.s.occupation3 0.751155
## Mother.s.occupation4 0.745754
## Mother.s.occupation5 0.828386
## Mother.s.occupation7 0.702549
## Mother.s.occupation9 0.682788
## Mother.s.occupationOther 0.543096
## Father.s.occupation4 0.081057 .
## Father.s.occupation5 0.839014
## Father.s.occupation6 0.227367
## Father.s.occupation7 0.415907
## Father.s.occupation8 0.762287
## Father.s.occupation9 0.102766
## Father.s.occupation10 0.951152
## Father.s.occupationOther 0.823428
## Admission.grade 0.117660
## Displaced1 0.067752 .
## Educational.special.needs1 0.927561
## Debtor1 1.10e-05 ***
## Tuition.fees.up.to.date1 < 2e-16 ***
## Gender1 0.088328 .
## Scholarship.holder1 0.000374 ***
## Age.at.enrollment 0.148469
## International1 NA
## Curricular.units.1st.sem..credited. 0.043318 *
## Curricular.units.1st.sem..enrolled. 0.108104
## Curricular.units.1st.sem..evaluations. 0.279846
## Curricular.units.1st.sem..approved. 7.49e-12 ***
## Curricular.units.1st.sem..grade. 0.011321 *
## Curricular.units.1st.sem..without.evaluations. 0.120162
## Curricular.units.2nd.sem..credited. 0.902277
## Curricular.units.2nd.sem..enrolled. 2.32e-07 ***
## Curricular.units.2nd.sem..evaluations. 0.998956
## Curricular.units.2nd.sem..approved. < 2e-16 ***
## Curricular.units.2nd.sem..grade. 0.035165 *
## Curricular.units.2nd.sem..without.evaluations. 0.158922
## Unemployment.rate 0.062847 .
## Inflation.rate 0.292918
## GDP 0.637361
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 3886.2 on 2902 degrees of freedom
## Residual deviance: 1245.1 on 2831 degrees of freedom
## AIC: 1389.1
##
## Number of Fisher Scoring iterations: 11train_simplified <- train_simplified |>
select(
-c(
Marital.status,
Application.order,
Daytime.evening.attendance.,
International
),
-matches("(?i)mother"),
-matches("(?i)father")
)
simplifiedLogistic <- glm(Target ~ .,
data = train_simplified,
family = binomial
)
summary(simplifiedLogistic) # The AIC has decreased between. The fully saturated and this simplified version. Put simply, AIC = “how good your model fits the data” + “how complicated your model is”. Noise has been removed. Now to test if the model is predicting reasonably well.##
## Call:
## glm(formula = Target ~ ., family = binomial, data = train_simplified)
##
## Coefficients:
## Estimate Std. Error z value
## (Intercept) 0.8526454 1.1488067 0.742
## Application.mode17 0.4188391 0.2018028 2.075
## Application.mode39 0.3574525 0.3199969 1.117
## Application.mode43 -0.1359885 0.3579053 -0.380
## Application.modeOther -0.1461884 0.2776736 -0.526
## Course9085 0.7089113 0.5157969 1.374
## Course9147 1.0696243 0.4752356 2.251
## Course9238 0.1847771 0.5159368 0.358
## Course9254 0.5873473 0.5066059 1.159
## Course9500 1.2231052 0.4911947 2.490
## Course9670 1.1358454 0.4863071 2.336
## Course9773 1.3690876 0.4842612 2.827
## Course9991 1.6355578 0.4905435 3.334
## CourseOther 1.5482948 0.4334950 3.572
## Previous.qualificationOther 0.1213098 0.2627736 0.462
## Previous.qualification..grade. -0.0004876 0.0068812 -0.071
## NacionalityOther -0.8062682 0.5416090 -1.489
## Admission.grade -0.0093100 0.0064592 -1.441
## Displaced1 0.3541893 0.1768298 2.003
## Educational.special.needs1 0.0414567 0.5869996 0.071
## Debtor1 1.1942206 0.2720851 4.389
## Tuition.fees.up.to.date1 -2.7733999 0.3243995 -8.549
## Gender1 0.3480420 0.1612680 2.158
## Scholarship.holder1 -0.7764812 0.1886097 -4.117
## Age.at.enrollment 0.0263483 0.0146191 1.802
## Curricular.units.1st.sem..credited. 0.2499171 0.1243220 2.010
## Curricular.units.1st.sem..enrolled. 0.3042771 0.1751229 1.738
## Curricular.units.1st.sem..evaluations. 0.0423247 0.0449229 0.942
## Curricular.units.1st.sem..approved. -0.6805951 0.0963783 -7.062
## Curricular.units.1st.sem..grade. 0.1495343 0.0551541 2.711
## Curricular.units.1st.sem..without.evaluations. -0.2748761 0.2065566 -1.331
## Curricular.units.2nd.sem..credited. 0.0140129 0.1305765 0.107
## Curricular.units.2nd.sem..enrolled. 0.8158481 0.1670733 4.883
## Curricular.units.2nd.sem..evaluations. 0.0005362 0.0423913 0.013
## Curricular.units.2nd.sem..approved. -1.0086864 0.0848207 -11.892
## Curricular.units.2nd.sem..grade. -0.1111705 0.0548564 -2.027
## Curricular.units.2nd.sem..without.evaluations. -0.2293201 0.1724447 -1.330
## Unemployment.rate 0.0500493 0.0308251 1.624
## Inflation.rate -0.0438319 0.0548049 -0.800
## GDP 0.0101367 0.0371851 0.273
## Pr(>|z|)
## (Intercept) 0.457966
## Application.mode17 0.037941 *
## Application.mode39 0.263973
## Application.mode43 0.703978
## Application.modeOther 0.598558
## Course9085 0.169317
## Course9147 0.024403 *
## Course9238 0.720239
## Course9254 0.246302
## Course9500 0.012772 *
## Course9670 0.019509 *
## Course9773 0.004696 **
## Course9991 0.000856 ***
## CourseOther 0.000355 ***
## Previous.qualificationOther 0.644331
## Previous.qualification..grade. 0.943513
## NacionalityOther 0.136579
## Admission.grade 0.149483
## Displaced1 0.045178 *
## Educational.special.needs1 0.943696
## Debtor1 1.14e-05 ***
## Tuition.fees.up.to.date1 < 2e-16 ***
## Gender1 0.030915 *
## Scholarship.holder1 3.84e-05 ***
## Age.at.enrollment 0.071494 .
## Curricular.units.1st.sem..credited. 0.044406 *
## Curricular.units.1st.sem..enrolled. 0.082298 .
## Curricular.units.1st.sem..evaluations. 0.346109
## Curricular.units.1st.sem..approved. 1.64e-12 ***
## Curricular.units.1st.sem..grade. 0.006704 **
## Curricular.units.1st.sem..without.evaluations. 0.183270
## Curricular.units.2nd.sem..credited. 0.914538
## Curricular.units.2nd.sem..enrolled. 1.04e-06 ***
## Curricular.units.2nd.sem..evaluations. 0.989908
## Curricular.units.2nd.sem..approved. < 2e-16 ***
## Curricular.units.2nd.sem..grade. 0.042706 *
## Curricular.units.2nd.sem..without.evaluations. 0.183578
## Unemployment.rate 0.104450
## Inflation.rate 0.423838
## GDP 0.785161
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 3886.2 on 2902 degrees of freedom
## Residual deviance: 1274.3 on 2863 degrees of freedom
## AIC: 1354.3
##
## Number of Fisher Scoring iterations: 8importance <- varImp(simplifiedLogistic, scale = TRUE)
importance <- importance[order(-importance$Overall), , drop = FALSE]
importance$Variable <- rownames(importance)
ggplot(
importance[1:10, ],
aes(
x = reorder(Variable, Overall),
y = Overall
)
) +
geom_col(fill = "#003057") + # WGU COLOR!
coord_flip() +
theme_minimal() +
labs(
title = "Top 10 Most Important Variables",
x = NULL,
y = "Importance (scaled 0-100)"
) # It is also important to identify WHICH variables are most useful for predicting the Target. This model suggests that the number of "curricular units successfully completed in the second semester" is the strongest predictor of Dropout. Students who complete fewer units in this period are substantially more likely to drop out, holding all other variables constant. This may indicate that academic performance in the second semester is critical for student persistence, and could represent a valuable time for intervention. However, this result reflects an association rather than a causal effect. A controlled study or experimental intervention would be required to determine whether improving second-semester performance directly reduces dropout rates.
test_simplified <- test_lr |>
mutate(
Marital.status = fct_other(Marital.status, keep = lump_levels$Marital.status),
Application.mode = fct_other(Application.mode, keep = lump_levels$Application.mode),
Course = fct_other(Course, keep = lump_levels$Course),
Previous.qualification = fct_other(Previous.qualification, keep = lump_levels$Previous.qualification),
Nacionality = fct_other(Nacionality, keep = lump_levels$Nacionality),
Mother.s.occupation = fct_other(Mother.s.occupation, keep = lump_levels$Mother.s.occupation),
Father.s.occupation = fct_other(Father.s.occupation, keep = lump_levels$Father.s.occupation),
Mother.s.qualification = fct_other(Mother.s.qualification, keep = lump_levels$Mother.s.qualification),
Father.s.qualification = fct_other(Father.s.qualification, keep = lump_levels$Father.s.qualification)
) |>
select(
-c(
Marital.status,
Application.order,
Daytime.evening.attendance.,
International
),
-matches("(?i)mother"),
-matches("(?i)father")
) # In order to run this logistic regression, the same changes made to the training data need to be made on the test data. In tidymodels, this would be saved as a recipe and applied to test data
predProbs <- predict(simplifiedLogistic,
newdata = test_simplified,
type = "response"
) # This is my actual predictions for each student!
predClass <- ifelse(predProbs > .5,
"Dropout",
"Graduate"
) |>
factor(levels = levels(test_simplified$Target)) # Convert completion prediction to class labels (.5 threshold)
confusionMatrix(predClass,
test_simplified$Target,
positive = "Dropout"
) # Now for Model Evaluation. I predicted Dropout or Graduate for each student, but was the model accurate?## Confusion Matrix and Statistics
##
## Reference
## Prediction Graduate Dropout
## Graduate 426 46
## Dropout 16 239
##
## Accuracy : 0.9147
## 95% CI : (0.892, 0.934)
## No Information Rate : 0.608
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.8177
##
## Mcnemar's Test P-Value : 0.0002305
##
## Sensitivity : 0.8386
## Specificity : 0.9638
## Pos Pred Value : 0.9373
## Neg Pred Value : 0.9025
## Prevalence : 0.3920
## Detection Rate : 0.3287
## Detection Prevalence : 0.3508
## Balanced Accuracy : 0.9012
##
## 'Positive' Class : Dropout
## # ROC (Receiver Operating Characteristic) curve for Model Evaluation
rocObj <- roc(
response = test_simplified$Target,
predictor = predProbs,
levels = c("Graduate", "Dropout")
)## Setting direction: controls < casesplot(rocObj,
main = "ROC Curve for Baseline Logistic Regression",
col = "#003057",
lwd = 2,
print.thres = seq(.2, .8, by = .2),
print.thres.pch = 19,
print.thres.col = "#97E152",
print.thres.cex = .8,
print.thres.adj = c(-.1, 1.5),
print.auc = TRUE,
print.auc.x = .4,
print.auc.y = .15
)
Of all the numbers in this output, the most important one is likely
Sensitivity: .8386. The positive case is Dropout, meaning I am
interested in flagging students at risk of dropping out and, therefore,
might benefit from an intervention of some kind. In this case, the model
correctly flagged 84% of those who ended up dropping out, allowing
allocation of resources toward intervening on their behalf. However, the
model misses 16% of students who may have benefited from intervention
but received none. These correctly flagged dropouts come at a cost: 4%
of students flagged for intervention were actually going to graduate
without it. Depending on the cost of these interventions (fiscal, time,
and opportunity costs), this rate maybe be deemed acceptable. This is
called Specificity. If the threshold to flag a “Dropout” is lowered,
more flasely flagged “Dropouts” must be accepted. This balance is a
trade-off that cannot be avoided and is shown in the ROC curve.
Previously identified was high-correlation in early semester performance. One way to handle this is to perform Principal Component Analysis (PCA). This reduces higher-dimensional data into lower dimensions based on its most important (or principal) variables (or components). This is Unsupervised Learning (there is no “correct”, labeled grouping to evaluate against) and will reduce correlation and perhaps improve my model.
# PCA Logistic Regression (Early semester performance compression)
set.seed(8247)
train_pca <- train_simplified # One option would be to start back at the full model. For convenience, and because previous removals appear valid regardless of model, I am going to continue with the simplified model landed on in the previous logistic model.
test_pca <- test_simplified
pca_recipe <- recipe(Target ~ ., data = train_pca) |>
step_pca(matches("1st|2nd"), num_comp = 5) # The recipe, prep, bake preprocessing can be unintuitive. This will be used often throughout. Think of it as plan, calculate, apply
pca_prep <- prep(pca_recipe, training = train_pca)
train_pca_baked <- bake(pca_prep, new_data = NULL)
test_pca_baked <- bake(pca_prep, new_data = test_pca)
pcaLogistic <- glm(Target ~ .,
data = train_pca_baked,
family = binomial
)
summary(pcaLogistic) # Early semeseter performance coluumns have been replaced with PC1-5##
## Call:
## glm(formula = Target ~ ., family = binomial, data = train_pca_baked)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.172978 1.046482 1.121 0.262340
## Application.mode17 0.412180 0.184588 2.233 0.025550 *
## Application.mode39 0.086719 0.279275 0.311 0.756168
## Application.mode43 0.453635 0.304964 1.488 0.136882
## Application.modeOther 0.323475 0.236664 1.367 0.171685
## Course9085 0.961429 0.450297 2.135 0.032753 *
## Course9147 1.587206 0.415504 3.820 0.000133 ***
## Course9238 0.097234 0.453212 0.215 0.830122
## Course9254 0.742077 0.441166 1.682 0.092553 .
## Course9500 0.088125 0.423568 0.208 0.835186
## Course9670 1.514696 0.433907 3.491 0.000482 ***
## Course9773 1.112284 0.431227 2.579 0.009899 **
## Course9991 1.773639 0.421536 4.208 2.58e-05 ***
## CourseOther 1.459106 0.378105 3.859 0.000114 ***
## Previous.qualificationOther 0.338767 0.225474 1.502 0.132977
## Previous.qualification..grade. 0.002086 0.006184 0.337 0.735847
## NacionalityOther -1.228408 0.480491 -2.557 0.010571 *
## Admission.grade -0.011330 0.005860 -1.933 0.053209 .
## Displaced1 0.326191 0.156371 2.086 0.036978 *
## Educational.special.needs1 0.333767 0.546078 0.611 0.541062
## Debtor1 1.146415 0.241982 4.738 2.16e-06 ***
## Tuition.fees.up.to.date1 -2.905069 0.299393 -9.703 < 2e-16 ***
## Gender1 0.604228 0.142217 4.249 2.15e-05 ***
## Scholarship.holder1 -0.957927 0.175358 -5.463 4.69e-08 ***
## Age.at.enrollment 0.048667 0.012677 3.839 0.000124 ***
## Unemployment.rate -0.005998 0.027048 -0.222 0.824502
## Inflation.rate 0.004263 0.048360 0.088 0.929750
## GDP 0.003909 0.032491 0.120 0.904243
## PC1 0.036455 0.010042 3.630 0.000283 ***
## PC2 -0.316721 0.022796 -13.894 < 2e-16 ***
## PC3 0.527300 0.034101 15.463 < 2e-16 ***
## PC4 -0.686069 0.075920 -9.037 < 2e-16 ***
## PC5 0.103682 0.049679 2.087 0.036885 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 3886.2 on 2902 degrees of freedom
## Residual deviance: 1524.3 on 2870 degrees of freedom
## AIC: 1590.3
##
## Number of Fisher Scoring iterations: 7# Predictiioins as probabilities
predProbs_pca <- predict(pcaLogistic,
newdata = test_pca_baked,
type = "response"
) # This is my actual predictions for each student!
# Convert to class labels (.5 threshold)
predClass_pca <- ifelse(predProbs_pca > .5,
"Dropout",
"Graduate"
) |>
factor(levels = levels(test_pca_baked$Target))
# Confusion matrix
confusionMatrix(predClass_pca,
test_pca_baked$Target,
positive = "Dropout"
)## Confusion Matrix and Statistics
##
## Reference
## Prediction Graduate Dropout
## Graduate 410 57
## Dropout 32 228
##
## Accuracy : 0.8776
## 95% CI : (0.8515, 0.9005)
## No Information Rate : 0.608
## P-Value [Acc > NIR] : < 2e-16
##
## Kappa : 0.7391
##
## Mcnemar's Test P-Value : 0.01096
##
## Sensitivity : 0.8000
## Specificity : 0.9276
## Pos Pred Value : 0.8769
## Neg Pred Value : 0.8779
## Prevalence : 0.3920
## Detection Rate : 0.3136
## Detection Prevalence : 0.3576
## Balanced Accuracy : 0.8638
##
## 'Positive' Class : Dropout
## # ROC curve
rocObj_pca <- roc(
response = test_pca_baked$Target,
predictor = predProbs_pca,
levels = c("Graduate", "Dropout")
)## Setting direction: controls < casesplot(rocObj_pca,
main = "ROC Curve for Logistic Regression with PCA",
col = "#003057",
lwd = 2,
print.thres = seq(.2, .8, by = .2),
print.thres.pch = 19,
print.thres.col = "#97E152",
print.thres.cex = .8,
print.thres.adj = c(-.1, 1.5),
print.auc = TRUE,
print.auc.x = .4,
print.auc.y = .15
)
The baseline logistic regression outperformed the PCA-based model on every metric that matters for this use case. AIC increased from 1354 to 1590. Notably, the PCA model is simpler, so a higher AIC despite fewer predictors indicates real information loss, not just added complexity. More critically, Sensitivity dropped from .8386 to .8000, meaning the PCA model misses more at-risk students. Since catching Dropouts is the primary objective, the baseline model is the stronger choice. PCA improved multicollinearity and produced a more compact representation, but at an unacceptable cost to sensitivity. Note: While PCA produces more reliable standard errors. That means in some instances (ie causal inferences) one might prefer PCA even though it has lower predictive power.
I can apply this same basic framework to other models. Here is a K-Nearest Neighbors. This maps out data. on a high-dimension cartesian coordinate plan and groups new data points based on closest, known points (Think “You are the average of the 5 people wiith whom you spend the most time”). However, this requires only numeric values be used. It also is a good idea to normalize data; otherwise, variables with larger values would always have a greater influence on which observations are considered neighbors (imagine plotting income and height— income would dominate the distance calculation because its values are much larger).
# K-Nearest Neighbors
set.seed(8247)
train_knn <- train_simplified |>
select(where(is.numeric), Target) # Only numeric columns
test_knn <- test_simplified |>
select(where(is.numeric), Target)
knn_recipe <- recipe(Target ~ ., data = train_knn) |>
step_normalize(all_numeric_predictors()) # Normalize
knn_spec <- nearest_neighbor(neighbors = tune()) |>
set_engine("kknn") |> # Which package should be used
set_mode("classification") # Regression or classification
knn_wf <- workflow() |>
add_recipe(knn_recipe) |>
add_model(knn_spec) # Workflow is container for recipe and model
folds <- vfold_cv(train_knn, v = 5) # 5-fold cross validation
knnTune <- tune_grid(
knn_wf,
resamples = folds,
grid = tibble(neighbors = seq(3, 25, by = 1)),
metrics = metric_set(accuracy)
) # Finds optimal hyperparameters (In KNN, number of neighbors)
autoplot(knnTune)
knn_best <- select_best(knnTune, metric = "accuracy") # RMSE, MAE, Precision, Recall
knn_best## # A tibble: 1 × 2
## neighbors .config
## <dbl> <chr>
## 1 23 pre0_mod21_post0final_knn <- finalize_workflow(knn_wf, knn_best) |>
fit(train_knn) # Notice KNN has no "training" phase. It is a lazy learner
predClass_knn <- predict(final_knn, test_knn, type = "class") |>
bind_cols(test_knn) # This is my actual predictions for each student!
confusionMatrix(predClass_knn$.pred_class, test_knn$Target, positive = "Dropout")## Confusion Matrix and Statistics
##
## Reference
## Prediction Graduate Dropout
## Graduate 423 85
## Dropout 19 200
##
## Accuracy : 0.8569
## 95% CI : (0.8294, 0.8816)
## No Information Rate : 0.608
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.687
##
## Mcnemar's Test P-Value : 1.844e-10
##
## Sensitivity : 0.7018
## Specificity : 0.9570
## Pos Pred Value : 0.9132
## Neg Pred Value : 0.8327
## Prevalence : 0.3920
## Detection Rate : 0.2751
## Detection Prevalence : 0.3012
## Balanced Accuracy : 0.8294
##
## 'Positive' Class : Dropout
## predProb_knn <- predict(final_knn, test_knn, type = "prob") |>
bind_cols(test_knn) # Probabilities needed for ROC, not just predicted class
rocObj_knn <- roc(
response = test_knn$Target,
predictor = predProb_knn$.pred_Dropout,
levels = c("Graduate", "Dropout")
)## Setting direction: controls < casesplot(rocObj_knn,
main = "ROC Curve for KNN",
col = "#003057",
lwd = 2,
print.thres = seq(.2, .8, by = .2),
print.thres.pch = 19,
print.thres.col = "#97E152",
print.thres.cex = .8,
print.thres.adj = c(-.1, 1.5),
print.auc = TRUE,
print.auc.x = .4,
print.auc.y = .15
)
KNN did worse than our basic model. Sensitivity decreases substaintially (From .8386 all the way down to .7018). Oddly enough, Specificity increased (From .9276 to .9570). It appears this model does a slightly better job identifying Graduates. If that was my output of interest, I might be interested in keeping this model. But knowing the goals of his study, I will continue to use the baseline as the preferred model.
Another relatively simple model is the Random Forest. It consists of many decision trees (like a forest!) that are built independently of one another. For classification, each tree casts one vote, and the majority vote determines the final prediction. The “random” component comes from each tree being built using a random subset of the predictors (and typically a random sample of the data). This differs from a single optimal decision tree, which uses all predictors.
# Random Forest
set.seed(8247)
train_rf <- train_simplified |>
select(Target, everything())
test_rf <- test_simplified |>
select(Target, everything())
rf_spec <- rand_forest(mtry = tune(), trees = tune()) |> # Predictor subset size, Number of trees in forest
set_engine("ranger") |>
set_mode("classification")
rf_wf <- workflow() |>
add_formula(Target ~ .) |>
add_model(rf_spec)
folds <- vfold_cv(train_rf, v = 5)
rfTune <- tune_grid(
rf_wf,
resamples = folds,
grid = 30, # Combinations of hyperparameters to try
metrics = metric_set(accuracy)
) # Finds optimal hyperparameter (Specified in rf_spec)## i Creating pre-processing data to finalize 1 unknown parameter: "mtry"autoplot(rfTune)
rf_best <- select_best(rfTune, metric = "accuracy")
rf_best## # A tibble: 1 × 3
## mtry trees .config
## <int> <int> <chr>
## 1 17 690 pre0_mod19_post0final_rf <- finalize_workflow(rf_wf, rf_best) |>
fit(train_rf)
predClass_rf <- predict(final_rf, test_rf, type = "class") |>
bind_cols(test_rf) # This is my actual predictions for each student!
confusionMatrix(predClass_rf$.pred_class, test_rf$Target, positive = "Dropout")## Confusion Matrix and Statistics
##
## Reference
## Prediction Graduate Dropout
## Graduate 423 47
## Dropout 19 238
##
## Accuracy : 0.9092
## 95% CI : (0.8859, 0.9291)
## No Information Rate : 0.608
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.8062
##
## Mcnemar's Test P-Value : 0.000889
##
## Sensitivity : 0.8351
## Specificity : 0.9570
## Pos Pred Value : 0.9261
## Neg Pred Value : 0.9000
## Prevalence : 0.3920
## Detection Rate : 0.3274
## Detection Prevalence : 0.3535
## Balanced Accuracy : 0.8961
##
## 'Positive' Class : Dropout
## predProb_rf <- predict(final_rf, test_rf, type = "prob") |>
bind_cols(test_rf)
rocObj_rf <- roc(
response = test_rf$Target,
predictor = predProb_rf$.pred_Dropout,
levels = c("Graduate", "Dropout")
)## Setting direction: controls < casesplot(rocObj_rf,
main = "ROC Curve for Random Forest",
col = "#003057",
lwd = 2,
print.thres = seq(.2, .8, by = .2),
print.thres.pch = 19,
print.thres.col = "#97E152",
print.thres.cex = .8,
print.thres.adj = c(-.1, 1.5),
print.auc = TRUE,
print.auc.x = .4,
print.auc.y = .15
)
Random Forest also did slightly worse than my basic model. Sensitivity decreased (From .8386 to .8351). Specificity again increased (From .9276 to .9570). Again, I will continue to use the baseline as the preferred model. (Note: The Random Forest algorithm also handles multicolinearity because it does no rely on coefficient estimates).
XGBoost is similar in that it builds an ensemble of decision trees, but unlike Random Forest it builds them sequentially rather than independently. Each tree is trained to correct the error from the previous trees, gradually improving performance. And as opposed to Random Forest’s majority vote, XGBoost predicts by summing the outputs of all trees, with each tree’s contribution scaled by a learning rate.
# XGBoost
set.seed(8247)
train_xgb <- train_simplified
test_xgb <- test_simplified
xgb_spec <- boost_tree(
trees = tune(), # Number of boosting rounds
tree_depth = tune(), # Number of levels
learn_rate = tune(), # Learning rate after rounds
loss_reduction = tune(), # Split improvement to justify inclusion
sample_size = tune(), # Sample size from training data
mtry = tune() # Predictor subset size
) |>
set_engine("xgboost") |>
set_mode("classification")
xgb_wf <- workflow() |>
add_formula(Target ~ .) |>
add_model(xgb_spec)
folds <- vfold_cv(train_xgb, v = 5)
xgbTune <- tune_grid(
xgb_wf,
resamples = folds,
grid = 30,
metrics = metric_set(accuracy)
) # Finds optimal hyperparameters (see xgb_spec above)## i Creating pre-processing data to finalize 1 unknown parameter: "mtry"autoplot(xgbTune)
xgb_best <- select_best(xgbTune, metric = "accuracy")
xgb_best## # A tibble: 1 × 7
## mtry trees tree_depth learn_rate loss_reduction sample_size .config
## <int> <int> <int> <dbl> <dbl> <dbl> <chr>
## 1 12 1172 13 0.0788 0.0000000597 0.983 pre0_mod08_post0final_xgb <- finalize_workflow(xgb_wf, xgb_best) |>
fit(train_xgb)
predClass_xgb <- predict(final_xgb, test_xgb, type = "class") |>
bind_cols(test_xgb) # This is my actual predictions for each student!
confusionMatrix(predClass_xgb$.pred_class, test_xgb$Target, positive = "Dropout")## Confusion Matrix and Statistics
##
## Reference
## Prediction Graduate Dropout
## Graduate 412 50
## Dropout 30 235
##
## Accuracy : 0.89
## 95% CI : (0.8649, 0.9118)
## No Information Rate : 0.608
## P-Value [Acc > NIR] : < 2e-16
##
## Kappa : 0.7662
##
## Mcnemar's Test P-Value : 0.03365
##
## Sensitivity : 0.8246
## Specificity : 0.9321
## Pos Pred Value : 0.8868
## Neg Pred Value : 0.8918
## Prevalence : 0.3920
## Detection Rate : 0.3232
## Detection Prevalence : 0.3645
## Balanced Accuracy : 0.8783
##
## 'Positive' Class : Dropout
## predProb_xgb <- predict(final_xgb, test_xgb, type = "prob") |>
bind_cols(test_xgb)
rocObj_xgb <- roc(
response = test_xgb$Target,
predictor = predProb_xgb$.pred_Dropout,
levels = c("Graduate", "Dropout")
)## Setting direction: controls < casesplot(rocObj_xgb,
main = "ROC Curve for XGBoost",
col = "#003057",
lwd = 2,
print.thres = seq(.2, .8, by = .2),
print.thres.pch = 19,
print.thres.col = "#97E152",
print.thres.cex = .8,
print.thres.adj = c(-.1, 1.5),
print.auc = TRUE,
print.auc.x = .4,
print.auc.y = .15
)
XGBoost also did slightly worse than our basic model. Sensitivity decreased (From .8386 to .8246). Specificity again increased (From .9276 to .9321). Again, I will continue to use the baseline as the preferred model.
To demonstrate breadth, I apply a Neural Network using Tensorflow as a final comparison. Books could (and have) been written on how these models work. In short, a neural network mimics how the brain processes information by passing data through layers to recognize complex patterns. While R has packages for fitting neural networks, I’ll use TensorFlow through Python, called from R using reticulate, to build the model.
use_virtualenv("~/tf_env", required = TRUE)# TensorFlow Neural Network
import random
import pandas as pd
import numpy as np
import matplotlib.pyplot as plt
from sklearn.compose import ColumnTransformer
from sklearn.preprocessing import OneHotEncoder, StandardScaler
from sklearn.metrics import confusion_matrix, classification_report, roc_curve, auc
import tensorflow as tf
from tensorflow import keras
SEED = 8287
random.seed(SEED)
np.random.seed(SEED)
tf.random.set_seed(SEED)
# Grab training and test data froom R
train_nn = r.train_simplified.copy()
test_nn = r.test_simplified.copy()
X_train = train_nn.drop(columns=["Target"])
y_train = (train_nn["Target"] == "Dropout").astype(int)
X_test = test_nn.drop(columns=["Target"])
y_test = (test_nn["Target"] == "Dropout").astype(int)
# Preprocess data
numeric = X_train.select_dtypes(include=["number"]).columns
categorical = X_train.select_dtypes(exclude=["number"]).columns
preprocess_recipe = ColumnTransformer(
transformers=[
("numbers", StandardScaler(), numeric), # Standardize numbers
("categories", OneHotEncoder(handle_unknown="ignore"), categorical) # NN-readable categorical data
]
)
X_train = preprocess_recipe.fit_transform(X_train)
X_test = preprocess_recipe.transform(X_test)
# Neural network design
model = keras.Sequential([
keras.layers.Input(shape=(X_train.shape[1],)),
keras.layers.Dense(64, activation="relu"), # 64 nodes, "firing" of neuron if >0
keras.layers.Dropout(.3), # Randomly disable 30% of neurons during training
keras.layers.Dense(1, activation="sigmoid") # Binary prediction
]) # I spent a while tweaking the design. I tried deeper architectures and found they overfit on this dataset of only ~3k observations. One hidden layer with outperformed them
model.compile(
optimizer="adam", # Or stochastic gradient descent. Method for weight updating
loss="binary_crossentropy", # Only Dropout or Graduate. What is minimized
metrics=["accuracy"]
)
early_stop = keras.callbacks.EarlyStopping(
monitor="val_loss",
patience=5,
restore_best_weights=True
) # This was overtraining a lot, so I put a fail-safe to prevent that
# Model training
history = model.fit(
X_train,
y_train,
epochs=100,
batch_size=32,
validation_split=.2,
verbose=0,
callbacks=[early_stop]
)
# Predict probabilities
predProb_nn = model.predict(X_test).flatten() # This is my actual predictions for each student!## [1m 1/23[0m [37m━━━━━━━━━━━━━━━━━━━━[0m [1m1s[0m 53ms/step[1m23/23[0m [32m━━━━━━━━━━━━━━━━━━━━[0m[37m[0m [1m0s[0m 2ms/step# Probabilities to classes
predClass_nn = np.where(
predProb_nn > .5,
"Dropout",
"Graduate"
)
# Confusion matrix
confusionMatrix = confusion_matrix(
test_nn["Target"],
predClass_nn,
labels=["Dropout", "Graduate"]
)
print(confusionMatrix)## [[243 42]
## [ 31 411]]print(
classification_report(
test_nn["Target"],
predClass_nn,
target_names=["Dropout", "Graduate"]
)
)## precision recall f1-score support
##
## Dropout 0.89 0.85 0.87 285
## Graduate 0.91 0.93 0.92 442
##
## accuracy 0.90 727
## macro avg 0.90 0.89 0.89 727
## weighted avg 0.90 0.90 0.90 727true_negative, false_positive, false_negative, true_positive = confusion_matrix(
y_test,
predProb_nn > .5
).ravel()
sensitivity = true_positive / (true_positive + false_negative) # AKA Recall
print(f"\nSensitivity: {sensitivity:.4f}")##
## Sensitivity: 0.8526# ROC Curve
false_positive_rate, true_positive_rate, thresholds = roc_curve(y_test, predProb_nn)
roc_auc = auc(false_positive_rate, true_positive_rate)
plt.figure(figsize=(6, 6))
plt.plot(
false_positive_rate,
true_positive_rate,
color="#003057",
linewidth=2,
label=f"AUC = {roc_auc:.3f}"
)
plt.plot([0, 1], [0, 1], "k--")
plt.xlabel("False Positive Rate")
plt.ylabel("True Positive Rate")
plt.title("ROC Curve for TensorFlow Neural Network")
plt.legend(loc="lower right")
plt.show()
The Neural Network beat the baseline model! Sensitivity increased from
.8386 to .8526. The improvement is slight, but it is what was being
optimized during his study. Note 1: While this model may be optimal now,
it would be important to monitor for continuous improvement. While this
is the best model now, new students, legislation, socioeconomic, or
known factors may chance optimal predictions. One way to combat this is
a retraining trigger if performance degrades beyond a defined threshold
(eg. If sensitiviy drops below .8000). Note 2: Neural networks
coefficients are highly unintuitive. It almost impossible to determine
which factor contribute most to Dropout potential. While it may do the
best job predicting Graduate/Dropout, it cannot explain why that
prediction is made. This is in opposition to the logistic model which
easily explained “early semester performance has the largest impact”. If
this was a study for WHICH factors have the largest impact, I would opt
for something like logistic regression even though the neural network
predicts better.
I will use this model to predict which currently enrolled students might be given some type of intervention.
# Using only currently enrolled students
enrolled_simplified <- rawData |>
filter(Target == "Enrolled") |>
droplevels() |>
mutate(
Marital.status = fct_other(Marital.status, keep = lump_levels$Marital.status),
Application.mode = fct_other(Application.mode, keep = lump_levels$Application.mode),
Course = fct_other(Course, keep = lump_levels$Course),
Previous.qualification = fct_other(Previous.qualification, keep = lump_levels$Previous.qualification),
Nacionality = fct_other(Nacionality, keep = lump_levels$Nacionality),
Mother.s.occupation = fct_other(Mother.s.occupation, keep = lump_levels$Mother.s.occupation),
Father.s.occupation = fct_other(Father.s.occupation, keep = lump_levels$Father.s.occupation),
Mother.s.qualification = fct_other(Mother.s.qualification, keep = lump_levels$Mother.s.qualification),
Father.s.qualification = fct_other(Father.s.qualification, keep = lump_levels$Father.s.qualification)
) |>
select(
-c(
Marital.status,
Application.order,
Daytime.evening.attendance.,
International
),
-matches("(?i)mother"),
-matches("(?i)father")
)enrolled_nn = r.enrolled_simplified.copy()
X_enrolled = enrolled_nn.drop(columns=["Target"])
# Preprocess data in same way for model
numeric = X_enrolled.select_dtypes(include=["number"]).columns
categorical = X_enrolled.select_dtypes(exclude=["number"]).columns
X_enrolled = preprocess_recipe.transform(X_enrolled)
enrolledProb_nn = model.predict(X_enrolled).flatten() # This is my actual predictions for each student! This time for students where the "correct" answer is not known## [1m 1/25[0m [37m━━━━━━━━━━━━━━━━━━━━[0m [1m0s[0m 22ms/step[1m25/25[0m [32m━━━━━━━━━━━━━━━━━━━━[0m[37m[0m [1m0s[0m 2ms/stepenrolledClass_nn = np.where(
enrolledProb_nn > .5,
"Dropout",
"Graduate"
)enrolledProb_nn <- py$enrolledProb_nn
enrolledClass_nn <- py$enrolledClass_nn
enrolled_results <- data.frame(
Student_id = 1:length(enrolledProb_nn),
Dropout_Probability = enrolledProb_nn,
Graduate_Dropout_Prediction = enrolledClass_nn
)
# Which students will drop out in order of model confidence
dropouts <- enrolled_results |>
filter(Graduate_Dropout_Prediction == "Dropout")
nrow(dropouts)## [1] 404dropouts |>
arrange(desc(Dropout_Probability)) |>
head(25)## Student_id Dropout_Probability Graduate_Dropout_Prediction
## 1 30 0.9999714 Dropout
## 2 157 0.9999596 Dropout
## 3 391 0.9999090 Dropout
## 4 163 0.9998428 Dropout
## 5 674 0.9997957 Dropout
## 6 554 0.9997841 Dropout
## 7 20 0.9995615 Dropout
## 8 482 0.9994577 Dropout
## 9 498 0.9994521 Dropout
## 10 265 0.9992898 Dropout
## 11 713 0.9992771 Dropout
## 12 488 0.9992689 Dropout
## 13 15 0.9991385 Dropout
## 14 168 0.9988894 Dropout
## 15 326 0.9987278 Dropout
## 16 753 0.9986851 Dropout
## 17 44 0.9983725 Dropout
## 18 268 0.9983531 Dropout
## 19 59 0.9979700 Dropout
## 20 772 0.9978831 Dropout
## 21 699 0.9978712 Dropout
## 22 649 0.9977934 Dropout
## 23 510 0.9977838 Dropout
## 24 415 0.9976854 Dropout
## 25 490 0.9976150 DropoutThe DECISION part of a DECISION SCIENTIST: I recommend intervention on behalf of these 404 students who are predicted to Dropout. If resources are scare, I recommend intervention in the indicated order (most needed first). While our final model is not able to indicate exactly what factor is most important- and therefore what intervention might be most helpful- our baseline model suggests early semester performance plays a significant role. Perhaps a “no-cost class retake” or an “integrated course” that reviews 100 level classes while moving onto to 200 level material. If these students are and/or feel behind, our models suggest that catching them up may make the difference in graduating or dropping out.