Chicago Community Investment Exploration

Population Displacement in Chicago Communities

Since the Great Recession, underrepresented minority populations in Chicago have been increasingly relegated to lower income areas in the South and West of the City. Some communities have maintained a foothold in their respective neighborhoods, while others are priced out as wealthier populations move into the areas they have historically called home.

all_demos_range <- readRDS(here::here("data", "range_demos_chi_proj.Rda"))
wards.2015 <- readRDS(here::here("data", "wards2015_sf.Rda"))

ward_range <- st_intersection(wards.2015, all_demos_range)

# plot intersection of Census tracts with chicago wards
# st_intersection(wards.2015, all_demos_range) %>%
ward_range %>% filter((predominant_race == "Latinx") & (id != 2015)) %>%
ggplot() +
  # outline tracts based on predominant race based on Census, shaded by median Income for tract
  geom_sf(aes(fill=below_poverty_pct), lwd = 2, color="#6d7d53") +

  scale_fill_gradient(low = "#dae0e2", high="#2d4f5a") +
  
  # outline Chicago wards over data
  geom_sf(data = wards.2015, color="#292929", lwd = 1, fill=NA) +

  coord_sf(datum = NA) +
  theme_map_modest() + 
  theme(
        plot.title = element_text(face = "bold", hjust="0.5", family = "Ledger", size=rel(2.5)),
        plot.subtitle = element_text(margin = unit(c(0, 0, 1, 0), "lines"), size=rel(2)),
        plot.caption = element_text(hjust=1, size=rel(1.75)),
        strip.text.x = element_text(family="Ledger", size=rel(2.25)),
        legend.position = "bottom",
        legend.box = "vertical",
        legend.title = element_text(size=rel(2), family = "Ledger"),
        legend.text = element_text(size=rel(1.1)),
        legend.key.size = unit(45, "pt"),
        panel.spacing = unit(1, "lines"),
        plot.margin = unit(c(2,4,2,2),"lines")
        ) +
  facet_wrap(~ id) + 
  # guides(fill = guide_colourbar(title.position="top", title.hjust = 0.5)) + 
  labs(alpha = "Median Income", color="Predominant Race", title="Latinx Populations in Chicago Pushed to South, West Neighborhoods", caption="Data Source: U.S. Census Bureau", 
       subtitle = "Chicago racial and ethnic group movement by census tract since 2012 (5 year averages) show that Latinx communities are being\ndisplaced from the city center.", fill="Tract Percentage Below Federal Poverty Line") 

While there are myriad factors contributing to the way communities move over time, race is an undeniable component. There is a clear shift of Latinx populations from desirable neighborhoods close to the center and north of the city to more western and southern neighborhoods.

ward_range %>% filter((predominant_race == "Black") & (id != 2015)) %>%
ggplot() +
  # outline tracts based on predominant race based on Census, shaded by median Income for tract
  # geom_sf(aes(alpha=below_poverty_pct), lwd = 0, fill=get_dt_cols("ocean")) +

  geom_sf(aes(fill=below_poverty_pct), lwd = 2, color="#9d8e64") +
  # scale_alpha(range = c(0.15, 1)) +
  scale_fill_gradient(low = "#dae0e2", high="#2d4f5a") +
  # outline Chicago wards over data
  geom_sf(data = wards.2015, color="#292929", lwd = 1, fill=NA) +
  coord_sf(datum = NA) +
  theme_map_modest() + 
  theme(
        plot.title = element_text(face = "bold", hjust="0.5", family = "Ledger", size=rel(2.5)),
        plot.subtitle = element_text(margin = unit(c(0, 0, 1, 0), "lines"), size=rel(2)),
        plot.caption = element_text(hjust=1, size=rel(1.75)),
        strip.text.x = element_text(family="Ledger", size=rel(2.25)),
        legend.position = "bottom",
        legend.box = "vertical",
        legend.title = element_text(size=rel(2), family = "Ledger"),
        legend.text = element_text(size=rel(1.1)),
        legend.key.size = unit(45, "pt"),
        panel.spacing = unit(1, "lines"),
        plot.margin = unit(c(2,4,2,2),"lines")
        ) +
  facet_wrap(~ id) +
  # guides(fill = guide_colourbar(title.position="top", title.hjust = 0.5)) + 
  labs(alpha = "Median Income", color="Predominant Race", title="In Contrast, Black Communities Stay in Place in Increasingly Poor Neighborhoods ", caption="Data Source: U.S. Census Bureau", 
       subtitle = "Black communities are not pushed out of their neighborhoods, however, the percentage of residents below the federal poverty line\nin predominantly Black tracts has increased city-wide.", fill="Tract Percentage Below Federal Poverty Line") 

