If you’re running this for the first time, make sure to uncomment package installation and API key setting.

#install.packages(c("tidycensus", "sf", "tigris", "ggplot2", "viridis","paletteer"))

# Load the packages
library(tidycensus)
library(sf)
## Linking to GEOS 3.12.2, GDAL 3.9.3, PROJ 9.4.1; sf_use_s2() is TRUE
library(tigris)
## To enable caching of data, set `options(tigris_use_cache = TRUE)`
## in your R script or .Rprofile.
library(ggplot2)
library(viridis)
## Loading required package: viridisLite
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(tidyr)
library(leaflet)
library(paletteer)


#census_api_key("8d2dec7d58676dfb242321e6386d6b8431cf8899",install=TRUE)

R Markdown

Covid Data set: (BP)

# county-level overcrowding data , pulled 2020 because most recent 5-year dataset
overcrowding_data <- get_acs(
  geography = "county",
  variables = c("B25001_001","B25014_005","B25014_006","B25014_007","B25014_011","B25014_012","B25014_013"), 
  year = 2020,
  survey = "acs5"
)
## Getting data from the 2016-2020 5-year ACS
overcrowding_data <- overcrowding_data %>% select(-moe) %>% spread(key = variable,value=estimate)
overcrowding_data <-  overcrowding_data %>% mutate(crowded = rowSums(select(.,4:9),na.rm=TRUE))
overcrowding_data <- overcrowding_data %>% select(1:3,10) 
overcrowding_data <- overcrowding_data %>% mutate(crowding_rate = crowded/B25001_001)
coviddata <- read.csv("C:/Users/MBA/OneDrive - Emory University/MBA Program/Semester_24Fall/EH584 Public Health and Built Environment/Final/data/coviddata.csv",colClasses = c("fips"="character"))
#colClasses = c("fips"="character")

ruccdata <- read.csv("C:/Users/MBA/OneDrive - Emory University/MBA Program/Semester_24Fall/EH584 Public Health and Built Environment/Final/data/Ruralurbancontinuumcodes2023.csv",colClasses = c("FIPS"="character"))
ruccdata <- ruccdata %>% mutate(rural_status = ifelse(RUCC_2023 %in% 1:3, 0, 1))

Mutated coviddata to ensure fips could match with GEOID

