Philadelphia’s Underwhelming Turnout

Now that all of our votes have been counted, we can discuss what’s been in the air for weeks: Philadelphia’s underwhelming turnout. How can a record 749,317 votes cast be underwhelming, you ask? Because everyone else in the state did so much more.

Note: This post largely just codifies analyses that have lived on the Results Hub, with a little narration. All of this is based on unofficial results as of 11/21/2020.

Philadelphia accounted for its lowest fraction of state turnout

First things first: Philadelphia cast a record 742K votes for President. (Note, this is different from the 749K turnout because 7K voters left President blank. For data availability reasons, I focus on votes cast for topline office.)

View code
library(tidyverse)

cofile_pattern <-"^PA_(Uno|O)fficial_([0-9]{4})_general_results(_[0-9]+)?.CSV"
cofiles <- list.files(
  "../../data/pa_election_data/electionreturns.pa.gov/", 
  pattern=cofile_pattern,
  full.names = TRUE
)

res <- vector(mode="list")

for(f in cofiles){
  df_co <- readr::read_csv(f) %>%
    rename(
      county = `County Name`,
      office = `Office Name`,
      election = `Election Name`,
      candidate = `Candidate Name`,
      party = `Party Name`,
      votes=Votes
    ) %>%
    mutate(county = tolower(county)) %>%
    select(county, office, election, candidate, party, votes) %>%
    filter(substr(office, 1, 8) %in% c("Presiden", "Governor")) %>%
    mutate(year = substr(election, 1, 4))
  
  res[[f]] <- df_co
}
df <- bind_rows(res)
# table(df$year)

asnum <- function(x) as.numeric(as.character(x))

county_results <- df %>%
  group_by(county, year) %>%
  mutate(
    turnout=sum(votes),
    pvote = votes / turnout,
    cycle=ifelse(asnum(year) %% 4 == 0, "President", "Governor"),
    county_group = case_when(
      county == "philadelphia" ~ "Philadelphia",
      county %in% c("bucks", "delaware", "montgomery", "chester") ~ "Phila Suburbs",
      TRUE ~ "Rest of State"
    )
  ) %>%
  filter(party %in% c("Democratic", "Republican")) %>%
  select(-votes, -candidate) %>%
  pivot_wider(names_from = party, values_from=pvote, names_prefix = "pvote_")

ggplot(
  county_results %>% filter(county == "philadelphia"),
  aes(x=asnum(year), y=turnout)
) +
  geom_line(
    aes(group=cycle, linetype=cycle),
    size=1,
    color=strong_blue
  ) +
  geom_point(size=4, color=strong_blue) +
  scale_linetype_manual(values=c(President="solid", Governor="dashed"), guide=FALSE) +
  geom_text(
    data=tribble(
      ~year, ~turnout, ~label,
      "2015", 380e3, "Governor",
      "2015", 650e3, "President"
    ),
    aes(label=label),
    fontface="bold",
    color=strong_blue,
    size=4,
    hjust=-0.1
  ) +
  theme_sixtysix() +
  scale_y_continuous(labels=scales::comma, breaks = seq(0, 700e3, 100e3)) +
  expand_limits(y=0) +
  labs(
    title="Philadelphia cast its most votes in decades",
    y="Votes Cast",
    x=NULL
  )

But the rest of the state grew much, much more.

View code
ggplot(
  county_results %>%
    filter(year %in% c(2016, 2020)) %>%
    mutate(gap = pvote_Democratic - pvote_Republican) %>%
    select(county, county_group, year, cycle, turnout, gap) %>%
    pivot_longer(c(turnout, gap)) %>%
    unite(var, name, year, sep="_") %>%
    pivot_wider(names_from=var, values_from=value),
  aes(
    x=100*(gap_2016 + gap_2020)/2,
    y=100*(turnout_2020 - turnout_2016)/turnout_2016,
    color=county_group
  ) 
) +
  geom_point(aes(size=(turnout_2016 + turnout_2020)/2)) +
  geom_text(
    data=tribble(
      ~x, ~y, ~county_group,
      20, 20, "Phila Suburbs",
      42, 7, "Philadelphia"
    ),
    aes(x=x, y=y, label=county_group),
    size=4,
    fontface="bold",
    hjust=0
  ) +
  scale_color_manual(
    values=c("Philadelphia"=strong_blue, "Rest of State" = light_grey, "Phila Suburbs" = strong_green),
    guide=FALSE
  ) +
  scale_x_continuous(
    "Average of 2016 and 2020 Results",
    labels=function(x) sprintf("+%s%% %s", abs(x), ifelse(x >= 0, "Dem", "Rep"))
  ) +
  scale_y_continuous(
    "Change in votes cast (as % of 2016)",
    labels=scales::comma
  ) +
  scale_size_area(
    "Avg(2016 votes cast, 2020 votes cast)",
    labels=scales::comma
  ) +
  theme_sixtysix() +
  geom_hline(yintercept=0)+
  labs(
    title="Philadelphia's turnout grew less than the state.",
    subtitle="Second lowest growth, higher only than State College's Centre County."
  )

The net result is that Philadelphia represented its smallest share of the Presidential vote since at least 2000.

View code
grouped_turnout <- county_results %>%
    group_by(year, cycle, county_group) %>%
    summarise(turnout=sum(turnout)) %>%
    group_by(year) %>%
    mutate(frac = turnout / sum(turnout))

