Week 4 - Using Spatial Data in R

This week’s project looked at using R to analyze, clean, and create maps using spatial data.

Part A, Question 1

For this part of the project we used tornado data for Oklahoma and R to visualize the data in various ways. For question 1 the tornado point and path data were filtered to only show data for 2016 - 2021. These data were then displayed on top of a shapefile of Oklahoma to visualize the study area in relationship to the tornado data.

#Importing packages 
library(sf)           
library(ggplot2)      
library(dplyr)        
library(tidyr)        
library(scales)       
library(RColorBrewer) 
library(tidyverse)
library(units)
library(cowplot)
library(leaflet)
library(shiny)
library(leafsync)

#Importing data
okcounty <- st_read("C:\\PSU\\Geog588\\Week4\\Chapter5\\Chapter5\\ok_counties.shp", 
                    quiet=TRUE)
tpoint <- st_read("C:\\PSU\\Geog588\\Week4\\Chapter5\\Chapter5\\ok_tornado_point.shp",
                  quiet=TRUE)
tpath <- st_read("C:\\PSU\\Geog588\\Week4\\Chapter5\\Chapter5\\ok_tornado_path.shp",
                 quiet=TRUE)

#Filtering Data
tpoint_16_21 <- tpoint %>%
  filter(yr >= 2016 & yr <= 2021) %>%
  select(om, yr, date)
tpath_16_21 <- tpath %>%
  filter(yr >= 2016 & yr <= 2021) %>%
  select(om, yr, date)

#Map 1 with Tornado Paths ----
pal <- colorNumeric(palette = "inferno", 
                    domain = tpath_16_21$yr)
binPal <- colorBin('inferno', tpath_16_21$yr)

leaflet() %>%
  addProviderTiles(providers$CartoDB) %>%
  addPolygons(data = okcounty, color = 'black', weight = 0.8, fillOpacity = 0) %>%
  addPolylines(data = tpath_16_21, color = ~binPal(yr), group = "year") %>%
  addCircleMarkers(data = tpoint_16_21, label=~date, stroke = FALSE,
                   radius = 2,
                   color='black',
                   fillOpacity = .5) %>%
  addLegend(pal=binPal, values = tpath_16_21$yr, 'bottomright',
            title = "Year")

Part A, Question 2

Question 2 is a continuation of question 1 but looked at the relationship between tornados and counties on a year by year basis. The following facet wrapped plots show the counties and their tonado density as a factor of each county’s area by year.

Part A, Question 3

This series of maps looks at the aggregated tornado data by county in Oklahoma. However, the difference between each map is the classification of the symbology used to highlight the tornados. The maps use a quantile classification for the sumbology but each map uses a different number of classes ranging from 3 - 6.

#TBD once GDAL and PROJ work

Part B, Question 1

This leaflet based map shows the 2045 estimated population of Washington, DC compared to the public ally available bike racks in the city. The polygons are census tracts and the darker red the tract is, the greater predicted population increase that tract is estimating to increase by. On top of this data are the bike racks. The comparison shows some unique characteristics between the clusterings of bike stands and perdicted population growth.

#Installing packages ----
library(leaflet)
library(sf)
library(tidyverse)
library(USAboundaries)
library(here)

#Reading in the DC population and employment forcast GeoJSON
DC_Data <- sf::read_sf('https://maps2.dcgis.dc.gov/dcgis/rest/services/DCGIS_DATA/MoveDC/MapServer/10/query?outFields=*&where=1%3D1&f=geojson')
bikes <- sf::read_sf('https://maps2.dcgis.dc.gov/dcgis/rest/services/DCGIS_DATA/Transportation_Bikes_Trails_WebMercator/MapServer/168/query?outFields=*&where=1%3D1&f=geojson')

#Mapping the data
#Mapping 2045 estimated population density increases
#Filter Bikes to not include ANC 3G
bikes <- bikes %>%
  filter((ANC_ID != '3G') %>%
  replace_na(T))

#Creating bike icons
icons = awesomeIcons(icon = 'bicycle', markerColor = "lightblue", library = 'fa')

#Mapping Data
DC_Data %>%
  filter(PCTCHANGE > 0.0) %>%
  leaflet() %>%
  addProviderTiles(providers$CartoDB) %>%
  addPolygons(stroke = FALSE, smoothFactor = 0.3, fillOpacity = 0.8,
              fillColor = ~colorQuantile('Reds', PCTCHANGE)(PCTCHANGE),
              label = ~paste0("Percentage Change: ", PCTCHANGE, "%")) %>%
  addAwesomeMarkers(data = bikes, icon = icons, popup = ~ANC_ID, clusterOptions = markerClusterOptions()) %>%
  addLegend("bottomright", 
            colors = c("#a50f15",  "#de2d26", "#fb6a4a", "#fcae91", "#fee5d9"),
            labels = c("More", "", "", "", "Less"),
            title = "2045 PopDen Increase",
            opacity = 0.75)