Introduction

According to Schwartz & Rothbart (2019) school lunches improve learning outcomes for students, while missing meals worsens outcomes

FRPL program is a social program that helps provide free school lunches to qualified children. Used to ensure that children who may not be able to afford school lunches are provided meals regardless.

I’m interested in this topic because all students deserve free lunch. With consistent threats to social funding programs, it is important to know who will be most impacted. We can use these sources to see who is using these programs, and have more insight to who is most at risk of food insecurity following funding cuts.

Loading and cleaning the data

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.4.4     ✔ 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

library(openxlsx)

## Warning: package 'openxlsx' was built under R version 4.3.3

frpl_demographics_22 <-  read.csv("frpl_demographics_2022.csv")

demographics <- frpl_demographics_22 %>%
  select(1, 9:13) %>%
  rename(Category = 1,
         `0 to 25%`= 2,
         `25 to 50%`= 3,
         `50 to 75%`= 4,
         `75 to 100%`= 5,
         `Missing/School Does Not Participate`= 6) %>% 
  mutate(across(where(is.character), ~str_replace_all(., "Â", ""))) %>% 
  mutate(Category = str_trim(Category))

Organizing the data by demographic

general <- demographics %>% 
    slice(1:8)

general_long <-  general %>% 
  pivot_longer(cols = -Category, names_to = "Percent Range", values_to = "Value") %>% 
  filter(!Category == "Total",
         !`Percent Range` == "Missing/School Does Not Participate")

ggplot(general_long, aes(x = Category, y = Value, fill = `Percent Range`)) +
  geom_bar(stat = "identity", position = "dodge")+
  labs(title = "Percentage of Students Eligible for FRPL by Race")+
  theme_minimal()+
  coord_flip()

### Creating smaller dataframes of different demographics

elementary <- demographics %>% 
  slice(10:17)

middle <- demographics %>% 
  slice(18:25)

high <- demographics %>% 
  slice(26:33)

city <- demographics %>% 
  slice(35:42)

suburb <- demographics %>% 
  slice(43:50)

town <- demographics %>% 
  slice(51:58)

rural <- demographics %>% 
  slice(59:66)

schools <- demographics %>% 
  slice(1,10,18,26)

Pivoting the data for visualization

schools_long <-  schools %>% 
  pivot_longer(cols = -Category, names_to = "Percent Range", values_to = "Value")

ggplot(schools_long, aes(x = `Percent Range`, y = Value, fill = Category)) +
  geom_bar(stat = "identity", position = "dodge")+
  labs(title = "Percentage of Students Eligible for FRPL by School Level")+
  coord_flip()

Extracting, subsetting, and visualizing by highest eligibility rates per school level

elementary_race <- elementary %>% 
  mutate(Level = "Elementary") %>% 
  slice(-1)

middle_race <- middle %>% 
  mutate(Level = "Middle") %>% 
  slice(-1)

high_race <- high %>% 
  mutate(Level = "High") %>% 
  slice(-1)

school_levels <- bind_rows(elementary_race, middle_race, high_race)

school_levels$Level <- factor(school_levels$Level, levels = c("Elementary", "Middle", "High"))

ggplot(data = school_levels, aes(x = Category, y = `75 to 100%`, fill = Level)) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(title = "Distribution of Students in Schools Where FRPL Eligibility between 75 - 100%, By Race and School Level")+
  theme_minimal()+
  coord_flip()

Viewing highest eligibility category by Race

ggplot(data = school_levels, aes(x = Category, y = `75 to 100%`, fill = Level)) +
  geom_bar(stat = "identity", position = "dodge")+
  coord_flip()

Incorpoating and cleaning HSNY Data

ny_data <- read_delim("breakfast_2018_19.txt", delim = "\t", trim_ws = TRUE)

## Rows: 687 Columns: 14
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: "\t"
## chr (9): County, School Food Authority, Qualified for F/RP %, Students Eatin...
## dbl (5): Enrollment, Qualified for F/RP #, Students Eating F/RP Breakfast #,...
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

ny_data$`Qualified for F/RP %` <- as.numeric(ny_data$`Qualified for F/RP %`)

## Warning: NAs introduced by coercion

county <- ny_data %>% 
  group_by(County) %>% 
  summarise(Count_Enrolled = sum(Enrollment, na.rm = TRUE),
            Count_Qualified = sum(`Qualified for F/RP #`), na.rm = TRUE) %>% 
  select(-na.rm) %>% 
  mutate(Percentage = Count_Qualified / Count_Enrolled) %>% 
  arrange(desc(Percentage))

Ranking counties by Eligibility

county_top5 <- county %>% head(5)
county_bot5 <- county %>% tail(5)  
count_topbottom <- bind_rows(county_top5, county_bot5)

count_topbottom <- count_topbottom %>%
  mutate(County = factor(County, levels = count_topbottom %>% 
                           arrange((Percentage)) %>% 
                           pull(County)))

ggplot(data = count_topbottom, aes(x = County , y = Percentage))+
  geom_bar(stat = "identity", position = "dodge")+
  labs(title = "Top and Bottom 5 NY Counties by Student FRPL Eligibility Percentage")+
  theme_minimal()+
  coord_flip()

FRPL - 607 Final

Lu Beyer

5/5/2024