Lab 4 — School Data: Summaries, “Top” Schools & Regression

Quantitative Reasoning · LAB 413

How to use this document. Run the code along with me. Comments start with #. If you see errors, read them! They usually tell you the fix.

Today’s plan

1. Fresh start + packages
2. Import & understand the School data
3. Count unique schools
4. Summaries: zero-suspension and attendance rates
5. “Top” schools: highest suspension, graduation, most graduates, most students
6. Correlations
7. Regression refresher (lm) + residuals
8. Quick practice

---

1 Fresh Start + Packages

rm(list = ls())   # (optional) clean environment

# Load (every session)
library(tidyverse)  # data tools (ggplot2, dplyr, readr, etc.)
library(dplyr)      # data wrangling (filter, select, summarize, mutate)
library(ggplot2)    # plotting (geom_*)

In the live session we set the working directory with setwd(...). In this document the data file SchoolData.csv sits next to the .Rmd, so no setwd() is needed.

2 Import & Understand the School Data

schooldata <- read.csv("SchoolData.csv")

# Quick peek
dim(schooldata)      # rows, columns

#> [1] 213  23

names(schooldata)    # variable names

#>  [1] "year_academic" "id_school"     "name_school"   "sector"       
#>  [5] "category"      "group"         "oss_denom"     "oss_0_numer"  
#>  [9] "oss_0_pct"     "oss_1_numer"   "oss_1_pct"     "oss_2_numer"  
#> [13] "oss_2_pct"     "oss_3_numer"   "oss_3_pct"     "oss_4_numer"  
#> [17] "oss_4_pct"     "att_denom"     "att_95_numer"  "att_95_pct"   
#> [21] "grad_denom"    "grad_4_numer"  "grad_4_pct"

# In RStudio you would run View(schooldata); here we preview the first rows.
knitr::kable(head(schooldata, 10), caption = "First rows of the School data")

First rows of the School data

year_academic	id_school	name_school	sector	category	group	oss_denom	oss_0_numer	oss_0_pct	oss_1_numer	oss_1_pct	oss_2_numer	oss_2_pct	oss_3_numer	oss_3_pct	oss_4_numer	oss_4_pct	att_denom	att_95_numer	att_95_pct	grad_denom	grad_4_numer	grad_4_pct
2018-2019	1010	John Bartram High School	District	All Students	All Students	683	579	84.77	84	12.30	14	2.05	6	0.88	0	0.00	683	174	25.48	159	94	59.12
2018-2019	1020	West Philadelphia High School	District	All Students	All Students	501	421	84.03	61	12.18	12	2.40	4	0.80	3	0.60	501	68	13.57	114	70	61.40
2018-2019	1030	High School of the Future	District	All Students	All Students	561	507	90.37	40	7.13	12	2.14	1	0.18	1	0.18	561	251	44.74	107	88	82.24
2018-2019	1050	Paul Robeson High School for Human Services	District	All Students	All Students	323	308	95.36	14	4.33	1	0.31	0	0.00	0	0.00	323	122	37.77	76	71	93.42
2018-2019	1100	William L. Sayre High School	District	All Students	All Students	539	418	77.55	83	15.40	30	5.57	6	1.11	2	0.37	539	84	15.58	103	55	53.40
2018-2019	1130	William T. Tilden School	District	All Students	All Students	457	362	79.21	59	12.91	16	3.50	9	1.97	11	2.41	457	233	50.98	NA	NA	NA
2018-2019	1190	Motivation High School	District	All Students	All Students	417	383	91.85	31	7.43	3	0.72	0	0.00	0	0.00	417	327	78.42	88	75	85.23
2018-2019	1200	John Barry School	District	All Students	All Students	764	722	94.50	35	4.58	5	0.65	2	0.26	0	0.00	764	211	27.62	NA	NA	NA
2018-2019	1230	William C. Bryant School	District	All Students	All Students	525	483	92.00	29	5.52	13	2.48	0	0.00	0	0.00	525	119	22.67	NA	NA	NA
2018-2019	1250	Joseph W. Catharine School	District	All Students	All Students	536	534	99.63	1	0.19	1	0.19	0	0.00	0	0.00	536	246	45.90	NA	NA	NA