# grouped_turnout %>% filter(county_group == "Philadelphia") %>% arrange(frac)
# grouped_turnout %>% filter(county_group == "Phila Suburbs") %>% arrange(frac)
ggplot(
  grouped_turnout %>% filter(county_group != "Rest of State"),
  aes(x=year, y=100*frac, color=county_group)
) +
  geom_line(aes(group=interaction(cycle, county_group), linetype=cycle), size=1) +
  geom_point(size=4) +
  scale_linetype_manual(values=c(President="solid", Governor="dashed")) +
  scale_color_manual(
    values=c("Philadelphia"=strong_blue, "Rest of State" = strong_red, "Phila Suburbs" = strong_green),
    guide=FALSE
  ) +
  geom_text(
    data=tribble(
      ~year, ~frac, ~county_group, 
      "2016", 0.13, "Philadelphia",
      "2016", 0.20, "Phila Suburbs"
    ),
    aes(label=county_group),
    hjust=0,
    fontface="bold"
  ) +
  theme_sixtysix() +
  # theme(title=element_text(size=8)) +
  expand_limits(y=0) +
  labs(
    title="Philadelphia and Suburbs' vote share",
    subtitle="The city accounted for its lowest share of presidential votes since at least 2000.",
    x=NULL,
    y="Percent of PA's Votes Cast",
    linetype="Cycle"
  )

Perhaps more surprising than turnout, though, was that Philadelphia’s percent for Trump grew from four years ago. That was only true of a few other counties, all really Republican.

View code
ggplot(
  county_results %>%
    filter(year %in% c(2016, 2020)) %>%
    mutate(gap = pvote_Democratic - pvote_Republican) %>%
    select(county, county_group, year, cycle, turnout, gap) %>%
    pivot_longer(c(turnout, gap)) %>%
    unite(var, name, year, sep="_") %>%
    pivot_wider(names_from=var, values_from=value),
  aes(
    size=(turnout_2016 + turnout_2020)/2, 
    x=100*gap_2016,
    y=100*(gap_2020 - gap_2016),
    color=county_group
  ) 
) +
  geom_point() +
    scale_color_manual(
    values=c("Philadelphia"=strong_blue, "Rest of State" = light_grey, "Phila Suburbs" = strong_green),
    guide=FALSE
  ) +
  geom_text(
    data=tribble(
      ~x, ~y, ~county_group,
      20, 6, "Phila Suburbs",
      42, -3, "Philadelphia"
    ),
    aes(x=x, y=y, label=county_group),
    size=4,
    fontface="bold",
    hjust=0
  ) +
  scale_x_continuous(
    "2016 Result",
    labels=function(x) sprintf("+%s%% %s", abs(x), ifelse(x >= 0, "Clinton", "Trump"))
  ) +
  scale_y_continuous(
    "2020 Biden vs 2016 Clinton",
    labels=function(x) sprintf("+%s%% %s", abs(x), ifelse(x > 0, "Biden", "Clinton"))
  ) +
  scale_size_area(
    "Avg(2016 turnout, 2020 turnout)",
    labels=scales::comma
  ) +
  theme_sixtysix() +
  geom_hline(yintercept=0)+
  labs(
    title="Biden won less of Philadelphia than Clinton",
    subtitle="Change in county preferences, 2016 to  2020."
  )

There’s tension between the plots above and the fact that Biden would not have won PA without Philadelphia. If you delete Philadelphia from the state, Trump wins handily. People who worked hard to make the city’s record turnout happen can feel unappreciated by pieces like this. And it’s not obvious what the counterfactual is: without their hard work, would Philadelphia’s turnout have actually been down? But the following is clear: if you want to know why Trump won PA four years ago and lost it this year, the answer is not “Philadelphia changed”. In fact, changes in Philadelphia swung towards Trump. Nate Cohn has a great thread on this tension.

More importantly, talking about Black voters’ “flat” turnout or Hispanic voters’ shift towards Trump ignores the fact that they voted more overwhelmingly for Biden than White voters did, and have carried the party for decades. It feels pejorative of groups that have long been the party’s most steadfast base of support. And it feels especially callous after a year of Covid and police violence hit Black communities the hardest. I point out below that turnout was flat, but it’s important to make clear that I haven’t done any of the necessary reporting to understand *why*.

To be clear, Philadelphia’s Black wards voted for Biden at 95%. And if we extend that to Black voters in other wards, Black voters probably account for more than half of Biden’s Philadelphia votes.

Patterns within the city

Within the city, there are five clear groups of Divisions: Wealthy Progressive divisions that turned out in droves, Trumpy Divisions that did too, Black Divisions where turnout was flat, Hispanic Divisions where turnout fell and preferences moved towards Trump, and student Divisions where turnout cratered.

View code
library(leaflet)
make_leaflet <- function(
  data,
  get_color, 
  title,
  is_percent=FALSE,
  is_race=FALSE, #if is_race, color should be % Dem - % Rep
  diverge_at_zero=FALSE,
  zoom=6
){
  color <- get_color(data)  
  vals <- cut_vals(color, is_race, diverge_at_zero)  

  legend_list <- create_legend(
    vals$min, 
    vals$max, 
    vals$step_size,
    vals$pal,
    is_percent,
    is_race,
    diverge_at_zero
  )  

  init_map(data, zoom) %>%
    addPolygons(
      data=data$geometry,
      weight=0, 
      color="white", 
      opacity=1, 
      fillOpacity = 0.8, 
      smoothFactor = 0,
      fillColor = vals$pal(color),
      popup=data$popup
    ) %>%
    addControl(title, position="topright", layerId="map_title") %>% 
    addLegend(
      layerId="geom_legend",
      position="bottomright",
      colors=legend_list$colors,
      labels=legend_list$labels
    )
}

init_map <- function(data, zoom){
  bbox <- st_bbox(data)
  
  leaflet(
    options=leafletOptions(
      minZoom=zoom,
      # maxZoom=zoom,
      zoomControl=TRUE,
      dragging=TRUE
      )
  )%>% 
    setView(
      zoom=zoom,
      lng=mean(bbox[c(1,3)]),
      lat=mean(bbox[c(2,4)])
    ) %>%
    addProviderTiles(providers$Stamen.TonerLite) %>%
    setMaxBounds(
      lng1=bbox["xmin"],
      lng2=bbox["xmax"],
      lat1=bbox["ymin"],
      lat2=bbox["ymax"]
    )
}

