Summary

This report visualizes testing data across New York City Public Schools for the annual Regent’s Exam standardized test from the 2014-2015 school year to the 2018-2019 school year. For each Regent’s Exam, a score of 65% or greater is considered passing, while a score of 80% or greater is considered mastery level. Certain exams also report college readiness (CR). For this report, only passing and mastery are analysed.

As part of this report, the provided school identifier information was broken into district- and borough-level segments for further analysis. Additionally, while the exam subjects are reported at a granular level (i.e., “Algebra I”, “Geometry”, “Earth Science”), for analysis purposes the exams have been grouped into five broad categories: English, Foreign Language, Math, Science, and Social Studies. These added identifiers appear in the “Subject”, “Borough”, and “District” columns.

Dataset Information

#Setup----
setwd("C:/Users/dobso/Documents/R Coding/R_datafiles")

fileURL1 <- 
  "https://data.cityofnewyork.us/api/views/2h3w-9uj9/files/ae520e30-953f-47a0-9654-c77900232236?download=true&filename=2014-15-to-2018-19-nyc-regents-overall-and-by-category---public%20(1).xlsx"

download.file(
  url = fileURL1,
  destfile = "C:/Users/dobso/Documents/R Coding/R_datafiles/Regent's_Exam.xlsx",
  mode = "wb"
)

library(data.table)
library(dplyr)
library(stringr) 
library(ggplot2)
library(scales)
library(ggthemes)
library(ggrepel)

df <- readxl::read_xlsx("C:/Users/dobso/Documents/R Coding/R_datafiles/Regent's_Exam.xlsx")
df[df=='na'] <-NA
df[df=='s'] <-NA

#Grouping by Subject----
df<- df%>%
  mutate(
    Subject=case_when(
      str_detect(df$`Regents Exam`, regex("Algebra|geometry", ignore_case = TRUE))~"Math",
      str_detect(df$`Regents Exam`, regex("Environment|Physical", ignore_case = TRUE))~"Science",
      str_detect(df$`Regents Exam`, regex("English", ignore_case = TRUE))~"English",
      str_detect(df$`Regents Exam`, regex("History", ignore_case = TRUE))~"Social Studies",
      str_detect(df$`Regents Exam`, regex("Spanish|Italian|French|Chinese", ignore_case = TRUE))~"Foreign Language",
      TRUE~"Other"
    ))

#Grouping by Borough----

df<- df%>%
  mutate(
    Borough=case_when(
      str_detect(df$`School DBN`, regex("K", ignore_case = TRUE))~"Brooklyn",
      str_detect(df$`School DBN`, regex("X", ignore_case = TRUE))~"The Bronx",
      str_detect(df$`School DBN`, regex("Q", ignore_case = TRUE))~"Queens",
      str_detect(df$`School DBN`, regex("M", ignore_case = TRUE))~"Manhattan",
      str_detect(df$`School DBN`, regex("R", ignore_case = TRUE))~"Staten Island",
    )
  )
#Grouping by District----

df<-df%>%
  mutate(
    District=paste0(substr(df$`School DBN`,1,2),"-",df$Borough)
  )
#Cleaning and Descriptive Statistics----
#Setting year as factor
year_level <- c("2015", "2016", "2017", "2018", "2019")
df$Year <- factor(df$Year, levels=year_level)

#Setting Scoring as numeric
df$`Mean Score` <- as.numeric(df$`Mean Score`)
df$`Percent Scoring Below 65` <-as.numeric(df$`Percent Scoring Below 65`)
df$`Number Scoring Below 65` <-as.numeric(df$`Number Scoring Below 65`)
df$`Percent Scoring 65 or Above`<-as.numeric(df$`Percent Scoring 65 or Above`)
df$`Number Scoring 65 or Above`<-as.numeric(df$`Number Scoring 65 or Above`)
df$`Percent Scoring 80 or Above` <- as.numeric(df$`Percent Scoring 80 or Above`)
df$`Number Scoring 80 or Above` <-as.numeric(df$`Number Scoring 80 or Above`)
df$`Percent Scoring CR`<-as.numeric(df$`Percent Scoring CR`)
df$`Number Scoring CR`<-as.numeric(df$`Number Scoring CR`)