Extended codebook (suspensions, attendance, graduation)

OSS = Out-of-School Suspension (a student kept out of school for up to 10 days).

• Suspension denominator (population base)
  • oss_denom = total number of students in the school (denominator for suspension %).
• Counts (numerators) by suspension frequency
  • oss_0_numer … oss_4_numer = # of students with exactly 0, 1, 2, 3, or 4+ OSS.
• Percentages by suspension frequency (relative to oss_denom)
  • oss_0_pct … oss_4_pct = % of students with exactly 0, 1, 2, 3, or 4+ OSS (oss_4_pct is the “highest suspension rate”).
• Attendance (\(\geq\) 95% of days)
  • att_denom, att_95_numer, att_95_pct.
• Graduation (4-year on-time)
  • grad_denom, grad_4_numer, grad_4_pct.
• IDs and labels
  • year_academic, id_school, name_school.

Notes: _numer columns are counts; _pct columns are percentages (0–100), typically computed as 100 * (numerator / denominator). Each row is usually a school-year record.

3 Count Unique Schools

nrow(schooldata)                      # if each row = a school

#> [1] 213

n_distinct(schooldata$id_school)      # safer - counts unique IDs

#> [1] 213

n_distinct(schooldata$name_school)

#> [1] 213

4 Summaries: Zero Suspensions & Attendance

Average % of students with ZERO suspensions. summarize() collapses the dataset into a tiny summary table.

schooldata %>%
  summarize(avg_zero_suspensions = mean(oss_0_pct, na.rm = TRUE),
            median_zero_sus      = median(oss_0_pct, na.rm = TRUE),
            max                  = max(oss_0_pct, na.rm = TRUE))

Average attendance % (att_95_pct).

schooldata %>%
  summarize(avg_attendance_rate = mean(att_95_pct, na.rm = TRUE))

5 “Top” Schools

School with the HIGHEST suspension rate. Start with the data, then filter, then select.

school_highest_suspension <-
  schooldata %>%
  filter(oss_4_pct == max(oss_4_pct, na.rm = TRUE)) %>%
  select(name_school, oss_4_pct)

school_highest_suspension

School with the HIGHEST graduation rate.

school_highest_graduation <-
  schooldata %>%
  filter(grad_4_pct == max(grad_4_pct, na.rm = TRUE)) %>%
  select(name_school, grad_4_pct)

school_highest_graduation

Schools with “perfect attendance.”

perfect_attendance <-
  schooldata %>%
  filter(att_95_pct == 100) %>%  # how I first define "perfect"
  select(name_school, att_95_pct)

perfect_attendance

Practice — redefine “perfect attendance.” Start with att_95_pct >= 95, and lower the threshold (90, 85, 80, …) until schools appear.

perfect_attendance <-
  schooldata %>%
  filter(att_95_pct >= 85) %>%
  select(name_school, att_95_pct)

perfect_attendance

School with the MOST graduates.

school_most_graduates <-
  schooldata %>%
  filter(grad_4_numer == max(grad_4_numer, na.rm = TRUE)) %>%
  select(name_school, grad_4_numer)

school_most_graduates

School with the MOST students.

school_most_students <-
  schooldata %>%
  filter(oss_denom == max(oss_denom, na.rm = TRUE)) %>%
  select(name_school, oss_denom)

school_most_students

6 Correlations

Correlation between the total number of students and the number of students who graduated in four years.

schooldata %>%
  summarize(total_vs_grad_num =
              cor(oss_denom, grad_4_numer, use = "complete.obs"))

Practice. Correlation between attendance percentage and graduation percentage — what does it tell you about their relationship?

schooldata %>%
  summarize(att_vs_grad =
              cor(att_95_pct, grad_4_pct, use = "complete.obs"))

7 Regression Refresher (lm)

Fit a regression: attendance % as a function of zero-suspension %.

m1 <- lm(att_95_pct ~ oss_0_pct, data = schooldata)
summary(m1)