Business Activity across Chicago Areas

The neighborhoods housing these minority communities are those with distinctly lower levels of economic activity. The majority of the city’s “bouncing back” after the recession happens in the Central, North, and West sides of the city.

all_wards_all_dates <-  readRDS(here::here("data", "all_wards_all_dates.Rda"))

allDatesCount.df <- all_wards_all_dates %>% expand(SIDE_CLEAN, WARD, `APPLICATION TYPE`, count_date) %>% 
 full_join(all_wards_all_dates) %>%  arrange(SIDE_CLEAN, WARD, `APPLICATION TYPE`, count_date) %>% 
  mutate(
    activity_wk = lubridate::as_date(
      cut(count_date, breaks = "week", start.on.monday = FALSE, origin = lubridate::origin)),
   activity_month = lubridate::as_date(
      cut(count_date, breaks = "month", start.on.monday = FALSE, origin = lubridate::origin)),
   activity_qtr = lubridate::as_date(
      cut(count_date, breaks = "quarter", start.on.monday = FALSE, origin = lubridate::origin)) 
   )


library(lemon)
allDatesCount.df %>% 
  filter(`APPLICATION TYPE` %in% c("ISSUE", "RENEW")) %>% group_by(SIDE, activity_qtr, `APPLICATION TYPE`) %>% 
  summarise(active_businesses = sum(active_businesses)) %>% 
  arrange(activity_qtr, desc(active_businesses), SIDE) %>%
 mutate(SIDE_CLEAN = factor(SIDE,levels = rev(unique(SIDE))),
        SIDE_CLEAN = ifelse(SIDE_CLEAN == "Far Southwest", "Far Southwest Side", 
                     ifelse(SIDE_CLEAN == "Far Southeast", "Far Southeast Side",
                     SIDE_CLEAN))) %>%
              ggplot(aes(x=activity_qtr, y=active_businesses)) +   
  geom_bar(aes(x=activity_qtr, y=active_businesses, fill=`APPLICATION TYPE`), stat = "identity", position="dodge") +
  scale_fill_dt(labels=c("    Newly Issued Licenses    ", "    License Renewals    ")) +
  # geom_text(aes(label=active_businesses), 
  #           size = 3, position = position_stack(vjust = 0.5), color="white") +
  scale_y_continuous(labels = scales::comma) +
  scale_x_date(date_labels = "%b %y", 
                date_breaks = "1 year", limits = c(ymd("2012-01-01"), ymd("2018-12-31"))) +
  theme_modest() + 
  theme(
        legend.direction = "horizontal",
        legend.key.size = unit(25, "pt"),
        legend.title = element_blank(),
        panel.grid.minor = element_blank(),
        panel.grid.major.x = element_blank(),
        panel.spacing = unit(2, "lines"),
        strip.text = element_text(family="Ledger", size=rel(1.2)),
        axis.title.y = element_text(size=rel(1.5), margin=unit(c(0,0,2,2), "lines"), angle=90, family="Ledger"),
        axis.text.y = element_text(size=rel(1), margin=unit(c(0,0,2,2), "lines")),
        axis.text.x = element_text(hjust = 0, angle=-45),
        legend.position = "bottom",
        axis.title.x = element_blank(),
        plot.margin = unit(c(2,4,2,2),"lines")) + 
  facet_rep_wrap(~ SIDE_CLEAN, repeat.tick.labels=TRUE) +
      labs(y="Number of Business Licenses Issued or Renewed", 
           colour="Chicago Council Ward", 
           caption="Data Source: Chicago Open Data Portal",  
           title="New Business Never Returns to Far Southeast and Far Southwest Post-Recession", 
           subtitle = "Steady decline in new business entry post-recession in Chicago areas with lowest economic activity pre-recession", fill="Chicago Area")  

  # annotate("text", x=lubridate::ymd("2013-01-01"), y = 850000, label="Business renewals dipping in 2013, were balanced by spikes in new business due to EDGE tax credits.")

Immediately post-recession in 2013, the amount of Economic Development for a Growing Economy (EDGE) tax credits granted by Illinois nearly doubled from the prior year, causing a brief spike in new business license Issuances for every area of the city beyond Central (Loop area), which has experienced fairly constant new business entry since the recession. Thus far, only the West Side of Chicago is approaching 2012 levels of new business, with most other areas of the city remaining fairly constant after EDGE excitement tapered off.