summary(df)
##         ...1           School DBN       School Name       School Type   
##  Length   :33031   Length   :33031   Length   :33031   Length   :33031  
##  N.unique :33031   N.unique : 1081   N.unique : 1072   N.unique :    5  
##  N.blank  :    0   N.blank  :    0   N.blank  :    0   N.blank  :    0  
##  Min.nchar:   28   Min.nchar:    6   Min.nchar:    5   Min.nchar:    4  
##  Max.nchar:   53   Max.nchar:    6   Max.nchar:   50   Max.nchar:   17  
##                                                                         
##                                                                         
##     School Level      Regents Exam     Year           Category    
##  Length   :33031   Length   :33031   2015:7103   Length   :33031  
##  N.unique :    7   N.unique :   18   2016:7555   N.unique :    1  
##  N.blank  :    0   N.blank  :    0   2017:6177   N.blank  :    0  
##  Min.nchar:    3   Min.nchar:    6   2018:6033   Min.nchar:   12  
##  Max.nchar:   31   Max.nchar:   31   2019:6163   Max.nchar:   12  
##                                                                   
##                                                                   
##   Total Tested      Mean Score    Number Scoring Below 65
##  Min.   :   1.0   Min.   :19.82   Min.   :  0.00         
##  1st Qu.:  23.0   1st Qu.:59.38   1st Qu.:  7.00         
##  Median :  67.0   Median :66.51   Median : 23.00         
##  Mean   : 108.1   Mean   :67.48   Mean   : 40.37         
##  3rd Qu.: 127.0   3rd Qu.:75.38   3rd Qu.: 52.00         
##  Max.   :2232.0   Max.   :98.27   Max.   :697.00         
##                   NAs    :3531    NAs    :3531           
##  Percent Scoring Below 65 Number Scoring 65 or Above
##  Min.   :  0.00           Min.   :   0.00           
##  1st Qu.: 14.63           1st Qu.:  16.00           
##  Median : 37.04           Median :  46.00           
##  Mean   : 39.09           Mean   :  80.43           
##  3rd Qu.: 60.31           3rd Qu.:  89.00           
##  Max.   :100.00           Max.   :2054.00           
##  NAs    :3531             NAs    :3531              
##  Percent Scoring 65 or Above Number Scoring 80 or Above
##  Min.   :  0.00              Min.   :   0.00           
##  1st Qu.: 39.69              1st Qu.:   2.00           
##  Median : 62.96              Median :  12.00           
##  Mean   : 60.91              Mean   :  38.02           
##  3rd Qu.: 85.37              3rd Qu.:  37.00           
##  Max.   :100.00              Max.   :1584.00           
##  NAs    :3531                NAs    :3531              
##  Percent Scoring 80 or Above Number Scoring CR Percent Scoring CR
##  Min.   :  0.000             Min.   :   0.0    Min.   :  0.00    
##  1st Qu.:  4.054             1st Qu.:   5.0    1st Qu.: 12.69    
##  Median : 15.625             Median :  24.0    Median : 34.71    
##  Mean   : 26.572             Mean   :  56.9    Mean   : 40.06    
##  3rd Qu.: 41.562             3rd Qu.:  63.0    3rd Qu.: 63.59    
##  Max.   :100.000             Max.   :1807.0    Max.   :100.00    
##  NAs    :3531                NAs    :19256     NAs    :19256     
##       Subject           Borough           District    
##  Length   :33031   Length   :33031   Length   :33031  
##  N.unique :    5   N.unique :    5   N.unique :   37  
##  N.blank  :    0   N.blank  :    0   N.blank  :    0  
##  Min.nchar:    4   Min.nchar:    6   Min.nchar:    9  
##  Max.nchar:   16   Max.nchar:   13   Max.nchar:   16  
##                                                       
## 
Exams<-sum(df$`Total Tested`)
Schools<-length(unique(df$`School DBN`))
print(paste("Between 2015 and 2019,",Exams,"exams were administered across",Schools,"testing locations"))
## [1] "Between 2015 and 2019, 3571083 exams were administered across 1081 testing locations"
Exams_by_Year <- aggregate(df$`Total Tested`~df$Year, FUN=sum)
colnames(Exams_by_Year)<- c("Year", "Number of Exams")
Exams_by_Year
##   Year Number of Exams
## 1 2015          762280
## 2 2016          720088
## 3 2017          688580
## 4 2018          696109
## 5 2019          704026
Exams_by_Borough <- aggregate(df$`Total Tested`~df$Borough, FUN=sum)
colnames(Exams_by_Borough)<- c("Borough", "Number of Exams")
Exams_by_Borough
##         Borough Number of Exams
## 1      Brooklyn         1037045
## 2     Manhattan          680016
## 3        Queens          984615
## 4 Staten Island          217847
## 5     The Bronx          651560

Across the population of Regent’s Exams from 2015 to 2019, an average of 61% of students passed, with 27% achieving mastery.

As shown here, the population of tests is not evenly distributed across the boroughs - Brooklyn and Queens have roughly 1 million tests across the period, Manhattan and the Bronx have roughly 650-700 thousand tests, while Staten Island only has 217 thousand tests in the same period. While congruent with the population distribution in New York City, this uneven distribution leads to a lower variance in scoring for Staten Island exams, as seen below.

Visualizations

# I paste some code in here if needed. This might be manipulation of the data after reading it in, to remove bad data, for example. You can explain some stuff about how you added some new columns, for example.