create_legend <- function(
  min_value, 
  max_value, 
  step_size,
  pal,
  is_percent,
  is_race,
  diverge_at_zero
){ 
  legend_values <- seq(min_value, max_value, step_size)
  legend_colors <- pal(legend_values)
  
  if(is_race & is_percent){
    legend_labels <- sprintf(
      "+%s%% %s",
      abs(legend_values),
      case_when(
        legend_values==0 ~ "", 
        legend_values > 0 ~ "Dem",
        legend_values < 0 ~ "Rep"
      )
    )
  }else if(is_percent){
    legend_labels <- sprintf("%s%%", legend_values)
  } else if(is_race){
    legend_labels <- sprintf(
      "+%s %s",
      comma(abs(legend_values)),
      case_when(
        legend_values==0 ~ "", 
        legend_values > 0 ~ "Dem",
        legend_values < 0 ~ "Rep"
      )
    )
  } else {
    legend_labels <- scales::comma(legend_values)
  }
 
  list(
    colors=legend_colors,
    values=legend_values,
    labels=legend_labels
  )
}

cut_vals <- function(x, is_race, diverge_at_zero){
  min_value <- min(x, na.rm=TRUE)
  max_value <- max(x, na.rm=TRUE)
  
  if(diverge_at_zero) {
    max_value <- max(abs(min_value), abs(max_value))
    min_value <- -max_value
  }
  
  sigfig <- round(log10(max_value-min_value)) - 1
  step_size <- 2 * 10^(sigfig)
  
  min_value <- step_size * floor(min_value / step_size)
  max_value <- step_size * ceiling(max_value / step_size)
  
  if(!is_race & !diverge_at_zero){
    pal <- colorNumeric(
      "viridis", 
      domain=c(min_value, max_value)
    )
  } else if(is_race){
    pal <- colorNumeric(
      c(strong_red, "grey95", strong_blue),
      domain=c(min_value, max_value)
    )
  } else {
    pal <- colorNumeric(
      c(strong_orange, "grey95", strong_purple),
      domain=c(min_value, max_value)
    )
  }
  
  list(
    min=min_value,
    max=max_value,
    step_size=step_size,
    pal=pal
  )
}
  
make_leaflet_circles <- function(
  data,
  get_color,
  get_radius,
  title,
  is_percent=FALSE,
  is_race=FALSE, #if is_race, should be % Dem - % Rep
  diverge_at_zero=FALSE,
  zoom=6
){
  
  radius <- get_radius(data)
  max_radius <- 20
  radius <- max_radius * radius / max(radius)
  data <- data[order(radius, decreasing=TRUE),]
  radius <- radius[order(radius, decreasing=TRUE)]
  
  color <- get_color(data)  
  vals <- cut_vals(color, is_race, diverge_at_zero)
  
  legend_list <- create_legend(
    vals$min, 
    vals$max, 
    vals$step_size,
    vals$pal,
    is_percent,
    is_race
  )  
  
  init_map(data, zoom) %>%  
    addCircleMarkers(
      lat=asnum(data$INTPTLAT),
      lng=asnum(data$INTPTLON),
      radius=radius,
      # weight=0, 
      stroke=FALSE,
      color=vals$pal(color), 
      opacity=1, 
      fillOpacity = 1,
      # smoothFactor = 0,
      fillColor = vals$pal(color),
      popup=data$popup
    ) %>%
    addControl(title, position="topright", layerId="map_title") %>% 
    addLegend(
      layerId="geom_legend",
      position="bottomright",
      colors=legend_list$colors,
      labels=legend_list$labels
    )
}

pretty_time <- function(time){
  gsub("^0", "", format(time, "%I:%M %p"))
}

Philadelphia was still overwhelmingly Democratic, casting 81% of its votes for Biden to 18% for Trump.

View code
wards <- st_read("../../data/gis/warddivs/201911/Political_Wards.shp", quiet=TRUE) %>%
  mutate(ward=sprintf("%02d", asnum(WARD_NUM)))

phila_res <- readRDS("../election_night_2020/tmp/tmp_phila_res.RDS")

phila_res %<>% 
  group_by(ward) %>% 
  mutate(turnout=sum(votes)) %>%
  ungroup() %>% 
  pivot_wider(names_from=party, values_from=votes, names_prefix = "votes_")

phila_res_16 <- readr::read_csv("../../data/raw_election_data/2016_general.csv") %>%
  filter(OFFICE == "PRESIDENT AND VICE PRESIDENT OF THE UNITED STATES") %>%
  mutate(ward=sprintf("%02d", WARD)) %>%
  mutate(party=case_when(
    PARTY == "DEMOCRATIC" ~ "D",
    PARTY == "REPUBLICAN" ~ "R",
    TRUE ~ "O"
  )) %>%
  group_by(ward, party) %>%
  summarise(votes=sum(VOTES)) %>%
  group_by(ward) %>%
  mutate(turnout_16 = sum(votes)) %>%
  pivot_wider(names_from=party, values_from=votes, names_prefix = "votes_16_")

phila_df <- read.csv("../election_night_2020/tmp/mailin_phila.csv") %>%
  mutate(ward=substr(warddiv, 1, 2)) %>%
  select(-warddiv, -turnout_16) %>%
  group_by(ward) %>%
  summarise_all(sum)

wards %<>% 
  left_join(phila_res, by="ward") %>% 
  left_join(phila_df, by="ward") %>%
  left_join(phila_res_16)

if(nrow(wards) != 66) stop()

