Newglobe Case study
Preliminary Investigation
#load the required library
library(readxl)
#load the data file into rstudio
lesson_completion <- read_excel("Lesson completion.xlsx")
pupil_attendance <- read_excel("Pupil attendance.xlsx")
pupil_scores <- read_excel("Pupil scores.xlsx")
school_information <- read_excel("School_information.xlsx")#preview lesson_completion
head(lesson_completion,10)str(lesson_completion)## tibble [552 × 4] (S3: tbl_df/tbl/data.frame)
## $ school_id : num [1:552] 416 416 416 416 416 792 792 792 792 792 ...
## $ teacher_id : num [1:552] 505 202 124 516 145 545 201 669 258 259 ...
## $ grade : chr [1:552] "Grade 1" "Grade 2" "Grade 3" "Grade 4" ...
## $ lesson_completion_rate: num [1:552] 0.568 0.681 0.25 0.359 0.397 ...summary(lesson_completion)## school_id teacher_id grade lesson_completion_rate
## Min. : 416 Min. : 1.0 Length:552 Min. :0.0000
## 1st Qu.: 49698 1st Qu.:191.8 Class :character 1st Qu.:0.4420
## Median :223941 Median :374.5 Mode :character Median :0.6408
## Mean :283530 Mean :377.7 Mean :0.6001
## 3rd Qu.:421680 3rd Qu.:561.5 3rd Qu.:0.7722
## Max. :991980 Max. :763.0 Max. :1.0000#preview pupil_attendance
head(pupil_attendance,10)str(pupil_attendance)## tibble [12,701 × 5] (S3: tbl_df/tbl/data.frame)
## $ school_id : num [1:12701] 35175 40580 9342 858450 792 ...
## $ pupil_id : num [1:12701] 1 7 8 10 13 14 16 18 27 34 ...
## $ grade : chr [1:12701] "Grade 1" "Grade 2" "Grade 5" "Grade 5" ...
## $ attendance_records: num [1:12701] 91 92 43 86 104 90 81 90 97 85 ...
## $ present_records : num [1:12701] 69 86 39 62 81 67 65 80 77 59 ...summary(pupil_attendance)## school_id pupil_id grade attendance_records
## Min. : 416 Min. : 1 Length:12701 Min. : 1.00
## 1st Qu.: 49404 1st Qu.: 6695 Class :character 1st Qu.: 74.00
## Median :223941 Median :13500 Mode :character Median : 90.00
## Mean :276782 Mean :13524 Mean : 82.29
## 3rd Qu.:406350 3rd Qu.:20277 3rd Qu.: 98.00
## Max. :991980 Max. :27063 Max. :109.00
## present_records
## Min. : 0.00
## 1st Qu.: 46.00
## Median : 66.00
## Mean : 62.36
## 3rd Qu.: 80.00
## Max. :107.00# preview pupil_scores
head(pupil_scores,10)str(pupil_scores)## tibble [37,947 × 5] (S3: tbl_df/tbl/data.frame)
## $ school_id: num [1:37947] 35175 35175 35175 40580 40580 ...
## $ pupil_id : num [1:37947] 1 1 1 7 7 7 8 8 8 10 ...
## $ grade : chr [1:37947] "Grade 1" "Grade 1" "Grade 1" "Grade 2" ...
## $ subject : chr [1:37947] "Fluency" "Kiswahili" "Math" "Math" ...
## $ score : num [1:37947] 65 0.943 1 0.933 0.943 ...summary(pupil_scores)## school_id pupil_id grade subject
## Min. : 416 Min. : 1 Length:37947 Length:37947
## 1st Qu.: 49404 1st Qu.: 6698 Class :character Class :character
## Median :226128 Median :13506 Mode :character Mode :character
## Mean :277151 Mean :13528
## 3rd Qu.:406350 3rd Qu.:20282
## Max. :991980 Max. :27063
##
## score
## Min. : 0.0000
## 1st Qu.: 0.6857
## Median : 0.9249
## Mean : 38.1947
## 3rd Qu.: 56.0000
## Max. :383.0000
## NA's :1783# preview pupil_information
head(school_information,10)str(school_information)## tibble [111 × 4] (S3: tbl_df/tbl/data.frame)
## $ region : chr [1:111] "Mombasa" "Kilifi" "Mombasa" "Eastern" ...
## $ province : chr [1:111] "Coast" "Coast" "Coast" "Eastern" ...
## $ school_id : num [1:111] 136992 687400 609982 223941 34092 ...
## $ tutoring_program: chr [1:111] "No" "Yes" "Yes" "No" ...summary(school_information)## region province school_id tutoring_program
## Length:111 Length:111 Min. : 416 Length:111
## Class :character Class :character 1st Qu.: 49551 Class :character
## Mode :character Mode :character Median :223941 Mode :character
## Mean :282162
## 3rd Qu.:420508
## Max. :991980Step 1: Data cleaning
# Working on the base file
# load the required library
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.1 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.1
## ✔ purrr 1.0.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# reshape pupil_scores
pupil_scores_reshaped <- pupil_scores %>%
pivot_wider(
id_cols = c(school_id, pupil_id, grade),
names_from = subject,
values_from = score
)
head(pupil_scores_reshaped)R code reshaped the pupil_scores data frame from long to wide format using the pivot_wider() function from the tidyverse package
#the data file (pupil_scores_reshaped) is renamed as base_file and merged with other files
#(pupil_attendance, lesson_completion and school_information)
base_file <- pupil_scores_reshaped
base_file <- merge(base_file, pupil_attendance, by = c("school_id", "pupil_id", "grade"), all.x = TRUE)
base_file <- merge(base_file, school_information, by = "school_id", all.x = TRUE)
base_file <- merge(base_file, lesson_completion, by = c("school_id", "grade"), all.x = TRUE)
# remove missing values
base_file <- base_file %>% na.omit()
head(base_file)View(base_file)
#save the merged table (base file)
write.csv(base_file, file = "base_file.csv")Step 2: Calculating KPIs
Task 1
# making sure that required vales (present_records and attendance_records) are numeric
base_file <- mutate(base_file,
present_records = as.numeric(present_records),
attendance_records = as.numeric(attendance_records))
# Calculating KPI (Percentage Pupils Present) for each pupils in 2 decimal points
base_file <- mutate(base_file,
percent_present = round((present_records / attendance_records)*100,2))
# Calculating network-level average Percent Pupils Present (all_pupils_kpi)
all_pupils_kpi <- mean(base_file$present_records/base_file$attendance_records) * 100
all_pupils_kpi## [1] 77.43928#Express average Percent Pupils Present in two decimal points
cat("Average Percent Pupils Present:", round(all_pupils_kpi, 2), "% \n")## Average Percent Pupils Present: 77.44 %Task 2
# Calculate average percent present per school rounded to 2 decimal points
school_avg_present <- base_file %>%
group_by(school_id) %>%
summarize(avg_percent_present = round(mean(percent_present, na.rm = TRUE),2))
head(school_avg_present)# Calculate average percentage present at the school-level.
school_level_avg_present <- mean(school_avg_present$avg_percent_present, na.rm = TRUE)
cat("Average Percent Pupils Present at the school-level.:", round(school_level_avg_present, 2), "% \n")## Average Percent Pupils Present at the school-level.: 77.37 %Task3
Network Level KPI helps in understanding the overall attendance pattern across the entire system. While the school level approach allows us to identify schools with poor or good attendance rates. In this case change between the two KPI does not matter. It matters when a very large number of schools are involved.
Step 3: Descriptives
Task 1:
# load the library for creating visualizations
library(ggplot2)
# Making sure fluency scores are numeric
base_file <- mutate(base_file, Fluency = as.numeric(Fluency))
# Obtaining Average fluency scores for each grade
average_fluency <- base_file %>%
group_by(grade) %>%
summarise(avg_fluency = mean(Fluency))
head(average_fluency)# Plotting average fluency scores
ggplot(average_fluency, aes(x = grade, y = avg_fluency)) +
geom_bar(stat = "identity", fill = "skyblue") +
labs(title = "Average Fluency Scores by Grade",
x = "Grade",
y = "Average Fluency Score")
### Task 2
#Checking for Regions with Lowest and Highest Average Fluency across all grades.
region_fluency_stats <- base_file %>%
group_by(region) %>%
summarize(avg_fluency = mean(Fluency, na.rm = TRUE)) %>%
arrange(avg_fluency)
head(region_fluency_stats)# Lowest
print(paste0("Region with Lowest Average Fluency:", region_fluency_stats$region[1]))## [1] "Region with Lowest Average Fluency:Kirinyaga"# Highest
print(paste0("Region with Highest Average Fluency:", region_fluency_stats$region[nrow(region_fluency_stats)]))## [1] "Region with Highest Average Fluency:Machakos"The Regions with Lowest and Highest Average Fluency across all grades are Kirinyaga and Machakos respectively.
Task 3
# Share of Pupils Scoring Under 10 by Grade (Bar Chart)
low_fluency <- mutate(base_file,
low_score = ifelse(Fluency <= 10, 1, 0))
low_fluency_grade <- low_fluency %>%
group_by(grade) %>%
summarize(share_low = mean(low_score))ggplot(low_fluency_grade, aes(x = grade, y = share_low)) +
geom_bar(stat = "identity", fill = "skyblue") +
labs(title = "Share of Pupils Scoring Under 10 by Grade",
x = "Grade",
y = "Share")
Task 4
#School with highest share of pupils scoring under threshold in grade 3
grade_3_low <- low_fluency %>%
filter(grade == "Grade 3") # Filter for grade 3 only
school_highest_low <- grade_3_low %>%
group_by(school_id) %>%
summarize(share_low = mean(low_score)) %>%
arrange(desc(share_low)) # Arrange by share in descending order
head(school_highest_low)print(paste0("School with Highest Share of Pupils Scoring Under 10 (Grade 3):",
school_highest_low$school_id[1]))## [1] "School with Highest Share of Pupils Scoring Under 10 (Grade 3):223941"Step 4: Impact evaluation
Task 1
#Assessing effects of tutoring program on test scores and attendance
# Calculate means for test scores and attendance by tutoring program
effect_analysis <- base_file %>%
group_by(tutoring_program) %>%
summarise(
avg_kiswahili_score = mean(Kiswahili),
avg_fluency_score = mean(Fluency),
avg_attendance = mean(present_records / attendance_records)
)
print(effect_analysis)## # A tibble: 2 × 4
## tutoring_program avg_kiswahili_score avg_fluency_score avg_attendance
## <chr> <dbl> <dbl> <dbl>
## 1 No 0.680 97.4 0.763
## 2 Yes 0.807 130. 0.786Task 2
#Assessing potential confounding effect of lesson completion rate
# Correlation analysis
correlation_matrix <- cor(base_file[, c("Math", "Kiswahili", "Fluency", "attendance_records", "lesson_completion_rate")])
correlation_matrix ## Math Kiswahili Fluency attendance_records
## Math 1.00000000 0.386378923 0.11785393 0.098487938
## Kiswahili 0.38637892 1.000000000 0.44155119 -0.002326412
## Fluency 0.11785393 0.441551188 1.00000000 -0.132538341
## attendance_records 0.09848794 -0.002326412 -0.13253834 1.000000000
## lesson_completion_rate 0.12461801 0.045426761 -0.09511312 0.413709571
## lesson_completion_rate
## Math 0.12461801
## Kiswahili 0.04542676
## Fluency -0.09511312
## attendance_records 0.41370957
## lesson_completion_rate 1.00000000Overall, this correlation matrix provides insights into the relationships between different variables in the dataset. The correlation between lesson completion rate and Math/Kiswahili/Fluency is weak, indicating a limited association between lesson completion rate and academic performance.