In the Far Southeast and Far Southwest Sides, economic activity (in terms of number of active businesses) was about half that of the next lowest areas, even before EDGE-induced business dropped off. One must wonder how much growth a neighborhood can experience with a monthly rate of new business entry that has hovered around 500 businesses for years. For context, the mean number of quarterly new licenses issued in the Central area of the city is just under 700,000, and the mean number of quarterly licenses issued in the Northwest Side is just over 85,000.

Mapping Chicago’s Forgotten Economies

There is unquestionable variation in the level of economic activity within each Side. However, positive variance from the norm for areas that are predominantly Black and Latinx actually appear to be in parts of these communities that border areas with larger Asian, White, and Other racial/ ethnic populations.

# filter for business license issuances and renewals, and create a monthly count
bus_licenses %>% filter(!is.na(WARD), active==1,  activity_date >= mdy("1/1/2012")) %>%
  group_by(activity_month, activity_yr, WARD, SIDE) %>% 
  summarise(business_count = n()) %>% group_by(WARD, SIDE) %>% arrange(desc(business_count)) %>% 
  
  # plot boxplot of median monthly issuances and renewals for each ward
  ggplot(aes(x=reorder(reorder(reorder(SIDE, business_count, FUN = median),WARD),business_count, FUN=median), y=business_count)) + 
  # add comparison line for lowest levels of montly ward business activity
  geom_hline(yintercept=25, linetype = "dotted") +
  # draw boxplots with color and order determined by Chicago Side area
  geom_boxplot(aes(group=reorder(as.factor(WARD), SIDE), fill=as.factor(SIDE)), show.legend = FALSE) + 
  scale_fill_dt() +
  
  # limit scale to 750, (one Loop ward's outliers extend ~1000 above other wards)
  # still very clearly the highest even without all outliers visible
  scale_y_continuous(breaks = sort(c(seq(0, 750, 150), 25)), limits = c(0, 750), 
                     minor_breaks = seq(0 , 750, 75)) +
  scale_x_discrete(breaks=unique(bus_licenses$SIDE), 
    labels=addline_format(as.factor(unique(bus_licenses$SIDE))) ) +
  labs(x="Chicago Council Ward", y="Average Monthly Business Count", caption="Data Source: Chicago Open Data Portal", title="Least New & Surviving Businesses in Far South, Southwest Wards for 5+ Years", subtitle="Since 2012, Far South wards average 26 or less monthly business license issuances and renewals",fill="Chicago Area") + 
  theme_modest() +
  theme(
        panel.grid.major.x = element_blank(),
        axis.ticks =  element_blank(),
        axis.title.x = element_blank(),
        axis.text.x = element_text( family="Ledger", size=rel(1)),
        axis.text.y = element_text( margin=unit(c(0,2,2,2), "lines"), size=rel(1)),
        axis.title.y = element_text(margin=unit(c(0,0,2,2), "lines"), size=rel(1.2), angle = 90, family = "Ledger"),
        plot.caption = element_text(hjust=1)
        ) +
  annotate("text", x = 7 , y= 390, label="Most West Side business\noccurs in Wards 2 and 27,\nwhich border the Loop.", size=rel(4)) +
  annotate("text", x = 8.9 , y= 745, label="The Central area is comprised\nof Ward 42, the Loop area.", size=rel(4)) +
  annotate("text", x = 5 , y= 335, label="South Side business activity\nis concentrated in Kenwood,\n Fuller Park areas bordering\nthe University of Chicago.", size=rel(4)) +
  annotate("text", x = 3 , y= 305, label="Ward 12 on the Southwest\nSide, which neighbors Chinatown, is\ncharacterized by higher rates\nof business activity than\nits neighbors.", size=rel(4)) 

Investing in the Future: Trends in Chicago Public Schools

While economic activity is definitively a factor in the a neighborhood’s ability to thrive, just as important in future success is the quality of education that students in the area are able to receive. Here I explore the variation in Chicago Public School spending for students of different socioeconomic backgrounds.

# read in combined school report card and budget dataset
school_data <-  readRDS(here::here("data", "combined_school_data.Rda"))

schoolsByWard <-  readRDS(here::here("data", "schoolsByWard.Rda"))



schoolsByWard <- schoolsByWard %>% rename("School_ID" =  "School.ID", 
                      "Unit_Name" = "Name.of.School",
                      "Address" = "Street.Address")