library(scales)
wards %<>%
  mutate(
    popup=sprintf(
      paste(
        c(
          "<b>Ward %s</b>",
          "Total Votes Counted: %s",
          "2016 Votes Cast: %s",
          "Change: %s",
          "Active Registered Voters: %s",
          "Turnout as %% of RVs: %0.0f%%",
          "",
          "Biden: %s (%0.0f%%)",
          "Trump: %s (%0.0f%%)",
          "",
          "Clinton 2016: %s (%0.0f%%)",
          "Trump 2016: %s (%0.0f%%)"
        ),
        collapse = "<br>"
      ),
      WARD_NUM,
      comma(turnout),
      comma(turnout_16),
      sprintf(
        "%s%0.0f%%", 
        ifelse(turnout > turnout_16, "+", "-"), 
        abs(100 * (turnout - turnout_16) / turnout_16)
      ),
      comma(n_reg),
      100 * turnout / n_reg,
      comma(votes_D), 100*votes_D / turnout,
      comma(votes_R), 100*votes_R / turnout,
      comma(votes_16_D), 100*votes_16_D / turnout_16,
      comma(votes_16_R), 100*votes_16_R / turnout_16
    )
  )

render_iframe <- function(widget, file=NULL){
  DIR <- "leaflet_files"
  if(!dir.exists(DIR)) dir.create(DIR)
  
  if(is.null(file)){
    obj.name <- deparse(substitute(widget))
    file <- sprintf("%s.html", obj.name)
  }
  
  setwd(DIR)  # saveWidget can't save to a folder
  
  htmlwidgets::saveWidget(
    widget, 
    file=file, 
    selfcontained=TRUE
  )
  
  setwd("..")
  
  sprintf(
    '<iframe src="%s/%s" width="100%%" height="600" scrolling="no" frameborder="0"></iframe>',
    DIR, file
  )
}

lf_res <- make_leaflet(
  data=wards,
  get_color=function(df) 100*(df$votes_D - df$votes_R)/df$turnout,
  is_percent = TRUE,
  title=sprintf("Presidential results"),
  is_race=TRUE,
  diverge_at_zero = TRUE,
  zoom=11
)

Turnout rose sharply in Center City and Fishtown, rose broadly across the Northeast, was flat in West Philly, fell in North Philly, and cratered in the wards around Penn, Drexel, and Temple.

View code
lf_turnout <- make_leaflet(
  data=wards,
  get_color=function(df) 100*(df$turnout - df$turnout_16)/df$turnout_16,
  is_percent = TRUE,
  title=sprintf("Change in votes cast from 2016"),
  is_race=FALSE,
  diverge_at_zero = TRUE,
  zoom=11
)

The correlation with demographics is striking. Merging in and crosswalking 2018 ACS estimates, we see that turnout was down sharply in Hispanic wards and flat in Black wards (in an election where the state and rest of the city was sharply up).

View code
pops <- read.csv(
  "../../data/census/acs_2018_5yr_age_phila/ACSST5Y2018.S1501_data_with_overlays_2020-11-08T110945.csv", 
  skip = 1
)

pops <- pops %>% 
  rename(
    pop_1824 = Estimate..Total..Population.18.to.24.years,
    pop_25over = Estimate..Total..Population.25.years.and.over,
    somecol_1824=Estimate..Total..Population.18.to.24.years..Some.college.or.associate.s.degree,
    colplus_1824 = Estimate..Total..Population.18.to.24.years..Bachelor.s.degree.or.higher
) %>% 
  dplyr::select(id, Geographic.Area.Name,pop_25over, pop_1824, somecol_1824, colplus_1824)

crosswalk <- readRDS("../../data/gis_crosswalks/bgs10_to_divs_201911.Rds")
crosswalk %<>% mutate(tract=substr(bg_fips, 1, 11)) %>%
  group_by(tract, WARD, DIV) %>%
  summarise(pop=sum(pop10), weight=sum(weight))

div_pops <- pops %>% 
  mutate(tract=gsub("^1400000US", "", id)) %>%
  left_join(crosswalk, by = "tract") %>% 
  group_by(WARD, DIV) %>%
  summarise(
    pop_25over=sum(pop_25over*weight),
    pop_1824=sum(pop_1824*weight),
    somecol_1824 =sum(somecol_1824 *weight),
    colplus_1824=sum(colplus_1824*weight)
  )

ward_pops <- div_pops %>% group_by(WARD) %>%
  summarise_at(vars(pop_25over:colplus_1824), sum) %>%
  mutate(
    p_1824_col=(somecol_1824 + colplus_1824)/(pop_25over + pop_1824)
  )

wards <- wards %>%
  left_join(ward_pops %>% rename(ward=WARD))

pops_race <- read.csv(
  "../../data/census/acs_2018_5yr_agerace_phila/ACSDP5Y2018.DP05_data_with_overlays_2020-11-08T121412.csv", 
  skip=1
)
pops_race <- pops_race %>%
  rename(
    pop_total=Estimate..HISPANIC.OR.LATINO.AND.RACE..Total.population,
    pop_hisp=Estimate..HISPANIC.OR.LATINO.AND.RACE..Total.population..Hispanic.or.Latino..of.any.race.,
    pop_nhwhite=Estimate..HISPANIC.OR.LATINO.AND.RACE..Total.population..Not.Hispanic.or.Latino..White.alone,
    pop_nhblack=Estimate..HISPANIC.OR.LATINO.AND.RACE..Total.population..Not.Hispanic.or.Latino..Black.or.African.American.alone
) %>%
  select(id, Geographic.Area.Name, pop_total, pop_hisp, pop_nhwhite, pop_nhblack)

div_race <- pops_race %>% 
  mutate(tract=gsub("^1400000US", "", id)) %>%
  left_join(crosswalk, by = "tract") %>% 
  group_by(WARD, DIV) %>%
  summarise(
    pop_total=sum(pop_total*weight),
    pop_hisp=sum(pop_hisp*weight),
    pop_nhwhite =sum(pop_nhwhite *weight),
    pop_nhblack=sum(pop_nhblack*weight)
  )

