Results https://twitter.com/elipousson/status/1479639834868297730/photo/1

2022-01-07_pedestrian_danger_index_state.R

library(crashapi)
library(dplyr)
library(ggplot2)

persons <-
  purrr::map_dfr(
    c(2013:2017),
    ~ get_fars_year(year = .x, data = "PERSON", format = "csv", download = FALSE) |> 
      bind_cols("year" = .x)
  )

url <- "https://docs.google.com/spreadsheets/d/1HGRdNLO1NbgnK5JkXFeW35Ezx6NIHvuxya08mfNRWrs/edit?usp=sharing"
racename_xwalk <- googlesheets4::read_sheet(url, sheet = "acs5_2017_B03002")

ped_fatalities <-
  persons |> 
  filter(
    # Filter to fatalities for pedestrians 
    per_typname %in% c("Pedestrian")# , c("Pedestrian, "Bicyclist", "Other Cyclist"),
    racename != "Not a Fatality (not Applicable)"
  ) |>
  mutate(
    # Fill racename with placeholder ('[Hispanic]') to match to xwalk
    racename =
      if_else(
      !(hispanicname %in% c("Unknown", "Non-Hispanic")),
      "[Hispanic]",
      racename
    ),
    # Convert state and county IDs to GeoID
    GEOID = paste0(
      stringr::str_pad(state, width = 2, pad = "0"),
      stringr::str_pad(county, width = 3, pad = "0")
      )
  ) |> 
  left_join(racename_xwalk, by = "racename")

census_year <- 2017
table_var <- "B03002"
summary_var <- "B03002_001"

state_pop <-
  tidycensus::get_acs("state", table = table_var, summary_var = summary_var, year = census_year) |> 
  select(GEOID, variable, estimate, summary_est) |> 
  mutate(
    perc_estimate = round(estimate / summary_est, digits = 2)
  )

table_var <- "B08301"
summary_var <- "B08301_001"

state_commute <-
  tidycensus::get_acs("state", table = table_var, summary_var = summary_var, year = census_year) |> 
  select(GEOID, variable, estimate, summary_est) |> 
  mutate(
    perc_estimate = estimate / summary_est, digits = 2
  )

state_walked <-
  state_commute |> 
  filter(variable == "B08301_019") |> 
  select(GEOID, perc_walked = perc_estimate)

# State Pedestrian Danger Index, 2013-2017
ped_fatality_rate_state_year <-
  ped_fatalities |> 
  # Total fatalities by group
  count(year, state, label, name = "fatalities") |> 
  # Bind total fatalities across all groups
  bind_rows(
    count(ped_fatalities, year, state, name = "fatalities") |> 
      bind_cols("label" = "Total")
  ) |> 
  mutate(
    state = stringr::str_pad(state, width = 2, pad = "0")
  ) |> 
  left_join(
    distinct(racename_xwalk, label, .keep_all = TRUE),
    by = "label"
    ) |> 
  left_join(state_pop, by = c("state" = "GEOID", "variable")) |> 
 # View()
  group_by(year, state, label) |> 
  summarise(
    fatalities = sum(fatalities),
    rate = round((fatalities / estimate) * 100000, digits = 2),
    total_pop = estimate
  )

ped_fatality_rate_state_year |> 
  filter(label == "Total") |> 
  left_join(state_walked, by = c("state" = "GEOID")) |> 
  left_join(
    tigris::fips_codes |> select(state = state_code, state_name) |> distinct(state, .keep_all = TRUE),
    by = "state"
  ) |>
  #View()
  group_by(state_name) |>
  #View()
  summarise(
    total_fatalities = sum(fatalities, na.rm = TRUE),
    fatality_list = list(fatalities),
    mean_rate = mean(rate, na.rm = TRUE),
    ped_danger_index = (((total_fatalities / total_pop) * 100000) / perc_walked),
    perc_walked = round(perc_walked, digits = 2),
    .groups = "drop_last"
  ) |> 
  distinct(state_name, .keep_all = TRUE) |> 
  filter(!is.na(state_name)) |> 
  arrange(desc(ped_danger_index)) |> 
  mutate(
    rank = row_number(),
    .before = "state_name"
  ) |> 
  select(-perc_walked) |> 
  gt() |> 
  tab_source_note(
    source_note = "Data: Fatality Analysis Reporting System (FARS); 2013-2017 5-year ACS; PDI methodology adapted from Dangerous by Design 2021"
  ) |> 
  cols_label(
      rank = "Rank",
      state_name = "State",
      total_fatalities = "Pedestrian fatalities",
      fatality_list = "Total, 2013-2017",
      mean_rate = "Avg annual fatality rate (per 100K pop)",
      ped_danger_index = "Pedestrian Danger Index (PDI)"
  ) |> 
  fmt_integer(total_fatalities) |> 
  fmt_number(c(mean_rate, ped_danger_index)) |>
  #fmt_percent(perc_walked) |> 
  gtExtras::gt_sparkline(fatality_list, same_limit = FALSE) |> 
  gtExtras::gt_theme_espn()