---
title: "Final Project"
output:
flexdashboard::flex_dashboard:
theme: spacelab
source: embed
smart: false
runtime: shiny
---
```{r include = FALSE}
# LOAD PACKAGES
library(DT)
library(ggmap)
library(shiny)
library(knitr)
library(pander)
library(leaflet)
library(viridis)
library(rsconnect)
library(tidyverse)
library(flexdashboard)
# READ IN DATA
url <- paste0("https://github.com/DS4PS/Data-",
"Science-Class/blob/master/DATA",
"/TempeTrafficAccidents.rds?raw=true")
dat <- readRDS(gzcon(url(url)))
# DATA PREPROCESSING I: INJURIES & FATALITIES
dat <- na.omit(dat) # Remove NAs
dat$fatal <- dat$Totalfatalities > 0 # 1+ fatalities
dat$inj <- dat$Totalinjuries > 0 & dat$Totalfatalities == 0 # 1+ injury, 0 fatal
dat$nohurt <- dat$Totalfatalities + dat$Totalinjuries == 0 # Harmless
date.vec <- strptime(dat$DateTime, format = "%m/%d/%y %H:%M") # Datetime variables
dat$hour <- format(date.vec, format = "%H") %>% as.numeric()
dat$month <- format(date.vec, format = "%b")
dat$day <- format(date.vec, format = "%a")
dat$day365 <- format(date.vec, format = "%j")
dat$week <- format(date.vec, format = "%V")
# DATA PREPROCESSING II: NAMED INTERVALS OF TIME
dat <- dat %>%
mutate(time.of.day = case_when(hour >= 6 & hour <= 9 ~ "Morning Commute",
hour >= 16 & hour <= 19 ~ "Evening Commute",
hour >= 14 & hour <= 15 ~ "School Pickup",
hour >= 9 & hour <= 13 ~ "Work",
hour >= 20 & hour <= 23 ~ "Night",
hour <= 5 & hour >= 0 ~ "Midnight to Dawn"))
dat$harm <- ifelse( dat$Totalinjuries > 0 | dat$Totalfatalities > 0, "Harm", "No Harm" )
# DATA PREPROCESSING III: PERMUTATIONS OF INEBRIATION
dat <- dat %>%
mutate(d1.substance = case_when(AlcoholUse_Drv1 == "Alcohol" &
DrugUse_Drv1 == "No Apparent Influence" ~ "Alcohol",
AlcoholUse_Drv1 == "No Apparent Influence" &
DrugUse_Drv1 == "Drugs" ~ "Drugs",
AlcoholUse_Drv1 == "Alcohol" &
DrugUse_Drv1 == "Drugs" ~ "Alcohol and Drugs",
AlcoholUse_Drv1 == "No Apparent Influence" &
DrugUse_Drv1 == "No Apparent Influence" ~ "No Apparent
Influence"))
dat <- dat %>%
mutate( d2.substance = case_when(AlcoholUse_Drv2 == "Alcohol" &
DrugUse_Drv2 == "No Apparent Influence" ~ "Alcohol",
AlcoholUse_Drv2 == "No Apparent Influence" &
DrugUse_Drv2 == "Drugs" ~ "Drugs",
AlcoholUse_Drv2 == "Alcohol" &
DrugUse_Drv2 == "Drugs" ~ "Alcohol and Drugs",
AlcoholUse_Drv2 == "No Apparent Influence" &
DrugUse_Drv2 == "No Apparent Influence" ~ "No Apparent
Influence"))
# DATA PREPROCESSING IV: AGE CATEGORIES
dat$age.cat <- case_when(dat$Age_Drv1 >= 0 &
dat$Age_Drv1 <= 18 ~ "Youth",
dat$Age_Drv1 >= 19 &
dat$Age_Drv1 <= 25 ~ "Young Adult",
dat$Age_Drv1 >= 26 &
dat$Age_Drv1 <= 64 ~ "Adult",
dat$Age_Drv1 >= 65 ~ "Senior")
```
Traffic Accidents By Day and Time
=====================================
Inputs {.sidebar}
-------------------------------------
```{r}
checkboxGroupInput("days", label = h3("Day of Week"),
choices = list("Monday" = "Mon",
"Tuesday" = "Tue",
"Wednesday" = "Wed",
"Thursday" = "Thu",
"Friday" = "Fri",
"Saturday" = "Sat",
"Sunday" = "Sun" ),
selected = c("Fri","Sat","Sun"))
sliderInput("hour", label = h3("Time of Day"),
min = 0, max = 23, value = c(6, 12))
# parameters
```
Outputs
-------------------------------------
### Traffic Accidents By Day and Time
```{r}
# LEAFLET MAPPING
renderLeaflet({
days.of.week <- input$days # Vector of checked days
start.time <- input$hour[1] # Slider input of lower time range
end.time <- input$hour[2] # Slider input of upper time range
d2 <- dat %>%
filter(day %in% input$days,
hour >= start.time & hour <= end.time)
d2$col.vec <- ifelse( d2$nohurt, "gray20",
ifelse(d2$inj, "steelblue", "darkorange") )
point.size <- d2$Totalinjuries + d2$Totalfatalities
crash.details <- paste0("Time: ", d2$DateTime, "
",
"Total Fatalities: ", d2$Totalfatalities, "
",
"Total Injuries: ", d2$Totalinjuries, "
",
"Collision type: ", d2$Collisionmanner)
tempe <- leaflet( ) %>%
addProviderTiles("CartoDB.Positron") %>%
setView(lng = -111.9278,
lat = 33.39951,
zoom = 13)
addCircles(tempe,
lng = d2$Longitude,
lat = d2$Latitude,
fillColor = d2$col.vec,
fillOpacity = 0.5,
stroke = FALSE,
radius = 50*(1+0.33*point.size),
popup = crash.details)
})
```
Driver Characteristics {data-orientation=rows}
=====================================
Sidebar {.sidebar}
-------------------------------------
Driver Characteristics
```{r}
sliderInput(inputId = "d1age",
label = h4("Driver 1 Age"),
min = 15,
max = 100,
value = c(18,36) )
sliderInput(inputId = "d2age",
label = h4("Driver 2 Age"),
min = 15,
max = 100,
value = c(18,36) )
selectInput(inputId = "d1gender",
label = h4("Driver 1 Gender"),
choices = c("Male","Female", "Unknown"),
selected = c("Male"))
selectInput(inputId = "d2gender",
label = h4("Driver 2 Gender"),
choices = c("Male","Female", "Unknown"),
selected = c("Male"))
radioButtons(inputId = "d1pedcy",
label = h4("Driver 1 Transportation"),
choices = c("Driver", "Pedalcyclist", "Pedestrian"),
selected = c("Driver"))
radioButtons(inputId = "d2pedcy",
label = h4("Driver 2 Transportation"),
choices = c("Driver", "Pedalcyclist", "Pedestrian"),
selected = c("Driver"))
```
Row
-------------------------------------
### Number of Crashes
```{r}
renderValueBox({
d2 <- dat %>%
filter(Age_Drv1 >= input$d1age[1] & Age_Drv1 <= input$d1age[2],
Age_Drv2 >= input$d2age[1] & Age_Drv2 <= input$d2age[2],
Gender_Drv1 %in% input$d1gender,
Gender_Drv2 %in% input$d2gender,
Unittype_One %in% input$d1pedcy,
Unittype_Two %in% input$d2pedcy )
crashes <- count( d2 )
valueBox(crashes,
icon = "fa-pencil",
color = ifelse( crashes > 50, "danger", "primary") )
})
```
### Total Injuries
```{r}
renderValueBox({
d2 <- dat %>%
filter(Age_Drv1 >= input$d1age[1] & Age_Drv1 <= input$d1age[2],
Age_Drv2 >= input$d2age[1] & Age_Drv2 <= input$d2age[2],
Gender_Drv1 %in% input$d1gender,
Gender_Drv2 %in% input$d2gender,
Unittype_One %in% input$d1pedcy,
Unittype_Two %in% input$d2pedcy)
total.injuries <- sum(d2$Totalinjuries)
valueBox(total.injuries,
icon = "fa-angry",
color = ifelse(total.injuries > 30, "danger", "primary" ))
})
```
### Total Fatalities
```{r}
renderValueBox({
d2 <- dat %>%
filter(Age_Drv1 >= input$d1age[1] & Age_Drv1 <= input$d1age[2],
Age_Drv2 >= input$d2age[1] & Age_Drv2 <= input$d2age[2],
Gender_Drv1 %in% input$d1gender,
Gender_Drv2 %in% input$d2gender,
Unittype_One %in% input$d1pedcy,
Unittype_Two %in% input$d2pedcy)
total.fatalities <- sum(d2$Totalfatalities)
valueBox(total.fatalities,
icon = "fa-briefcase-medical",
color = ifelse(total.fatalities > 10, "danger", "primary"))
})
```
### Rate of Harm
```{r}
renderValueBox({
d2 <- dat %>%
filter(Age_Drv1 >= input$d1age[1] & Age_Drv1 <= input$d1age[2],
Age_Drv2 >= input$d2age[1] & Age_Drv2 <= input$d2age[2],
Gender_Drv1 %in% input$d1gender,
Gender_Drv2 %in% input$d2gender,
Unittype_One %in% input$d1pedcy,
Unittype_Two %in% input$d2pedcy)
rate.of.harm <- round(length(which(d2$harm == "Harm"))/count(d2), 3)
valueBox(rate.of.harm,
icon = "fa-pencil",
color = ifelse(rate.of.harm > 0.5, "danger", "primary"))
})
```
Outputs
-------------------------------------
### Traffic Accidents by Driver Characteristics
```{r}
renderLeaflet({
# days.of.week <- input$days # vector will all checked values
# start.time <- input$hour[1] # sliderInput lower value
# end.time <- input$hour[2]
d2 <- dat %>%
filter(Age_Drv1 >= input$d1age[1] & Age_Drv1 <= input$d1age[2],
Age_Drv2 >= input$d2age[1] & Age_Drv2 <= input$d2age[2],
Gender_Drv1 %in% input$d1gender,
Gender_Drv2 %in% input$d2gender,
Unittype_One %in% input$d1pedcy,
Unittype_Two %in% input$d2pedcy)
d2$col.vec <- ifelse(d2$nohurt, "gray20",
ifelse(d2$inj, "steelblue", "darkorange") )
point.size <- d2$Totalinjuries + d2$Totalfatalities
crash.details <- paste0("Time: ", d2$DateTime, "
",
"Total Fatalities: ", d2$Totalfatalities, "
",
"Total Injuries: ", d2$Totalinjuries, "
",
"Collision type: ", d2$Collisionmanner)
tempe <- leaflet() %>%
addProviderTiles( "CartoDB.Positron" ) %>%
setView( lng=-111.9278, lat=33.39951, zoom=13 )
addCircles(tempe, lng=d2$Longitude, lat=d2$Latitude,
fillColor=d2$col.vec, fillOpacity=0.5,
stroke=F, radius=50*(1+0.33*point.size),
popup=crash.details )
})
```
About
=====================================
Row
-------------------------------------
### About this Dashboard
### Dashboard Author
Row
-------------------------------------
DATA DICTIONARY
```{r}
url.dd <- paste0("https://raw.githubusercontent.com",
"/DS4PS/cpp-526-fall-2019/master/l",
"abs/final-project/TempeTrafficAcc",
"identsDataDictionary.csv")
data.dictionary <- read.csv(url.dd,
stringsAsFactors = FALSE)
data.dictionary$description <- stringi::stri_trans_general(data.dictionary$description,
"latin-ascii")
data.dictionary %>%
select(column, description) %>%
pander()
```
Data
=====================================
```{r}
# library( DT )
these.buttons <- c('copy', 'csv', 'pdf', 'print')
renderDataTable({
datatable(dat[1:100, ],
filter = 'bottom',
rownames = FALSE,
#options=list( pageLength=5, autoWidth=TRUE ),
fillContainer = TRUE,
style = "bootstrap",
class = 'table-condensed table-striped',
extensions = 'Buttons',
options = list(dom = 'Bfrtip',
buttons=these.buttons))
})
```