R Spatial Lab Assignment # 3
task 1:
acsCovidDat <- st_read("acsPopByZip.gpkg", layer="NYC_COVID_Pop_by_Zip")
## Reading layer `NYC_COVID_Pop_by_Zip' from data source
## `/Users/giannaselleck/Documents/RStudio/Week_9/R-Spatial_III_Lab/acsPopByZip.gpkg'
## using driver `GPKG'
## Simple feature collection with 180 features and 13 fields
## Geometry type: MULTIPOLYGON
## Dimension: XY
## Bounding box: xmin: 913129 ymin: 120020.9 xmax: 1067113 ymax: 272710.9
## Projected CRS: NAD83 / New York Long Island (ftUS)
covid_breaks <- classIntervals(acsCovidDat$Positiv, n = 5, style = "quantile")$brks
offs <- 1e-7
covid_breaks[1] <- covid_breaks[1] - offs
covid_breaks[length(covid_breaks)] <- covid_breaks[length(covid_breaks)] + offs
covid_palette <- brewer.pal(5, "YlOrRd")
covid_map <- ggplot(acsCovidDat) +
geom_sf(aes(fill = cut(Positiv, breaks = covid_breaks, include.lowest = TRUE)),
color = "white", linewidth = 0.2) +
scale_fill_manual(values = covid_palette, name = "Confirmed Cases") +
labs(
title = "COVID-19 Cases by NYC Zip Code",
x = "Longitude",
y = "Latitude"
) +
theme_minimal() +
theme(
axis.text = element_text(size = 8),
axis.title = element_text(size = 10),
plot.title = element_text(hjust = 0.5, face = "bold"),
panel.grid.major = element_line(color = "gray80", linetype = "dotted"),
panel.border = element_rect(color = "black", fill = NA, linewidth = 1)
) +
annotation_scale(location = "bl", width_hint = 0.4) +
annotation_north_arrow(location = "tl", style = north_arrow_fancy_orienteering())
covid_map
elderly_breaks <- classIntervals(acsCovidDat$eldrlyP, n = 5, style = "quantile")$brks
## Warning in classIntervals(acsCovidDat$eldrlyP, n = 5, style = "quantile"): var
## has missing values, omitted in finding classes
offs <- 1e-7
elderly_breaks[1] <- elderly_breaks[1] - offs
elderly_breaks[length(elderly_breaks)] <- elderly_breaks[length(elderly_breaks)] + offs
elderly_palette <- brewer.pal(5, "YlGnBu")
elderly_map <- ggplot(acsCovidDat) +
geom_sf(aes(fill = cut(eldrlyP, breaks = elderly_breaks, include.lowest = TRUE)),
color = "white", linewidth = 0.2) +
scale_fill_manual(values = elderly_palette, name = "Elderly Population") +
labs(
title = "Elderly Population by NYC Zip Code",
x = "Longitude",
y = "Latitude"
) +
theme_minimal() +
theme(
axis.text = element_text(size = 8),
axis.title = element_text(size = 10),
plot.title = element_text(hjust = 0.5, face = "bold"),
panel.grid.major = element_line(color = "gray80", linetype = "dotted"),
panel.border = element_rect(color = "black", fill = NA, linewidth = 1)
) +
annotation_scale(location = "bl", width_hint = 0.4) +
annotation_north_arrow(location = "tl", style = north_arrow_fancy_orienteering())
elderly_map
task 2:
map_covid <- ggplot(acsCovidDat) +
geom_sf(aes(fill = cut(Positiv, breaks = covid_breaks, include.lowest = TRUE)),
color = "white", linewidth = 0.2) +
scale_fill_manual(values = covid_palette, name = "COVID Cases") +
labs(
title = "COVID-19 Cases",
x = "Longitude",
y = "Latitude"
) +
theme_minimal() +
theme(
axis.text = element_text(size = 8),
axis.title = element_text(size = 10),
plot.title = element_text(hjust = 0.5, face = "bold"),
panel.grid.major = element_line(color = "gray80", linetype = "dotted"),
panel.border = element_rect(color = "black", fill = NA, linewidth = 1),
coord_sf(expand = FALSE)
)
map_elderly <- ggplot(acsCovidDat) +
geom_sf(aes(fill = cut(eldrlyP, breaks = elderly_breaks, include.lowest = TRUE)),
color = "white", linewidth = 0.2) +
scale_fill_manual(values = elderly_palette, name = "Elderly Population") +
labs(
title = "Elderly Population",
x = "Longitude",
y = "Latitude"
) +
theme_minimal() +
theme(
axis.text = element_text(size = 8),
axis.title = element_text(size = 10),
plot.title = element_text(hjust = 0.5, face = "bold"),
panel.grid.major = element_line(color = "gray80", linetype = "dotted"),
panel.border = element_rect(color = "black", fill = NA, linewidth = 1),
coord_sf(expand = FALSE)
)
ggarrange(
map_covid + theme(legend.position = "right"),
map_elderly + theme(legend.position = "right"),
ncol = 2, nrow = 1,
common.legend = TRUE,
legend = "right"
)
task 3:
# first layer: Positiv
# second layer: elderlyP
# third layer: % Elderly
# this is creating the third layer
acsCovidDat <- acsCovidDat %>%
mutate(pct_elderly = (eldrlyP / totPop) * 100)
pal_covid <- colorQuantile("YlOrRd", acsCovidDat$Positiv, n = 5)
pal_elderly <- colorQuantile("YlGnBu", acsCovidDat$eldrlyP, n = 5)
pal_pct_elderly <- colorQuantile("PuBuGn", acsCovidDat$pct_elderly, n = 5)
popup_covid <- paste0("<strong>Zip Code: </strong>", acsCovidDat$ZIPCODE,
"<br><strong>COVID Cases: </strong>", acsCovidDat$Positiv)
popup_elderly <- paste0("<strong>Zip Code: </strong>", acsCovidDat$ZIPCODE,
"<br><strong>Elderly Pop.: </strong>", acsCovidDat$eldrlyP)
popup_pct_elderly <- paste0("<strong>Zip Code: </strong>", acsCovidDat$ZIPCODE,
"<br><strong>% Elderly: </strong>", round(acsCovidDat$pct_elderly,1), "%")
# Added hover labels
label_covid <- paste0("ZIP: ", acsCovidDat$ZIPCODE,
" | COVID Cases: ", acsCovidDat$Positiv)
label_elderly <- paste0("ZIP: ", acsCovidDat$ZIPCODE,
" | Elderly Pop: ", acsCovidDat$eldrlyP)
label_pct_elderly <- paste0("ZIP: ", acsCovidDat$ZIPCODE,
" | % Elderly: ", round(acsCovidDat$pct_elderly,1), "%")
polyHighlightOption <- leaflet::highlightOptions(opacity = 1.0, weight = 2, color = "black")
polyLabelOption <- leaflet::labelOptions(opacity = 1.0, textsize = "11px")
interactive_map <- leaflet(acsCovidDat %>% st_transform(4326)) %>%
addTiles(group = "OSM") %>%
addProviderTiles("CartoDB.Positron", group = "Carto") %>%
addPolygons(fillColor = ~pal_covid(Positiv),
fillOpacity = 0.7, color = "grey", weight = 1,
popup = popup_covid,
label = label_covid,
labelOptions = polyLabelOption,
group = "COVID Cases",
highlightOptions = polyHighlightOption) %>%
addPolygons(fillColor = ~pal_elderly(eldrlyP),
fillOpacity = 0.7, color = "grey", weight = 1,
popup = popup_elderly,
label = label_elderly,
labelOptions = polyLabelOption,
group = "Elderly Population",
highlightOptions = polyHighlightOption) %>%
addPolygons(fillColor = ~pal_pct_elderly(pct_elderly),
fillOpacity = 0.7, color = "grey", weight = 1,
popup = popup_pct_elderly,
label = label_pct_elderly,
labelOptions = polyLabelOption,
group = "% Elderly",
highlightOptions = polyHighlightOption) %>%
# Legend for COVID Cases
addLegend(position = "bottomright", pal = pal_covid, values = acsCovidDat$Positiv,
title = "COVID Cases", opacity = 0.7) %>%
addLayersControl(baseGroups = c("OSM", "Carto"),
overlayGroups = c("COVID Cases", "Elderly Population", "% Elderly"),
options = layersControlOptions(collapsed = FALSE))
# this is for hiding legend when layer it is turned off
interactive_map <- htmlwidgets::onRender(interactive_map, jsCode = "
function(el, x) {
var map = this;
var legend = document.getElementsByClassName('legend')[0];
map.on('overlayadd', function(e) {
if (e.name === 'COVID Cases') {
if (legend) legend.style.display = 'block';
}
});
map.on('overlayremove', function(e) {
if (e.name === 'COVID Cases') {
if (legend) legend.style.display = 'none';
}
});
}
")
interactive_map