coviddata$fips<-stringr::str_pad(coviddata$fips,width=5, side = "left", pad="0")
coviddata_selected <- coviddata  
# Load shapefiles for us counties
counties_sf <- counties(cb = TRUE)
## Retrieving data for the year 2022
##   |                                                                              |                                                                      |   0%  |                                                                              |                                                                      |   1%  |                                                                              |=                                                                     |   1%  |                                                                              |=                                                                     |   2%  |                                                                              |==                                                                    |   3%  |                                                                              |===                                                                   |   4%  |                                                                              |===                                                                   |   5%  |                                                                              |====                                                                  |   5%  |                                                                              |====                                                                  |   6%  |                                                                              |=====                                                                 |   7%  |                                                                              |======                                                                |   8%  |                                                                              |======                                                                |   9%  |                                                                              |=======                                                               |  10%  |                                                                              |========                                                              |  12%  |                                                                              |=========                                                             |  13%  |                                                                              |==========                                                            |  14%  |                                                                              |===========                                                           |  15%  |                                                                              |===========                                                           |  16%  |                                                                              |============                                                          |  17%  |                                                                              |=============                                                         |  18%  |                                                                              |==============                                                        |  20%  |                                                                              |===============                                                       |  21%  |                                                                              |================                                                      |  22%  |                                                                              |================                                                      |  23%  |                                                                              |=================                                                     |  24%  |                                                                              |==================                                                    |  25%  |                                                                              |===================                                                   |  26%  |                                                                              |===================                                                   |  27%  |                                                                              |===================                                                   |  28%  |                                                                              |====================                                                  |  29%  |                                                                              |=====================                                                 |  30%  |                                                                              |======================                                                |  31%  |                                                                              |======================                                                |  32%  |                                                                              |=======================                                               |  33%  |                                                                              |========================                                              |  34%  |                                                                              |=========================                                             |  36%  |                                                                              |==========================                                            |  36%  |                                                                              |==========================                                            |  37%  |                                                                              |==========================                                            |  38%  |                                                                              |===========================                                           |  39%  |                                                                              |============================                                          |  40%  |                                                                              |=============================                                         |  41%  |                                                                              |==============================                                        |  42%  |                                                                              |==============================                                        |  43%  |                                                                              |==============================                                        |  44%  |                                                                              |===============================                                       |  45%  |                                                                              |================================                                      |  46%  |                                                                              |=================================                                     |  47%  |                                                                              |==================================                                    |  48%  |                                                                              |===================================                                   |  50%  |                                                                              |====================================                                  |  51%  |                                                                              |====================================                                  |  52%  |                                                                              |=====================================                                 |  53%  |                                                                              |======================================                                |  55%  |                                                                              |=======================================                               |  56%  |                                                                              |========================================                              |  57%  |                                                                              |=========================================                             |  58%  |                                                                              |==========================================                            |  59%  |                                                                              |==========================================                            |  61%  |                                                                              |===========================================                           |  62%  |                                                                              |============================================                          |  63%  |                                                                              |=============================================                         |  64%  |                                                                              |==============================================                        |  66%  |                                                                              |===============================================                       |  67%  |                                                                              |================================================                      |  68%  |                                                                              |=================================================                     |  69%  |                                                                              |=================================================                     |  71%  |                                                                              |==================================================                    |  72%  |                                                                              |===================================================                   |  73%  |                                                                              |====================================================                  |  74%  |                                                                              |=====================================================                 |  75%  |                                                                              |======================================================                |  77%  |                                                                              |=======================================================               |  78%  |                                                                              |=======================================================               |  79%  |                                                                              |========================================================              |  80%  |                                                                              |=========================================================             |  82%  |                                                                              |==========================================================            |  83%  |                                                                              |===========================================================           |  84%  |                                                                              |============================================================          |  85%  |                                                                              |=============================================================         |  87%  |                                                                              |=============================================================         |  88%  |                                                                              |==============================================================        |  89%  |                                                                              |===============================================================       |  90%  |                                                                              |================================================================      |  92%  |                                                                              |=================================================================     |  93%  |                                                                              |==================================================================    |  94%  |                                                                              |===================================================================   |  95%  |                                                                              |====================================================================  |  96%  |                                                                              |====================================================================  |  98%  |                                                                              |===================================================================== |  99%  |                                                                              |======================================================================| 100%
# Merge overcrowding data with shapefile by GEOID (FIPS code)
overcrowding_sf1 <- left_join(counties_sf, overcrowding_data, by = c("GEOID" = "GEOID"))
overcrowding_sf2 <- left_join(overcrowding_sf1, coviddata_selected, by = c("GEOID" = "fips"))
overcrowding_sf <- left_join(overcrowding_sf2, ruccdata, by = c("GEOID" = "FIPS"))
# Reproject the shapefile to WGS84 (EPSG:4326)
overcrowding_sf <- st_transform(overcrowding_sf, crs = 4326)
overcrowding_sf$population <- gsub(",", "", overcrowding_sf$population)
overcrowding_sf$population <- as.numeric(overcrowding_sf$population)

#mutate to remove outliers

overcrowding_sf <- overcrowding_sf %>%
  mutate(rate = ifelse(rate > 4.83, NA, rate))
# Create a color palette for the overcrowding and death rate with 95th percentile cutoff
n_colors<-100
num <- c(-2,4.83)
pal <- colorNumeric(palette = "Reds", domain = num)
pal_rural <- colorFactor(palette = "Blues", domain = c(0, 1))

# Create the interactive map using leaflet
leaflet(data = overcrowding_sf) %>%
  addProviderTiles("CartoDB.DarkMatter")  %>%
  addPolygons(
  fillColor = ~pal_rural(rural_status),  
  fillOpacity = 0.4,  
  color = "black",  # Border color
  weight = 1,  # Border width
  opacity = 0
  ) %>% 
  addPolygons(
  #  fillColor = ~"white",  
  #  fillOpacity = ~ifelse(is.na(rate),0,rural_status),
    color = ~ifelse(is.na(rate),"white",pal(rate)),  #white if na, otherwise by legend
    weight = ~crowding_rate/0.01,  #thicker for higher % of crowding
    popup = ~paste(
      "County: ", NAME.x, "<br>",
      "Overcrowding Rate: ", crowding_rate, "<br>","death rate",rate,      "Metro/Nonmetro: ", ifelse(rural_status == 1, "Rural", "Urban")
    ),opacity=~ifelse(is.na(rate),0,.8)
  ) %>%
  addLegend(
    pal = pal, 
    values = ~num, 
    title = "Rate",
    position = "bottomright"
   )