ward_race <- div_race %>% group_by(WARD) %>%
  summarise_at(vars(pop_total:pop_nhblack), sum) 

wards <- wards %>% left_join(ward_race %>% rename(ward=WARD))

df_race <- wards %>%
  as.data.frame() %>%
  pivot_longer(
    cols = c(pop_hisp, pop_nhwhite, pop_nhblack),
    names_to="race",
    values_to="pop"
  ) %>%
  mutate(prace = pop / pop_total)%>% 
  mutate(race_raw=gsub("pop_", "", race)) %>%
  mutate(
    race_formatted=case_when(
      race_raw=="nhwhite" ~ "Non-Hispanic White",
      race_raw=="nhblack" ~ "Non-Hispanic Black",
      race_raw=="hisp" ~ "Hispanic",
      TRUE ~ "NA"
    )
  )

ggplot(
  df_race ,
  aes(x=prace, y=turnout / turnout_16)
) + 
  geom_hline(yintercept=1) +
  geom_point(aes(size=turnout_16, color=race_raw), alpha=0.8, pch=16) +
  facet_grid(race_formatted ~ .) +
  theme_sixtysix() +
  scale_color_manual(
    values=c(
      nhblack=strong_blue,
      nhwhite=strong_red,
      hisp=strong_orange
    ),
    guide=FALSE
  ) +
  labs(
    x="Proportion of Population",
    y="Votes cast 2020 / Votes cast in 2016",
    title="Votes are down in Hispanic wards, flat in Black wards",
    subtitle=sprintf("Dots are wards, each ward shows up in each facet. Recorded votes as of %s.", format(Sys.time(), "%m/%d %H:%M")),
    size="2016 votes cast"
  )

Turnout was also way down in the student- and recent-grad-heavy wards. Presumably, these young voters just voted from their parents’ house, thanks to Covid. It may be a wash at the state level, though we certainly lost some out-of-state strategic swing voters, and it overall makes Philadelphia look disproportionately low.

How much better would the city’s turnout look with the students added back in? If we think they’re worth 30K votes, that would put Philadelphia still at the bottom of the pack, but not an outlier. I’ll dig into these results more when the individual-level voter file is updated.

View code
ggplot(
  wards,
  aes(x=p_1824_col, y=turnout/turnout_16)
) + 
  geom_hline(yintercept=1) +
  geom_point(
    aes(size=turnout_16),
    alpha=0.8,
    color=strong_grey,
    pch=16
  ) +
  scale_size_area() +
  theme_sixtysix() +
  labs(
    x="Proportion of over-18 pop that is 18-24 and has at least some college",
    y="Votes cast 2020 / Votes cast in 2016",
    title="Votes are down in young, educated wards",
    size="2016 votes cast"
  )

North Philly’s Hispanic wards not only turned out less, but shifted their preferences towards Trump. In 2016, Clinton won the 7th by 89 percentage points, Biden only won by 67. Meanwhile, Manayunk is the only neighborhood with a sizeable swing towards Biden.

View code
lf_pref <- make_leaflet(
  data=wards,
  get_color=function(df) 100*((df$votes_D - df$votes_R)/df$turnout - (df$votes_16_D - df$votes_16_R)/df$turnout_16),
  is_percent = TRUE,
  title=sprintf("Change in %% gap vs 2016."),
  is_race=TRUE,
  diverge_at_zero = TRUE,
  zoom=11
)

The result is a net change in the overall vote gap of +471K for Biden, down from +475 for Clinton in 2016. Again, not a huge change, but not in the direction that would explain Biden’s win. Turnout changes in Center City and Manayunk drove the largest increase in the gap for Biden, offset by shrinking gaps nearly everywhere else.

View code
lf_gap <- make_leaflet(
  data=wards,
  get_color=function(df) ((df$votes_D - df$votes_R) - (df$votes_16_D - df$votes_16_R)),
  is_percent = FALSE,
  title=sprintf("Change in vote gap vs 2016 (combined turnout and preferences)."),
  is_race=TRUE,
  diverge_at_zero = TRUE,
  zoom=11
)

Coming next: the Turnout Tracker

Now, if you watched the Turnout Tracker on Election Day, you wouldn’t have just been underwhelmed by the turnout. Instead, it looked like a bloodbath. Coming next, a deep dive into what went wrong.

The race for PA Senate 1

Party control of the Pennsylvania Senate will be contested this November, especially important in 2020 as the winners will draw the post-Census boundaries.

But that’s in November. Before that, in April’s Primary, we are going to have a rare contested senate race right here in our city. Incumbent Senator Larry Farnese is being challenged by fellow (former) Ward leader Nikil Saval (Saval stepped down from the second to be able to run for this seat). Saval, a co-founder of Reclaim Philadelphia, is presumably trying to win by running to Farnese’s left, a heat check of the recent successes of Larry Krasner and Kendra Brooks.

What are the dynamics at play? Let’s break down Philadelphia’s State Senate PA-1.

View code
library(tidyverse)
library(sf)
library(ggmap)
library(magrittr)
source("../../admin_scripts/util.R")

df_major <- readRDS("../../data/processed_data/df_major_2019-12-03.Rds")
df_major %<>% mutate(warddiv = pretty_div(warddiv))

divs <- st_read("../../data/gis/warddivs/201911/Political_Divisions.shp") %>%
  mutate(
    warddiv = pretty_div(DIVISION_N),
    area = as.numeric(st_area(geometry)) / (1609^2)  # mi^2
  )wards <- st_read("../../data/gis/warddivs/201911/Political_Wards.shp") %>%
  mutate(ward = sprintf("%02d", asnum(WARD_NUM)))sts <- st_read("../../data/gis/state_senate/tigris_upper_house_2015.shp") %>%
  st_transform(4326)sts_1 <- sts %>% filter(SLDUST == "001")
