#get covid and zip code data
nyc_covid <-read_csv("Week_08/R-Spatial_II_Lab/tests-by-zcta_2021_04_23.csv", lazy = FALSE)
## Rows: 177 Columns: 13
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (3): NEIGHBORHOOD_NAME, BOROUGH_GROUP, label
## dbl (10): MODIFIED_ZCTA, lat, lon, COVID_CASE_COUNT, COVID_CASE_RATE, POP_DE...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
nyc_covid$MODIFIED_ZCTA<-as.character(nyc_covid$MODIFIED_ZCTA)
nyc_covid <- nyc_covid %>%
filter(!is.na(lon) , !is.na(lat))
nyc_zip_codes_sf <- st_read("Week_08/R-Spatial_I_Lab/ZIP_CODE_040114/ZIP_CODE_040114.shp") %>% st_transform(nyc_zip_codes_sf, crs = 4326)
## Reading layer `ZIP_CODE_040114' from data source
## `/Users/khadijajallow/Documents/R/Week_08/R-Spatial_I_Lab/ZIP_CODE_040114/ZIP_CODE_040114.shp'
## using driver `ESRI Shapefile'
## Simple feature collection with 263 features and 12 fields
## Geometry type: POLYGON
## Dimension: XY
## Bounding box: xmin: 913129 ymin: 120020.9 xmax: 1067494 ymax: 272710.9
## Projected CRS: NAD83 / New York Long Island (ftUS)
zip_covid <- nyc_zip_codes_sf %>%
left_join(nyc_covid, by = c("ZIPCODE" = "MODIFIED_ZCTA"))
nyc_food_retail <- st_read("Week_08/R-Spatial_II_Lab/nycFoodStore.shp")
## Reading layer `nycFoodStore' from data source
## `/Users/khadijajallow/Documents/R/Week_08/R-Spatial_II_Lab/nycFoodStore.shp'
## using driver `ESRI Shapefile'
## Simple feature collection with 11300 features and 16 fields
## Geometry type: POINT
## Dimension: XY
## Bounding box: xmin: -74.2484 ymin: 40.50782 xmax: -73.67061 ymax: 40.91008
## Geodetic CRS: WGS 84
retail <- nyc_food_retail %>%
dplyr::filter(grepl('B|C|F|H', Estbl_T)) %>%
sf::st_join(nyc_zip_codes_sf, ., join= st_contains) %>%
group_by(ZIPCODE) %>%
summarise(count_store = n())
Plot at least two high-quality static maps at the zip code level, with one using the COVID-19 testing data and one using a related factor such as the number of nursing homes or the elderly population.
#plot covid cases bty zipcode
plot(zip_covid['COVID_CASE_COUNT'],
main = "Covid Cases by Zip Code",
border = "Black",
breaks = "quantile",
graticule = TRUE,
axes = TRUE,
reset = FALSE
)
#plot elderly population by zipcode
plot(popData_merged['elderlyPop'],
main = "Elderly Population by Zip Code",
border = "White",
breaks = "quantile", nbreaks = 5,
graticule = TRUE,
axes = TRUE,
reset = FALSE
)
Use ggplot2 and other ggplot-compatible packages to create a multi-map figure illustrating the possible relationship between COVID-19 confirmed cases or rate and another factor (e.g., the number of nursing homes, neighborhood racial composition, elderly population, etc.).
#make sure there are no NA values
covid_cases <- covid_cases %>%
filter(!is.na(COVID_CASE_COUNT), !is.na(blackPop))
#making intervals for covid cases and race
require(classInt)
## Loading required package: classInt
break_cases_qt <- classIntervals(c(min(covid_cases$COVID_CASE_COUNT) - 1, covid_cases$COVID_CASE_COUNT),
n = 5,
style = "quantile")
breaks_race_qt <- classIntervals(c(min(covid_cases$blackPop) - 1, covid_cases$blackPop), n= 5, style = "quantile")
covid_cases <- mutate(popData_nyc_to_zip, covid_case = cut(COVID_CASE_COUNT, break_cases_qt$brks,dig.lab = 4, digits =1))
covid_cases <- mutate(covid_cases, blackpop_covid_count = cut(blackPop, breaks_race_qt$brks, dig.lab = 4, digits =1))
require(ggpubr)
#plot maps for both covid cases and black population and combine
covid_map <- ggplot(covid_cases) +
geom_sf(aes(fill = covid_case)) +
scale_fill_brewer(palette = "RdPu", name = 'Covid Cases Interval') +
labs(x ="Longitude", y = "Latitude", title = "Covid Cases") +
guides(fill = guide_legend(nrow = 3))+
theme(
legend.title.position = "top",
legend.position = 'bottom') +
ggspatial::annotation_north_arrow(location = "tl", style = ggspatial::north_arrow_fancy_orienteering())
#added arrows + compass
black_pop_map <- ggplot(covid_cases) +
geom_sf(aes(fill = blackpop_covid_count)) +
scale_fill_brewer(palette = "OrRd", name = 'Population Interval') +
labs(x ="Longitude", y = "Latitude", title = "Black Population") +
guides(fill = guide_legend(nrow = 3))+
theme(
legend.title.position = "top",
legend.position = 'bottom') +
ggspatial::annotation_north_arrow(location = "tl", style = ggspatial::north_arrow_fancy_orienteering())
covid_map + black_pop_map + plot_layout(ncol = 2, nrow = 1)
Create a web-based interactive map for COIVD-19 data using tmap, mapview, or leaflet package and save it as a HTML file.
#colors
pal_fun <- colorQuantile("Blues", NULL, n = 5)
pal_fun2 <- colorQuantile("OrRd", NULL, n = 5)
covid_leaflet <- leaflet(covid_cases) %>%
addPolygons(
stroke = FALSE,
fillColor = ~pal_fun(COVID_CASE_COUNT),
fillOpacity = 0.8, smoothFactor = 0.5,
popup = ~paste("Zipcode: ", ZIPCODE, "<br>CovidCases: ", COVID_CASE_COUNT)
) %>%
addTiles() %>%
addLegend(
position = "bottomright",
pal = pal_fun,
values = ~COVID_CASE_COUNT,
title = "Covid Cases"
)
covid_leaflet
htmlwidgets::saveWidget(covid_leaflet, 'interactive_covid_leaflet.html')
#just trying some things here
al_fun <- colorQuantile("Blues", NULL, n = 5)
pal_fun2 <- colorQuantile("OrRd", NULL, n = 5)
covid_leaflet <- leaflet(covid_cases) %>%
addPolygons(
stroke = FALSE,
fillColor = ~pal_fun(COVID_CASE_COUNT),
fillOpacity = 0.8, smoothFactor = 0.5,
popup = ~paste("Zipcode: ", ZIPCODE, "<br>CovidCases: ", COVID_CASE_COUNT)
) %>%
addPolygons(
stroke = FALSE,
fillColor = ~pal_fun2(blackPop),
fillOpacity = 0.8, smoothFactor = 0.5,
popup = ~paste("Zipcode: ", ZIPCODE, "<br>Black Population: ", blackPop)
) %>%
addLegend(
pal = pal_fun2,
values = ~blackPop,
title = "Black Population",
position = "bottomleft"
) %>%
addTiles() %>%
addLegend(
position = "bottomright",
pal = pal_fun,
values = ~COVID_CASE_COUNT,
title = "Covid Cases"
) %>%
addLayersControl(
overlayGroups = c("Covid Cases", "Black Population"),
options = layersControlOptions(collapsed = FALSE)
)
covid_leaflet