Interactive PA Accident DataData reflects reported Pennsylvania crashes in 2016 from the open data PA website. Select a tab and choose options in the left panel to explore the data. |
# Load libraries
library(shiny)
library(leaflet)
library(leaflet.extras)
library(plotly)
library(readr)
library(ggplot2)
library(dplyr)
# Wrangle data
crash_2016 <- read_csv("crashes_2016.csv") %>%
select(`County Name`,
`Longitude (Decimal)`,
`Latitude (Decimal)`,
`Collision Type`,
`Hour of Day`,
`Crash Month`,
`Intersection Type`,
`Fatal`) %>%
rename(county_name = `County Name`,
longitude = `Longitude (Decimal)`,
latitude = `Latitude (Decimal)`,
col_type = `Collision Type`,
hour = `Hour of Day`,
month = `Crash Month`,
int_type = `Intersection Type`,
fatal = `Fatal`) %>%
filter(!is.na(longitude), !is.na(latitude),
hour != 99) %>%
mutate(time_period = as.factor(as.numeric(hour) %/% 6)) %>%
mutate(time_period = case_when(time_period == 0 ~ "Early Morning",
time_period == 1 ~ "Morning",
time_period == 2 ~ "Afternoon",
time_period == 3 ~ "Evening")) %>%
mutate(season = as.factor((as.numeric(month) %% 12) %/% 3)) %>%
mutate(season = case_when(season == 0 ~ "Winter",
season == 1 ~ "Spring",
season == 2 ~ "Summer",
season == 3 ~ "Fall"))
### Server ###
server<-function(input,output){
# Create interactive map
output$map <- renderLeaflet({
req(input$type)
crash_react <- crash_2016 %>%
filter(int_type %in% input$type)
# Create color palette
factpal <- colorFactor(c("#a6cee3", "#1f78b4", "#b2df8a", "#33a02c",
"#fb9a99", "#e31a1c", "#fdbf6f", "#ff7f00",
"#cab2d6", "#6a3d9a", "#333333"),
crash_2016$int_type)
# Define base leaflet map
p <- leaflet(crash_react, options = leafletOptions(minZoom = 7)) %>%
addProviderTiles(providers$OpenStreetMap.BlackAndWhite, group = "BW")
# Plot data based on input
if(input$disp_shape == "Points") {
# scatterplot
p %>%
addCircles(lng = ~longitude, lat = ~latitude,
color = ~factpal(int_type), opacity = 0.8) %>%
addLegend("topright", pal = factpal, values = ~int_type,
title = "Intersection Types",
opacity = 1)
} else {
# heatmap
p %>% addHeatmap(lng = ~longitude, lat = ~latitude, radius = 7)
}
})
output$nomap <- renderUI({
req(!isTruthy(input$type))
HTML(paste('<br><em><span style="color:grey">',
'Please select at least one intersection type.',
'</span></em></div>'))
})
# Create density plot
output$density <- renderPlot({
req(input$season)
crash_react2 <- crash_2016 %>%
filter(season %in% input$season)
if(input$fatal == "Fatal"){
crash_react2 <- crash_react2 %>%
filter(fatal == "Yes")
} else if (input$fatal == "Non-fatal"){
crash_react2 <- crash_react2 %>%
filter(fatal == "No")
}
# Create color palette
pal <- setNames(rainbow(4, 0.6, 0.9), sort(unique(crash_2016$season)))
ggplot(
data = crash_react2,
mapping = aes(
x = as.numeric(hour),
col = season,
fill = season)) +
geom_density(alpha = 0.1) +
labs(x = "Hour of Day", y = "Density", col = "Season", fill = "Season") +
theme_light() +
scale_color_manual(values = pal) +
scale_fill_manual(values = pal)
})
output$nodensity <- renderUI({
req(!isTruthy(input$season))
HTML(paste('<br><em><span style="color:grey">',
'Please select at least one season.',
'</span></em></div>'))
})
}
### UI ###
ui<-fluidPage(
# Intro Text
titlePanel("Interactive PA Accident Data"),
p("Data reflects reported Pennsylvania crashes in 2016 from the",
a(href = "https://data.pa.gov/Public-Safety/Crash-Data-1997-to-Current-Transportation/dc5b-gebx", "open data PA"),
"website."),
p(em("Select a tab and choose options in the left panel to explore the data.")),
tabsetPanel(
# Density plot tab
tabPanel(
"By Season",
br(),
sidebarLayout(
sidebarPanel(
# season select
checkboxGroupInput(inputId = "season",
label = h4("Select season(s):"),
choices = sort(unique(crash_2016$season)),
selected = sort(unique(crash_2016$season))),
# fatal/non-fatal select
radioButtons(inputId = "fatal",
label = h4("Select the severity:"),
choices = c("Fatal", "Non-fatal", "Both"))
),
mainPanel(
uiOutput("nodensity"),
plotOutput("density")
)
)
),
# Map tab
tabPanel(
"By Location",
br(),
sidebarLayout(
sidebarPanel(
# points vs density select
selectInput(inputId = "disp_shape",
label = h4("How do you want the data displayed?"),
choices = list("Points", "Density"),
selected = "Points"),
# crash type select
checkboxGroupInput(inputId = "type",
label = h4("Select intersection type(s):"),
choices = sort(unique(crash_2016$int_type)),
selected = sort(unique(crash_2016$int_type))[11])
),
mainPanel(
uiOutput("nomap"),
leafletOutput("map")
)
)
)
)
)
shinyApp(ui=ui, server=server)