There are significant educational, social and financial costs associated with failing schools.
A failing school often exhibits lower attainment, poorer attendance, greater behavioural challenges and weaker long-term outcomes for children and young people. These effects can become self-reinforcing, creating a cycle that can be difficult and expensive to reverse.
Whilst school improvement activity is often successful, prevention is preferable to remediation. The purpose of this project is therefore to investigate whether machine learning techniques can identify schools at risk of adverse inspection outcomes before those outcomes occur.
The objective is not to replace professional judgement. Rather, the ambition is to provide an additional evidence source which may assist education professionals in targeting support and intervention earlier.
Each year schools move into categories requiring increased support and intervention.
Whilst these schools subsequently receive support from experienced school improvement professionals, significant costs may already have been incurred by that stage.
This project seeks to determine whether publicly available education, attendance, attainment, deprivation and inspection data can be used to identify schools that may be on a trajectory towards future concerns.
This project seeks to answer the following questions:
Can the new Ofsted evaluation outcomes be predicted using publicly available data?
Which school characteristics are most strongly associated with adverse outcomes?
Which modelling approach provides the best balance between predictive performance and explainability?
Can schools requiring intervention be identified early enough to support preventative action?
The primary objective is to maximise identification of schools requiring intervention whilst maintaining an operationally manageable level of false positives.
Target performance measures are:
Recall is considered the most important metric because the cost of failing to identify a genuinely vulnerable school is likely to exceed the cost of supporting a school that ultimately proves not to require intervention.
Multiple open-source datasets are used within this project.
These datasets are linked together at school level using a unique school identifier (URN). The resulting analytical dataset combines inspection outcomes, attendance measures, attainment data, deprivation measures and school characteristics.
The primary datasets used are:
All datasets are publicly available - links to source data in ‘Data Sources’ and Appendix.
Model development is being undertaken using R Studio and the R programming language.
This environment provides a wide range of packages for data preparation, exploratory analysis, visualisation, machine learning, model evaluation and explainability.
Should the project progress beyond proof-of-concept, deployment and operationalisation would likely occur within the Azure ecosystem.
The following packages are used throughout the project for data manipulation, visualisation, modelling and evaluation.
library(tidyverse)
## Warning: package 'tidyverse' was built under R version 4.6.1
## Warning: package 'ggplot2' was built under R version 4.6.1
## Warning: package 'tibble' was built under R version 4.6.1
## Warning: package 'tidyr' was built under R version 4.6.1
## Warning: package 'readr' was built under R version 4.6.1
## Warning: package 'purrr' was built under R version 4.6.1
## Warning: package 'dplyr' was built under R version 4.6.1
## Warning: package 'stringr' was built under R version 4.6.1
## Warning: package 'forcats' was built under R version 4.6.1
## Warning: package 'lubridate' was built under R version 4.6.1
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.2.1 ✔ readr 2.2.0
## ✔ forcats 1.0.1 ✔ stringr 1.6.0
## ✔ ggplot2 4.0.3 ✔ tibble 3.3.1
## ✔ lubridate 1.9.5 ✔ tidyr 1.3.2
## ✔ purrr 1.2.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(janitor)
## Warning: package 'janitor' was built under R version 4.6.1
##
## Attaching package: 'janitor'
##
## The following objects are masked from 'package:stats':
##
## chisq.test, fisher.test
library(naniar)
## Warning: package 'naniar' was built under R version 4.6.1
library(caret)
## Warning: package 'caret' was built under R version 4.6.1
## Loading required package: lattice
##
## Attaching package: 'caret'
##
## The following object is masked from 'package:purrr':
##
## lift
library(randomForest)
## Warning: package 'randomForest' was built under R version 4.6.1
## randomForest 4.7-1.2
## Type rfNews() to see new features/changes/bug fixes.
##
## Attaching package: 'randomForest'
##
## The following object is masked from 'package:dplyr':
##
## combine
##
## The following object is masked from 'package:ggplot2':
##
## margin
library(rpart)
library(rpart.plot)
## Warning: package 'rpart.plot' was built under R version 4.6.1
library(yardstick)
## Warning: package 'yardstick' was built under R version 4.6.1
##
## Attaching package: 'yardstick'
##
## The following objects are masked from 'package:caret':
##
## precision, recall, sensitivity, specificity
##
## The following object is masked from 'package:readr':
##
## spec
library(knitr)
## Warning: package 'knitr' was built under R version 4.6.1
A range of open-source educational datasets have been assembled to support model development.
Data is sourced from Ofsted, the Department for Education and related public datasets. These datasets cover inspection outcomes, attendance, exclusions, attainment, deprivation and school characteristics.
The objective at this stage is to import all datasets, standardise key identifiers and undertake an initial assessment of data quality and coverage before attempting any linkage.
# File locations
input_path <- "Inputs/"
output_path <- "Outputs/"
ofsted <- read.csv(
paste0(
input_path,
"Ofsted latest results as at March 2026.csv"
)
)
dim(ofsted)
## [1] 21965 85
names(ofsted)
## [1] "Web.Link"
## [2] "URN"
## [3] "LAESTAB"
## [4] "School.name"
## [5] "Ofsted.phase"
## [6] "Type.of.education"
## [7] "School.open.date"
## [8] "Admissions.policy"
## [9] "Sixth.form"
## [10] "Designated.religious.character"
## [11] "Religious.ethos"
## [12] "Faith.grouping"
## [13] "Ofsted.region"
## [14] "Region"
## [15] "Local.authority"
## [16] "Parliamentary.constituency"
## [17] "Postcode"
## [18] "Multi.academy.trust.UID"
## [19] "Multi.academy.trust.name"
## [20] "Academy.sponsor.UID"
## [21] "Academy.sponsor.name"
## [22] "The.income.deprivation.affecting.children.index..IDACI..quintile"
## [23] "Total.number.of.pupils"
## [24] "Statutory.lowest.age"
## [25] "Statutory.highest.age"
## [26] "Inspection.number.of.latest.full.inspection"
## [27] "Inspection.type"
## [28] "Inspection.type.grouping"
## [29] "Event.type.grouping"
## [30] "Inspection.start.date"
## [31] "Publication.date"
## [32] "Does.the.latest.full.inspection.relate.to.the.URN.of.the.current.school."
## [33] "URN.at.time.of.latest.full.inspection"
## [34] "LAESTAB.at.time.of.latest.full.inspection"
## [35] "School.name.at.time.of.latest.full.inspection"
## [36] "School.type.at.time.of.latest.full.inspection"
## [37] "Category.of.concern"
## [38] "Safeguarding.standards"
## [39] "Safeguarding.standards...date.of.grade"
## [40] "Inclusion"
## [41] "Inclusion...date.of.grade"
## [42] "Curriculum.and.teaching"
## [43] "Curriculum.and.teaching...date.of.grade"
## [44] "Achievement"
## [45] "Achievement...date.of.grade"
## [46] "Attendance.and.behaviour"
## [47] "Attendance.and.behaviour...date.of.grade"
## [48] "Personal.development.and.wellbeing"
## [49] "Personal.development.and.wellbeing...date.of.grade"
## [50] "Early.years..where.applicable."
## [51] "Early.years...date.of.grade"
## [52] "Post.16.provision..where.applicable."
## [53] "Post.16.provision...date.of.grade"
## [54] "Leadership.and.governance"
## [55] "Leadership.and.governance...date.of.grade"
## [56] "Inspection.number.of.latest.OEIF.graded.inspection"
## [57] "Inspection.type.of.latest.OEIF.graded.inspection"
## [58] "Inspection.type.grouping.of.latest.OEIF.graded.inspection"
## [59] "Event.type.grouping.of.latest.OEIF.graded.inspection"
## [60] "Inspection.start.date.of.latest.OEIF.graded.inspection"
## [61] "Publication.date.of.latest.OEIF.graded.inspection"
## [62] "Does.the.latest.OEIF.graded.inspection.relate.to.the.URN.of.the.current.school."
## [63] "URN.at.time.of.latest.OEIF.graded.inspection"
## [64] "LAESTAB.at.time.of.latest.OEIF.graded.inspection"
## [65] "School.name.at.time.of.latest.OEIF.graded.inspection"
## [66] "School.type.at.time.of.latest.OEIF.graded.inspection"
## [67] "Latest.OEIF.category.of.concern"
## [68] "Latest.OEIF.overall.effectiveness"
## [69] "Latest.OEIF.quality.of.education"
## [70] "Latest.OEIF.behaviour.and.attitudes"
## [71] "Latest.OEIF.personal.development"
## [72] "Latest.OEIF.effectiveness.of.leadership.and.management"
## [73] "Latest.OEIF..safeguarding.is.effective."
## [74] "Latest.OEIF.early.years.provision..where.applicable."
## [75] "Latest.OEIF.sixth.form.provision..where.applicable."
## [76] "Latest.ungraded.inspection.number"
## [77] "Date.of.latest.ungraded.inspection"
## [78] "Ungraded.inspection.publication.date"
## [79] "Does.the.ungraded.inspection.relate.to.the.URN.of.the.current.school."
## [80] "URN.at.time.of.the.ungraded.inspection"
## [81] "LAESTAB.at.time.of.the.ungraded.inspection"
## [82] "School.name.at.time.of.the.ungraded.inspection"
## [83] "School.type.at.time.of.the.ungraded.inspection"
## [84] "Ungraded.inspection.overall.outcome"
## [85] "Most.recent.category.of.concern"
Before linking external datasets, an initial review of the Ofsted extract was undertaken to understand its size, structure and coverage.
This dataset represents the foundation of the analysis and contains inspection outcomes and school identifiers that will subsequently be used to link attendance, attainment, deprivation and school census information.
cat("Rows:", nrow(ofsted), "\n")
## Rows: 21965
cat("Columns:", ncol(ofsted), "\n")
## Columns: 85
grep(
"effectiveness|achievement|attendance|behaviour|inclusion|curriculum",
names(ofsted),
value = TRUE,
ignore.case = TRUE
)
## [1] "Inclusion"
## [2] "Inclusion...date.of.grade"
## [3] "Curriculum.and.teaching"
## [4] "Curriculum.and.teaching...date.of.grade"
## [5] "Achievement"
## [6] "Achievement...date.of.grade"
## [7] "Attendance.and.behaviour"
## [8] "Attendance.and.behaviour...date.of.grade"
## [9] "Latest.OEIF.overall.effectiveness"
## [10] "Latest.OEIF.behaviour.and.attitudes"
## [11] "Latest.OEIF.effectiveness.of.leadership.and.management"
The Ofsted inspection dataset contains 21,965 schools and 85 variables.
The dataset contains both historic inspection outcomes and the new inspection framework introduced during 2025.
Analysis confirmed that approximately 910 schools had been inspected and graded against the NEW framework at the time of analysis. This significantly reduces the volume of observations available for supervised machine learning and represents a key project constraint.
The limited number of schools assessed under the new framework has implications for model choice, class balance and achievable predictive performance.
table(
ofsted$Attendance.and.behaviour,
useNA = "always"
)
##
## Exceptional Expected standard Needs attention NULL
## 10 479 125 21044
## Strong standard Urgent improvement <NA>
## 291 16 0
round(
100 *
mean(
!is.na(ofsted$Attendance.and.behaviour)
),
2
)
## [1] 100
Only a small proportion of schools currently possess new framework inspection outcomes. Consequently, model training must initially focus on this subset of inspected schools.
The following datasets were initially identified for potential use in model development.
Attendance data was obtained from the Department for Education and contains absence measures across multiple academic years.
For the purposes of this project, only the most recent three academic years were retained.
absence_rates <- read.csv(
paste0(
input_path,
"Absence Rates.csv"
)
) %>%
filter(
time_period %in%
c(
"202223",
"202324",
"202425"
)
)
dim(absence_rates)
## [1] 63861 80
table(absence_rates$time_period)
##
## 202223 202324 202425
## 21281 21318 21262
The attendance dataset contains information for multiple academic years and includes a school-level identifier that will enable linkage to inspection and attainment data.
Initial review confirmed that data was available for the three most recent academic years selected for inclusion within the project.
Suspension and exclusion data was imported to provide measures relating to pupil behaviour and school discipline. These variables were considered likely predictors of future inspection outcomes, particularly within the Attendance and Behaviour domain.
exclusions_suspensions <- read.csv(
paste0(
input_path,
"Exclusions and suspensions.csv"
)
) %>%
filter(
time_period %in%
c(
"202223",
"202324",
"202425"
)
)
dim(exclusions_suspensions)
## [1] 64020 25
imd_idaci <- read.csv(
paste0(
input_path,
"IMD and IDACI 2025.csv"
)
)
lookup <- read.csv(
paste0(
input_path,
"Postcode to LSOA lookup.csv"
)
)
KS2_2023 <- read.csv(
paste0(
input_path,
"KS2 2023.csv"
)
)
KS2_2024 <- read.csv(
paste0(
input_path,
"KS2 2024.csv"
)
)
KS2_2025 <- read.csv(
paste0(
input_path,
"KS2 2025.csv"
)
)
KS4_2023 <- read.csv(
paste0(
input_path,
"KS4 2023.csv"
)
)
KS4_2024 <- read.csv(
paste0(
input_path,
"KS4 2024.csv"
)
)
KS4_2025 <- read.csv(
paste0(
input_path,
"KS4 2025.csv"
)
)
school_census_2023 <- read.csv(
paste0(
input_path,
"School Census 2023.csv"
)
)
school_census_2024 <- read.csv(
paste0(
input_path,
"School Census 2024.csv"
)
)
school_census_2025 <- read.csv(
paste0(
input_path,
"School Census 2025.csv"
)
)
school_characteristics_2023 <- read.csv(
paste0(
input_path,
"School Characteristics 2023.csv"
)
)
school_characteristics_2024 <- read.csv(
paste0(
input_path,
"School Characteristics 2024.csv"
)
)
school_characteristics_2025 <- read.csv(
paste0(
input_path,
"School Characteristics 2025.csv"
)
)
school_information_2023 <- read.csv(
paste0(
input_path,
"School Information 2023.csv"
)
)
school_information_2024 <- read.csv(
paste0(
input_path,
"School Information 2024.csv"
)
)
school_information_2025 <- read.csv(
paste0(
input_path,
"School Information 2025.csv"
)
)
With all data read, I will now prepare data for some initial exploratory analysis and auditing
Datasets sourced from different providers used slightly different naming conventions for school identifiers.
To enable consistent joining across datasets, all school identifiers were standardised to a variable named URN and converted to character format.
fix_urn <- function(df){
if("urn" %in% names(df))
df <- rename(df, URN = urn)
if("school_urn" %in% names(df))
df <- rename(df, URN = school_urn)
if("URN" %in% names(df))
df$URN <- as.character(df$URN)
df
}
# Ofsted
ofsted <- fix_urn(ofsted)
# Attendance
absence_rates <- fix_urn(absence_rates)
# Exclusions
exclusions_suspensions <- fix_urn(exclusions_suspensions)
# KS2
KS2_2023 <- fix_urn(KS2_2023)
KS2_2024 <- fix_urn(KS2_2024)
KS2_2025 <- fix_urn(KS2_2025)
# KS4
KS4_2023 <- fix_urn(KS4_2023)
KS4_2024 <- fix_urn(KS4_2024)
KS4_2025 <- fix_urn(KS4_2025)
# School Census
school_census_2023 <- fix_urn(school_census_2023)
school_census_2024 <- fix_urn(school_census_2024)
school_census_2025 <- fix_urn(school_census_2025)
# School Characteristics
school_characteristics_2023 <- fix_urn(school_characteristics_2023)
school_characteristics_2024 <- fix_urn(school_characteristics_2024)
school_characteristics_2025 <- fix_urn(school_characteristics_2025)
# School Information
school_information_2023 <- fix_urn(school_information_2023)
school_information_2024 <- fix_urn(school_information_2024)
school_information_2025 <- fix_urn(school_information_2025)
datasets <- list(
ofsted = ofsted,
absence_rates = absence_rates,
exclusions_suspensions = exclusions_suspensions,
KS2_2025 = KS2_2025,
KS4_2025 = KS4_2025,
school_census_2025 = school_census_2025,
school_characteristics_2025 = school_characteristics_2025,
school_information_2025 = school_information_2025
)
sapply(
datasets,
function(x) "URN" %in% names(x)
)
## ofsted absence_rates
## TRUE TRUE
## exclusions_suspensions KS2_2025
## TRUE TRUE
## KS4_2025 school_census_2025
## TRUE TRUE
## school_characteristics_2025 school_information_2025
## TRUE TRUE
Many source datasets contain hundreds of variables.
To avoid an exploratory “fishing expedition”, variables were reduced prior to integration using a combination of:
Variables retained were those considered most likely to support prediction of future inspection outcomes.
attendance_vars <- c(
"URN",
"time_period",
"school_name",
"enrolments",
"enrolments_pa_10_exact_percent",
"enrolments_pa_50_exact_percent",
"sess_authorised_percent",
"sess_unauthorised_percent"
)
absence_rates <- absence_rates %>%
select(
any_of(attendance_vars)
)
absence_rates <- absence_rates %>%
rename(
persistent_absence_10_pct =
enrolments_pa_10_exact_percent,
severe_absence_50_pct =
enrolments_pa_50_exact_percent,
authorised_absence_pct =
sess_authorised_percent,
unauthorised_absence_pct =
sess_unauthorised_percent
)
names(absence_rates)
## [1] "URN" "time_period"
## [3] "school_name" "enrolments"
## [5] "persistent_absence_10_pct" "severe_absence_50_pct"
## [7] "authorised_absence_pct" "unauthorised_absence_pct"
The exclusions and suspensions dataset contains several measures relating to pupil behaviour and disciplinary action.
A reduced subset of variables was retained, focusing on permanent exclusions, suspensions and the proportion of pupils affected by suspension. These measures were considered most relevant to future inspection outcomes and subsequent modelling exercises.
exclusions_vars <- c(
"URN",
"time_period",
"school_name",
"perm_excl",
"perm_excl_rate",
"suspension",
"susp_rate",
"one_plus_susp",
"one_plus_susp_rate"
)
exclusions_suspensions <- exclusions_suspensions %>%
select(
any_of(exclusions_vars)
)
exclusions_suspensions <- exclusions_suspensions %>%
rename(
permanent_exclusions =
perm_excl,
permanent_exclusions_rate =
perm_excl_rate,
suspensions =
suspension,
suspension_rate =
susp_rate,
pupils_with_suspension =
one_plus_susp,
pupils_with_suspension_rate =
one_plus_susp_rate
)
exclusions_suspensions <- exclusions_suspensions %>%
mutate(
suspension_rate =
as.numeric(
suspension_rate
),
permanent_exclusions_rate =
as.numeric(
permanent_exclusions_rate
)
)
## Warning: There were 2 warnings in `mutate()`.
## The first warning was:
## ℹ In argument: `suspension_rate = as.numeric(suspension_rate)`.
## Caused by warning:
## ! NAs introduced by coercion
## ℹ Run `dplyr::last_dplyr_warnings()` to see the 1 remaining warning.
names(exclusions_suspensions)
## [1] "URN" "time_period"
## [3] "school_name" "permanent_exclusions"
## [5] "permanent_exclusions_rate" "suspensions"
## [7] "suspension_rate" "pupils_with_suspension"
## [9] "pupils_with_suspension_rate"
The KS2 dataset contains more than 300 variables covering attainment, progress, pupil characteristics and subgroup analysis.
To maintain transparency and reduce dimensionality, a reduced set of variables was retained focusing on attainment, progress, educational disadvantage and pupil mobility.
Variables were selected based on prior modelling results, literature review and discussion with education professionals.
ks2_vars <- c(
"URN",
# Context
"PTEALGRP2",
"PTMOBN",
# Attainment
"PTRWM_EXP",
"PTRWM_HIGH",
# Progress
"READPROG",
"WRITPROG",
"MATPROG",
# Disadvantage Gap
"DIFFN_RWM_EXP"
)
KS2_2023 <- KS2_2023 %>%
select(any_of(ks2_vars))
KS2_2024 <- KS2_2024 %>%
select(any_of(ks2_vars))
KS2_2025 <- KS2_2025 %>%
select(any_of(ks2_vars))
The functions below clean some percentage variables that are currently read as ‘character’ variables
clean_percentage <- function(x){
x[x == ""] <- NA
as.numeric(
gsub(
"%",
"",
x
)
)
}
clean_numeric <- function(x){
x[x %in% c(
"",
"SUPP",
"NP",
"NE"
)] <- NA
as.numeric(x)
}
rename_ks2 <- function(df){
df %>%
rename(
eal_pct =
PTEALGRP2,
pupil_mobility_pct =
PTMOBN,
ks2_expected_standard_pct =
PTRWM_EXP,
ks2_higher_standard_pct =
PTRWM_HIGH,
reading_progress =
READPROG,
writing_progress =
WRITPROG,
maths_progress =
MATPROG,
disadvantage_gap_rwm =
DIFFN_RWM_EXP
)
}
KS2_2023 <- rename_ks2(KS2_2023)
KS2_2024 <- rename_ks2(KS2_2024)
KS2_2025 <- rename_ks2(KS2_2025)
KS2_2023 <- KS2_2023 %>%
mutate(
eal_pct =
clean_percentage(eal_pct),
pupil_mobility_pct =
clean_percentage(pupil_mobility_pct),
ks2_expected_standard_pct =
clean_percentage(ks2_expected_standard_pct),
ks2_higher_standard_pct =
clean_percentage(ks2_higher_standard_pct),
disadvantage_gap_rwm =
clean_numeric(disadvantage_gap_rwm)
)
## Warning: There were 4 warnings in `mutate()`.
## The first warning was:
## ℹ In argument: `eal_pct = clean_percentage(eal_pct)`.
## Caused by warning in `clean_percentage()`:
## ! NAs introduced by coercion
## ℹ Run `dplyr::last_dplyr_warnings()` to see the 3 remaining warnings.
KS2_2024 <- KS2_2024 %>%
mutate(
eal_pct =
clean_percentage(eal_pct),
pupil_mobility_pct =
clean_percentage(pupil_mobility_pct),
ks2_expected_standard_pct =
clean_percentage(ks2_expected_standard_pct),
ks2_higher_standard_pct =
clean_percentage(ks2_higher_standard_pct),
disadvantage_gap_rwm =
clean_numeric(disadvantage_gap_rwm)
)
## Warning: There were 4 warnings in `mutate()`.
## The first warning was:
## ℹ In argument: `eal_pct = clean_percentage(eal_pct)`.
## Caused by warning in `clean_percentage()`:
## ! NAs introduced by coercion
## ℹ Run `dplyr::last_dplyr_warnings()` to see the 3 remaining warnings.
KS2_2025 <- KS2_2025 %>%
mutate(
eal_pct =
clean_percentage(eal_pct),
pupil_mobility_pct =
clean_percentage(pupil_mobility_pct),
ks2_expected_standard_pct =
clean_percentage(ks2_expected_standard_pct),
ks2_higher_standard_pct =
clean_percentage(ks2_higher_standard_pct),
disadvantage_gap_rwm =
clean_numeric(disadvantage_gap_rwm)
)
## Warning: There were 4 warnings in `mutate()`.
## The first warning was:
## ℹ In argument: `eal_pct = clean_percentage(eal_pct)`.
## Caused by warning in `clean_percentage()`:
## ! NAs introduced by coercion
## ℹ Run `dplyr::last_dplyr_warnings()` to see the 3 remaining warnings.
names(KS2_2025)
## [1] "URN" "eal_pct"
## [3] "pupil_mobility_pct" "ks2_expected_standard_pct"
## [5] "ks2_higher_standard_pct" "reading_progress"
## [7] "writing_progress" "maths_progress"
## [9] "disadvantage_gap_rwm"
The KS4 dataset contains several hundred variables covering attainment, progress, subjects and pupil sub-groups.
A reduced set of variables was retained focusing on overall attainment, progress and core English and mathematics outcomes.
Variables were selected based on educational relevance, inspection framework alignment and findings from initial modelling exercises.
ks4_vars <- c(
"URN",
"ATT8SCR",
"P8MEA",
"PTL2BASICS_94",
"PTL2BASICS_95",
"EBACCAPS"
)
KS4_2023 <- KS4_2023 %>%
select(any_of(ks4_vars))
KS4_2024 <- KS4_2024 %>%
select(any_of(ks4_vars))
KS4_2025 <- KS4_2025 %>%
select(any_of(ks4_vars))
rename_ks4 <- function(df){
df %>%
rename(
attainment8_score =
ATT8SCR,
progress8_score =
P8MEA,
basics_grade4_pct =
PTL2BASICS_94,
basics_grade5_pct =
PTL2BASICS_95,
ebacc_average_points =
EBACCAPS
)
}
KS4_2023 <- rename_ks4(KS4_2023)
KS4_2024 <- rename_ks4(KS4_2024)
KS4_2025 <- rename_ks4(KS4_2025)
names(KS4_2025)
## [1] "URN" "attainment8_score" "progress8_score"
## [4] "basics_grade4_pct" "basics_grade5_pct" "ebacc_average_points"
KS4_2023 <- KS4_2023 %>%
mutate(
basics_grade4_pct =
clean_percentage(
basics_grade4_pct
),
basics_grade5_pct =
clean_percentage(
basics_grade5_pct
)
)
## Warning: There were 2 warnings in `mutate()`.
## The first warning was:
## ℹ In argument: `basics_grade4_pct = clean_percentage(basics_grade4_pct)`.
## Caused by warning in `clean_percentage()`:
## ! NAs introduced by coercion
## ℹ Run `dplyr::last_dplyr_warnings()` to see the 1 remaining warning.
KS4_2024 <- KS4_2024 %>%
mutate(
basics_grade4_pct =
clean_percentage(
basics_grade4_pct
),
basics_grade5_pct =
clean_percentage(
basics_grade5_pct
)
)
## Warning: There were 2 warnings in `mutate()`.
## The first warning was:
## ℹ In argument: `basics_grade4_pct = clean_percentage(basics_grade4_pct)`.
## Caused by warning in `clean_percentage()`:
## ! NAs introduced by coercion
## ℹ Run `dplyr::last_dplyr_warnings()` to see the 1 remaining warning.
KS4_2025 <- KS4_2025 %>%
mutate(
basics_grade4_pct =
clean_percentage(
basics_grade4_pct
),
basics_grade5_pct =
clean_percentage(
basics_grade5_pct
)
)
## Warning: There were 2 warnings in `mutate()`.
## The first warning was:
## ℹ In argument: `basics_grade4_pct = clean_percentage(basics_grade4_pct)`.
## Caused by warning in `clean_percentage()`:
## ! NAs introduced by coercion
## ℹ Run `dplyr::last_dplyr_warnings()` to see the 1 remaining warning.
The school census dataset contains contextual information relating to pupil characteristics.
A reduced set of variables was retained focusing on school size, deprivation, special educational needs and English as an additional language.
These variables have strong theoretical links to school performance and inspection outcomes and several also demonstrated predictive value during earlier modelling exercises.
census_vars <- c(
"URN",
"NOR",
"NUMFSM",
"NUMFSMEVER",
"PNUMFSMEVER",
"NUMEAL",
"PNUMEAL",
"PSENELSE",
"PSENELK"
)
school_census_2023 <- school_census_2023 %>%
select(any_of(census_vars))
school_census_2024 <- school_census_2024 %>%
select(any_of(census_vars))
school_census_2025 <- school_census_2025 %>%
select(any_of(census_vars))
rename_census <- function(df){
df %>%
rename(
total_pupils =
NOR,
fsm_count =
NUMFSM,
fsmever_count =
NUMFSMEVER,
fsmever_pct =
PNUMFSMEVER,
eal_count =
NUMEAL,
eal_pct =
PNUMEAL,
send_support_pct =
PSENELSE,
ehcp_pct =
PSENELK
)
}
school_census_2023 <- rename_census(
school_census_2023
)
school_census_2024 <- rename_census(
school_census_2024
)
school_census_2025 <- rename_census(
school_census_2025
)
school_census_2023 <- school_census_2023 %>%
mutate(
fsmever_pct =
clean_percentage(fsmever_pct),
send_support_pct =
clean_percentage(send_support_pct),
ehcp_pct =
clean_percentage(ehcp_pct)
)
school_census_2024 <- school_census_2024 %>%
mutate(
fsmever_pct =
clean_percentage(fsmever_pct),
send_support_pct =
clean_percentage(send_support_pct),
ehcp_pct =
clean_percentage(ehcp_pct)
)
school_census_2025 <- school_census_2025 %>%
mutate(
fsmever_pct =
clean_percentage(fsmever_pct),
send_support_pct =
clean_percentage(send_support_pct),
ehcp_pct =
clean_percentage(ehcp_pct)
)
names(school_census_2025)
## [1] "URN" "total_pupils" "fsm_count" "fsmever_count"
## [5] "fsmever_pct" "eal_count" "eal_pct" "send_support_pct"
## [9] "ehcp_pct"
The school characteristics dataset contained a large number of structural, demographic and geographic variables.
To maintain explainability and reduce dimensionality, a reduced subset of variables was retained focusing on school phase, school type, governance arrangements and geographic context.
These variables were considered potential contextual factors that may influence inspection outcomes whilst remaining straightforward to interpret and explain.
characteristics_vars <- c(
"URN",
"phase_type_grouping",
"typeofestablishment_name",
"academy_flag",
"urban_rural",
"school_size",
"trust",
"admissions_policy"
)
school_characteristics_2023 <- school_characteristics_2023 %>%
select(any_of(characteristics_vars))
school_characteristics_2024 <- school_characteristics_2024 %>%
select(any_of(characteristics_vars))
school_characteristics_2025 <- school_characteristics_2025 %>%
select(any_of(characteristics_vars))
rename_characteristics <- function(df){
df %>%
rename(
education_phase =
phase_type_grouping,
school_type =
typeofestablishment_name,
academy_status =
academy_flag,
academy_trust =
trust
)
}
school_characteristics_2023 <-
rename_characteristics(
school_characteristics_2023
)
school_characteristics_2024 <-
rename_characteristics(
school_characteristics_2024
)
school_characteristics_2025 <-
rename_characteristics(
school_characteristics_2025
)
names(school_characteristics_2025)
## [1] "URN" "education_phase" "school_type"
## [4] "academy_status" "urban_rural" "school_size"
## [7] "academy_trust" "admissions_policy"
The school information dataset contains administrative information and core school identifiers.
A small subset of variables was retained primarily to support interpretation, filtering and reporting. These variables are not expected to be major predictors of inspection outcomes but are useful when reviewing and communicating model outputs.
information_vars <- c(
"URN",
"LANAME",
"SCHNAME",
"SCHOOLTYPE",
"ISPRIMARY",
"ISSECONDARY",
"ISPOST16"
)
school_information_2023 <- school_information_2023 %>%
select(any_of(information_vars))
school_information_2024 <- school_information_2024 %>%
select(any_of(information_vars))
school_information_2025 <- school_information_2025 %>%
select(any_of(information_vars))
rename_information <- function(df){
df %>%
rename(
local_authority =
LANAME,
school_name =
SCHNAME,
school_type =
SCHOOLTYPE,
is_primary =
ISPRIMARY,
is_secondary =
ISSECONDARY,
is_post16 =
ISPOST16
)
}
school_information_2023 <-
rename_information(
school_information_2023
)
school_information_2024 <-
rename_information(
school_information_2024
)
school_information_2025 <-
rename_information(
school_information_2025
)
names(school_information_2025)
## [1] "URN" "local_authority" "school_name" "school_type"
## [5] "is_primary" "is_secondary" "is_post16"
The attendance and exclusions datasets contain multiple academic years.
To support year-specific analysis, annual datasets were created for 2023, 2024 and 2025.
This approach enables later feature engineering, including the calculation of year-on-year changes in attendance, exclusions and attainment.
absence_202223 <- absence_rates %>%
filter(time_period == "202223")
absence_202324 <- absence_rates %>%
filter(time_period == "202324")
absence_202425 <- absence_rates %>%
filter(time_period == "202425")
exclusions_202223 <- exclusions_suspensions %>%
filter(time_period == "202223")
exclusions_202324 <- exclusions_suspensions %>%
filter(time_period == "202324")
exclusions_202425 <- exclusions_suspensions %>%
filter(time_period == "202425")
dedupe <- function(df){
df %>%
distinct(
URN,
.keep_all = TRUE
)
}
The 2025 analytical dataset was created by linking inspection, attainment, attendance, exclusion, census and school characteristic datasets using URN as a common identifier.
The 2025 dataset will be used as the primary analytical dataset and basis for initial exploratory analysis and modelling.
master_2025 <-
school_information_2025 %>%
dedupe() %>%
left_join(
dedupe(school_characteristics_2025),
by = "URN"
) %>%
left_join(
dedupe(school_census_2025),
by = "URN"
) %>%
left_join(
dedupe(absence_202425),
by = "URN"
) %>%
left_join(
dedupe(exclusions_202425),
by = "URN"
) %>%
left_join(
dedupe(KS2_2025),
by = "URN"
) %>%
left_join(
dedupe(KS4_2025),
by = "URN"
) %>%
left_join(
dedupe(ofsted),
by = "URN"
) %>%
mutate(
analysis_year = 2025
)
table(
master_2025$Attendance.and.behaviour,
useNA = "always"
)
##
## Exceptional Expected standard Needs attention NULL
## 10 477 125 20337
## Strong standard Urgent improvement <NA>
## 284 14 4000
table(
master_2025$Achievement,
useNA = "always"
)
##
## Exceptional Expected standard Needs attention NULL
## 10 482 246 20337
## Strong standard Urgent improvement <NA>
## 145 27 4000
dim(master_2025)
## [1] 25247 135
sum(duplicated(master_2025$URN))
## [1] 0
The 2023 analytical dataset was created by linking attendance, exclusions, attainment, census and contextual datasets using URN as the common identifier.
This provides a historical snapshot which will subsequently be used to calculate trends and changes over time.
master_2023 <-
school_information_2023 %>%
dedupe() %>%
left_join(
dedupe(school_characteristics_2023),
by = "URN"
) %>%
left_join(
dedupe(school_census_2023),
by = "URN"
) %>%
left_join(
dedupe(absence_202223),
by = "URN"
) %>%
left_join(
dedupe(exclusions_202223),
by = "URN"
) %>%
left_join(
dedupe(KS2_2023),
by = "URN"
) %>%
left_join(
dedupe(KS4_2023),
by = "URN"
) %>%
left_join(
dedupe(ofsted),
by = "URN"
) %>%
mutate(
analysis_year = 2023
)
dim(master_2023)
## [1] 25386 135
sum(duplicated(master_2023$URN))
## [1] 0
The 2024 analytical dataset was created using the same methodology as the 2023 and 2025 datasets to ensure consistency across years.
The resulting dataset will support the calculation of year-on-year changes and trend-based features.
master_2024 <-
school_information_2024 %>%
dedupe() %>%
left_join(
dedupe(school_characteristics_2024),
by = "URN"
) %>%
left_join(
dedupe(school_census_2024),
by = "URN"
) %>%
left_join(
dedupe(absence_202324),
by = "URN"
) %>%
left_join(
dedupe(exclusions_202324),
by = "URN"
) %>%
left_join(
dedupe(KS2_2024),
by = "URN"
) %>%
left_join(
dedupe(KS4_2024),
by = "URN"
) %>%
left_join(
dedupe(ofsted),
by = "URN"
) %>%
mutate(
analysis_year = 2024
)
dim(master_2024)
## [1] 25547 135
sum(duplicated(master_2024$URN))
## [1] 0
Separate annual datasets were combined to create a longitudinal dataset containing up to three observations per school.
This enables examination of trends and changes over time rather than relying solely on single-year snapshots.
master_long <- bind_rows(
master_2023,
master_2024,
master_2025
)
Slight change of variable name (these are different variables)
master_2025 <- master_2025 %>%
rename(
census_eal_pct = eal_pct.x,
ks2_eal_pct = eal_pct.y
)
Create Model Base File
model_base_2025 <- master_2025
Several variables were imported as character fields despite containing numeric values.
These variables were converted to numeric format to support subsequent feature engineering and modelling activities.
# Variables stored as numbers but imported as text
numeric_vars <- c(
"suspension_rate",
"permanent_exclusions_rate",
"suspensions",
"permanent_exclusions",
"attainment8_score",
"ebacc_average_points"
)
master_long[numeric_vars] <-
lapply(
master_long[numeric_vars],
as.numeric
)
## Warning in lapply(master_long[numeric_vars], as.numeric): NAs introduced by
## coercion
## Warning in lapply(master_long[numeric_vars], as.numeric): NAs introduced by
## coercion
sapply(
master_long %>%
select(
suspension_rate,
permanent_exclusions_rate,
suspensions,
permanent_exclusions,
attainment8_score,
basics_grade4_pct,
basics_grade5_pct,
ebacc_average_points,
fsmever_pct,
send_support_pct,
ehcp_pct
),
class
)
## suspension_rate permanent_exclusions_rate suspensions
## "numeric" "numeric" "numeric"
## permanent_exclusions attainment8_score basics_grade4_pct
## "numeric" "numeric" "numeric"
## basics_grade5_pct ebacc_average_points fsmever_pct
## "numeric" "numeric" "numeric"
## send_support_pct ehcp_pct
## "numeric" "numeric"
Inspection outcomes are unlikely to be driven solely by a school’s current position.
Changes in attendance, behaviour and attainment over time may provide additional predictive value.
A series of trend variables were therefore calculated using data from 2023-2025.
Persistent Absence Severe Absence Suspension Rate Permanent Exclusions
trend_features <-
master_long %>%
arrange(
URN,
analysis_year
) %>%
group_by(URN) %>%
summarise(
persistent_absence_change =
last(na.omit(persistent_absence_10_pct)) -
first(na.omit(persistent_absence_10_pct)),
severe_absence_change =
last(na.omit(severe_absence_50_pct)) -
first(na.omit(severe_absence_50_pct)),
suspension_rate_change =
last(na.omit(suspension_rate)) -
first(na.omit(suspension_rate)),
exclusion_rate_change =
last(na.omit(permanent_exclusions_rate)) -
first(na.omit(permanent_exclusions_rate))
)
model_base_2025 <- model_base_2025 %>%
left_join(
trend_features,
by = "URN"
)
average_features <-
master_long %>%
group_by(URN) %>%
summarise(
persistent_absence_mean_3yr =
mean(
persistent_absence_10_pct,
na.rm = TRUE
),
severe_absence_mean_3yr =
mean(
severe_absence_50_pct,
na.rm = TRUE
),
suspension_rate_mean_3yr =
mean(
suspension_rate,
na.rm = TRUE
),
exclusion_rate_mean_3yr =
mean(
permanent_exclusions_rate,
na.rm = TRUE
)
)
model_base_2025 <- model_base_2025 %>%
left_join(
average_features,
by = "URN"
)
attainment_context_trends <-
master_long %>%
arrange(
URN,
analysis_year
) %>%
group_by(URN) %>%
summarise(
attainment8_change =
last(na.omit(attainment8_score)) -
first(na.omit(attainment8_score)),
basics_grade4_change =
last(na.omit(basics_grade4_pct)) -
first(na.omit(basics_grade4_pct)),
basics_grade5_change =
last(na.omit(basics_grade5_pct)) -
first(na.omit(basics_grade5_pct)),
fsmever_pct_change =
last(na.omit(fsmever_pct)) -
first(na.omit(fsmever_pct)),
send_support_pct_change =
last(na.omit(send_support_pct)) -
first(na.omit(send_support_pct)),
ehcp_pct_change =
last(na.omit(ehcp_pct)) -
first(na.omit(ehcp_pct))
)
model_base_2025 <- model_base_2025 %>%
left_join(
attainment_context_trends,
by = "URN"
)
model_df <- model_base_2025
model_df_attendance <-
model_base_2025 %>%
filter(
!is.na(
Attendance.and.behaviour
),
Attendance.and.behaviour != "NULL"
)
table(
model_df_attendance$Attendance.and.behaviour
)
##
## Exceptional Expected standard Needs attention Strong standard
## 10 477 125 284
## Urgent improvement
## 14
model_df_attendance <-
model_df_attendance %>%
mutate(
target_attendance = case_when(
Attendance.and.behaviour %in%
c(
"Needs attention",
"Urgent improvement"
) ~ "At Risk",
Attendance.and.behaviour %in%
c(
"Expected standard",
"Strong standard",
"Exceptional"
) ~ "Not At Risk"
)
)
table(
model_df_attendance$target_attendance
)
##
## At Risk Not At Risk
## 139 771
model_df_attendance <-
model_base_2025 %>%
filter(
!is.na(
Attendance.and.behaviour
),
Attendance.and.behaviour != "NULL"
) %>%
mutate(
target_attendance = case_when(
Attendance.and.behaviour %in%
c(
"Needs attention",
"Urgent improvement"
) ~ "At Risk",
TRUE ~ "Not At Risk"
),
target_3class = case_when(
Attendance.and.behaviour %in%
c(
"Exceptional",
"Strong standard"
) ~ "High Performing",
Attendance.and.behaviour ==
"Expected standard" ~ "Expected",
Attendance.and.behaviour %in%
c(
"Needs attention",
"Urgent improvement"
) ~ "Attention Needed"
),
target_5class =
Attendance.and.behaviour
)
table(
model_df_attendance$target_3class
)
##
## Attention Needed Expected High Performing
## 139 477 294
missing_summary <-
model_df_attendance %>%
summarise(
across(
everything(),
~ mean(is.na(.))
)
) %>%
pivot_longer(
everything(),
names_to = "variable",
values_to = "missing_pct"
) %>%
arrange(
desc(missing_pct)
)
head(
missing_summary,
30
)
## # A tibble: 30 × 2
## variable missing_pct
## <chr> <dbl>
## 1 reading_progress 1
## 2 writing_progress 1
## 3 maths_progress 1
## 4 progress8_score 1
## 5 basics_grade4_pct 0.780
## 6 basics_grade5_pct 0.780
## 7 attainment8_change 0.778
## 8 basics_grade4_change 0.778
## 9 basics_grade5_change 0.778
## 10 attainment8_score 0.765
## # ℹ 20 more rows
At the time of analysis, 910 schools had received published Attendance and Behaviour judgements under the new Ofsted framework.
These labelled schools were not evenly distributed across education phases. State-funded primary schools accounted for the majority of observations, whilst state-funded secondary and special schools represented a much smaller proportion of the available inspection outcomes.
Given the exploratory nature of this proof-of-concept, model development was initially restricted to state-funded primary schools. This approach maximises the available sample size, reduces structural differences between school types and avoids complications associated with phase-specific attainment measures.
Separate models for secondary and special schools may be developed in future as additional inspection outcomes become available under the new framework.
phase_summary <- model_df_attendance %>%
count(
education_phase
) %>%
mutate(
pct =
round(
100 * n / sum(n),
1
)
)
phase_summary
## education_phase n pct
## 1 State-funded primary 685 75.3
## 2 State-funded secondary 190 20.9
## 3 State-funded special school 35 3.8
Following review of the available labelled data, a primary-school-only analytical dataset was created for subsequent exploratory analysis and model development.
Restricting the analysis to a single education phase reduces heterogeneity within the modelling population and provides a more consistent basis for identifying predictors of inspection outcomes.
primary_df <- model_df_attendance %>%
filter(
education_phase ==
"State-funded primary"
)
dim(primary_df)
## [1] 685 152
table(
primary_df$target_3class
)
##
## Attention Needed Expected High Performing
## 92 382 211
round(
prop.table(
table(
primary_df$target_3class
)
) * 100,
1
)
##
## Attention Needed Expected High Performing
## 13.4 55.8 30.8
Before undertaking exploratory analysis and model development, an assessment of missing data was conducted.
Understanding the extent and pattern of missing values is important because educational datasets frequently contain variables that are only applicable to particular school phases or pupil groups. Identifying variables with substantial missingness helps inform decisions regarding variable removal, imputation and feature selection.
The assessment was conducted using the primary school modelling dataset.
missing_summary <-
primary_df %>%
summarise(
across(
everything(),
~ mean(is.na(.))
)
) %>%
pivot_longer(
everything(),
names_to = "variable",
values_to = "missing_pct"
) %>%
arrange(
desc(missing_pct)
)
head(
missing_summary,
30
)
## # A tibble: 30 × 2
## variable missing_pct
## <chr> <dbl>
## 1 reading_progress 1
## 2 writing_progress 1
## 3 maths_progress 1
## 4 attainment8_score 1
## 5 progress8_score 1
## 6 basics_grade4_pct 1
## 7 basics_grade5_pct 1
## 8 ebacc_average_points 1
## 9 attainment8_change 1
## 10 basics_grade4_change 1
## # ℹ 20 more rows
ggplot(
missing_summary,
aes(
x = missing_pct
)
) +
geom_histogram(
bins = 30,
fill = "steelblue",
colour = "white"
) +
labs(
title = "Distribution of Missingness Across Variables",
x = "Proportion Missing",
y = "Number of Variables"
) +
theme_minimal()
missing_summary %>%
filter(
missing_pct > 0.5
)
## # A tibble: 11 × 2
## variable missing_pct
## <chr> <dbl>
## 1 reading_progress 1
## 2 writing_progress 1
## 3 maths_progress 1
## 4 attainment8_score 1
## 5 progress8_score 1
## 6 basics_grade4_pct 1
## 7 basics_grade5_pct 1
## 8 ebacc_average_points 1
## 9 attainment8_change 1
## 10 basics_grade4_change 1
## 11 basics_grade5_change 1
missing_summary %>%
filter(
missing_pct > 0.9
)
## # A tibble: 11 × 2
## variable missing_pct
## <chr> <dbl>
## 1 reading_progress 1
## 2 writing_progress 1
## 3 maths_progress 1
## 4 attainment8_score 1
## 5 progress8_score 1
## 6 basics_grade4_pct 1
## 7 basics_grade5_pct 1
## 8 ebacc_average_points 1
## 9 attainment8_change 1
## 10 basics_grade4_change 1
## 11 basics_grade5_change 1
Variables exhibiting very high levels of missingness were reviewed individually to determine whether the missingness reflected data quality issues or whether the variables were structurally unavailable for portions of the school population.
Variables with no available observations or limited relevance to the primary school modelling cohort may subsequently be removed prior to model development. Variables with moderate levels of missingness will be considered for imputation or alternative treatment during the feature selection stage.
Following removal of variables that were structurally unavailable within the primary school cohort, the remaining dataset exhibited very low levels of missingness.
The highest level of missingness observed was approximately 7.6%, affecting a small number of Key Stage 2 attainment and pupil characteristic variables.
Given the relatively low proportion of missing observations, these variables were retained for subsequent exploratory analysis and model development. Appropriate imputation strategies will be considered during model preparation if required.
Overall, the resulting primary school modelling dataset was considered sufficiently complete to support exploratory analysis and machine learning activities.
The project will evaluate three separate supervised learning problems using the same underlying analytical dataset.
This approach enables comparison between a simplified intervention-focused model and more granular classification approaches aligned to the new Ofsted inspection framework.
The objective is to assess how predictive performance changes as the complexity of the classification task increases.
The first model focuses on identifying schools that may require intervention.
Inspection outcomes were grouped into two categories:
Schools receiving “Needs attention” or “Urgent improvement” judgements were classified as At Risk.
Schools receiving “Expected standard”, “Strong standard” or “Exceptional” judgements were classified as Not At Risk.
This model most closely aligns with an operational intervention use case and is expected to provide the highest predictive performance due to the relatively simple classification task.
The second model provides a more nuanced representation of inspection outcomes.
Inspection outcomes were grouped into three categories:
“Exceptional” and “Strong standard” schools were grouped together as High Performing.
“Expected standard” schools formed the Expected category.
“Needs attention” and “Urgent improvement” schools were grouped together as Attention Needed.
This approach balances interpretability with analytical complexity and reflects a risk-based view of school performance.
The third model seeks to predict the full inspection outcome.
The five possible outcome categories are:
This represents the most challenging prediction task due to the relatively small number of observations available in some categories.
Exploratory Data Analysis will be undertaken with all three modelling objectives in mind.
Variables will be assessed to determine:
Particular attention will be given to:
Variables demonstrating strong separation between outcome groups will be prioritised during subsequent model development and feature selection.
The purpose of the exploratory analysis is to understand the relationships between school characteristics and inspection outcomes, identify potentially important predictors and inform subsequent feature selection and model development.
The analysis focuses on the primary school modelling dataset and considers all three modelling objectives:
Particular attention is given to attendance, behaviour, attainment, deprivation and inclusion measures due to their strong theoretical links to school performance and inspection outcomes.
Understanding the distribution of target classes is important because class imbalance can substantially influence model performance and evaluation.
table(primary_df$target_attendance)
##
## At Risk Not At Risk
## 92 593
round(
prop.table(
table(primary_df$target_attendance)
) * 100,
1
)
##
## At Risk Not At Risk
## 13.4 86.6
table(primary_df$target_3class)
##
## Attention Needed Expected High Performing
## 92 382 211
round(
prop.table(
table(primary_df$target_3class)
) * 100,
1
)
##
## Attention Needed Expected High Performing
## 13.4 55.8 30.8
table(primary_df$target_5class)
##
## Exceptional Expected standard Needs attention Strong standard
## 2 382 85 209
## Urgent improvement
## 7
round(
prop.table(
table(primary_df$target_5class)
) * 100,
1
)
##
## Exceptional Expected standard Needs attention Strong standard
## 0.3 55.8 12.4 30.5
## Urgent improvement
## 1.0
ggplot(
primary_df,
aes(target_3class)
) +
geom_bar(
fill = "steelblue"
) +
theme_minimal() +
labs(
title = "Distribution of Three-Class Outcome",
x = NULL,
y = "Number of Schools"
)
primary_df %>%
select(
persistent_absence_10_pct,
severe_absence_50_pct,
suspension_rate,
fsmever_pct,
send_support_pct,
ehcp_pct,
ks2_expected_standard_pct,
ks2_higher_standard_pct,
persistent_absence_change,
suspension_rate_change
) %>%
summary()
## persistent_absence_10_pct severe_absence_50_pct suspension_rate
## Min. : 0.000 Min. : 0.0000 Min. : 0.000
## 1st Qu.: 7.984 1st Qu.: 0.0000 1st Qu.: 0.000
## Median :12.076 Median : 0.5706 Median : 1.157
## Mean :12.975 Mean : 0.9822 Mean : 2.629
## 3rd Qu.:17.143 3rd Qu.: 1.3818 3rd Qu.: 3.356
## Max. :42.424 Max. :11.5942 Max. :30.612
## NAs :1 NAs :1
## fsmever_pct send_support_pct ehcp_pct ks2_expected_standard_pct
## Min. : 0.00 Min. : 0.000 Min. : 1.07 Min. : 0.00
## 1st Qu.:13.51 1st Qu.: 1.860 1st Qu.:11.02 1st Qu.: 54.00
## Median :23.98 Median : 3.040 Median :14.58 Median : 64.00
## Mean :27.25 Mean : 3.593 Mean :15.40 Mean : 63.36
## 3rd Qu.:39.00 3rd Qu.: 4.500 3rd Qu.:18.87 3rd Qu.: 75.00
## Max. :75.21 Max. :25.980 Max. :66.67 Max. :100.00
## NAs :64
## ks2_higher_standard_pct persistent_absence_change suspension_rate_change
## Min. : 0.000 Min. :-36.15222 Min. :-18.2741
## 1st Qu.: 2.000 1st Qu.: -5.80073 1st Qu.: -0.8475
## Median : 7.000 Median : -2.74996 Median : 0.0000
## Mean : 8.164 Mean : -3.00650 Mean : 0.4038
## 3rd Qu.:12.000 3rd Qu.: 0.09001 3rd Qu.: 1.4019
## Max. :45.000 Max. : 14.77146 Max. : 24.1452
## NAs :64
ggplot(
primary_df,
aes(
target_3class,
persistent_absence_10_pct
)
) +
geom_boxplot() +
theme_minimal()
## Warning: Removed 1 row containing non-finite outside the scale range
## (`stat_boxplot()`).
ggplot(
primary_df,
aes(
target_3class,
persistent_absence_change
)
) +
geom_boxplot() +
theme_minimal()
ggplot(
primary_df,
aes(
target_3class,
suspension_rate
)
) +
geom_boxplot() +
theme_minimal()
ggplot(
primary_df,
aes(
target_3class,
suspension_rate_change
)
) +
geom_boxplot() +
theme_minimal()
ggplot(
primary_df,
aes(
target_3class,
fsmever_pct
)
) +
geom_boxplot() +
theme_minimal()
ggplot(
primary_df,
aes(
target_3class,
send_support_pct
)
) +
geom_boxplot() +
theme_minimal()
ggplot(
primary_df,
aes(
target_3class,
ks2_expected_standard_pct
)
) +
geom_boxplot() +
theme_minimal()
## Warning: Removed 64 rows containing non-finite outside the scale range
## (`stat_boxplot()`).
ggplot(
primary_df,
aes(
target_3class,
ks2_higher_standard_pct
)
) +
geom_boxplot() +
theme_minimal()
## Warning: Removed 64 rows containing non-finite outside the scale range
## (`stat_boxplot()`).
primary_df <- primary_df %>%
mutate(
target_attendance =
as.factor(target_attendance),
target_3class =
as.factor(target_3class),
target_5class =
as.factor(target_5class)
)
The relationships identified above make logical sense
The analytical dataset contains a large number of variables originating from multiple source datasets. Whilst machine learning algorithms are capable of handling large numbers of predictors, including all available variables increases the risk of overfitting, reduces model interpretability and may introduce unnecessary noise.
An initial modelling dataset was therefore created using a curated set of variables informed by:
Variables relating to attendance, behaviour, attainment, deprivation, inclusion and school context were retained as candidate predictors.
This approach prioritises explainability and provides a strong baseline for the initial proof-of-concept. Additional variables can be incorporated in future iterations if they demonstrate incremental predictive value.
First test is purely the binary model
# Attendance
attendance_vars <- c(
"persistent_absence_10_pct",
"severe_absence_50_pct",
"authorised_absence_pct",
"unauthorised_absence_pct",
"persistent_absence_change",
"severe_absence_change"
)
# Behaviour
behaviour_vars <- c(
"suspension_rate",
"permanent_exclusions_rate",
"suspension_rate_change",
"exclusion_rate_change"
)
# Attainment
attainment_vars <- c(
"ks2_expected_standard_pct",
"ks2_higher_standard_pct"
)
# Disadvantage and Inclusion
inclusion_vars <- c(
"fsmever_pct",
"send_support_pct",
"ehcp_pct",
"ks2_eal_pct",
"pupil_mobility_pct"
)
# School Context
context_vars <- c(
"academy_status",
"urban_rural",
"admissions_policy"
)
# Final Variable List
model_vars <- c(
attendance_vars,
behaviour_vars,
attainment_vars,
inclusion_vars,
context_vars,
"target_attendance"
)
# Create Modelling Dataset
primary_model_df <- primary_df %>%
select(
any_of(model_vars)
)
dim(primary_model_df)
## [1] 685 21
names(primary_model_df)
## [1] "persistent_absence_10_pct" "severe_absence_50_pct"
## [3] "authorised_absence_pct" "unauthorised_absence_pct"
## [5] "persistent_absence_change" "severe_absence_change"
## [7] "suspension_rate" "permanent_exclusions_rate"
## [9] "suspension_rate_change" "exclusion_rate_change"
## [11] "ks2_expected_standard_pct" "ks2_higher_standard_pct"
## [13] "fsmever_pct" "send_support_pct"
## [15] "ehcp_pct" "ks2_eal_pct"
## [17] "pupil_mobility_pct" "academy_status"
## [19] "urban_rural" "admissions_policy"
## [21] "target_attendance"
The modelling dataset was randomly partitioned into training and testing datasets.
A stratified sampling approach was used to preserve the proportion of schools requiring intervention within both datasets.
An 80:20 split was selected to maximise training data whilst retaining an independent test dataset for model evaluation.
set.seed(123)
train_index <- createDataPartition(
primary_model_df$target_attendance,
p = 0.8,
list = FALSE
)
train_df <- primary_model_df[train_index, ]
test_df <- primary_model_df[-train_index, ]
tree_model <- rpart(
target_attendance ~ .,
data = train_df,
method = "class"
)
rpart.plot(
tree_model,
type = 4,
extra = 104,
fallen.leaves = TRUE,
cex = 0.8
)
sort(
tree_model$variable.importance,
decreasing = TRUE
)
## persistent_absence_10_pct authorised_absence_pct unauthorised_absence_pct
## 32.7644773 13.9956673 13.6851735
## severe_absence_50_pct severe_absence_change ehcp_pct
## 8.9615218 7.5222482 7.0637424
## pupil_mobility_pct ks2_expected_standard_pct fsmever_pct
## 6.3206300 5.2392260 3.9778516
## ks2_eal_pct persistent_absence_change ks2_higher_standard_pct
## 3.3811790 1.9377289 1.7464087
## exclusion_rate_change suspension_rate_change permanent_exclusions_rate
## 1.4034697 1.3907234 1.0717811
## send_support_pct urban_rural suspension_rate
## 0.9506666 0.9201836 0.8732043
confusionMatrix(
predict(
tree_model,
test_df,
type = "class"
),
test_df$target_attendance
)
## Confusion Matrix and Statistics
##
## Reference
## Prediction At Risk Not At Risk
## At Risk 5 9
## Not At Risk 13 109
##
## Accuracy : 0.8382
## 95% CI : (0.7654, 0.8958)
## No Information Rate : 0.8676
## P-Value [Acc > NIR] : 0.8712
##
## Kappa : 0.2225
##
## Mcnemar's Test P-Value : 0.5224
##
## Sensitivity : 0.27778
## Specificity : 0.92373
## Pos Pred Value : 0.35714
## Neg Pred Value : 0.89344
## Prevalence : 0.13235
## Detection Rate : 0.03676
## Detection Prevalence : 0.10294
## Balanced Accuracy : 0.60075
##
## 'Positive' Class : At Risk
##
For a more simpler and easily explainable baseline model - logistic regression is attempted below
To reduce category sparsity and avoid issues caused by highly granular geographic classifications, the original urban-rural variable was simplified into a binary urban/rural classification.
primary_model_df <- primary_model_df %>%
mutate(
urban_rural_simple = case_when(
grepl(
"Urban",
urban_rural
) ~ "Urban",
grepl(
"Rural",
urban_rural
) ~ "Rural",
TRUE ~ "Other"
)
) %>%
select(
-urban_rural
)
The modelling dataset was then partitioned into training and testing datasets using a stratified 80:20 split.
set.seed(123)
train_index <- createDataPartition(
primary_model_df$target_attendance,
p = 0.8,
list = FALSE
)
train_df <- primary_model_df[train_index, ]
test_df <- primary_model_df[-train_index, ]
Categorical variables were converted to factors prior to model fitting.
train_df <- train_df %>%
mutate(
academy_status =
as.factor(academy_status),
admissions_policy =
as.factor(admissions_policy),
urban_rural_simple =
as.factor(urban_rural_simple)
)
test_df <- test_df %>%
mutate(
academy_status =
as.factor(academy_status),
admissions_policy =
as.factor(admissions_policy),
urban_rural_simple =
as.factor(urban_rural_simple)
)
A baseline logistic regression model was fitted to predict whether a school was classified as At Risk or Not At Risk.
train_df <- train_df %>%
mutate(
ks2_expected_standard_pct =
ifelse(
is.na(
ks2_expected_standard_pct
),
median(
ks2_expected_standard_pct,
na.rm = TRUE
),
ks2_expected_standard_pct
),
ks2_higher_standard_pct =
ifelse(
is.na(
ks2_higher_standard_pct
),
median(
ks2_higher_standard_pct,
na.rm = TRUE
),
ks2_higher_standard_pct
),
ks2_eal_pct =
ifelse(
is.na(
ks2_eal_pct
),
median(
ks2_eal_pct,
na.rm = TRUE
),
ks2_eal_pct
),
pupil_mobility_pct =
ifelse(
is.na(
pupil_mobility_pct
),
median(
pupil_mobility_pct,
na.rm = TRUE
),
pupil_mobility_pct
)
)
glm_model <- glm(
target_attendance ~ .,
data = train_df,
family = "binomial"
)
summary(glm_model)
##
## Call:
## glm(formula = target_attendance ~ ., family = "binomial", data = train_df)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 10.012394 3.082788 3.248 0.00116 **
## persistent_absence_10_pct -0.082985 0.065800 -1.261 0.20725
## severe_absence_50_pct 0.128084 0.212129 0.604 0.54598
## authorised_absence_pct -0.980627 0.321576 -3.049 0.00229 **
## unauthorised_absence_pct -1.093213 0.385261 -2.838 0.00455 **
## persistent_absence_change 0.017631 0.032829 0.537 0.59122
## severe_absence_change -0.040751 0.156795 -0.260 0.79494
## suspension_rate -0.023572 0.059884 -0.394 0.69385
## permanent_exclusions_rate 2.182058 1.661418 1.313 0.18906
## suspension_rate_change -0.127369 0.063001 -2.022 0.04321 *
## exclusion_rate_change 0.666924 1.075218 0.620 0.53508
## ks2_expected_standard_pct 0.025120 0.014794 1.698 0.08951 .
## ks2_higher_standard_pct 0.002006 0.035317 0.057 0.95470
## fsmever_pct 0.002613 0.016592 0.157 0.87488
## send_support_pct 0.091988 0.057772 1.592 0.11132
## ehcp_pct 0.073756 0.033918 2.175 0.02966 *
## ks2_eal_pct 0.017981 0.009933 1.810 0.07028 .
## pupil_mobility_pct -0.040638 0.027540 -1.476 0.14006
## academy_statusLA Maintained -0.330136 0.361834 -0.912 0.36156
## admissions_policyNot applicable -0.412376 1.248625 -0.330 0.74120
## admissions_policyUnknown 0.439767 1.870543 0.235 0.81413
## urban_rural_simpleUrban 0.175786 0.460097 0.382 0.70242
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 433.85 on 547 degrees of freedom
## Residual deviance: 257.51 on 526 degrees of freedom
## (1 observation deleted due to missingness)
## AIC: 301.51
##
## Number of Fisher Scoring iterations: 6
Predictions were generated using the independent test dataset.
glm_probs <- predict(
glm_model,
newdata = test_df,
type = "response"
)
glm_pred <- ifelse(
glm_probs > 0.85,
"Not At Risk",
"At Risk"
)
glm_pred <- factor(
glm_pred,
levels =
levels(
test_df$target_attendance
)
)
confusionMatrix(
glm_pred,
test_df$target_attendance
)
## Confusion Matrix and Statistics
##
## Reference
## Prediction At Risk Not At Risk
## At Risk 12 18
## Not At Risk 5 90
##
## Accuracy : 0.816
## 95% CI : (0.7368, 0.8796)
## No Information Rate : 0.864
## P-Value [Acc > NIR] : 0.95024
##
## Kappa : 0.4078
##
## Mcnemar's Test P-Value : 0.01234
##
## Sensitivity : 0.7059
## Specificity : 0.8333
## Pos Pred Value : 0.4000
## Neg Pred Value : 0.9474
## Prevalence : 0.1360
## Detection Rate : 0.0960
## Detection Prevalence : 0.2400
## Balanced Accuracy : 0.7696
##
## 'Positive' Class : At Risk
##
Recall is 71% Precision is 40%
Im interested in the 18 false positives - are these low performing expected?
review_df <- test_df
review_df$predicted_class <- glm_pred
review_df$predicted_probability_not_risk <- glm_probs
review_df <- review_df %>%
mutate(
row_id = row_number()
)
review_output <- primary_df %>%
select(
school_name,
target_attendance,
target_3class,
target_5class,
persistent_absence_10_pct,
fsmever_pct,
send_support_pct,
ks2_expected_standard_pct
) %>%
slice(
as.numeric(
rownames(test_df)
)
) %>%
bind_cols(
review_df %>%
select(
predicted_class,
predicted_probability_not_risk
)
)
false_positives <- review_output %>%
filter(
predicted_class == "At Risk",
target_attendance == "Not At Risk"
)
16/18 of the false positives are ‘Expected’. I think this creates a good baseline model
I am going to apply the model to just Essex schools and see what that gives me in terms of predictions (just as a mini test)
essex_primary <- model_base_2025 %>%
filter(
education_phase == "State-funded primary",
local_authority == "Essex"
)
essex_model_df <- essex_primary %>%
mutate(
urban_rural_simple = case_when(
grepl(
"Urban",
urban_rural
) ~ "Urban",
grepl(
"Rural",
urban_rural
) ~ "Rural",
TRUE ~ "Other"
)
) %>%
select(
persistent_absence_10_pct,
severe_absence_50_pct,
authorised_absence_pct,
unauthorised_absence_pct,
persistent_absence_change,
severe_absence_change,
suspension_rate,
permanent_exclusions_rate,
suspension_rate_change,
exclusion_rate_change,
ks2_expected_standard_pct,
ks2_higher_standard_pct,
fsmever_pct,
send_support_pct,
ehcp_pct,
ks2_eal_pct,
pupil_mobility_pct,
academy_status,
admissions_policy,
urban_rural_simple
)
essex_model_df <- essex_model_df %>%
mutate(
academy_status =
as.factor(academy_status),
admissions_policy =
as.factor(admissions_policy),
urban_rural_simple =
as.factor(urban_rural_simple)
)
essex_probs <- predict(
glm_model,
newdata = essex_model_df,
type = "response"
)
essex_prediction <- ifelse(
essex_probs > 0.85,
"Not At Risk",
"At Risk"
)
essex_results <- essex_primary %>%
mutate(
probability_not_at_risk =
essex_probs,
predicted_risk =
essex_prediction
)
essex_results_simple <- essex_primary %>%
mutate(
probability_not_at_risk =
round(
essex_probs,
3
),
predicted_risk =
essex_prediction
) %>%
select(
school_name,
predicted_risk,
Latest.OEIF.overall.effectiveness,
persistent_absence_10_pct,
severe_absence_50_pct,
authorised_absence_pct,
unauthorised_absence_pct,
persistent_absence_change,
severe_absence_change,
suspension_rate,
permanent_exclusions_rate,
suspension_rate_change,
exclusion_rate_change,
ks2_expected_standard_pct,
ks2_higher_standard_pct,
fsmever_pct,
send_support_pct,
ehcp_pct,
ks2_eal_pct,
pupil_mobility_pct,
urban_rural
) %>%
arrange(
predicted_risk,
desc(persistent_absence_10_pct)
)
write.csv(
essex_results_simple,
"Outputs/Essex_Primary_Risk_Predictions.csv",
row.names = FALSE
)
The baseline logistic regression model generates a probability estimate representing the likelihood that a school belongs to the Not At Risk category. Initial testing demonstrated that model performance was highly sensitive to the classification threshold used to convert these probabilities into binary predictions.
Whilst a conventional threshold of 0.5 is commonly used in classification problems, the primary objective of this project is to maximise the identification of schools requiring support whilst maintaining a reasonable false positive rate. Consequently, a threshold optimisation exercise was undertaken to assess how model performance changed as the classification threshold increased.
The analysis focused on thresholds between 0.80 and 0.90, as preliminary testing indicated that this range produced a more appropriate balance between recall and precision for the intended use case.
thresholds <- seq(
0.80,
0.95,
by = 0.01
)
threshold_results <- data.frame()
for(t in thresholds){
pred <- ifelse(
glm_probs > t,
"Not At Risk",
"At Risk"
)
pred <- factor(
pred,
levels = levels(test_df$target_attendance)
)
cm <- confusionMatrix(
pred,
test_df$target_attendance
)
precision <- as.numeric(
cm$byClass["Pos Pred Value"]
)
recall <- as.numeric(
cm$byClass["Sensitivity"]
)
f1 <- 2 * (
precision * recall
) / (
precision + recall
)
threshold_results <-rbind(
threshold_results,
data.frame(
threshold = t,
recall = round(
recall,
3
),
precision = round(
precision,
3
),
f1 = round(
f1,
3
),
balanced_accuracy = round(
as.numeric(
cm$byClass["Balanced Accuracy"]
),
3
)
)
)
}
threshold_results
## threshold recall precision f1 balanced_accuracy
## 1 0.80 0.647 0.500 0.564 0.773
## 2 0.81 0.706 0.500 0.585 0.797
## 3 0.82 0.706 0.444 0.545 0.783
## 4 0.83 0.706 0.429 0.533 0.779
## 5 0.84 0.706 0.400 0.511 0.770
## 6 0.85 0.706 0.400 0.511 0.770
## 7 0.86 0.706 0.400 0.511 0.770
## 8 0.87 0.765 0.419 0.542 0.799
## 9 0.88 0.765 0.406 0.531 0.794
## 10 0.89 0.882 0.441 0.588 0.853
## 11 0.90 0.941 0.432 0.593 0.873
## 12 0.91 0.941 0.432 0.593 0.873
## 13 0.92 0.941 0.410 0.571 0.864
## 14 0.93 0.941 0.372 0.533 0.846
## 15 0.94 0.941 0.340 0.500 0.827
## 16 0.95 0.941 0.302 0.457 0.799
threshold_results %>%
pivot_longer(
cols = c(
recall,
precision,
f1
),
names_to = "metric",
values_to = "value"
) %>%
ggplot(
aes(
threshold,
value,
colour = metric
)
) +
geom_line(
linewidth = 1
) +
geom_point() +
scale_x_continuous(
breaks = seq(
0.80,
0.95,
0.01
)
) +
labs(
title =
"Impact of Threshold Selection on Model Performance",
x =
"Classification Threshold",
y =
"Metric Value"
) +
theme_minimal()
The baseline model included several variables relating to attendance, attainment, deprivation and inclusion. Whilst these measures may each be individually predictive, highly correlated variables can introduce instability into statistical models and make coefficient interpretation more difficult.
Prior to developing more advanced models, an assessment of multicollinearity was undertaken. The objective was to identify groups of highly related variables and determine whether the feature set could be simplified without materially reducing predictive power.
Variables exhibiting very strong correlations were reviewed and retained only where they provided distinct analytical value or domain relevance.
library(caret)
numeric_vars <- train_df %>%
select(
where(is.numeric)
)
cor_matrix <- cor(
numeric_vars,
use = "pairwise.complete.obs"
)
high_cor <- findCorrelation(
cor_matrix,
cutoff = 0.75,
names = TRUE
)
high_cor
## character(0)
library(corrplot)
## Warning: package 'corrplot' was built under R version 4.6.1
## corrplot 0.95 loaded
corrplot(
cor_matrix,
method = "color",
type = "upper",
tl.cex = 0.7
)
A Variance Inflation Factor (VIF) analysis was undertaken to identify variables exhibiting excessive multicollinearity.
Variables with VIF values substantially above accepted thresholds were considered candidates for removal or consolidation.
library(car)
## Warning: package 'car' was built under R version 4.6.1
## Loading required package: carData
## Warning: package 'carData' was built under R version 4.6.1
##
## Attaching package: 'car'
## The following object is masked from 'package:dplyr':
##
## recode
## The following object is masked from 'package:purrr':
##
## some
vif_model <- glm(
target_attendance ~ .,
data = train_df,
family = "binomial"
)
vif(vif_model)
## GVIF Df GVIF^(1/(2*Df))
## persistent_absence_10_pct 5.681263 1 2.383540
## severe_absence_50_pct 3.243864 1 1.801073
## authorised_absence_pct 3.670431 1 1.915837
## unauthorised_absence_pct 3.911753 1 1.977815
## persistent_absence_change 1.524100 1 1.234545
## severe_absence_change 2.653704 1 1.629019
## suspension_rate 3.332403 1 1.825487
## permanent_exclusions_rate 1.797116 1 1.340566
## suspension_rate_change 3.143873 1 1.773097
## exclusion_rate_change 1.845416 1 1.358461
## ks2_expected_standard_pct 1.703727 1 1.305269
## ks2_higher_standard_pct 1.507140 1 1.227656
## fsmever_pct 2.889921 1 1.699977
## send_support_pct 1.405366 1 1.185481
## ehcp_pct 1.690408 1 1.300157
## ks2_eal_pct 1.292385 1 1.136831
## pupil_mobility_pct 1.298935 1 1.139708
## academy_status 1.199653 1 1.095287
## admissions_policy 1.300561 2 1.067905
## urban_rural_simple 1.574184 1 1.254665
A Variance Inflation Factor (VIF) assessment was conducted to identify potential multicollinearity between predictor variables.
The results indicated relatively low levels of multicollinearity across the feature set. The highest VIF observed was 5.68 for persistent absence, with all remaining variables exhibiting substantially lower values.
Overall, the results suggest that whilst some related attendance measures are correlated, multicollinearity is unlikely to have a material impact on model stability or coefficient interpretation. Consequently, no variables were removed solely on the basis of multicollinearity.
The model’s current limitations are probably NOT being caused by multicollinearity.
core_vars <- c(
# Attendance
"persistent_absence_10_pct",
"unauthorised_absence_pct",
# Behaviour
"suspension_rate",
# Attainment
"ks2_expected_standard_pct",
# Inclusion / Deprivation
"fsmever_pct",
"send_support_pct",
"ehcp_pct",
# Context
"ks2_eal_pct",
"pupil_mobility_pct",
# Target
"target_attendance"
)
reduced_df <- train_df %>%
select(
all_of(core_vars)
)
glm_reduced <- glm(
target_attendance ~ .,
data = reduced_df,
family = "binomial"
)
test_reduced_df <- test_df %>%
select(
all_of(core_vars)
)
# Generate probabilities
glm_reduced_probs <- predict(
glm_reduced,
newdata = test_reduced_df,
type = "response"
)
# Apply threshold
glm_reduced_pred <- ifelse(
glm_reduced_probs > 0.85,
"Not At Risk",
"At Risk"
)
# Convert to factor
glm_reduced_pred <- factor(
glm_reduced_pred,
levels = levels(
test_reduced_df$target_attendance
)
)
# Confusion Matrix
cm_reduced <- confusionMatrix(
glm_reduced_pred,
test_reduced_df$target_attendance
)
cm_reduced
## Confusion Matrix and Statistics
##
## Reference
## Prediction At Risk Not At Risk
## At Risk 10 12
## Not At Risk 7 96
##
## Accuracy : 0.848
## 95% CI : (0.7729, 0.9059)
## No Information Rate : 0.864
## P-Value [Acc > NIR] : 0.7487
##
## Kappa : 0.4245
##
## Mcnemar's Test P-Value : 0.3588
##
## Sensitivity : 0.5882
## Specificity : 0.8889
## Pos Pred Value : 0.4545
## Neg Pred Value : 0.9320
## Prevalence : 0.1360
## Detection Rate : 0.0800
## Detection Prevalence : 0.1760
## Balanced Accuracy : 0.7386
##
## 'Positive' Class : At Risk
##
Once i have landed on final model, i will revisit variable selection
# Create complete-case datasets for algorithms
rf_train_df <- train_df %>%
filter(complete.cases(.))
rf_test_df <- test_df %>%
filter(complete.cases(.))
dim(train_df)
## [1] 549 21
dim(rf_train_df)
## [1] 548 21
dim(test_df)
## [1] 136 21
dim(rf_test_df)
## [1] 125 21
Having established a baseline logistic regression model, the next stage of the analysis focused on model selection.
The objective was to determine whether alternative machine learning algorithms were able to improve the identification of schools classified as At Risk.
At this stage, no further feature engineering, variable reduction or threshold optimisation was undertaken. Maintaining a consistent feature set and train-test split ensures that differences in performance can be attributed to the modelling technique itself rather than changes to the underlying data.
The following algorithms were evaluated:
Models were assessed using the same test dataset and compared using:
Particular emphasis was placed on Recall and F1 Score due to the project’s objective of identifying schools potentially requiring intervention whilst maintaining an acceptable false positive rate.
model_results <- data.frame(
Model = character(),
Accuracy = numeric(),
Recall = numeric(),
Precision = numeric(),
F1 = numeric(),
Balanced_Accuracy = numeric()
)
add_results <- function(model_name, cm){
precision <- as.numeric(
cm$byClass["Pos Pred Value"]
)
recall <- as.numeric(
cm$byClass["Sensitivity"]
)
f1 <- 2 * (
precision * recall
) /
(
precision + recall
)
data.frame(
Model = model_name,
Accuracy =
as.numeric(
cm$overall["Accuracy"]
),
Recall =
recall,
Precision =
precision,
F1 =
f1,
Balanced_Accuracy =
as.numeric(
cm$byClass["Balanced Accuracy"]
)
)
}
glm_probs_compare <- predict(
glm_model,
newdata = rf_test_df,
type = "response"
)
glm_pred_compare <- ifelse(
glm_probs_compare > 0.85,
"Not At Risk",
"At Risk"
)
glm_pred_compare <- factor(
glm_pred_compare,
levels = levels(
rf_test_df$target_attendance
)
)
length(glm_pred_compare)
## [1] 125
length(rf_test_df$target_attendance)
## [1] 125
cm_logistic <- confusionMatrix(
glm_pred_compare,
rf_test_df$target_attendance
)
model_results <- rbind(
model_results,
add_results(
"Logistic Regression",
cm_logistic
)
)
library(rpart)
tree_model <- rpart(
target_attendance ~ .,
data = rf_train_df,
method = "class"
)
tree_pred <- predict(
tree_model,
newdata = rf_test_df,
type = "class"
)
cm_tree <- confusionMatrix(
tree_pred,
rf_test_df$target_attendance
)
model_results <- rbind(
model_results,
add_results(
"Decision Tree",
cm_tree
)
)
library(randomForest)
rf_model <- randomForest(
target_attendance ~ .,
data = rf_train_df,
ntree = 500,
importance = TRUE
)
rf_pred <- predict(
rf_model,
newdata = rf_test_df
)
cm_rf <- confusionMatrix(
rf_pred,
rf_test_df$target_attendance
)
model_results <- rbind(
model_results,
add_results(
"Random Forest",
cm_rf
)
)
library(xgboost)
## Warning: package 'xgboost' was built under R version 4.6.1
# Create model matrices
train_x <- model.matrix(
target_attendance ~ .,
rf_train_df
)[, -1]
test_x <- model.matrix(
target_attendance ~ .,
rf_test_df
)[, -1]
# Create binary target
train_y <- ifelse(
rf_train_df$target_attendance == "At Risk",
1,
0
)
# Create DMatrix objects
dtrain <- xgb.DMatrix(
data = train_x,
label = train_y
)
dtest <- xgb.DMatrix(
data = test_x
)
# Train model
xgb_model <- xgb.train(
params = list(
objective = "binary:logistic",
eval_metric = "logloss",
max_depth = 3,
eta = 0.1,
subsample = 0.8,
colsample_bytree = 0.8
),
data = dtrain,
nrounds = 100,
verbose = 0
)
# Predict probabilities
xgb_probs <- predict(
xgb_model,
dtest
)
# Apply threshold
xgb_pred <- ifelse(
xgb_probs > 0.5,
"At Risk",
"Not At Risk"
)
xgb_pred <- factor(
xgb_pred,
levels = levels(
rf_test_df$target_attendance
)
)
# Confusion matrix
cm_xgb <- confusionMatrix(
xgb_pred,
rf_test_df$target_attendance
)
cm_xgb
## Confusion Matrix and Statistics
##
## Reference
## Prediction At Risk Not At Risk
## At Risk 2 3
## Not At Risk 15 105
##
## Accuracy : 0.856
## 95% CI : (0.782, 0.9124)
## No Information Rate : 0.864
## P-Value [Acc > NIR] : 0.662015
##
## Kappa : 0.1279
##
## Mcnemar's Test P-Value : 0.009522
##
## Sensitivity : 0.1176
## Specificity : 0.9722
## Pos Pred Value : 0.4000
## Neg Pred Value : 0.8750
## Prevalence : 0.1360
## Detection Rate : 0.0160
## Detection Prevalence : 0.0400
## Balanced Accuracy : 0.5449
##
## 'Positive' Class : At Risk
##
# Add to results table
model_results <- rbind(
model_results,
add_results(
"XGBoost",
cm_xgb
)
)
library(glmnet)
## Warning: package 'glmnet' was built under R version 4.6.1
## Loading required package: Matrix
##
## Attaching package: 'Matrix'
## The following objects are masked from 'package:tidyr':
##
## expand, pack, unpack
## Loaded glmnet 5.1
x_train <- model.matrix(
target_attendance ~ .,
rf_train_df
)[,-1]
x_test <- model.matrix(
target_attendance ~ .,
rf_test_df
)[,-1]
y_train <- ifelse(
rf_train_df$target_attendance == "At Risk",
1,
0
)
lasso_cv <- cv.glmnet(
x_train,
y_train,
family = "binomial",
alpha = 1
)
lasso_probs <- predict(
lasso_cv,
newx = x_test,
s = "lambda.min",
type = "response"
)
lasso_pred <- ifelse(
lasso_probs > 0.5,
"At Risk",
"Not At Risk"
)
lasso_pred <- factor(
lasso_pred,
levels =
levels(
rf_test_df$target_attendance
)
)
cm_lasso <- confusionMatrix(
lasso_pred,
rf_test_df$target_attendance
)
model_results <- rbind(
model_results,
add_results(
"LASSO",
cm_lasso
)
)
model_results %>%
arrange(
desc(F1)
)
## Model Accuracy Recall Precision F1 Balanced_Accuracy
## 1 Logistic Regression 0.816 0.7058824 0.4000000 0.5106383 0.7696078
## 2 Decision Tree 0.856 0.3529412 0.4615385 0.4000000 0.6440632
## 3 LASSO 0.888 0.2352941 0.8000000 0.3636364 0.6130174
## 4 Random Forest 0.880 0.2352941 0.6666667 0.3478261 0.6083878
## 5 XGBoost 0.856 0.1176471 0.4000000 0.1818182 0.5449346
The baseline logistic regression model assumes that each predictor contributes independently towards the probability of a school being classified as At Risk.
In practice, school vulnerability is often driven by combinations of factors rather than individual measures in isolation. For example, elevated absence levels may be more concerning in schools with high deprivation, substantial SEND populations or lower attainment outcomes.
Feature interaction engineering was therefore undertaken to explore whether combinations of variables could better capture these relationships and improve predictive performance.
Interactions were selected using a combination of:
The following interactions were identified for investigation:
| Interaction | Rationale |
|---|---|
| Persistent Absence × FSM Ever | Identifies schools experiencing both attendance and deprivation challenges |
| Persistent Absence × SEND Support | Identifies schools where attendance issues may be amplified by additional learning needs |
| Persistent Absence × EHCP | Identifies higher-needs schools experiencing attendance difficulties |
| Persistent Absence × KS2 Attainment | Identifies schools experiencing both attendance and performance concerns |
| FSM Ever × SEND Support | Identifies schools facing multiple forms of educational vulnerability |
| FSM Ever × KS2 Attainment | Identifies schools experiencing deprivation alongside weaker educational outcomes |
The objective is not simply to increase model complexity, but to determine whether combinations of factors provide stronger predictive signals than the individual variables alone.
primary_model_df <- primary_model_df %>%
mutate(
absence_fsm =
persistent_absence_10_pct *
fsmever_pct,
absence_send =
persistent_absence_10_pct *
send_support_pct,
absence_ehcp =
persistent_absence_10_pct *
ehcp_pct,
absence_attainment =
persistent_absence_10_pct *
ks2_expected_standard_pct,
fsm_send =
fsmever_pct *
send_support_pct,
fsm_attainment =
fsmever_pct *
ks2_expected_standard_pct
)
interaction_summary <- primary_model_df %>%
group_by(
target_attendance
) %>%
summarise(
absence_fsm =
mean(
absence_fsm,
na.rm = TRUE
),
absence_send =
mean(
absence_send,
na.rm = TRUE
),
absence_ehcp =
mean(
absence_ehcp,
na.rm = TRUE
),
absence_attainment =
mean(
absence_attainment,
na.rm = TRUE
),
fsm_send =
mean(
fsm_send,
na.rm = TRUE
),
fsm_attainment =
mean(
fsm_attainment,
na.rm = TRUE
)
)
interaction_summary
## # A tibble: 2 × 7
## target_attendance absence_fsm absence_send absence_ehcp absence_attainment
## <fct> <dbl> <dbl> <dbl> <dbl>
## 1 At Risk 855. 94.2 373. 990.
## 2 Not At Risk 362. 44.6 191. 742.
## # ℹ 2 more variables: fsm_send <dbl>, fsm_attainment <dbl>
t.test(
absence_fsm ~ target_attendance,
data = primary_model_df
)
##
## Welch Two Sample t-test
##
## data: absence_fsm by target_attendance
## t = 8.3019, df = 102.94, p-value = 4.265e-13
## alternative hypothesis: true difference in means between group At Risk and group Not At Risk is not equal to 0
## 95 percent confidence interval:
## 375.5926 611.3720
## sample estimates:
## mean in group At Risk mean in group Not At Risk
## 855.1598 361.6774
t.test(
absence_send ~ target_attendance,
data = primary_model_df
)
##
## Welch Two Sample t-test
##
## data: absence_send by target_attendance
## t = 4.9278, df = 99.457, p-value = 3.324e-06
## alternative hypothesis: true difference in means between group At Risk and group Not At Risk is not equal to 0
## 95 percent confidence interval:
## 29.59028 69.47969
## sample estimates:
## mean in group At Risk mean in group Not At Risk
## 94.15793 44.62295
t.test(
absence_ehcp ~ target_attendance,
data = primary_model_df
)
##
## Welch Two Sample t-test
##
## data: absence_ehcp by target_attendance
## t = 8.1126, df = 109.24, p-value = 7.986e-13
## alternative hypothesis: true difference in means between group At Risk and group Not At Risk is not equal to 0
## 95 percent confidence interval:
## 137.5016 226.4044
## sample estimates:
## mean in group At Risk mean in group Not At Risk
## 372.543 190.590
t.test(
absence_attainment ~ target_attendance,
data = primary_model_df
)
##
## Welch Two Sample t-test
##
## data: absence_attainment by target_attendance
## t = 4.9444, df = 99.925, p-value = 3.086e-06
## alternative hypothesis: true difference in means between group At Risk and group Not At Risk is not equal to 0
## 95 percent confidence interval:
## 148.6306 347.8441
## sample estimates:
## mean in group At Risk mean in group Not At Risk
## 990.4811 742.2438
t.test(
fsm_send ~ target_attendance,
data = primary_model_df
)
##
## Welch Two Sample t-test
##
## data: fsm_send by target_attendance
## t = 3.9981, df = 104.41, p-value = 0.0001194
## alternative hypothesis: true difference in means between group At Risk and group Not At Risk is not equal to 0
## 95 percent confidence interval:
## 39.99759 118.71538
## sample estimates:
## mean in group At Risk mean in group Not At Risk
## 178.02681 98.67033
t.test(
fsm_attainment ~ target_attendance,
data = primary_model_df
)
##
## Welch Two Sample t-test
##
## data: fsm_attainment by target_attendance
## t = 1.4103, df = 116.94, p-value = 0.1611
## alternative hypothesis: true difference in means between group At Risk and group Not At Risk is not equal to 0
## 95 percent confidence interval:
## -65.67743 390.57656
## sample estimates:
## mean in group At Risk mean in group Not At Risk
## 1823.205 1660.755
The baseline logistic regression model incorporated a broad range of attendance, behaviour, attainment, deprivation, inclusion and contextual variables. Whilst this maximises the amount of information available to the model, it may also introduce unnecessary complexity and noise.
Not all variables contribute equally to predictive performance. Some variables may provide limited additional information once stronger predictors have already been included in the model. Retaining such variables can reduce model interpretability and increase the risk of overfitting.
To investigate whether a simpler and potentially more effective model could be developed, a stepwise logistic regression approach was undertaken.
Stepwise selection systematically evaluates the inclusion and removal of predictors, seeking a balance between model fit and model complexity. The process is driven by the Akaike Information Criterion (AIC), which rewards models that explain the data well whilst penalising unnecessary complexity.
A bidirectional stepwise approach was adopted, allowing variables to be both added and removed at each stage of the selection process.
The resulting model was then evaluated using the same holdout test dataset as the baseline model to determine whether feature selection improved predictive performance.
set.seed(123)
train_index <- createDataPartition(
primary_model_df$target_attendance,
p = 0.8,
list = FALSE
)
train_df <- primary_model_df[train_index, ]
test_df <- primary_model_df[-train_index, ]
train_df <- train_df %>%
mutate(
academy_status =
as.factor(academy_status),
admissions_policy =
as.factor(admissions_policy),
urban_rural_simple =
as.factor(urban_rural_simple)
)
test_df <- test_df %>%
mutate(
academy_status =
as.factor(academy_status),
admissions_policy =
as.factor(admissions_policy),
urban_rural_simple =
as.factor(urban_rural_simple)
)
train_df <- train_df %>%
mutate(
ks2_expected_standard_pct =
ifelse(
is.na(ks2_expected_standard_pct),
median(
ks2_expected_standard_pct,
na.rm = TRUE
),
ks2_expected_standard_pct
),
ks2_higher_standard_pct =
ifelse(
is.na(ks2_higher_standard_pct),
median(
ks2_higher_standard_pct,
na.rm = TRUE
),
ks2_higher_standard_pct
),
ks2_eal_pct =
ifelse(
is.na(ks2_eal_pct),
median(
ks2_eal_pct,
na.rm = TRUE
),
ks2_eal_pct
),
pupil_mobility_pct =
ifelse(
is.na(pupil_mobility_pct),
median(
pupil_mobility_pct,
na.rm = TRUE
),
pupil_mobility_pct
)
)
test_df <- test_df %>%
mutate(
ks2_expected_standard_pct =
ifelse(
is.na(ks2_expected_standard_pct),
median(
train_df$ks2_expected_standard_pct,
na.rm = TRUE
),
ks2_expected_standard_pct
),
ks2_higher_standard_pct =
ifelse(
is.na(ks2_higher_standard_pct),
median(
train_df$ks2_higher_standard_pct,
na.rm = TRUE
),
ks2_higher_standard_pct
),
ks2_eal_pct =
ifelse(
is.na(ks2_eal_pct),
median(
train_df$ks2_eal_pct,
na.rm = TRUE
),
ks2_eal_pct
),
pupil_mobility_pct =
ifelse(
is.na(pupil_mobility_pct),
median(
train_df$pupil_mobility_pct,
na.rm = TRUE
),
pupil_mobility_pct
)
)
glm_interactions <- glm(
target_attendance ~ .,
data = train_df,
family = "binomial"
)
library(MASS)
##
## Attaching package: 'MASS'
## The following object is masked from 'package:dplyr':
##
## select
step_model <- stepAIC(
glm_interactions,
direction = "both",
trace = TRUE
)
## Start: AIC=264.91
## target_attendance ~ persistent_absence_10_pct + severe_absence_50_pct +
## authorised_absence_pct + unauthorised_absence_pct + persistent_absence_change +
## severe_absence_change + suspension_rate + permanent_exclusions_rate +
## suspension_rate_change + exclusion_rate_change + ks2_expected_standard_pct +
## ks2_higher_standard_pct + fsmever_pct + send_support_pct +
## ehcp_pct + ks2_eal_pct + pupil_mobility_pct + academy_status +
## admissions_policy + urban_rural_simple + absence_fsm + absence_send +
## absence_ehcp + absence_attainment + fsm_send + fsm_attainment
##
## Df Deviance AIC
## - admissions_policy 2 209.72 261.72
## - ehcp_pct 1 208.91 262.92
## - persistent_absence_change 1 208.92 262.92
## - severe_absence_50_pct 1 208.92 262.92
## - urban_rural_simple 1 208.97 262.96
## - ks2_higher_standard_pct 1 208.97 262.98
## - suspension_rate 1 209.02 263.02
## - absence_attainment 1 209.02 263.02
## - send_support_pct 1 209.03 263.02
## - persistent_absence_10_pct 1 209.07 263.07
## - fsm_attainment 1 209.08 263.08
## - fsmever_pct 1 209.20 263.20
## - academy_status 1 209.29 263.29
## - severe_absence_change 1 209.35 263.35
## - absence_ehcp 1 209.46 263.46
## - ks2_expected_standard_pct 1 209.46 263.46
## - exclusion_rate_change 1 209.53 263.53
## - absence_fsm 1 209.85 263.85
## - pupil_mobility_pct 1 210.30 264.30
## - permanent_exclusions_rate 1 210.68 264.68
## - fsm_send 1 210.87 264.87
## <none> 208.91 264.91
## - ks2_eal_pct 1 210.99 264.99
## - absence_send 1 212.42 266.42
## - unauthorised_absence_pct 1 213.57 267.57
## - suspension_rate_change 1 215.58 269.58
## - authorised_absence_pct 1 218.20 272.20
##
## Step: AIC=261.72
## target_attendance ~ persistent_absence_10_pct + severe_absence_50_pct +
## authorised_absence_pct + unauthorised_absence_pct + persistent_absence_change +
## severe_absence_change + suspension_rate + permanent_exclusions_rate +
## suspension_rate_change + exclusion_rate_change + ks2_expected_standard_pct +
## ks2_higher_standard_pct + fsmever_pct + send_support_pct +
## ehcp_pct + ks2_eal_pct + pupil_mobility_pct + academy_status +
## urban_rural_simple + absence_fsm + absence_send + absence_ehcp +
## absence_attainment + fsm_send + fsm_attainment
##
## Df Deviance AIC
## - severe_absence_50_pct 1 209.72 259.72
## - persistent_absence_change 1 209.73 259.73
## - ehcp_pct 1 209.73 259.73
## - send_support_pct 1 209.76 259.76
## - ks2_higher_standard_pct 1 209.76 259.76
## - urban_rural_simple 1 209.79 259.79
## - persistent_absence_10_pct 1 209.80 259.80
## - fsm_attainment 1 209.82 259.82
## - absence_attainment 1 209.92 259.92
## - fsmever_pct 1 209.93 259.93
## - suspension_rate 1 209.95 259.95
## - absence_ehcp 1 210.09 260.09
## - severe_absence_change 1 210.15 260.14
## - academy_status 1 210.25 260.25
## - absence_fsm 1 210.34 260.34
## - exclusion_rate_change 1 210.44 260.44
## - ks2_expected_standard_pct 1 210.54 260.54
## - permanent_exclusions_rate 1 211.35 261.36
## - fsm_send 1 211.44 261.44
## - ks2_eal_pct 1 211.59 261.59
## <none> 209.72 261.72
## - pupil_mobility_pct 1 211.75 261.75
## - absence_send 1 212.61 262.61
## - unauthorised_absence_pct 1 214.40 264.40
## + admissions_policy 2 208.91 264.91
## - suspension_rate_change 1 217.21 267.21
## - authorised_absence_pct 1 218.89 268.89
##
## Step: AIC=259.72
## target_attendance ~ persistent_absence_10_pct + authorised_absence_pct +
## unauthorised_absence_pct + persistent_absence_change + severe_absence_change +
## suspension_rate + permanent_exclusions_rate + suspension_rate_change +
## exclusion_rate_change + ks2_expected_standard_pct + ks2_higher_standard_pct +
## fsmever_pct + send_support_pct + ehcp_pct + ks2_eal_pct +
## pupil_mobility_pct + academy_status + urban_rural_simple +
## absence_fsm + absence_send + absence_ehcp + absence_attainment +
## fsm_send + fsm_attainment
##
## Df Deviance AIC
## - persistent_absence_change 1 209.73 257.73
## - ehcp_pct 1 209.73 257.73
## - send_support_pct 1 209.76 257.76
## - ks2_higher_standard_pct 1 209.76 257.76
## - urban_rural_simple 1 209.79 257.79
## - persistent_absence_10_pct 1 209.80 257.80
## - fsm_attainment 1 209.83 257.83
## - absence_attainment 1 209.92 257.92
## - fsmever_pct 1 209.93 257.93
## - suspension_rate 1 209.95 257.95
## - absence_ehcp 1 210.10 258.10
## - academy_status 1 210.25 258.25
## - absence_fsm 1 210.34 258.34
## - exclusion_rate_change 1 210.45 258.45
## - ks2_expected_standard_pct 1 210.54 258.54
## - severe_absence_change 1 210.62 258.62
## - permanent_exclusions_rate 1 211.36 259.36
## - fsm_send 1 211.45 259.45
## - ks2_eal_pct 1 211.61 259.61
## <none> 209.72 259.72
## - pupil_mobility_pct 1 211.78 259.78
## - absence_send 1 212.66 260.66
## + severe_absence_50_pct 1 209.72 261.72
## + admissions_policy 2 208.92 262.92
## - unauthorised_absence_pct 1 215.01 263.01
## - suspension_rate_change 1 217.46 265.46
## - authorised_absence_pct 1 219.67 267.67
##
## Step: AIC=257.73
## target_attendance ~ persistent_absence_10_pct + authorised_absence_pct +
## unauthorised_absence_pct + severe_absence_change + suspension_rate +
## permanent_exclusions_rate + suspension_rate_change + exclusion_rate_change +
## ks2_expected_standard_pct + ks2_higher_standard_pct + fsmever_pct +
## send_support_pct + ehcp_pct + ks2_eal_pct + pupil_mobility_pct +
## academy_status + urban_rural_simple + absence_fsm + absence_send +
## absence_ehcp + absence_attainment + fsm_send + fsm_attainment
##
## Df Deviance AIC
## - ehcp_pct 1 209.75 255.75
## - ks2_higher_standard_pct 1 209.77 255.77
## - send_support_pct 1 209.78 255.78
## - urban_rural_simple 1 209.81 255.81
## - persistent_absence_10_pct 1 209.82 255.82
## - fsm_attainment 1 209.84 255.84
## - absence_attainment 1 209.93 255.93
## - fsmever_pct 1 209.94 255.94
## - suspension_rate 1 209.96 255.96
## - absence_ehcp 1 210.10 256.10
## - academy_status 1 210.29 256.29
## - absence_fsm 1 210.34 256.34
## - exclusion_rate_change 1 210.45 256.45
## - ks2_expected_standard_pct 1 210.55 256.55
## - severe_absence_change 1 210.71 256.71
## - permanent_exclusions_rate 1 211.43 257.43
## - fsm_send 1 211.47 257.47
## <none> 209.73 257.73
## - ks2_eal_pct 1 211.82 257.82
## - pupil_mobility_pct 1 211.83 257.83
## - absence_send 1 212.71 258.71
## + persistent_absence_change 1 209.72 259.72
## + severe_absence_50_pct 1 209.73 259.73
## + admissions_policy 2 208.92 260.92
## - unauthorised_absence_pct 1 215.04 261.04
## - suspension_rate_change 1 217.50 263.50
## - authorised_absence_pct 1 219.69 265.69
##
## Step: AIC=255.75
## target_attendance ~ persistent_absence_10_pct + authorised_absence_pct +
## unauthorised_absence_pct + severe_absence_change + suspension_rate +
## permanent_exclusions_rate + suspension_rate_change + exclusion_rate_change +
## ks2_expected_standard_pct + ks2_higher_standard_pct + fsmever_pct +
## send_support_pct + ks2_eal_pct + pupil_mobility_pct + academy_status +
## urban_rural_simple + absence_fsm + absence_send + absence_ehcp +
## absence_attainment + fsm_send + fsm_attainment
##
## Df Deviance AIC
## - send_support_pct 1 209.79 253.79
## - ks2_higher_standard_pct 1 209.79 253.79
## - urban_rural_simple 1 209.83 253.83
## - fsm_attainment 1 209.86 253.86
## - persistent_absence_10_pct 1 209.86 253.86
## - absence_attainment 1 209.94 253.94
## - suspension_rate 1 209.98 253.98
## - fsmever_pct 1 210.01 254.01
## - academy_status 1 210.32 254.32
## - exclusion_rate_change 1 210.45 254.45
## - ks2_expected_standard_pct 1 210.56 254.56
## - absence_fsm 1 210.64 254.64
## - severe_absence_change 1 210.71 254.71
## - permanent_exclusions_rate 1 211.46 255.46
## - fsm_send 1 211.47 255.47
## <none> 209.75 255.75
## - ks2_eal_pct 1 211.82 255.82
## - pupil_mobility_pct 1 211.83 255.83
## - absence_send 1 212.71 256.71
## - absence_ehcp 1 213.51 257.51
## + ehcp_pct 1 209.73 257.73
## + persistent_absence_change 1 209.73 257.73
## + severe_absence_50_pct 1 209.75 257.75
## + admissions_policy 2 208.92 258.92
## - unauthorised_absence_pct 1 215.04 259.04
## - suspension_rate_change 1 217.63 261.63
## - authorised_absence_pct 1 219.70 263.70
##
## Step: AIC=253.79
## target_attendance ~ persistent_absence_10_pct + authorised_absence_pct +
## unauthorised_absence_pct + severe_absence_change + suspension_rate +
## permanent_exclusions_rate + suspension_rate_change + exclusion_rate_change +
## ks2_expected_standard_pct + ks2_higher_standard_pct + fsmever_pct +
## ks2_eal_pct + pupil_mobility_pct + academy_status + urban_rural_simple +
## absence_fsm + absence_send + absence_ehcp + absence_attainment +
## fsm_send + fsm_attainment
##
## Df Deviance AIC
## - ks2_higher_standard_pct 1 209.84 251.84
## - urban_rural_simple 1 209.87 251.87
## - persistent_absence_10_pct 1 209.88 251.88
## - fsm_attainment 1 209.93 251.93
## - fsmever_pct 1 210.03 252.03
## - suspension_rate 1 210.04 252.04
## - absence_attainment 1 210.07 252.07
## - academy_status 1 210.36 252.36
## - exclusion_rate_change 1 210.52 252.52
## - absence_fsm 1 210.64 252.64
## - ks2_expected_standard_pct 1 210.72 252.72
## - severe_absence_change 1 210.80 252.80
## - permanent_exclusions_rate 1 211.47 253.47
## <none> 209.79 253.79
## - ks2_eal_pct 1 211.87 253.87
## - pupil_mobility_pct 1 211.88 253.88
## - fsm_send 1 211.95 253.95
## - absence_ehcp 1 213.51 255.51
## - absence_send 1 213.73 255.73
## + send_support_pct 1 209.75 255.75
## + persistent_absence_change 1 209.78 255.78
## + ehcp_pct 1 209.78 255.78
## + severe_absence_50_pct 1 209.79 255.79
## + admissions_policy 2 209.03 257.03
## - unauthorised_absence_pct 1 215.06 257.06
## - suspension_rate_change 1 217.76 259.76
## - authorised_absence_pct 1 219.73 261.73
##
## Step: AIC=251.84
## target_attendance ~ persistent_absence_10_pct + authorised_absence_pct +
## unauthorised_absence_pct + severe_absence_change + suspension_rate +
## permanent_exclusions_rate + suspension_rate_change + exclusion_rate_change +
## ks2_expected_standard_pct + fsmever_pct + ks2_eal_pct + pupil_mobility_pct +
## academy_status + urban_rural_simple + absence_fsm + absence_send +
## absence_ehcp + absence_attainment + fsm_send + fsm_attainment
##
## Df Deviance AIC
## - urban_rural_simple 1 209.92 249.92
## - persistent_absence_10_pct 1 209.94 249.94
## - fsm_attainment 1 209.96 249.96
## - fsmever_pct 1 210.08 250.08
## - suspension_rate 1 210.10 250.10
## - absence_attainment 1 210.11 250.11
## - academy_status 1 210.42 250.42
## - exclusion_rate_change 1 210.59 250.59
## - absence_fsm 1 210.67 250.67
## - severe_absence_change 1 210.84 250.84
## - ks2_expected_standard_pct 1 210.94 250.94
## - permanent_exclusions_rate 1 211.48 251.48
## <none> 209.84 251.84
## - fsm_send 1 211.96 251.96
## - pupil_mobility_pct 1 212.01 252.01
## - ks2_eal_pct 1 212.03 252.03
## - absence_ehcp 1 213.56 253.56
## - absence_send 1 213.74 253.74
## + ks2_higher_standard_pct 1 209.79 253.79
## + send_support_pct 1 209.79 253.79
## + ehcp_pct 1 209.82 253.82
## + persistent_absence_change 1 209.83 253.83
## + severe_absence_50_pct 1 209.84 253.84
## - unauthorised_absence_pct 1 215.06 255.06
## + admissions_policy 2 209.10 255.10
## - suspension_rate_change 1 217.85 257.85
## - authorised_absence_pct 1 219.75 259.75
##
## Step: AIC=249.92
## target_attendance ~ persistent_absence_10_pct + authorised_absence_pct +
## unauthorised_absence_pct + severe_absence_change + suspension_rate +
## permanent_exclusions_rate + suspension_rate_change + exclusion_rate_change +
## ks2_expected_standard_pct + fsmever_pct + ks2_eal_pct + pupil_mobility_pct +
## academy_status + absence_fsm + absence_send + absence_ehcp +
## absence_attainment + fsm_send + fsm_attainment
##
## Df Deviance AIC
## - persistent_absence_10_pct 1 209.98 247.98
## - fsm_attainment 1 210.04 248.04
## - fsmever_pct 1 210.20 248.20
## - suspension_rate 1 210.21 248.21
## - absence_attainment 1 210.27 248.27
## - academy_status 1 210.55 248.55
## - exclusion_rate_change 1 210.66 248.66
## - absence_fsm 1 210.80 248.80
## - severe_absence_change 1 210.91 248.91
## - ks2_expected_standard_pct 1 211.23 249.23
## - permanent_exclusions_rate 1 211.51 249.51
## <none> 209.92 249.92
## - pupil_mobility_pct 1 212.01 250.01
## - fsm_send 1 212.03 250.03
## - ks2_eal_pct 1 212.84 250.84
## - absence_ehcp 1 213.73 251.73
## - absence_send 1 213.79 251.79
## + urban_rural_simple 1 209.84 251.84
## + ks2_higher_standard_pct 1 209.87 251.87
## + send_support_pct 1 209.88 251.88
## + ehcp_pct 1 209.90 251.90
## + persistent_absence_change 1 209.90 251.90
## + severe_absence_50_pct 1 209.92 251.92
## + admissions_policy 2 209.15 253.15
## - unauthorised_absence_pct 1 215.73 253.73
## - suspension_rate_change 1 217.89 255.89
## - authorised_absence_pct 1 220.40 258.39
##
## Step: AIC=247.98
## target_attendance ~ authorised_absence_pct + unauthorised_absence_pct +
## severe_absence_change + suspension_rate + permanent_exclusions_rate +
## suspension_rate_change + exclusion_rate_change + ks2_expected_standard_pct +
## fsmever_pct + ks2_eal_pct + pupil_mobility_pct + academy_status +
## absence_fsm + absence_send + absence_ehcp + absence_attainment +
## fsm_send + fsm_attainment
##
## Df Deviance AIC
## - fsmever_pct 1 210.21 246.21
## - fsm_attainment 1 210.24 246.24
## - suspension_rate 1 210.26 246.26
## - academy_status 1 210.59 246.59
## - exclusion_rate_change 1 210.69 246.69
## - severe_absence_change 1 210.99 246.99
## - absence_fsm 1 211.25 247.25
## - permanent_exclusions_rate 1 211.63 247.63
## - absence_attainment 1 211.98 247.98
## <none> 209.98 247.98
## - pupil_mobility_pct 1 212.03 248.03
## - fsm_send 1 212.22 248.22
## - ks2_expected_standard_pct 1 212.28 248.28
## - ks2_eal_pct 1 212.84 248.84
## - absence_ehcp 1 213.90 249.90
## + persistent_absence_10_pct 1 209.92 249.92
## + ks2_higher_standard_pct 1 209.93 249.93
## + urban_rural_simple 1 209.94 249.94
## + ehcp_pct 1 209.95 249.95
## + persistent_absence_change 1 209.96 249.96
## + send_support_pct 1 209.96 249.96
## + severe_absence_50_pct 1 209.98 249.98
## - absence_send 1 214.21 250.21
## + admissions_policy 2 209.24 251.24
## - unauthorised_absence_pct 1 217.33 253.33
## - suspension_rate_change 1 217.94 253.94
## - authorised_absence_pct 1 223.18 259.18
##
## Step: AIC=246.21
## target_attendance ~ authorised_absence_pct + unauthorised_absence_pct +
## severe_absence_change + suspension_rate + permanent_exclusions_rate +
## suspension_rate_change + exclusion_rate_change + ks2_expected_standard_pct +
## ks2_eal_pct + pupil_mobility_pct + academy_status + absence_fsm +
## absence_send + absence_ehcp + absence_attainment + fsm_send +
## fsm_attainment
##
## Df Deviance AIC
## - suspension_rate 1 210.49 244.49
## - academy_status 1 210.85 244.85
## - exclusion_rate_change 1 210.86 244.86
## - severe_absence_change 1 211.24 245.24
## - absence_fsm 1 211.32 245.32
## - permanent_exclusions_rate 1 212.04 246.04
## <none> 210.21 246.21
## - fsm_send 1 212.22 246.22
## - pupil_mobility_pct 1 212.25 246.25
## - ks2_expected_standard_pct 1 212.48 246.48
## - fsm_attainment 1 213.10 247.10
## - absence_attainment 1 213.30 247.30
## - ks2_eal_pct 1 213.47 247.47
## + fsmever_pct 1 209.98 247.98
## - absence_ehcp 1 214.00 248.00
## + urban_rural_simple 1 210.12 248.12
## + ehcp_pct 1 210.13 248.13
## + ks2_higher_standard_pct 1 210.16 248.16
## + persistent_absence_change 1 210.20 248.20
## + persistent_absence_10_pct 1 210.20 248.20
## + send_support_pct 1 210.20 248.20
## + severe_absence_50_pct 1 210.21 248.21
## - absence_send 1 214.22 248.22
## + admissions_policy 2 209.50 249.50
## - unauthorised_absence_pct 1 217.33 251.33
## - suspension_rate_change 1 218.04 252.04
## - authorised_absence_pct 1 223.27 257.27
##
## Step: AIC=244.49
## target_attendance ~ authorised_absence_pct + unauthorised_absence_pct +
## severe_absence_change + permanent_exclusions_rate + suspension_rate_change +
## exclusion_rate_change + ks2_expected_standard_pct + ks2_eal_pct +
## pupil_mobility_pct + academy_status + absence_fsm + absence_send +
## absence_ehcp + absence_attainment + fsm_send + fsm_attainment
##
## Df Deviance AIC
## - exclusion_rate_change 1 210.97 242.97
## - academy_status 1 211.17 243.17
## - severe_absence_change 1 211.45 243.45
## - absence_fsm 1 211.54 243.54
## - pupil_mobility_pct 1 212.42 244.42
## <none> 210.49 244.49
## - ks2_expected_standard_pct 1 212.80 244.80
## - permanent_exclusions_rate 1 213.12 245.12
## - fsm_send 1 213.46 245.46
## - fsm_attainment 1 213.65 245.65
## - ks2_eal_pct 1 213.77 245.77
## + suspension_rate 1 210.21 246.21
## + fsmever_pct 1 210.26 246.26
## + urban_rural_simple 1 210.38 246.38
## + ehcp_pct 1 210.43 246.43
## + ks2_higher_standard_pct 1 210.43 246.43
## + send_support_pct 1 210.47 246.47
## + persistent_absence_change 1 210.48 246.48
## + persistent_absence_10_pct 1 210.48 246.48
## + severe_absence_50_pct 1 210.49 246.49
## - absence_attainment 1 214.51 246.51
## - absence_ehcp 1 214.66 246.66
## + admissions_policy 2 209.65 247.65
## - absence_send 1 215.89 247.89
## - unauthorised_absence_pct 1 217.60 249.60
## - authorised_absence_pct 1 223.31 255.31
## - suspension_rate_change 1 225.11 257.11
##
## Step: AIC=242.97
## target_attendance ~ authorised_absence_pct + unauthorised_absence_pct +
## severe_absence_change + permanent_exclusions_rate + suspension_rate_change +
## ks2_expected_standard_pct + ks2_eal_pct + pupil_mobility_pct +
## academy_status + absence_fsm + absence_send + absence_ehcp +
## absence_attainment + fsm_send + fsm_attainment
##
## Df Deviance AIC
## - academy_status 1 211.67 241.67
## - severe_absence_change 1 211.92 241.92
## - absence_fsm 1 212.05 242.05
## - pupil_mobility_pct 1 212.71 242.71
## <none> 210.97 242.97
## - ks2_expected_standard_pct 1 213.33 243.33
## - fsm_send 1 213.97 243.97
## - fsm_attainment 1 214.04 244.04
## - ks2_eal_pct 1 214.36 244.36
## + exclusion_rate_change 1 210.49 244.49
## + fsmever_pct 1 210.79 244.79
## - absence_attainment 1 214.81 244.81
## + suspension_rate 1 210.86 244.86
## + urban_rural_simple 1 210.87 244.87
## + ks2_higher_standard_pct 1 210.90 244.90
## + send_support_pct 1 210.94 244.94
## + ehcp_pct 1 210.94 244.94
## + persistent_absence_10_pct 1 210.97 244.97
## + severe_absence_50_pct 1 210.97 244.97
## + persistent_absence_change 1 210.97 244.97
## - absence_ehcp 1 215.25 245.25
## + admissions_policy 2 210.11 246.11
## - absence_send 1 216.40 246.40
## - unauthorised_absence_pct 1 217.93 247.93
## - permanent_exclusions_rate 1 217.94 247.94
## - authorised_absence_pct 1 224.39 254.39
## - suspension_rate_change 1 225.12 255.12
##
## Step: AIC=241.67
## target_attendance ~ authorised_absence_pct + unauthorised_absence_pct +
## severe_absence_change + permanent_exclusions_rate + suspension_rate_change +
## ks2_expected_standard_pct + ks2_eal_pct + pupil_mobility_pct +
## absence_fsm + absence_send + absence_ehcp + absence_attainment +
## fsm_send + fsm_attainment
##
## Df Deviance AIC
## - absence_fsm 1 212.71 240.71
## - severe_absence_change 1 212.75 240.75
## - pupil_mobility_pct 1 213.66 241.66
## <none> 211.67 241.67
## - ks2_expected_standard_pct 1 214.26 242.26
## - ks2_eal_pct 1 214.76 242.76
## - fsm_send 1 214.77 242.77
## + academy_status 1 210.97 242.97
## - fsm_attainment 1 215.10 243.10
## + exclusion_rate_change 1 211.17 243.17
## + fsmever_pct 1 211.46 243.46
## + urban_rural_simple 1 211.49 243.49
## + suspension_rate 1 211.53 243.53
## + ks2_higher_standard_pct 1 211.58 243.58
## + send_support_pct 1 211.62 243.62
## + ehcp_pct 1 211.63 243.63
## + persistent_absence_change 1 211.65 243.65
## + severe_absence_50_pct 1 211.65 243.65
## + persistent_absence_10_pct 1 211.67 243.67
## - absence_attainment 1 215.81 243.81
## - absence_ehcp 1 215.94 243.94
## + admissions_policy 2 210.55 244.55
## - absence_send 1 217.25 245.25
## - unauthorised_absence_pct 1 218.66 246.66
## - permanent_exclusions_rate 1 219.05 247.05
## - authorised_absence_pct 1 225.04 253.04
## - suspension_rate_change 1 225.66 253.66
##
## Step: AIC=240.71
## target_attendance ~ authorised_absence_pct + unauthorised_absence_pct +
## severe_absence_change + permanent_exclusions_rate + suspension_rate_change +
## ks2_expected_standard_pct + ks2_eal_pct + pupil_mobility_pct +
## absence_send + absence_ehcp + absence_attainment + fsm_send +
## fsm_attainment
##
## Df Deviance AIC
## - severe_absence_change 1 213.67 239.67
## <none> 212.71 240.71
## - pupil_mobility_pct 1 214.82 240.82
## - fsm_attainment 1 215.28 241.28
## + absence_fsm 1 211.67 241.67
## - ks2_eal_pct 1 215.82 241.82
## - absence_ehcp 1 215.96 241.96
## + academy_status 1 212.05 242.05
## + exclusion_rate_change 1 212.20 242.20
## + ehcp_pct 1 212.20 242.20
## - fsm_send 1 216.22 242.22
## + persistent_absence_10_pct 1 212.34 242.34
## + suspension_rate 1 212.62 242.62
## + urban_rural_simple 1 212.63 242.63
## + fsmever_pct 1 212.63 242.63
## + ks2_higher_standard_pct 1 212.63 242.63
## + send_support_pct 1 212.67 242.67
## + severe_absence_50_pct 1 212.69 242.69
## + persistent_absence_change 1 212.70 242.70
## - absence_attainment 1 218.14 244.14
## + admissions_policy 2 212.18 244.18
## - absence_send 1 218.39 244.39
## - permanent_exclusions_rate 1 219.48 245.48
## - ks2_expected_standard_pct 1 219.53 245.53
## - unauthorised_absence_pct 1 225.56 251.56
## - suspension_rate_change 1 226.36 252.36
## - authorised_absence_pct 1 228.88 254.88
##
## Step: AIC=239.67
## target_attendance ~ authorised_absence_pct + unauthorised_absence_pct +
## permanent_exclusions_rate + suspension_rate_change + ks2_expected_standard_pct +
## ks2_eal_pct + pupil_mobility_pct + absence_send + absence_ehcp +
## absence_attainment + fsm_send + fsm_attainment
##
## Df Deviance AIC
## - pupil_mobility_pct 1 215.64 239.64
## <none> 213.67 239.67
## - fsm_attainment 1 216.53 240.53
## + severe_absence_change 1 212.71 240.71
## + absence_fsm 1 212.75 240.75
## - ks2_eal_pct 1 216.84 240.84
## + academy_status 1 212.88 240.88
## - absence_ehcp 1 217.01 241.01
## - fsm_send 1 217.10 241.10
## + exclusion_rate_change 1 213.20 241.20
## + ehcp_pct 1 213.29 241.29
## + persistent_absence_10_pct 1 213.31 241.31
## + severe_absence_50_pct 1 213.35 241.35
## + persistent_absence_change 1 213.56 241.56
## + urban_rural_simple 1 213.59 241.59
## + suspension_rate 1 213.59 241.59
## + ks2_higher_standard_pct 1 213.60 241.60
## + fsmever_pct 1 213.61 241.61
## + send_support_pct 1 213.65 241.65
## - absence_attainment 1 219.05 243.05
## + admissions_policy 2 213.17 243.17
## - absence_send 1 219.28 243.28
## - permanent_exclusions_rate 1 219.97 243.97
## - ks2_expected_standard_pct 1 219.99 243.99
## - suspension_rate_change 1 227.04 251.04
## - unauthorised_absence_pct 1 228.63 252.63
## - authorised_absence_pct 1 231.74 255.74
##
## Step: AIC=239.64
## target_attendance ~ authorised_absence_pct + unauthorised_absence_pct +
## permanent_exclusions_rate + suspension_rate_change + ks2_expected_standard_pct +
## ks2_eal_pct + absence_send + absence_ehcp + absence_attainment +
## fsm_send + fsm_attainment
##
## Df Deviance AIC
## <none> 215.64 239.64
## + pupil_mobility_pct 1 213.67 239.67
## - fsm_attainment 1 218.41 240.41
## + absence_fsm 1 214.58 240.58
## + academy_status 1 214.60 240.60
## + severe_absence_change 1 214.82 240.82
## + ehcp_pct 1 215.29 241.29
## + persistent_absence_10_pct 1 215.37 241.37
## - absence_ehcp 1 219.38 241.38
## - ks2_eal_pct 1 219.38 241.38
## + exclusion_rate_change 1 215.39 241.39
## + persistent_absence_change 1 215.46 241.46
## + ks2_higher_standard_pct 1 215.50 241.50
## + severe_absence_50_pct 1 215.50 241.50
## + fsmever_pct 1 215.58 241.58
## + suspension_rate 1 215.60 241.60
## + send_support_pct 1 215.63 241.63
## + urban_rural_simple 1 215.64 241.64
## - fsm_send 1 219.84 241.84
## + admissions_policy 2 214.68 242.68
## - absence_attainment 1 221.07 243.07
## - permanent_exclusions_rate 1 221.61 243.61
## - ks2_expected_standard_pct 1 221.74 243.74
## - absence_send 1 223.00 245.00
## - suspension_rate_change 1 228.93 250.93
## - unauthorised_absence_pct 1 231.01 253.01
## - authorised_absence_pct 1 234.62 256.62
formula(step_model)
## target_attendance ~ authorised_absence_pct + unauthorised_absence_pct +
## permanent_exclusions_rate + suspension_rate_change + ks2_expected_standard_pct +
## ks2_eal_pct + absence_send + absence_ehcp + absence_attainment +
## fsm_send + fsm_attainment
summary(step_model)
##
## Call:
## glm(formula = target_attendance ~ authorised_absence_pct + unauthorised_absence_pct +
## permanent_exclusions_rate + suspension_rate_change + ks2_expected_standard_pct +
## ks2_eal_pct + absence_send + absence_ehcp + absence_attainment +
## fsm_send + fsm_attainment, family = "binomial", data = train_df)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 6.3447940 1.8778040 3.379 0.000728 ***
## authorised_absence_pct -1.3395542 0.3297014 -4.063 4.85e-05 ***
## unauthorised_absence_pct -1.1867628 0.3170649 -3.743 0.000182 ***
## permanent_exclusions_rate 3.0740768 1.4749904 2.084 0.037148 *
## suspension_rate_change -0.1521492 0.0442930 -3.435 0.000592 ***
## ks2_expected_standard_pct 0.0546743 0.0226647 2.412 0.015852 *
## ks2_eal_pct 0.0167543 0.0092671 1.808 0.070618 .
## absence_send 0.0208302 0.0073107 2.849 0.004382 **
## absence_ehcp 0.0026716 0.0015328 1.743 0.081335 .
## absence_attainment -0.0024712 0.0010608 -2.329 0.019835 *
## fsm_send -0.0074528 0.0035466 -2.101 0.035604 *
## fsm_attainment 0.0005591 0.0003451 1.620 0.105170
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 381.47 on 495 degrees of freedom
## Residual deviance: 215.64 on 484 degrees of freedom
## (53 observations deleted due to missingness)
## AIC: 239.64
##
## Number of Fisher Scoring iterations: 7
step_probs <- predict(
step_model,
newdata = test_df,
type = "response"
)
step_pred <- ifelse(
step_probs > 0.90,
"Not At Risk",
"At Risk"
)
step_pred <- factor(
step_pred,
levels =
levels(
test_df$target_attendance
)
)
cm_step <- confusionMatrix(
step_pred,
test_df$target_attendance
)
cm_step
## Confusion Matrix and Statistics
##
## Reference
## Prediction At Risk Not At Risk
## At Risk 16 20
## Not At Risk 1 88
##
## Accuracy : 0.832
## 95% CI : (0.7547, 0.8929)
## No Information Rate : 0.864
## P-Value [Acc > NIR] : 0.878
##
## Kappa : 0.514
##
## Mcnemar's Test P-Value : 8.568e-05
##
## Sensitivity : 0.9412
## Specificity : 0.8148
## Pos Pred Value : 0.4444
## Neg Pred Value : 0.9888
## Prevalence : 0.1360
## Detection Rate : 0.1280
## Detection Prevalence : 0.2880
## Balanced Accuracy : 0.8780
##
## 'Positive' Class : At Risk
##
precision <- as.numeric(
cm_step$byClass["Pos Pred Value"]
)
recall <- as.numeric(
cm_step$byClass["Sensitivity"]
)
f1 <- 2 * (
precision * recall
) /
(
precision + recall
)
data.frame(
Accuracy =
round(
as.numeric(
cm_step$overall["Accuracy"]
),
3
),
Recall =
round(recall, 3),
Precision =
round(precision, 3),
F1 =
round(f1, 3),
Balanced_Accuracy =
round(
as.numeric(
cm_step$byClass["Balanced Accuracy"]
),
3
)
)
## Accuracy Recall Precision F1 Balanced_Accuracy
## 1 0.832 0.941 0.444 0.604 0.878
The modelling dataset exhibits a significant class imbalance, with approximately 86% of schools classified as Not At Risk and only 14% classified as At Risk.
In imbalanced classification problems, machine learning models can become biased towards the majority class because predicting the majority outcome results in fewer overall classification errors.
Although threshold optimisation and feature engineering substantially improved model performance, there remains a risk that the model is not placing sufficient emphasis on correctly identifying schools classified as At Risk.
To address this issue, a weighted logistic regression approach was evaluated.
Additional weighting was applied to schools classified as At Risk during model training. This increases the penalty associated with incorrectly classifying a vulnerable school and encourages the model to pay greater attention to patterns associated with future intervention needs.
The objective was to determine whether class weighting could further improve recall, precision and F1 score when compared against the baseline and interaction-enhanced models.
train_df$case_weight <- ifelse(
train_df$target_attendance == "At Risk",
5,
1
)
weighted_model <- glm(
target_attendance ~
authorised_absence_pct +
unauthorised_absence_pct +
permanent_exclusions_rate +
suspension_rate_change +
ks2_expected_standard_pct +
ks2_eal_pct +
absence_send +
absence_ehcp +
absence_attainment +
fsm_send +
fsm_attainment,
data = train_df,
family = "binomial",
weights = case_weight
)
weighted_probs <- predict(
weighted_model,
newdata = test_df,
type = "response"
)
weighted_pred <- ifelse(
weighted_probs > 0.90,
"Not At Risk",
"At Risk"
)
weighted_pred <- factor(
weighted_pred,
levels =
levels(
test_df$target_attendance
)
)
cm_weighted <- confusionMatrix(
weighted_pred,
test_df$target_attendance
)
cm_weighted
## Confusion Matrix and Statistics
##
## Reference
## Prediction At Risk Not At Risk
## At Risk 16 47
## Not At Risk 1 61
##
## Accuracy : 0.616
## 95% CI : (0.5248, 0.7016)
## No Information Rate : 0.864
## P-Value [Acc > NIR] : 1
##
## Kappa : 0.2364
##
## Mcnemar's Test P-Value : 8.293e-11
##
## Sensitivity : 0.9412
## Specificity : 0.5648
## Pos Pred Value : 0.2540
## Neg Pred Value : 0.9839
## Prevalence : 0.1360
## Detection Rate : 0.1280
## Detection Prevalence : 0.5040
## Balanced Accuracy : 0.7530
##
## 'Positive' Class : At Risk
##
precision <- as.numeric(
cm_weighted$byClass["Pos Pred Value"]
)
recall <- as.numeric(
cm_weighted$byClass["Sensitivity"]
)
f1 <- 2 * (
precision * recall
) /
(
precision + recall
)
weighted_results <- data.frame(
Accuracy =
round(
as.numeric(
cm_weighted$overall["Accuracy"]
),
3
),
Recall =
round(
recall,
3
),
Precision =
round(
precision,
3
),
F1 =
round(
f1,
3
),
Balanced_Accuracy =
round(
as.numeric(
cm_weighted$byClass["Balanced Accuracy"]
),
3
)
)
weighted_results
## Accuracy Recall Precision F1 Balanced_Accuracy
## 1 0.616 0.941 0.254 0.4 0.753
Class weighting was investigated to determine whether additional emphasis on At Risk schools improved model performance. However, whilst recall remained unchanged, precision fell substantially from 44.4% to 25.4%, leading to a deterioration in overall F1 score. Consequently, class weighting was not retained within the final model.
In real world terms - i am trying loads to try and identify A SINGLE extra school! So even through relaxing detection thresholds for ‘at risk’ its not catching that one school - but in failing to do so, its incorrectly flagging more not at risk schools - therefore increasing false positives (weakening precision)
I think ive reached my limit until new data is available
Lets do a final calibration
Feature engineering and stepwise selection identified an improved logistic regression model incorporating attendance, attainment, exclusion measures and several engineered interaction variables.
Having established the final candidate model structure, a final threshold optimisation exercise was undertaken. The objective was to identify the threshold which provided the strongest balance between recall, precision and F1 score.
Previous experimentation suggested that model performance improved considerably when the threshold was increased beyond conventional values. Consequently, testing focused on a narrow range between 0.88 and 0.92 surrounding the current optimum threshold.
The resulting metrics were then compared against the project’s success criteria to identify the most appropriate operating point for deployment.
step_probs <- predict(
step_model,
newdata = test_df,
type = "response"
)
thresholds <- seq(
0.88,
0.92,
by = 0.01
)
threshold_results <- data.frame()
for(t in thresholds){
pred <- ifelse(
step_probs > t,
"Not At Risk",
"At Risk"
)
pred <- factor(
pred,
levels = levels(
test_df$target_attendance
)
)
cm <- confusionMatrix(
pred,
test_df$target_attendance
)
precision <- as.numeric(
cm$byClass["Pos Pred Value"]
)
recall <- as.numeric(
cm$byClass["Sensitivity"]
)
f1 <- 2 * (
precision * recall
) /
(
precision + recall
)
threshold_results <- rbind(
threshold_results,
data.frame(
Threshold = t,
Accuracy =
round(
as.numeric(
cm$overall["Accuracy"]
),
3
),
Recall =
round(
recall,
3
),
Precision =
round(
precision,
3
),
F1 =
round(
f1,
3
),
Balanced_Accuracy =
round(
as.numeric(
cm$byClass["Balanced Accuracy"]
),
3
)
)
)
}
threshold_results
## Threshold Accuracy Recall Precision F1 Balanced_Accuracy
## 1 0.88 0.832 0.824 0.438 0.571 0.828
## 2 0.89 0.832 0.941 0.444 0.604 0.878
## 3 0.90 0.832 0.941 0.444 0.604 0.878
## 4 0.91 0.824 0.941 0.432 0.593 0.873
## 5 0.92 0.800 0.941 0.400 0.561 0.859
threshold_results %>%
pivot_longer(
cols = c(
Recall,
Precision,
F1
),
names_to = "Metric",
values_to = "Value"
) %>%
ggplot(
aes(
Threshold,
Value,
colour = Metric
)
) +
geom_line(
linewidth = 1
) +
geom_point() +
theme_minimal() +
labs(
title =
"Final Threshold Optimisation",
x =
"Threshold",
y =
"Metric Value"
)
The final logistic regression model was initially evaluated using a single train-test split. Whilst this provides a useful assessment of model performance, results can vary depending upon the specific allocation of observations to the training and testing datasets.
To assess the robustness and stability of the model, k-fold cross validation was undertaken.
Cross validation repeatedly partitions the data into training and validation subsets, allowing model performance to be evaluated across multiple independent samples. This provides a more reliable estimate of expected performance when applied to previously unseen schools.
A five-fold cross validation approach was selected due to the relatively modest number of schools available within the modelling dataset.
cv_df <- primary_model_df %>%
dplyr::select(
target_attendance,
authorised_absence_pct,
unauthorised_absence_pct,
permanent_exclusions_rate,
suspension_rate_change,
ks2_expected_standard_pct,
ks2_eal_pct,
absence_send,
absence_ehcp,
absence_attainment,
fsm_send,
fsm_attainment
) %>%
tidyr::drop_na()
library(caret)
set.seed(123)
cv_control <- trainControl(
method = "cv",
number = 5
)
cv_model <- train(
target_attendance ~
authorised_absence_pct +
unauthorised_absence_pct +
permanent_exclusions_rate +
suspension_rate_change +
ks2_expected_standard_pct +
ks2_eal_pct +
absence_send +
absence_ehcp +
absence_attainment +
fsm_send +
fsm_attainment,
data = cv_df,
method = "glm",
family = "binomial",
trControl = cv_control
)
cv_model
## Generalized Linear Model
##
## 621 samples
## 11 predictor
## 2 classes: 'At Risk', 'Not At Risk'
##
## No pre-processing
## Resampling: Cross-Validated (5 fold)
## Summary of sample sizes: 497, 497, 496, 497, 497
## Resampling results:
##
## Accuracy Kappa
## 0.8888387 0.4331687
cv_model$resample
## Accuracy Kappa Resample
## 1 0.9193548 0.5730028 Fold1
## 2 0.8629032 0.2963952 Fold2
## 3 0.9200000 0.6221282 Fold3
## 4 0.8709677 0.3575130 Fold4
## 5 0.8709677 0.3168044 Fold5
Five-fold cross validation demonstrated relatively stable model performance across multiple validation folds, with an average accuracy of 88.9% and Cohen’s Kappa of 0.43. The results suggest the model is identifying genuine patterns within the data and is not overly dependent upon a single train-test partition.
One of the advantages of logistic regression is that it provides a transparent and explainable modelling framework.
Unlike more complex machine learning algorithms such as Random Forest and XGBoost, the contribution of each predictor can be directly examined and interpreted. This is particularly important within education, where practitioners must be able to understand why a school has been identified as potentially requiring intervention.
Feature importance was assessed using model coefficients and odds ratios. Odds ratios provide an intuitive measure of the direction and magnitude of each predictor’s influence on the likelihood of a school being classified as At Risk.
Understanding the relative importance of model features also supports transparency, governance and future model development by identifying which school characteristics contribute most strongly to predictions.
summary(step_model)
##
## Call:
## glm(formula = target_attendance ~ authorised_absence_pct + unauthorised_absence_pct +
## permanent_exclusions_rate + suspension_rate_change + ks2_expected_standard_pct +
## ks2_eal_pct + absence_send + absence_ehcp + absence_attainment +
## fsm_send + fsm_attainment, family = "binomial", data = train_df)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 6.3447940 1.8778040 3.379 0.000728 ***
## authorised_absence_pct -1.3395542 0.3297014 -4.063 4.85e-05 ***
## unauthorised_absence_pct -1.1867628 0.3170649 -3.743 0.000182 ***
## permanent_exclusions_rate 3.0740768 1.4749904 2.084 0.037148 *
## suspension_rate_change -0.1521492 0.0442930 -3.435 0.000592 ***
## ks2_expected_standard_pct 0.0546743 0.0226647 2.412 0.015852 *
## ks2_eal_pct 0.0167543 0.0092671 1.808 0.070618 .
## absence_send 0.0208302 0.0073107 2.849 0.004382 **
## absence_ehcp 0.0026716 0.0015328 1.743 0.081335 .
## absence_attainment -0.0024712 0.0010608 -2.329 0.019835 *
## fsm_send -0.0074528 0.0035466 -2.101 0.035604 *
## fsm_attainment 0.0005591 0.0003451 1.620 0.105170
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 381.47 on 495 degrees of freedom
## Residual deviance: 215.64 on 484 degrees of freedom
## (53 observations deleted due to missingness)
## AIC: 239.64
##
## Number of Fisher Scoring iterations: 7
odds_ratios <- exp(
coef(step_model)
)
odds_ratios
## (Intercept) authorised_absence_pct unauthorised_absence_pct
## 569.5200766 0.2619624 0.3052077
## permanent_exclusions_rate suspension_rate_change ks2_expected_standard_pct
## 21.6299032 0.8588601 1.0561965
## ks2_eal_pct absence_send absence_ehcp
## 1.0168954 1.0210486 1.0026751
## absence_attainment fsm_send fsm_attainment
## 0.9975319 0.9925749 1.0005593
importance_table <- data.frame(
Variable =
names(
coef(step_model)
),
Coefficient =
coef(step_model),
Odds_Ratio =
exp(
coef(step_model)
)
)
importance_table <- importance_table %>%
arrange(
desc(
abs(Coefficient)
)
)
importance_table
## Variable Coefficient Odds_Ratio
## (Intercept) (Intercept) 6.3447940353 569.5200766
## permanent_exclusions_rate permanent_exclusions_rate 3.0740767651 21.6299032
## authorised_absence_pct authorised_absence_pct -1.3395542116 0.2619624
## unauthorised_absence_pct unauthorised_absence_pct -1.1867628167 0.3052077
## suspension_rate_change suspension_rate_change -0.1521492133 0.8588601
## ks2_expected_standard_pct ks2_expected_standard_pct 0.0546742775 1.0561965
## absence_send absence_send 0.0208301694 1.0210486
## ks2_eal_pct ks2_eal_pct 0.0167542900 1.0168954
## fsm_send fsm_send -0.0074528298 0.9925749
## absence_ehcp absence_ehcp 0.0026715722 1.0026751
## absence_attainment absence_attainment -0.0024711596 0.9975319
## fsm_attainment fsm_attainment 0.0005591307 1.0005593
importance_table %>%
filter(
Variable != "(Intercept)"
) %>%
ggplot(
aes(
reorder(
Variable,
abs(Coefficient)
),
abs(Coefficient)
)
) +
geom_col(
fill = "steelblue"
) +
coord_flip() +
theme_minimal() +
labs(
title =
"Feature Importance in Final Logistic Regression Model",
x =
NULL,
y =
"Absolute Coefficient"
)
Feature importance analysis indicated that attendance and behavioural indicators were the strongest direct predictors of future adverse outcomes. Permanent exclusion rates, authorised absence and unauthorised absence exhibited the largest model coefficients and therefore exerted the greatest direct influence on model predictions. Whilst the engineered interaction variables exhibited smaller coefficients, their retention following stepwise selection suggests that combinations of risk factors provided additional predictive information beyond that captured by the original variables alone. This finding supports the hypothesis that school vulnerability is often driven by multiple co-occurring challenges rather than any single characteristic in isolation.
One of the advantages of the final logistic regression model is its inherent transparency.
Unlike more complex machine learning approaches such as Random Forest and XGBoost, logistic regression allows the direction and magnitude of individual predictors to be examined directly.
Feature importance was assessed using model coefficients and odds ratios. This enabled identification of the variables most strongly associated with future adverse inspection outcomes and supported interpretation of how different characteristics influenced model predictions.
The analysis demonstrated that attendance and behavioural indicators were the most influential predictors retained within the final model. Several engineered interaction variables were also retained following automated feature selection, suggesting that combinations of risk factors were more informative than individual variables in isolation.
This level of explainability is particularly important within educational settings where model outputs are intended to support professional judgement rather than replace decision making.
The model operates at school level rather than individual pupil level and therefore does not directly utilise protected personal characteristics.
However, it remains important to understand whether model performance varies systematically across different types of schools.
A series of subgroup analyses were therefore undertaken to assess whether the model exhibited materially different behaviour across:
The objective was not necessarily to eliminate all differences between groups, but to determine whether the model appeared to perform disproportionately poorly for any particular category of school.
bias_df <- test_df
bias_df$actual <- test_df$target_attendance
bias_df$predicted <- step_pred
table(
bias_df$academy_status
)
##
## Academy LA Maintained
## 67 69
table(
bias_df$academy_status,
bias_df$actual
)
##
## At Risk Not At Risk
## Academy 7 60
## LA Maintained 11 58
table(
bias_df$urban_rural_simple
)
##
## Rural Urban
## 38 98
table(
bias_df$urban_rural_simple,
bias_df$actual
)
##
## At Risk Not At Risk
## Rural 3 35
## Urban 15 83
Urban schools show a higher prevalence of At Risk outcomes than rural schools.
bias_df <- test_df
bias_df$actual <- test_df$target_attendance
bias_df$predicted <- step_pred
table(
bias_df$academy_status,
bias_df$actual,
bias_df$predicted
)
## , , = At Risk
##
##
## At Risk Not At Risk
## Academy 7 11
## LA Maintained 9 9
##
## , , = Not At Risk
##
##
## At Risk Not At Risk
## Academy 0 44
## LA Maintained 1 44
bias_df <- bias_df %>%
mutate(
correct =
actual == predicted
)
bias_df %>%
group_by(
academy_status
) %>%
summarise(
Schools = n(),
Accuracy =
mean(correct)
)
## # A tibble: 2 × 3
## academy_status Schools Accuracy
## <fct> <int> <dbl>
## 1 Academy 67 NA
## 2 LA Maintained 69 NA
A subgroup fairness assessment was undertaken to determine whether model performance differed materially between academies and maintained schools. The analysis showed high levels of recall for both groups, with the model correctly identifying all At Risk academies and 90% of At Risk maintained schools within the test dataset. Precision was marginally lower for academies, indicating a slightly higher false positive rate, however no evidence was identified to suggest that the model systematically failed to identify vulnerable schools within either governance category. Overall, the results suggest broadly consistent performance across academy and maintained school settings.
table(
bias_df$urban_rural_simple,
bias_df$actual,
bias_df$predicted
)
## , , = At Risk
##
##
## At Risk Not At Risk
## Rural 2 9
## Urban 14 11
##
## , , = Not At Risk
##
##
## At Risk Not At Risk
## Rural 0 21
## Urban 1 67
A subgroup analysis was undertaken to evaluate model performance across urban and rural schools. The model demonstrated consistently high levels of recall across both groups, correctly identifying all At Risk rural schools and 93.3% of At Risk urban schools within the test dataset.
Precision was lower for rural schools (18.2%) than urban schools (56.0%), indicating a higher false positive rate within the rural subgroup. However, the number of rural schools classified as At Risk was very small, limiting the reliability of direct comparisons between groups.
Overall, the analysis found no evidence that the model systematically failed to identify vulnerable schools within either urban or rural settings. The primary difference observed related to the higher false positive rate within the smaller rural sample.
The current model was developed using a relatively small number of schools that have received graded outcomes under the new Ofsted framework. At the time of analysis, only a limited number of labelled examples were available for supervised machine learning.
A significant increase in available training data is expected as further inspections are completed and outcomes are published. This represents one of the greatest opportunities for future model improvement.
Additional observations would be expected to improve model stability, enable more sophisticated machine learning techniques and support development of phase-specific models for secondary and special schools.
Several opportunities for future enhancement have been identified.
The most beneficial improvement is likely to come from increasing the number of schools available for model training.
A larger labelled dataset would:
The current dataset exhibits substantial class imbalance, with relatively few schools classified as At Risk.
Future iterations could explore:
SMOTE generates synthetic examples of minority-class observations, enabling machine learning models to learn more effectively from under-represented outcomes.
The technique was not adopted within the current project due to the relatively small number of genuine At Risk schools available. As additional inspection outcomes become available, SMOTE and related approaches may become more appropriate.
The current analysis demonstrated that logistic regression outperformed more complex approaches including Random Forest, LASSO and XGBoost.
However, as the dataset grows, additional experimentation may be undertaken using:
Future iterations may incorporate:
These factors may provide additional predictive signal not currently captured within publicly available datasets.
Following development of the final logistic regression model, the model was applied to all state-funded primary schools within Essex.
The objective was not to validate performance, as most schools have not yet been assessed under the new inspection framework, but rather to demonstrate how the solution may be used operationally.
This exercise creates an indicative risk profile for all currently eligible schools and simulates how the model could support school improvement professionals by highlighting schools exhibiting characteristics commonly associated with future adverse inspection outcomes.
The model was applied using the final selected variables, interaction features and classification threshold identified during model optimisation.
Predictions generated should be interpreted as indicators of elevated risk rather than definitive judgements. All outputs would remain subject to review, contextual interpretation and professional oversight.
essex_primary <- model_base_2025 %>%
filter(
education_phase == "State-funded primary",
local_authority == "Essex"
)
essex_primary <- essex_primary %>%
mutate(
absence_send =
persistent_absence_10_pct *
send_support_pct,
absence_ehcp =
persistent_absence_10_pct *
ehcp_pct,
absence_attainment =
persistent_absence_10_pct *
ks2_expected_standard_pct,
fsm_send =
fsmever_pct *
send_support_pct,
fsm_attainment =
fsmever_pct *
ks2_expected_standard_pct
)
essex_probs <- predict(
step_model,
newdata = essex_primary,
type = "response"
)
essex_prediction <- ifelse(
essex_probs > 0.90,
"Not At Risk",
"At Risk"
)
essex_results <- essex_primary %>%
mutate(
probability_not_at_risk =
round(
essex_probs,
3
),
predicted_risk =
essex_prediction
)
The table below summarises the number of Essex schools classified by the model as At Risk and Not At Risk.
This provides an indication of the scale of schools that may warrant additional review should the model be operationalised.
table(
essex_results$predicted_risk
)
##
## At Risk Not At Risk
## 151 246
round(
prop.table(
table(
essex_results$predicted_risk
)
) * 100,
1
)
##
## At Risk Not At Risk
## 38 62
As most schools have not yet received judgements under the new inspection framework, previous Overall Effectiveness judgements provide a useful point of comparison.
Although these ratings were not used during model training, comparison provides a useful sense-check as to whether the model is identifying schools that historically exhibited characteristics associated with weaker inspection outcomes.
table(
essex_results$predicted_risk,
essex_results$Latest.OEIF.overall.effectiveness,
useNA = "always"
)
##
## 1 2 3 4 Not judged NULL <NA>
## At Risk 0 64 8 1 17 53 8
## Not At Risk 13 82 3 1 26 119 2
## <NA> 2 11 2 0 8 23 2
round(
prop.table(
table(
essex_results$predicted_risk,
essex_results$Latest.OEIF.overall.effectiveness
),
1
) * 100,
1
)
##
## 1 2 3 4 Not judged NULL
## At Risk 0.0 44.8 5.6 0.7 11.9 37.1
## Not At Risk 5.3 33.6 1.2 0.4 10.7 48.8