expand <- function(x, factor){
  mean_x <- mean(x)
  return(mean_x + factor * (x - mean_x))
}

expand_bb <- function(bb, factor){
  bb[c(1,3)] <- expand(bb[c(1,3)], factor)
  bb[c(2,4)] <- expand(bb[c(2,4)], factor)
  bb
}

st_bbox <- function(obj, expand, ...){
  bb <- sf::st_bbox(obj, ...)
  bb %<>% expand_bb(expand)
  names(bb) <- c("left", "bottom", "right", "top")
  bb
}

bb <- st_bbox(sts_1, expand=1.2)

basemap <- ggmap::get_stamenmap(
  bbox=bb, 
  zoom = 12, 
  maptype="toner-lite"
)

get_labpt_df <- function(sf){
  df <- st_centroid(sf) %>%
    mutate(
      x=sapply(geometry, "[", 1),
      y=sapply(geometry, "[", 2)
    ) %>%
    as.data.frame() %>%
    select(-geometry)
  return(df)
}

district_map <- ggmap(
  basemap, 
  extent="device",
  base_layer = ggplot(sts),
  maprange = FALSE
) +
  theme_map_sixtysix() %+replace%
  theme(legend.position = c(0.8, 0.2))

The geography of PA-1

[Reminder: You can make all of these maps and more on the Ward Portal!]

PA-1 covers most of South Philly (minus Point Breeze), Center City, and reaches North into Brewerytown, Kensington, and Port Richmond. Both of the candidates were until recently Ward Leaders in the district: Farnese still is in West Center City’s 8th Ward, and Saval was in Queen Village’s 2nd until resigning to run for this seat.

View code
phila_whole <- st_union(wards)
bb_phila <- st_bbox(phila_whole, 1.2)

ggplot(phila_whole) +
  geom_sf(fill=strong_green, color=NA, alpha=0.4) +
  geom_sf(
    data=st_crop(sts, bb_phila),
    fill=strong_green, color = "white", size = 1, alpha=0.3
  ) +
  geom_sf(
    data=sts %>% filter(SLDUST == "001"),
    fill=strong_green, color = "white", size = 1
  ) +
  geom_sf_text(
    data = st_crop(sts, bb_phila),
    aes(label=asnum(SLDUST))
  ) +
  ggtitle("State Senate Districts") +
  theme_map_sixtysix() %+replace%
  theme(panel.grid.major = element_blank())

View code
divs$sts <- divs %>%
  st_centroid() %>%
  st_covered_by(sts) %>%
  (function(x){sts$SLDUST[unlist(x)]})

district <- "001"
district_map +
  geom_sf(
    data = wards %>% filter(ward %in% c("02", "08")),
    fill="black",
    alpha = 0.5,
    color=NA
  ) +
  geom_sf(
    aes(alpha = (SLDUST == district)),
    fill="black",
    color = "grey50",
    size=2
  ) +
  geom_sf_text(
    data=wards %>% filter(ward %in% c("02", "08")),
    aes(label = sprintf("Ward %i", asnum(ward))),
    color="white"
  ) +
  scale_alpha_manual(values = c(`TRUE` = 0.2, `FALSE` = 0), guide = FALSE) +
  ggtitle(sprintf("State Senate District %s", asnum(district)))

The vast majority of the district’s votes come from Center City, South Philly, and Fairmount, which represented the highest-turnout neighborhoods in the entire city in November’s General.

View code
turnout <- df_major %>%
  filter(is_topline_office) %>%
  group_by(warddiv, year, election) %>%
  summarise(turnout = sum(votes))

maxval <- 20e3
labelmax <- function(x, max) {
  ifelse(
    x == max, 
    paste0(scales::comma(x), "+"), 
    scales::comma(x)
  )
}

district_map +
  geom_sf(
    data=divs %>% 
      left_join(
        turnout %>% filter(year == 2019, election == "general")
      ),
    aes(fill = pmin(turnout/area, maxval)),
    color=NA,
    alpha=0.8
  ) +
  geom_sf(
    data=st_crop(sts, bb_phila), 
    fill=NA, 
    color="white",
    size=2
  ) +
  scale_fill_viridis_c(
    "Votes/\n mile^2", 
    labels=function(x) labelmax(x, maxval)
  ) +
  ggtitle("Votes in the 2019 General")

The district’s residents are mostly White: the ACS 2017 estimates have the district 61% White, 13% Black, 12% Asian, and 11% Hispanic. The boundaries manage to almost perfectly gerrymander out the predominantly-Black neighborhoods of Point Breeze, carving out below Washington, above Passyunk, and West of Broad; and North Philly, running along the racial boundary of Girard.

View code
census <- read_csv("../../data/census/acs_2013_2017_phila_bg_race_income.csv")

maxpop_name <- function(wht, blk, hisp, asn){
  maxes <- apply(cbind(wht, blk, hisp, asn), 1, which.max)
  maxes <- sapply(maxes, function(x) if(length(x) == 1) x else NA)
  c("white", "black", "hispanic", "asian")[maxes]
}

maxpop_val <- function(wht, blk, hisp, asn){
  apply(cbind(wht, blk, hisp, asn), 1, max)
}

census <- census %>%
  mutate(tract = substr(as.character(Geo_FIPS), 1, 11)) %>%
  group_by(tract) %>%
  summarise_at(
    vars(starts_with("pop_")), 
    funs(sum)
  ) %>%
  mutate(pop_total = pop_hisp + pop_nh) %>%
  mutate(
    pwht = pop_nh_white / pop_total,
    pblk = pop_nh_black / pop_total,
    phisp = pop_hisp / pop_total,
    pasn = pop_nh_asian / pop_total
  ) %>%
  mutate(
    maxpop = maxpop_name(pwht, pblk, phisp, pasn),
    maxpop_val = maxpop_val(pwht, pblk, phisp, pasn)
  )

