R Week 09 Assignment

Zip Code Data

COVID, Retail, and Health

Quarto markdown is different from R markdown in terms of chunk options. See chunk options at Quarto website.

popData <- popData %>%
  mutate(BIPOC_percentage = round((blackPop / totPop) * 100, 1))


plotbipoc <- ggplot(popData) +
  geom_sf(aes(fill = BIPOC_percentage)) +
  scale_fill_distiller(palette = "OrRd", direction = 1, name = "Percentage BIPOC") +
  coord_sf(xlim = c(-74.4, -73.65), default_crs = sf::st_crs(4326) ) +
  labs(x = "Longitude", y = "Latitude",
       title = "BIPOC Population Percentage in Each NYC ZIP Code") +
  theme_minimal() +
  theme(legend.position = "right") 

# Ensure COVID_DEATH_COUNT is numeric
nyc_covid_data_sf_merged$COVID_DEATH_COUNT <- as.numeric(nyc_covid_data_sf_merged$COVID_DEATH_COUNT)

# Compute the quartile breaks based on COVID_DEATH_COUNT
breaks_qt <- quantile(nyc_covid_data_sf_merged$COVID_DEATH_COUNT, probs = 0:4/4, na.rm = TRUE)

# Create a new column that categorizes COVID_DEATH_COUNT into quartiles
nyc_covid_data_sf_merged <- mutate(nyc_covid_data_sf_merged, 
                                   covid_death_cat = cut(COVID_DEATH_COUNT, 
                                                         breaks = breaks_qt, 
                                                         include.lowest = TRUE, 
                                                         labels = c("Q1 (Low)", "Q2", "Q3", "Q4 (High)"),
                                                         dig.lab = 4, 
                                                         digits = 1))

# Plot using ggplot2
plotcaserate <- ggplot(nyc_covid_data_sf_merged) + 
  geom_sf(aes(fill = covid_death_cat)) +
  scale_fill_brewer(palette = "OrRd", direction = 1, name = 'COVID-19 Death Count') +  # Color scale for quartiles
  coord_sf(xlim = c(-74.4, -73.65), default_crs = sf::st_crs(4326)) +
  labs(x = 'Longitude', y = 'Latitude', 
       title = 'COVID-19 Death Count by ZIP Code') +
  theme_minimal() +
  theme(legend.position = "right")




plotelder <- ggplot(popData) +
  geom_sf(aes(fill = elderly_pct)) +
  scale_fill_distiller(palette = "OrRd", direction = 1, name = "% Elderly") +
  coord_sf(xlim = c(-74.4, -73.65), default_crs = sf::st_crs(4326) ) +
  labs(x = "Longitude", y = "Latitude",
       title = "Elderly Population Percentage in Each NYC ZIP Code") +
  theme_minimal() +
  theme(legend.position = "right") 


plotcaserate

plotbipoc

plotelder

#  Code for Elderly Pop


popData <- popData %>%
  mutate(elderly_pct = round((elderlyPop / totPop) * 100, 1))

install.packages("gridExtra")

## 
## The downloaded binary packages are in
##  /var/folders/dm/sj7012g577qdnv76gj2_szd80000gp/T//Rtmps3ccE8/downloaded_packages

library(gridExtra)

## 
## Attaching package: 'gridExtra'

## The following object is masked from 'package:dplyr':
## 
##     combine

require(ggmap)


install.packages("patchwork")

## 
## The downloaded binary packages are in
##  /var/folders/dm/sj7012g577qdnv76gj2_szd80000gp/T//Rtmps3ccE8/downloaded_packages

require(patchwork)

## Loading required package: patchwork

## 
## Attaching package: 'patchwork'

## The following object is masked from 'package:raster':
## 
##     area

plotelder + plotcaserate + plot_layout(ncol = 2, nrow = 1, widths = 2, heights = 2)

p_tip <- paste0("Neighborhood: ", covid_data$NEIGHBORHOOD_NAME);

p_popup <- paste0("<strong>COVID Death Density: </strong>", 
                  nyc_covid_data_sf_merged$COVID_DEATH_COUNT%>%round(3)%>%format(nsmall = 3), 
                  " /sqkm",
                  " <br/>",
                  "<strong> Number of Deaths: </strong>",
                  nyc_covid_data_sf_merged$COVID_DEATH_RATE,
                  sep="")


popData <- st_transform(popData, st_crs(nyc_covid_data_sf_merged))

nyc_covid_combined <- st_join(
  nyc_covid_data_sf_merged,
  popData
)

nyc_covid_combined <- st_transform(nyc_covid_combined, 4326)

pal_death_count <- colorQuantile("YlOrRd", nyc_covid_combined$COVID_DEATH_COUNT, n = 5)
pal_case_count <- colorQuantile("Blues", nyc_covid_combined$COVID_CASE_COUNT, n = 5)
pal_elderly <- colorQuantile("Purples", nyc_covid_combined$elderly_pct, n = 5)

    
brks_death <- quantile(nyc_covid_combined$COVID_DEATH_COUNT, probs = seq(0, 1, length.out = 6), na.rm = TRUE)
brks_case  <- quantile(nyc_covid_combined$COVID_CASE_COUNT, probs = seq(0, 1, length.out = 6), na.rm = TRUE)
brks_elderly <- quantile(nyc_covid_combined$elderly_pct, probs = seq(0, 1, length.out = 6), na.rm = TRUE)


htmlMap <- leaflet(nyc_covid_combined) %>%
  addTiles() %>%
  
  # Death Count
  addPolygons(
    group = "Death Count",
    stroke = FALSE,
    fillColor = ~pal_death_count(COVID_DEATH_COUNT),
    fillOpacity = 0.8,
    label = p_tip,
    popup = p_popup
  ) %>% 
  addLegend(
    "bottomright",
    colors = brewer.pal(5, "YlOrRd"),
    labels = round(brks_death[-1], 2),
    title = "COVID Death Counts",
    opacity = 0.8
  ) %>%
  
  # Case Count
  addPolygons(
    group = "Case Count",
    stroke = FALSE,
    fillColor = ~pal_case_count(COVID_CASE_COUNT),
    fillOpacity = 0.8,
    smoothFactor = 0.5,
    label = p_tip,
    popup = p_popup
  ) %>% 
  addLegend(
    "bottomright",
    colors = brewer.pal(5, "Blues"),
    labels = round(brks_case[-1], 2),
    title = "COVID Case Counts",
    opacity = 0.8
  ) %>%
  
  # Elderly Population
  addPolygons(
    group = "Percent Elderly Population",
    stroke = FALSE,
    fillColor = ~pal_elderly(elderly_pct),
    fillOpacity = 0.8,
    smoothFactor = 0.5,
    label = p_tip,
    popup = p_popup
  ) %>%
  addLegend(
    "bottomright",
    colors = brewer.pal(5, "Purples"),
    labels = round(brks_elderly[-1], 2),
    title = "Percent Elderly",
    opacity = 0.8
  ) %>%
  
  addLayersControl(
    overlayGroups = c("Death Count", "Case Count", "Percent Elderly Population"),
    options = layersControlOptions(collapsed = FALSE)
  )


knitr::include_graphics("COVIDDEATHS.png")

knitr::include_graphics("COVIDCASES.png")

knitr::include_graphics("COVIDELDERS.png")