Highest Performing School Districts

Subject_List <- c(unique(df$Subject))

Mastery_Mean<-df%>%
  aggregate(df$`Percent Scoring 80 or Above` ~ df$District, FUN=mean)%>%
  data.frame()
colnames(Mastery_Mean) <- c("District", "Percent Scoring 80 or Above")
Mastery_Mean$`Percent Scoring 80 or Above` <- round(Mastery_Mean$`Percent Scoring 80 or Above`,2)
Mastery_Mean <- Mastery_Mean[order(Mastery_Mean$`Percent Scoring 80 or Above`, decreasing=TRUE),]
top_districts <- Mastery_Mean$District[1:10]
top_districts_df <- Mastery_Mean %>%
  filter(Mastery_Mean$District %in% top_districts) %>%
  select(District, `Percent Scoring 80 or Above`) %>%
  data.frame()
unique(df$District)
##  [1] "01-Manhattan"     "02-Manhattan"     "03-Manhattan"     "04-Manhattan"    
##  [5] "05-Manhattan"     "06-Manhattan"     "07-The Bronx"     "08-The Bronx"    
##  [9] "09-The Bronx"     "10-The Bronx"     "11-The Bronx"     "12-The Bronx"    
## [13] "13-Brooklyn"      "14-Brooklyn"      "15-Brooklyn"      "16-Brooklyn"     
## [17] "17-Brooklyn"      "18-Brooklyn"      "19-Brooklyn"      "20-Brooklyn"     
## [21] "21-Brooklyn"      "22-Brooklyn"      "23-Brooklyn"      "24-Queens"       
## [25] "25-Queens"        "26-Queens"        "27-Queens"        "28-Queens"       
## [29] "29-Queens"        "30-Queens"        "31-Staten Island" "32-Brooklyn"     
## [33] "84-Brooklyn"      "84-Manhattan"     "84-Queens"        "84-Staten Island"
## [37] "84-The Bronx"
ggplot(top_districts_df, aes(x=reorder(District,-`Percent.Scoring.80.or.Above`), y=`Percent.Scoring.80.or.Above`))+
  geom_col(color="black", fill = "lightblue" )+
  labs(title="Highest Performing Districts (2015-2019)", x= "District", y="Percentage of Students Achieving Mastery")+
  theme_light()+
  theme(plot.title = element_text(hjust = .5), axis.text.x = element_text(angle=45, hjust=1))+
  geom_text(data=top_districts_df ,  aes(x = District, y = `Percent.Scoring.80.or.Above`, 
                                         label = scales::percent(`Percent.Scoring.80.or.Above`,scale=1), fill = NULL), 
                                         hjust = .5, vjust= -.3, size = 3.2)

This chart shows the top 10 average mastery achievement by district across all subjects in the time frame. Notably, while the top 2 districts are both located in Brooklyn, 6 out of the 7 school districts in Queens rank among the top 10, and Staten Island’s lone district ranks at #8.

Passed Exams by Borough by Year

Passing_Borough_Year<-df%>%
  aggregate(df$`Percent Scoring 65 or Above` ~ df$Borough+df$Year, FUN=mean, na.action = na.omit)%>%
  data.frame()
colnames(Passing_Borough_Year) <- c("Borough", "Year", "Average Passing Rate")
Passing_Borough_Year$`Average Passing Rate` <- round(Passing_Borough_Year$`Average Passing Rate`,2)

ggplot(Passing_Borough_Year, aes(x=Borough, y=Year, fill=`Average Passing Rate`))+
  geom_tile(color="black")+
  geom_text(aes(label=percent(`Average Passing Rate`,scale=1)))+
  labs(title="Heatmap: Passing Rate by Borough")+
  theme_economist()+
  theme(plot.title = element_text(hjust=.5))+
  guides(fill=guide_legend(reverse = TRUE, override.aes=list(colour="black")))

This heatmap shows the average passing rate for all exams in each borough for each year in the timeframe. The worst performance was in the Bronx in 2016, where only 51% of exams recieved a passing score, while the best performance was Staten Island in 2018 with a 73% passing rate. This chart also demonstrates an interesting trend; for all 5 boroughs, passing rates decreased from 2015 to 2016, and increased in each subsequent year.

Mastery Achivement by Subject by Year

Mastery_Mean_Year<-df%>%
  aggregate(df$`Percent Scoring 80 or Above` ~ df$Subject+df$Year, FUN=mean)%>%
  data.frame()
