surveilling-surveillance/analysis/figures.R

estimate_detection_metrics <- function(df, recall = 0.63) {
  df %>%
    left_join(city_data) %>%
    transmute(
      city,
      type,
      period,
      road_network_length_km ,
      m_per_pano,
      pop_pano = 2 * road_network_length_km * 1000 / m_per_pano, # N
      n_pano, 
      n_detection, 
      # detection rate (unadjusted detections per pano)
      p_hat = n_detection / n_pano,
      # infinite population sd:
      p_hat_sd = sqrt(p_hat * (1 - p_hat) / n_pano),
      # for finite population sd:
      # p_hat_sd = sqrt((p_hat * (1 - p_hat) / n_pano) * ((pop_pano - n_pano) / (pop_pano - 1))),
      # detection rate (detections per km counting both sides of the road per km)
      est_detections_per_km = p_hat * (1000 / m_per_pano) * (2 / recall),
      se_detections_per_km = p_hat_sd * (1000 / m_per_pano) * (2 / recall),
      # detection count
      est_detections = est_detections_per_km * road_network_length_km,
      se_detections = se_detections_per_km * road_network_length_km
    ) %>%
    ungroup() %>%
    select(-p_hat, -p_hat_sd)
}

plot_camera_density <- function(df, legend = TRUE) {
  if (legend) {
    legend_position = "bottom"
  } else {
    legend_position = "none"
  }
  
  df %>%
    ggplot(aes(x = city, y = est_detections_per_km, fill = type)) +
    geom_col() +
    geom_linerange(aes(
      ymin = est_detections_per_km - 1.96*se_detections_per_km, 
      ymax = est_detections_per_km + 1.96*se_detections_per_km
    )) +
    scale_x_discrete(name = "") +
    scale_y_continuous(
      name = "Estimated cameras per km", 
      position = "right",
      expand = expansion(mult = c(0, 0.1))
    ) +
    scale_fill_discrete(name = "") +
    coord_flip() +
    theme(
      panel.border = element_blank(), 
      axis.line = element_line(size = 1, color = "black"),
      axis.title.x = element_text(family = "Helvetica", color = "black"), 
      axis.text = element_text(family = "Helvetica", color = "black"),
      legend.position = legend_position,
      panel.grid.major.x = element_blank(),
      panel.grid.major.y = element_blank(),
      panel.grid.minor = element_blank()
    ) 
}

load_road_network <- function(city_name){
  stopifnot(city_name %in% city_data$city)
  
  path <- here::here("data", "road_network", city_name, "edges.shp")
  read_sf(path)
}

get_max_points <- function(df){
  df %>%
    select(geometry) %>%
    st_cast("POINT") %>%
    st_coordinates() %>%
    as_tibble() %>%
    summarize(
      x_max = max(X),
      x_min = min(X),
      y_max = max(Y),
      y_min = min(Y)
    ) 
}

generate_sampled_point_map <- function(df, city_name){
  # load road network
  road_network <- load_road_network(city_name)
  
  # get crs
  road_network_crs <- st_crs(road_network) %>%
    as.integer() 
  road_network_crs <- road_network_crs[1]
  
  # find bounding coordinates of road network
  bbox <- st_bbox(road_network)
  
  # plot points
  road_network %>%
    ggplot() +
    geom_sf(fill = "white", color = "gray", alpha = 0.6) +
    geom_sf(
      data = df %>%
        filter(city == city_name) %>%
        st_as_sf(coords = c("lon", "lat"),
                 # ensure same crs as road network
                 crs = road_network_crs, 
                 agr = "constant"), 
      color = "blue", size = 0.2, 
      shape = 16, alpha = 1 
    ) + 
    scale_x_continuous(expand = expansion(mult = c(0.02, 0.02))) +
    scale_y_continuous(expand = expansion(mult = c(0, 0.02))) +
    coord_sf(xlim = c(bbox$xmin, bbox$xmax), ylim = c(bbox$ymin, bbox$ymax)) +
    theme(
      axis.text = element_blank(), 
      axis.ticks = element_blank(),
      panel.grid = element_blank(),
      panel.border = element_blank(),
      legend.position = "bottom",
      legend.text = element_text(size = 20)
    )
}

generate_detected_point_map <- function(df, city_name){
  # load road network
  road_network <- load_road_network(city_name)
  
  # get crs
  road_network_crs <- st_crs(road_network) %>%
    as.integer() 
  road_network_crs <- road_network_crs[1]
  
  # find bounding coordinates of road network
  bbox <- st_bbox(road_network)
  
  # plot points
  road_network %>%
    ggplot() +
    geom_sf(fill = "white", color = "gray", alpha = 0.6) +
    geom_sf(
      data = df %>%
        filter(
          city == city_name,
          camera_count > 0
        ) %>%
        st_as_sf(coords = c("lon", "lat"),
                 # ensure same crs as road network
                 crs = road_network_crs, 
                 agr = "constant"), 
      color = "red", size = 0.5,
      shape = 16, alpha = 1
    ) + 
    scale_x_continuous(expand = expansion(mult = c(0.02, 0.02))) +
    scale_y_continuous(expand = expansion(mult = c(0, 0.02))) +
    coord_sf(xlim = c(bbox$xmin, bbox$xmax), ylim = c(bbox$ymin, bbox$ymax)) +
    theme(
      axis.text = element_blank(), 
      axis.ticks = element_blank(),
      panel.grid = element_blank(),
      panel.border = element_blank(),
      legend.position = "bottom",
      legend.text = element_text(size = 20)
    )
}

annotate_points_with_census <- function(df, city_name, census_var){
  stopifnot(census_var %in% c("income", "race"))
  
  # define state, county using `city_data`
  state <- city_data %>%
    filter(city == city_name) %>%
    pull(state)
  county <- city_data %>%
    filter(city == city_name) %>%
    pull(county)
  
  
  # specify variables
  summary_vars <- "B03002_001" # total population
  if (census_var == "income") {
    vars <- c(Income = "B19113_001")
  } else if (census_var == "race") {
    vars <- c(White = "B03002_003") #non-Hispanic white
  }
  
  # get census data
  if (city_name == "New York") {
    state = "NY"
    counties <- c("New York County", "Kings County", "Queens County", 
                  "Bronx County", "Richmond County")
    
    new_york <- purrr::map(
      counties,
      ~ get_acs(
        state = state, 
        county = .x, 
        geography = "block group",
        variables = vars,
        summary_var = summary_vars,
        geometry = TRUE
      )
    )
    
    df_census_block_group <- bind_rows(new_york)
    
  } else{
    
    if (city_name == "Washington") {
      county <- NULL
    }
    
    df_census_block_group <- get_acs(
      state = state, 
      county = county, 
      geography = "block group",
      variables = vars,
      summary_var = summary_vars,
      geometry = TRUE
    )
  }
  
  
  # add GIS features
  df <- df %>%
    filter(city == city_name) %>%
    # ensure same coords as tidycensus
    st_as_sf(
      coords = c("lon", "lat"),
      crs = 4269, 
      agr = "constant"
    )
  
  # annotate points with census data
  if (census_var == "income") {
    df <- st_join(
      df, 
      df_census_block_group %>% 
        select(GEOID, NAME, median_household_income = estimate, geometry)
    )
  } else if (census_var == "race") {
    df <- st_join(
      df, 
      df_census_block_group %>% 
        transmute(
          GEOID, NAME, 
          percentage_minority = (summary_est - estimate) / summary_est, geometry
        )
    )
  }
  
  df
}