tracts <- st_read("../../data/gis/census/cb_2015_42_tract_500k.shp") %>%
  filter(COUNTYFP == "101") %>%
  st_transform(4326) %>%
  left_join(census, by=c("GEOID" = "tract"))district_map +
  geom_sf(
    data=tracts %>% 
      filter(!is.na(maxpop_val)) %>%
      mutate(maxpop = format_name(maxpop)),
    aes(
      fill=maxpop,
      alpha = 100 * maxpop_val
    ),
    color=NA
  ) +
  geom_sf(
    data=st_crop(sts, bb_phila), 
    fill=NA, 
    color="white",
    size=2
  ) +
  scale_alpha_continuous(
    range=c(0, 1),
    guide=FALSE
  ) +
  scale_fill_manual(
    "Predominant\n Race/Ethn.",
    values = c(
      Black = light_blue,
      White = light_red,
      Hispanic = light_green,
      Asian = strong_orange
    )
  ) +
  ggtitle(
    "Predominant Race and Ethnicity", 
    "2017 ACS 5-year estimates. Opacity = Percent."
  )

PA-1’s recent elections

Farnese hasn’t been plausibly challenged since 2008, when he won the seat vacated by indicted Senator Vince Fumo.

Ironically, Farnese won that race on the votes of Center City’s wealthy progressives, edging out Johnny Doc 43% to 38% (candidate Anne Dicker won the last 19%).

View code
sts_2008 <- df_major %>% 
  filter(
    election == "primary", party == "DEMOCRATIC", 
    year == 2008, office == "SENATOR IN THE GENERAL ASSEMBLY",
    district == 1
  ) %>%
  group_by(ward, candidate) %>%
  summarise(votes = sum(votes)) %>%
  group_by(ward) %>%
  mutate(
    total_votes = sum(votes), 
    pvote=100 * votes/total_votes,
    candidate=format_name(candidate),
    is_winner = rank(desc(pvote)) == 1,
    margin = pvote - pvote[rank(desc(pvote)) == 2]
  )

district_map +
  geom_sf(
    data = st_intersection(wards, sts_1) %>% 
      inner_join(sts_2008 %>% filter(is_winner)),
    aes(fill=candidate, alpha=margin),
    color=NA,
  ) +
  scale_fill_manual(
    "Winner",
    values=c(light_green, light_purple)
  ) +
  scale_alpha_continuous("Margin (%)") +
  theme(legend.box = "vertical") +
  ggtitle("The 2008 PA-1 Democratic Primary")

Those progressive districts have only become more influential. In more recent elections, the district has run significantly more progressive than the city as a whole. Bernie Sanders performed 7 percentage points better than in the city as a whole (though still lost the district to Clinton), Krasner 6 pp better, and Brooks 1.6 pp.

View code
races <- tribble(
  ~year, ~election, ~office, ~short_office, ~candidates,
  "2016", "primary", "PRESIDENT OF THE UNITED STATES", "President", list("HILLARY CLINTON", "BERNIE SANDERS"),
  "2017", "primary", "DISTRICT ATTORNEY", "District Attorney",list("LAWRENCE S KRASNER", "JOE KHAN"),
  "2019", "general", "COUNCIL AT LARGE", "City Council", list("KENDRA BROOKS", "DAVID OH")
)

div_cats <- readRDS("../../data/processed_data/div_cats_2019-12-03.RDS")
divs %<>% left_join(div_cats)

df_cand <- df_major %>% 
  inner_join(races) %>%
  filter(election == "general" | party == "DEMOCRATIC") %>%
  left_join(divs %>% as.data.frame() %>% select(warddiv, sts, cat)) %>%
  group_by(warddiv, year, office) %>%
  mutate(total_votes = sum(votes), pvote=100 * votes/total_votes) %>%
  filter(mapply(`%in%`, candidate, candidates))

df0 <- df_cand %>%
  group_by(candidate, year, election, short_office) %>%
  summarise(
    pvote_city = weighted.mean(pvote, total_votes),
    pvote_sts01 = weighted.mean(pvote, ifelse(sts == "001", total_votes, 0))
  ) %>%
  ungroup()

df0 %>%
  mutate(candidate = format_name(candidate)) %>% 
  arrange(year) %>%
  mutate(election = paste(year, format_name(election))) %>%
  select(election, candidate, pvote_city, pvote_sts01) %>%
  knitr::kable(digits=1, col.names=c("Election", "Candidate", "City %", "PA-1 %"))
Election Candidate City % PA-1 %
2016 Primary Bernie Sanders 37.0 44.2
2016 Primary Hillary Clinton 62.6 55.3
2017 Primary Joe Khan 20.3 24.7
2017 Primary Lawrence S Krasner 38.2 44.6
2019 General David Oh 4.0 4.5
2019 General Kendra Brooks 4.5 7.1

Revisit Philadelphia’s Voting Blocs. The district is mage up mostly of Wealthy Progressive and White Moderate divisions.

View code
bloc_colors <- c(
  "Black Voters" = light_blue,
  "Wealthy Progressives" = light_red,
  "White Moderates" = light_orange,
  "Hispanic North Philly" = light_green
)
district_map +
  geom_sf(
    data=divs,
    aes(fill = cat),
    color=NA,
    alpha=0.8
  ) +
  geom_sf(
    data=st_crop(sts, bb_phila), 
    fill=NA, 
    color="white"
  ) +
  scale_fill_manual(
    "Voting Bloc",
    values=bloc_colors
  ) +
  ggtitle("Voting Blocs of PA-1")