# add ward to rows from schoolsByWard document parsed above
school_data <- left_join(school_data, 
                         schoolsByWard %>% 
                           dplyr::select(School_ID, WARD = Ward, NAME_WARD_JOIN = Unit_Name), 
                         by=c("School_ID" = "School_ID")) %>% 
  dplyr::select(School_ID, WARD, SCHOOL_NAME = `SCHOOL NAME`, 
                NAME_WARD_JOIN, `Proposed Budget`, 
                `SCHOOL TOTAL ENROLLMENT`, everything())

# calculate average spend per student
school_data <- school_data %>% 
  mutate(
    # remove commas from enrollment column and make sure it's numeric
    `SCHOOL TOTAL ENROLLMENT` = as.numeric(gsub(",","",`SCHOOL TOTAL ENROLLMENT`)),
    `Proposed Budget` = as.numeric(`Proposed Budget`),
    # calculate a basic average spend based on enrollment and budget for each row
    AVG_SPEND_PER_STUDENT = as.numeric(`Proposed Budget` / as.numeric(gsub(",","",`SCHOOL TOTAL ENROLLMENT`))),
   # ensure year columns are all numeric
   YEAR = as.numeric(YEAR),
   PREV_YR = as.numeric(YEAR) - 1,
   TWO_YR_PRIOR = as.numeric(YEAR) - 2,
   # remove trailing white space from school types column 
   `SCHOOL TYPE NAME` = str_trim(`SCHOOL TYPE NAME`),
   SCHOOL_NAME = str_trim(SCHOOL_NAME),
   # make sure all charter schools are included in school types column
   `SCHOOL TYPE NAME` = ifelse(str_detect(pattern="C$", `SCHOOL ID (R-C-D-T-S)`),
                                "CHARTERSCH", `SCHOOL TYPE NAME`)) %>% 
  dplyr::select(YEAR, PREV_YR, TWO_YR_PRIOR, School_ID, WARD, NAME_WARD_JOIN, 
                CY_BUDGET = `Proposed Budget`, 
                SCHOOL_TOTAL_ENROLLMENT =  `SCHOOL TOTAL ENROLLMENT`,
                AVG_SPEND_PER_STUDENT, everything())

# add Chicago area based on matching generated from Chicago Open Data portal dataset 
# and UChicago community-area-to-Side matching
school_data <- left_join(school_data, read_csv(here::here("data", "wardSides.csv")),
                         by="WARD") %>% 
  dplyr::select(YEAR, PREV_YR, TWO_YR_PRIOR, School_ID, WARD, SIDE, everything())

    
# make sure all years have all school types
# school_data %>% distinct(YEAR, `SCHOOL TYPE NAME`)

# create variable of columns to keep in front after modifications
front_cols <- c("YEAR", "School_ID", "WARD", "SIDE", "SCHOOL_NAME", "NAME_WARD_JOIN", "CY_BUDGET", "SCHOOL_TOTAL_ENROLLMENT")

# bin enrollment and spend values for comparison
school_data <- school_data %>% 
  mutate(
    ENROLLMENT_RANGE = cut(SCHOOL_TOTAL_ENROLLMENT, 
    breaks=c(0, 500, 1000, 1500, 2000, 2500, 3000, 3500, 4000, 4500, 5000, Inf),
    labels=c("0-499", "500-999", "1,000-1,499", "1,500-1,999", 
             "2,000-2,499", "2,500-2,999", "3,000-3,499", 
             "3,500-3,999", "4,000-4,499", "4,500-4,999", "5,000+"), 
    ordered_result = TRUE),
        SPEND_RANGE = cut(AVG_SPEND_PER_STUDENT, 
                          breaks=c(0, 2500, 5000, 75000, 10000, 12500, 15000, Inf),
                          labels=c("0-2,499", "2,500-4,999", "5,000-7,499", 
                                   "7,500-9,999", "10,000-12,499", "12,500-14,999",
                                   "15,000+"), 
                          ordered_result = TRUE)) %>%
  dplyr::select(one_of(front_cols), ENROLLMENT_RANGE, SPEND_RANGE, everything())

# enable mapping by majority race in school
school_data <- left_join(
  school_data,
  school_data %>% group_by(`SCHOOL ID (R-C-D-T-S)`) %>% 
      summarise(
        White= mean(`SCHOOL - WHITE %`, na.rm=TRUE),
        Black= mean(`SCHOOL - BLACK %`, na.rm=TRUE),
        Asian= mean(`SCHOOL - ASIAN %`, na.rm=TRUE),
        Latinx = mean(`SCHOOL - HISPANIC %`, na.rm=TRUE)) %>% 
      gather(group_name, pct, -`SCHOOL ID (R-C-D-T-S)`) %>% 
      group_by(`SCHOOL ID (R-C-D-T-S)`) %>% 
      # sanity check to make sure all races in output to start before slicing
      # arrange(`SCHOOL ID (R-C-D-T-S)`)  %>%
      slice(which.max(pct)) %>% 
      dplyr::select(`SCHOOL ID (R-C-D-T-S)`, group_name, pct), 
  by = c("SCHOOL ID (R-C-D-T-S)")) %>% 
    dplyr::select(front_cols, ENROLLMENT_RANGE, SPEND_RANGE, 
      predominant_race = group_name, max_pct = pct, everything())
  

