Map Interface

# key setups
library(pacman)

pacman::p_load(
    sf, leaflet, leaflet.minicharts, leaflet.extras,
    tools, stringi, magrittr, htmltools, 
    DT, shiny, shinyjs, shinydashboard, sqldf, kableExtra, raster, rmapshaper, htmlwidgets,
    magrittr, tictoc, tidyverse, leafpop
)

#remotes::install_github("r-spatial/leafpop")

# db connection
source("R:/Project/UWED/code/dbconnect.R")
U <- uwed <- connectdb(dbname = "uwed", host = "doyenne.csde.washington.edu", user = "uwed_user", password = Sys.getenv("uwed_user_pgpassword"))

The map below show racial demographics by precinct in Washington in 2020. Hovering over the precinct shows the county and precinct name. Click on a precinct to see a chart showing the population broken down by race. The full dataset, containing years 2007-2022, is available for download in the Datasets tab, under Section 2.1.

# get PostGIS data
# all years
# v_sf <- st_read(dsn = U, layer = "precinct_census_cvap_agg_votes_piechart")

# 2020 only
v_sf <- v_sf_2020 <- st_read(dsn = U, layer = "v_precinct_census_cvap_agg_votes_piechart_2020")
v_sf_2020<- rmapshaper::ms_simplify(v_sf, keep_shapes = TRUE)

# a function to create a pie chart
make_pl <- function(i, overwrite = FALSE, verbose = FALSE){
    x <- v_plots[i,]
    # year-create image dirs
    myyear <- x$electionyear
    # id, etc.
    xid <- x$fmoid
    # county, precinct
    mycounty <- x$county
    myprecinct <- x$precinctname
    mytitle <- str_c(myyear, mycounty, str_to_title(myprecinct), sep = ", " )

    # long format
    xl <- x %>% 
        select(matches("race")) %>% 
        gather() %>% 
        filter(key != "race_total") %>% 
        mutate(
            key = str_remove_all(string = key, pattern = "race_") %>% 
                factor(levels = c("white", "black", "aian", "asian", "nhpi", "hispanic", "other"), 
                       labels = c("White", "Black", "AIAN", "Asian", "NHPI", "Hispanic", "Other"))
            ) %>%
        rename(Race = key,
               Population = value)
    
    colors <- RColorBrewer::brewer.pal(7, "Dark2")
        
    
     g <- ggplot(data = xl, aes(x = Race, y = Population)) +
         geom_col(aes(fill = colors), show.legend = F) +
         theme_minimal() +
         geom_text(aes(label=ceiling(Population)), vjust = -1, color = "gray20") +
         ggtitle(paste0("Population by Race in ", mycounty, " County, ", str_to_title(myprecinct), " Precicnt, ", myyear)) +
         theme(axis.text.x = element_text(angle = 45, hjust=1)) +
         ylim(c(0, max(xl$Population)+ 0.05*max(xl$Population))) +
         labs(caption = "*AIAN: American Indian/Alaska Native\nNHPI: Native Hawaiin/Pacific Islander ")
 return(g)
}


v_plots <- st_drop_geometry(v_sf_2020) 

pls <- lapply(c(1:nrow(v_plots)), make_pl)
# list of files for popup images
# L <- list.files(path = "R:/Project/UWED/html/images/2020/", pattern = ".*png", full.names = TRUE)

# labels for hover
labels <- v_sf_2020 %>%
    mutate(labs = paste0("County: ", county, "<br  />Precinct: ", str_to_title(precinctname)))%>%
    pull(labs) %>% 
    lapply(htmltools::HTML)

v_sf_simple <- ms_simplify(v_sf_2020, keep_shapes = TRUE)

m <- leaflet(data = v_sf_simple, width = "100%") %>%
    addProviderTiles(providers$CartoDB.Positron) %>%
    addPolygons(weight = 2, label = ~labels, group = "v_sf_simple", color = 'gray',
                fillColor = 'gray', opacity = 0.5,
                highlight = highlightOptions(
                      weight = 3,
                      fillOpacity = 0.6,
                      color = "gray",
                      opacity = 1.0,
                      bringToFront = TRUE,
                      sendToBack = TRUE) ) %>% 
    leafpop::addPopupGraphs(graph = pls, group = "v_sf_simple")

#leafpop::addPopupImages(image = L, group = "v_sf_2020")

m