#> 
#> Call:
#> lm(formula = att_95_pct ~ oss_0_pct, data = schooldata)
#> 
#> Residuals:
#>     Min      1Q  Median      3Q     Max 
#> -27.171 -10.417  -1.643   7.405  35.349 
#> 
#> Coefficients:
#>             Estimate Std. Error t value Pr(>|t|)    
#> (Intercept) -90.7972    14.2159  -6.387 1.06e-09 ***
#> oss_0_pct     1.4575     0.1515   9.622  < 2e-16 ***
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> Residual standard error: 14.09 on 211 degrees of freedom
#> Multiple R-squared:  0.305,  Adjusted R-squared:  0.3017 
#> F-statistic: 92.58 on 1 and 211 DF,  p-value: < 2.2e-16

Scatterplot with a loess curve (red) and a regression line (blue).

ggplot(schooldata, aes(x = oss_0_pct, y = att_95_pct)) +
  geom_point() +
  geom_smooth(color = "red") +                  # loess curve
  geom_smooth(method = lm, color = "blue") +    # regression line
  labs(title = "Zero Suspensions (%) vs Attendance (%)",
       x = "% with 0 Suspensions",
       y = "% with 95%+ Attendance")

8 Residuals

Create a new column of residuals, then plot them. A good residual plot is centered around 0 with no pattern.

schooldata <- schooldata %>%
  mutate(Residuals = residuals(m1)) # residuals for the model

ggplot(schooldata, aes(x = oss_0_pct, y = Residuals)) +
  geom_point() +                               # residual vs predictor
  geom_hline(yintercept = 0, color = "red") +  # perfect-prediction line
  labs(title = "Residual Plot",
       x = "% with 0 Suspensions",
       y = "Residuals")

9 Quick Practice

P1) On average, what percentage of students had exactly 1 suspension across all schools?

# base R way
mean(schooldata$oss_1_pct)

#> [1] 4.327606

# tidyverse
schooldata %>%
  summarize(avg_oss1_pct = mean(oss_1_pct, na.rm = TRUE))

P2) Which school had the largest number of students with exactly 2 suspensions?

schooldata %>%
  filter(oss_2_numer == max(oss_2_numer, na.rm = TRUE)) %>%
  select(name_school, oss_2_numer, year_academic)

P3) Is there a correlation between attendance rate and the total number of students in the school?

cor(schooldata$att_95_pct, schooldata$oss_denom, use = "complete.obs")

#> [1] 0.1182958

P4) Fit a regression predicting attendance % from total number of students. What is the slope?

m2 <- lm(att_95_pct ~ oss_denom, data = schooldata)
summary(m2)

#> 
#> Call:
#> lm(formula = att_95_pct ~ oss_denom, data = schooldata)
#> 
#> Residuals:
#>     Min      1Q  Median      3Q     Max 
#> -33.252 -13.552  -0.786  11.294  40.604 
#> 
#> Coefficients:
#>              Estimate Std. Error t value Pr(>|t|)    
#> (Intercept) 42.339385   2.240539   18.90   <2e-16 ***
#> oss_denom    0.005096   0.002945    1.73    0.085 .  
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> Residual standard error: 16.78 on 211 degrees of freedom
#> Multiple R-squared:  0.01399,    Adjusted R-squared:  0.009321 
#> F-statistic: 2.995 on 1 and 211 DF,  p-value: 0.085

P5) Add residuals from the P4 model and make a residual plot.

schooldata$resid_m2 <- residuals(m2)

ggplot(schooldata, aes(x = att_95_pct, y = resid_m2)) +
  geom_point(alpha = 0.6) +
  geom_hline(yintercept = 0, color = "red")

Interpretation. The residuals form a strong diagonal line — almost like another regression line. This means the model is not capturing the relationship correctly and suggests model assumptions (linearity or independence) are violated.

P6) Make a histogram of residuals.

ggplot(schooldata, aes(x = resid_m2)) +
  geom_histogram(bins = 30, color = "white", fill = "steelblue") +
  labs(title = "Residuals Histogram", x = "Residuals", y = "Count")