#########################
##  Quasi-Random Plot  ##
#########################
school_data %>% group_by(`SCHOOL ID (R-C-D-T-S)`, predominant_race) %>% 
  summarise(avg_LI_pct = mean(`LOW-INCOME SCHOOL %`, na.rm = TRUE),
                              school_count = n()) %>% 
  ggplot(aes(predominant_race, avg_LI_pct, color=factor(predominant_race))) +
      geom_quasirandom(varwidth=TRUE, size=1.5, show.legend = FALSE) +
  scale_color_dt("diverging", reverse = TRUE, na.value=get_dt_cols("palegray")) +
  scale_y_continuous(labels = function(x) paste0(x, "%")) +
  scale_x_discrete(position = "top", 
                   labels = c("Majority Asian Schools", "Majority Black Schools",
                             "Majority Latinx Schools", "Majority White Schools")) +
  theme_modest() + 
  theme(axis.text.x.top = element_text(size=rel(1.25), vjust = -8, face="bold"),
        axis.text.y = element_text(size=rel(1.25), margin=unit(c(0,0,0,3),"lines")),
        axis.title.y = element_text(size=rel(1.25), angle = 90, family = "Ledger"),
        axis.title.x = element_blank(),
      # legend.title = element_text(size=rel(2)),
       #  legend.key.size =  unit(35, "pt"),
       # legend.text = element_text(size=rel(1.5))
       plot.title = element_text(size=rel(1.15))
       ) +
  labs(title = "Majority Black and Majority Latinx Schools Have Much Higher Percentages\nof Low Income Students", 
       x="Predominant Race in School", 
       y="Percentage of Low Income Students", 
       caption="Data Source: Illinois State Board of Education") + 
    annotate("text", y = 30, x = 2.4, label = "A handful of Near West Side\nand Wicker Park schools buck\nthe overall trend.", hjust=0.5, size=rel(4), face="bold") + 
  annotate("segment", x = 2.55, xend = 2.975, y = 34, yend = 40) +
  annotate("segment", x = 2.8, xend = 2.975, y = 30, yend = 31.5) +
  annotate("segment", x = 2.05, xend = 2.15, y = 27, yend = 28) +
  annotate("text", x = 2.45, y= 18, label="Keller Gifted Magnet Elementary School*", hjust=0.5, size=rel(4), fontface="bold") + 
  annotate("text", x = 1.3, y= 53, label="Sheridan Math & Science\nAcademy in Chinatown", hjust=0.5, size=rel(4), face="bold") +
  annotate("text", x = 1.45, y= 26, label="Rates at South Loop Elementary School\nand Lenart Regional Gifted Center\nElementary School located six blocks from\nthe University of Chicago are likely\nreflective of overall higher median\nincomes in the schools' neighborhoods.", hjust=0.5, size=rel(4), face="bold") +
  annotate("segment", x = 1.875, xend = 1.975, y = 30, yend = 33) +
  annotate("segment", x = 1.875, xend = 1.975, y = 30, yend = 30.5) +
  annotate("text", x=1.60, y = 38, label="Sutherland Elementary School*",hjust=0.5, size=rel(4), fontface="bold") + 
    annotate("text", x=3.55, y = 80, label="Schools near Humbolt Park and\nO'Hare have comparably high rates\nof low-income White students.",hjust=0.5, size=rel(4), face="bold") + 
  annotate("text", x = 1.4, y = 5, label = "*Keller Gifted Magnet and Sutherland Elementary Schools in the neighboring Mt. Greenwood and Beverly communities on the Far\nSouthwest Side have two of the smallest differences between white and non-white student percentages across all non-white schools.", hjust=0, size=rel(4), face="bold")

On average over the last 5 school years, non-white schools have served significantly higher percentages of low-income students, as determined by free and reduced lunch designation.

It seems to follow that these schools would provide more resources for students, however, over the same time period, average spend per student remains roughly the same across schools’ low-income percentages.