colnames(Mastery_Mean_Year) <- c("Subject", "Year", "Mastery")
ggplot(Mastery_Mean_Year, aes(x=Year, y=Mastery, group=Subject))+
  geom_line(aes(color=Subject),linewidth = 1)+
  geom_point(shape=21, size=2, color='black', fill='black')+
  labs(title="Mastery Achievement by Subject and Year")+
  theme_bw()+
  theme(plot.title = element_text(hjust=0.5))+
  geom_label_repel(aes(label=ifelse(Mastery==max(Mastery)|Mastery==min(Mastery),scales::percent(Mastery, scale=1),"")), box.padding = 1, point.padding = .5, size=4, color='gray50', segment.colour = 'darkblue')

This trend chart shows the progression of mastery achievement across the timeframe for each subject category. The Foreign Language exam stands out with a much higher mastery achievement that the other 4 test categories. One potential factor is that the administration of the exams is more decentralized for each district, whereas the other 4 subjects have stricter standards set by the state. Students also take fewer language exams compared to the other subjects.

Overall, the mastery achievement for math and English improved measurably over the time period, while science and social studies remained level.

Number of Passed Exams by Subject and Year

Passing_Subject_Year<-df%>%
  aggregate(df$`Number Scoring 65 or Above` ~ df$Subject+df$Year, FUN=sum, na.action = na.omit)%>%
  data.frame()
colnames(Passing_Subject_Year) <- c("Subject", "Year", "Number of Passed Exams")
Passing_Subject_Year$`Number of Passed Exams` <- round(Passing_Subject_Year$`Number of Passed Exams`,2)

ggplot(Passing_Subject_Year, aes(x=reorder(Subject,-`Number of Passed Exams`), y=`Number of Passed Exams`, fill=Year))+
  geom_bar(stat = "identity", position = position_stack(reverse=TRUE) )+
  labs(title = "Passed Exams by Subject and Year", x="Subject", y="Number of Passed Exams")+
  theme_clean()+
  theme(plot.title = element_text(hjust = .5))+
  scale_fill_brewer(palette = "Spectral", guide = guide_legend(reverse = TRUE))+
  scale_y_continuous(labels=comma)+
  geom_text(data = Passing_Subject_Year,  
            aes(x = Subject, 
                y = `Number of Passed Exams`, 
                label = scales::comma(`Number of Passed Exams`), 
                fill = NULL), 
            position = position_stack(vjust=.5),
            hjust =.5, 
            size = 3.1,
            fontface = "bold")

This shows the raw number of passed exams in each subject category across the timeframe. Math, with the highest total number of exams passed, also shows a year-over-year decrease in number of exams passed. Combined with the increasing mastery acheivement rate over the timeframe, this would imply that overall fewer math exams being taken year over year. Further analysis could dig into the subject groups to identify if potential consolidation/elimination of subject exams could be the culprit.

Passed Exams by Borough and Subject

Borough_by_Subject <- df %>%
  group_by(`Borough`, `Subject`) %>%
  summarise(avg_score = mean(`Mean Score`, na.rm = TRUE), .groups = "drop") %>%
  group_by(Borough) %>%
  arrange(desc(avg_score)) %>%     
  mutate(rank = row_number()) %>%    
  filter(rank <= 5) %>%                
  ungroup() %>%
  data.frame()
colnames(Borough_by_Subject) <- c("Borough", "Subject", "Score", "Rank")

Borough_by_Subject$Score <- round(Borough_by_Subject$Score,0)
ggplot(Borough_by_Subject, 
       aes(x = reorder(Subject, -`Score`), y = `Score`, fill = Borough)) +
  geom_bar(stat = "identity", width = 0.7) +
  geom_text(aes(label = percent(`Score`, scale = 1)), vjust = -0.4, size = 2.5)+
  labs(title = "Passed Exams by Borough and Subject", x = "Subject", y = "Average Score") +
  theme_clean() +
  theme(plot.title = element_text(hjust = 0.55),
      axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)) +
  scale_fill_brewer(palette = "Dark2", guide = "none") +  
  facet_wrap(~ Borough, ncol = 5, nrow = 1)

This chart is a breakdown of each borough’s average score in each subject across the timeframe. Across subjects, the trend remains mostly consistent, with foreign language scoring notably higher and math being the subject with the lowest pass rate. Other trends also appear here, with Queens and Staten Island having the highest pass rates across almost all subjects, and the Bronx and Brooklyn with the lowest. Interestingly, foreign language bucks this trend as well where The Bronx and Manhattan have the highest pass rate.

Wrap up / Conclusion

The main findings from this report show that overall, performance on the Regent’s Exams has improved over the timeframe across boroughs and subjects, even though performance is not evenly distributed geographically. The population disparities between boroughs further complicates 1:1 analysis, but trends point to Queens being the overall strongest performing borough on the Regent’s Exams.

Further analysis here could dig into the specifics of subject matter, for example digging into which, if any, foreign language exams contribute abnormally to the high pass and mastery rates for that subject group. Additionally, more district-level analysis could point to areas of strong subject-matter performance, which may tie to the presence of technical or charter schools in those districts.