(Notice that my blocs based on voting patterns don’t perfectly match the Census populations; my Black Voter bloc extends above Washington Ave and the Census population doesn’t. That’s because the blocs are based on all elections back to 2002, while the Census data is more recent. That’s an emergent boundary that’s moving South as Point Breeze gentrifies.)

View code
turnout_nums <- turnout %>% 
  filter(year %in% c(2016, 2017, 2019)) %>% 
  ungroup() %>% 
  inner_join(
    divs %>%
      filter(sts == "001") 
  ) %>% 
  group_by(year,election,cat) %>%
  summarise(turnout = sum(turnout)) %>% 
  group_by(year, election) %>%
  mutate(pturnout = turnout / sum(turnout)) %>% 
  as.data.frame()

The Wealthy Progressives cast 67% of the votes in the 2016 Primary, 73% in the 2017 Primary, and 68% in the 2019 General. Their votes drive the overall results of the district.

View code
cand_nums <- df_cand %>%
  group_by(year, election, short_office) %>%
  mutate(candnum = as.numeric(factor(candidate))) %>%
  select(year, election, short_office, candidate, candnum) %>%
  unique()

ggplot(
  df_cand %>% 
    ungroup() %>%
    filter(sts == "001") %>%
    group_by(candidate, year, election, short_office, cat) %>%
    summarise(votes = sum(votes)) %>%
    left_join(cand_nums)
) +
  geom_bar(
    aes(x = cat, y = votes, fill=cat),
    stat="identity"
  ) +
  scale_fill_manual(NULL, values=bloc_colors) +
  facet_grid(paste(year, format_name(election)) ~ candnum) +
  geom_label(
    data=cand_nums, 
    aes(label=format_name(candidate)), 
    x = 4.5, y=20e3,
    hjust=1,
    vjust=0
  ) +
  scale_y_continuous("Votes", labels = scales::comma) +
  theme_sixtysix() %+replace% 
  theme(
    strip.text.x = element_blank(),
    axis.text.x = element_blank()
  ) +
  labs(
    title="Recent results in PA-1",
    x=NULL
  )

The recent left-wing support comes slightly more from the gentrifying ring around Center City than from Center City itself, while deeper South Philly and Northern Kensington and Port Richmond remain more conservative.

View code
district_map +
  geom_sf(
    data=divs %>% 
      left_join(df_cand) %>%
      # left_join(office_max) %>%
      left_join(cand_nums) %>%
      group_by(year, election, short_office, warddiv) %>%
      mutate(pvote_head2head = 100 * pvote / sum(pvote)),
    aes(fill=pvote_head2head),
    color=NA,
    alpha=0.8
  ) +
  geom_sf(
    data=st_crop(sts, bb_phila), 
    fill=NA, 
    color="white"
  ) +
  geom_label(
    data = cand_nums,
    aes(label=format_name(candidate)),
    hjust=1.1,
    vjust=1,
    x = bb["right"],
    y = bb["top"]
  ) +
  facet_grid(year + election ~ candnum) +
  theme(
    strip.text.x = element_blank(),
    legend.position = "right"
  ) +
  scale_fill_viridis_c("Head-to-head\n % of Vote") +
  ggtitle("Recent Elections in PA-1", "Head-to-head Vote Percentages")

Farnese vs Saval in April

This race will test a dynamic that the city hasn’t really tested yet in the post-2016 world: a candidate who historically has performed well among Wealthy Progressive divisions being challenged from the left.

Because of that, it’s hard to use past elections to predict this one. There aren’t easily predictable fault-lines, the way there were in 2019’s Council races for District 2 and District 3.

But let’s assume Farnese does better than Saval in the White Moderate and Black Voter divisions, maybe by a gap of 70-30. And assume that the Wealthy Progressive divisions again make up 70% of the vote. Saval would need to win the Wealthy Progressives by 59 – 41 to win the district. That’s a steep challenge, but we’ve seen steep challenges overcome in recent months.

View code
prop_wealthy_progressive <- 0.7
line_slope <- -prop_wealthy_progressive / (1-prop_wealthy_progressive)
y_intercept <- 0.5 / (1-prop_wealthy_progressive)

cand_scatter <- df_cand %>% 
  ungroup() %>%
  filter(sts == "001") %>%
  mutate(
    is_wealthy = ifelse(
      cat == "Wealthy Progressives", "wealthyprogs", "other"
    )
  ) %>%
  group_by(candidate, year, election, short_office, is_wealthy) %>%
  summarise(votes = sum(votes)) %>%
  group_by(year, election, short_office, is_wealthy) %>%
  mutate(pvote_h2h = votes / sum(votes)) %>%
  ungroup() %>%
  select(year, election, short_office, candidate, is_wealthy, pvote_h2h) %>%
  spread(key=is_wealthy, value=pvote_h2h)
    

ggplot(
  cand_scatter,
  aes(x = 100*wealthyprogs, y=100*other)
) +
  geom_label(aes(label = format_name(candidate))) +
  geom_abline(
    slope = line_slope, 
    intercept = 100 * y_intercept,
    linetype="dashed"
  ) +
  coord_fixed() + 
  xlim(c(0,100)) +
  ylim(c(0, 100)) +
  annotate(
    "text",
    y=0,
    # x=-100*y_intercept/line_slope,
    x=0,
    label=sprintf("Assuming Wealthy Progressives have %s%% of turnout.\nCandidates are at their head-to-head percentages.", round(100*prop_wealthy_progressive)),
    hjust=0,
    vjust=-0.1,
    color="grey50"
  ) +
  labs(
    title="Win Line for PA-1",
    subtitle="Candidates to the top-right win.",
    x="Percent in Wealthy Progressive divisions",
    y="Percent in other divisions"
  ) +
  theme_sixtysix()

Need more? Create your own analyses on the Ward Portal!