school_data %>% group_by(YEAR, low_income_decile) %>% 
  summarise(median_spend = median(AVG_SPEND_PER_STUDENT, na.rm=T)) %>%
  ggplot() +
  geom_area(aes(as.factor(YEAR), median_spend,
                   group=as.factor(low_income_decile),  fill=low_income_decile)) +
  scale_fill_dt(discrete=F) +
      scale_y_continuous(labels = scales::dollar) +
  theme_modest() +
  theme(legend.text = element_text(size=rel(1)),
        legend.title = element_text(size=rel(1), family = "Ledger"),
        plot.caption = element_text(hjust=1, size=rel(0.75)),
        panel.grid.minor = element_blank(),
        legend.position = "bottom",
        axis.title.x = element_blank(),
        axis.title.y = element_text(angle = 90, family = "Ledger", size=rel(1.25), 
                                    margin=unit(c(0,0,2,2), "lines")),
        axis.text.y = element_text( margin=unit(c(0,2,2,2), "lines"))
        ) +
      guides(fill = guide_colourbar(title.position="top", title.hjust = 0.5)) +
          labs(y= "Median Spend per Student", x="Year", caption="Data Source: Chicago Public Schools & Illinois State Board of Education", title="Average Spending per Student Largely Similar Across Schools by Low-Income Deciles", fill="Low Income Decile")

Schools with a large proportion on average of low-income students do tend to be on the lower end of the spectrum in terms of spend per student, based on the breakdown of low-income student percentages from the Illinois State Board of Education:

library(waffle)

parts_all <- school_data %>% filter(!is.na(SPEND_RANGE)) %>% group_by(SPEND_RANGE) %>% summarise(
  mean_enrollment = round(mean(SCHOOL_TOTAL_ENROLLMENT, na.rm=T),0),
  Black =round( mean(`SCHOOL - BLACK %`, na.rm=T)),
  White = round(mean(`SCHOOL - WHITE %`, na.rm=T)),
  Asian = round(mean(`SCHOOL - ASIAN %`, na.rm=T)),
  Latinx = round(mean(`SCHOOL - HISPANIC %`, na.rm=T)),
  `Low-Income` = round(mean(`LOW-INCOME SCHOOL %`, na.rm=T))
  )  %>% 
mutate(
  Black = round((Black/100) * mean_enrollment),
  White = round((White/100) * mean_enrollment),
  Asian = round((Asian/100) * mean_enrollment),
  Latinx = round((Latinx/100) * mean_enrollment),
  `Low-Income` = round((`Low-Income`/100) * mean_enrollment),
  `Not Low-Income` = mean_enrollment - `Low-Income`
  )

parts_all.list <- setNames(split(parts_all, seq(nrow(parts_all))), rownames(parts_all))

# school waffles by low-income status
waffles <- plot_grid(
waffle(round(mapply(FUN = `/`, as.list(parts_all.list[[1]])[7:8], 1)), colors = c("#986769", "#ebb742"), pad = (800 - as.list(parts_all.list[[1]])[[2]]) / 40,
       # pad = (800 - as.list(parts_all.list[[1]])[[2]]),
       rows=40, size=0.5, title="Under $2,500", xlab = "1 Square == 1 Student") +  
  theme(panel.grid.major=element_blank(), panel.grid.minor=element_blank(), axis.text = element_blank(), text = element_text(family="Roboto")),

waffle(round(mapply(FUN = `/`, as.list(parts_all.list[[2]])[7:8], 1)), colors = c("#986769", "#ebb742"), pad = (800 - as.list(parts_all.list[[2]])[[2]]) / 40,
       rows=40, size=0.5, title="$2,500-4,999", xlab = "1 Square == 1 Student") + 
  theme(panel.grid=element_blank(), axis.text = element_blank(), text = element_text(family="Roboto")),

waffle(round(mapply(FUN = `/`, as.list(parts_all.list[[3]])[7:8], 1)), colors = c("#986769", "#ebb742"), pad = (800 - as.list(parts_all.list[[3]])[[2]]) / 40,
       rows=40, size=0.5, title="$5,000-7,499", xlab = "1 Square == 1 Student") +  
  theme(panel.grid=element_blank(), axis.text = element_blank(), text = element_text(family="Roboto")),
NULL, NULL, NULL,
waffle(round(mapply(FUN = `/`, as.list(parts_all.list[[4]])[7:8], 1)), colors = c("#986769", "#ebb742"), pad = (800 - as.list(parts_all.list[[4]])[[2]]) / 40,
       rows=40, size=0.5, title="$7,500-9,999", xlab = "1 Square == 1 Student") + 
  theme(panel.grid=element_blank(), axis.text = element_blank(), text = element_text(family="Roboto")),

waffle(round(mapply(FUN = `/`, as.list(parts_all.list[[5]])[7:8], 1)), colors = c("#986769", "#ebb742"), pad = (800 - as.list(parts_all.list[[5]])[[2]]) / 40,
       rows=40, size=0.5, title="$10,000-12,499", xlab = "1 Square == 1 Student") + 
  theme(panel.grid=element_blank(), axis.text = element_blank(), text = element_text(family="Roboto")),

waffle(round(mapply(FUN = `/`, as.list(parts_all.list[[6]])[7:8], 1)), colors = c("#986769", "#ebb742"), pad = (800 - as.list(parts_all.list[[6]])[[2]]) / 40,
       rows=40, size=0.5, title="$12,500-14,999", xlab = "1 Square == 1 Student") +  
  theme(panel.grid=element_blank(), axis.text = element_blank(), text = element_text(family="Roboto")), 
ncol = 3, nrow=3, rel_heights =  c(1, 0.05, 1), align = 'v') + theme_modest() + theme(panel.grid=element_blank(), axis.text = element_blank())

