Interactive PA Accident Data

Data 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.



Interactive PA Accidents Data
by Tom Fitch and Rachel Diamond

show with app
# 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)