title <- ggdraw() + draw_label("More Low-Income Students in Schools with Low- to Mid-Range Spend", fontface='bold', size=20, fontfamily="Ledger") + theme_modest() + theme(panel.grid=element_blank(), axis.text = element_blank(), axis.ticks=element_blank())
caption <- ggdraw() + draw_label("Data Source: Illinois State Board of Education",  size=12, hjust = 0) + theme_modest() + theme(panel.grid=element_blank(), axis.text = element_blank(), axis.ticks=element_blank())

plot_grid(title, waffles, caption, ncol=1, align="v", rel_heights = c(0.10, 0.75, 0.09))

However, in a perhaps reassuring trend, the newest Evidence-Based-Fuding Formula used by CPS appears to have increased the number of predominantly non-white schools spending more per student.

library(gganimate)
# library(gapminder)
school_data %>% mutate(NONWHITE_PCT = (100 - as.numeric(`SCHOOL - WHITE %`)),
                       DIFF_NONWHITE = NONWHITE_PCT - as.numeric(`SCHOOL - WHITE %`)) %>% 
  arrange(desc(predominant_race), DIFF_NONWHITE) %>% 
  dplyr::select(front_cols, predominant_race, NONWHITE_PCT, DIFF_NONWHITE, everything()) %>%   
ggplot(aes(NONWHITE_PCT, AVG_SPEND_PER_STUDENT, frame = as.integer(YEAR))) +
  geom_point(alpha = 0.5, aes(size = `OVERALL AVERAGE CLASS SIZE - SCHOOL`,
           colour = predominant_race, group=`SCHOOL ID (R-C-D-T-S)`)) +
  scale_size(range = c(2, 12)) +
  scale_color_dt("diverging", reverse = TRUE, na.value=get_dt_cols("palegray")) +
  enter_fade() +
  exit_fade() +
  theme_modest() +
  theme(
        axis.text.y = element_text(margin=unit(c(0,0,0,2),"lines")),
        axis.text.x = element_text(margin=unit(c(2,0,0,0),"lines")),
        panel.grid.minor.y = element_blank(),
        axis.text = element_text(size=rel(0.75)),
        axis.title.x = element_text(size=rel(1.25), family = "Ledger"),
        plot.subtitle = element_text(size=rel(0.9)),
        legend.text = element_text(size=rel(0.75)),
        legend.direction = "horizontal",
        legend.key.size = unit(45, "pt"),
        legend.position = "bottom",
        # plot.title = element_text(size=rel(1.5), hjust = .5),
        plot.title = element_text(hjust = .5),
        plot.caption = element_text(size=rel(0.75)),
        axis.title.y = element_text(size=rel(1.25), angle = 90, family = "Ledger")
  ) +
  # add animation
  labs(subtitle = 'Average Spend per student by Class Size, School Predominant Rance in Year: {frame_time}', x = 'Non-White Student Percentage', y = 'Average Spend per Student',
       title = "Spread of Spend per Student Increases for Predominantly Non-White Schools\nafter 2018 School Funding Formula Changes",
       caption="Data Source: Illinois State Board of Education", color="Predominant Race", size="Average Class Size") +
  transition_components(as.integer(YEAR), enter_length = as.integer(2), exit_length=as.integer(2),range=c(as.integer(2012), as.integer(2019))) +
  # gganimate::transition_time(time=as.integer(YEAR)) +
  exit_fade() +
  enter_fade() +
  ease_aes('sine-in-out') +
  guides(colour = guide_legend(title.position="top", title.hjust = 0.5, legend.box = "vertical", 
                               override.aes = list(alpha = .75)),
         size = guide_legend(title.position="top", title.hjust = 0.5, legend.box = "vertical"))

Exploring Voter Activation in Deinvested Wards

In light of fairly clear de-investment in certain parts of Chicago, I hypothesized that voters in affected wards would be encouraged to vote in aldermen who would help improve their interests. I was interested to see that the Far Southwest Side, arguably the area most impacted by de-investment, had the highest voter turnout in both of the two most recent elections.

As it turns out, the highest voter activation in this area occurred in Ward 19, the Beverly and Mt. Greenwood area, of which over 70% of the population is white, in comparison to the rest of the area, which has a white population of less than 1%, and had turnout of 35-40%. It is perhaps interesting that in a community that is largely black, another population group has the loudest voices in terms of voter input.

# read in turnout and change in turnout by Chicago ward and Chciago Side
  turnoutSides <-  readRDS(here::here("data", "sides_turnout.Rda"))
  turnoutDiff <-  readRDS(here::here("data", "wards_turnout.Rda"))
  
  # turnoutDiff %>% group_by(SIDE, WARD) %>% summarise(z = max(TURNOUT)) %>% filter(SIDE == "Far Southwest")
  
  # plot average turnout in 2011 and 2015 for each Chicago Side
  ggplot(turnoutSides, aes(x=as.factor(YEAR), y=TURNOUT, group=as.factor(SIDE))) + 
  geom_line(aes(colour=SIDE), size=1.5, show.legend = FALSE) +
  # geom_line(data = filter(turnoutSides, (DIFFERENCE > -0)||(is.na(DIFFERENCE))), aes(colour=SIDE), size=1.5, show.legend=FALSE) +
  scale_color_dt() + 
    
  # add lines for distribution within each Side at Ward level
  geom_line(data = turnoutDiff, aes(group=as.factor(WARD), color=SIDE), size=0.5, alpha=0.35, show.legend = FALSE) +
  
  # label each Side's values in line graphs for both 2011 and 2015
  geom_label_repel(data = turnoutSides %>% filter(YEAR == 2011), 
            aes(label = paste0(SIDE, " - ", TURNOUT, "%"), color = SIDE),
            fill=NA,
            hjust = "left",
            nudge_x = -.15,
            force=6,
            direction = "y",
            xlim= c(-0.5,.965),
            fontface = "bold",
            label.size = 0,
            point.padding   = 0.75,
            size = rel(5),
            show.legend = FALSE,
            family="Ledger") +
  geom_label_repel(data = turnoutSides %>% filter(YEAR == 2015),
            aes(label = paste0(SIDE, " - ", TURNOUT, "%"), color = SIDE),
            fill=NA,
            hjust = "right",
            nudge_x = .25,
            force = 5,
            direction = "y",
            fontface = "bold",
            point.padding   = 0.75,
            xlim=c(2.05,3),
            label.size = 0,
            size = rel(5),
            show.legend = FALSE,
            family="Ledger") +
  # move x-axis text to top of graph
  scale_x_discrete(position = "top") +
   # coord_cartesian(ylim=c(23.5, 60)) +
  theme_modest() + 
  theme(axis.text.x.top = element_text(size=rel(1.25), vjust = -8, face="bold", family="Ledger"),
          axis.title.y = element_blank(),
          axis.title.x = element_blank(),
          axis.text.y = element_blank(),
          panel.grid.minor=element_blank(),
          panel.grid.major=element_blank()
          # plot.title = element_text(size=rel(1.5)),
          # plot.subtitle = element_text(hjust=0.35)
        ) +
       
  labs(title="Amid City-Wide Turnout Dropoff, Significantly Higher Voter Activation in Far Southwest Side", 
         subtitle="Voters in the Far Southwest, which has faced de-investment as determined by a number of factors, far exceeded other areas'\nparticipation in the last two City Council elections.", 
         caption="Source: Chicago Board of Election Commissioners", color="Chicago Area") +
  annotate("text",  x = 1, y = 25, label = "*Underlying ward trends visualized\nbehind Side trendlines", size=rel(4)) + 
    annotate("text", x = 0.7, y = 70, label="Ward 19 on the Far Southwest\nSide, which contains the Beverly\nand Morgan Park neighborhoods,\nhad voter turnout of nearly 75%\n in the 2011 City Council Election.", size=rel(4), hjust=0, color=get_dt_cols("mauve"))

The disparities explored above give all Chicagoans good reason to utilize their right to choose leaders who will work to build a more equitable Chicago.