---
title: "DATA CRASHBOARD"
output:
flexdashboard::flex_dashboard:
source: embed
smart: false
runtime: shiny
---
```{r global, include=FALSE}
library( flexdashboard )
library( tidyverse )
library( ggmap )
library( leaflet )
library( viridis )
library( shiny )
library( DT )
library( pander )
library( knitr )
library( rsconnect )
URL <- "https://github.com/DS4PS/Data-Science-Class/blob/master/DATA/TempeTrafficAccidents.rds?raw=true"
dat <- readRDS(gzcon(url( URL )))
dat <- na.omit(dat) # omit any rows with NAs
dat$fatal <- dat$Totalfatalities > 0
dat$inj <- dat$Totalinjuries > 0 & dat$Totalfatalities == 0
dat$nohurt <- dat$Totalfatalities + dat$Totalinjuries == 0
date.vec <- strptime( dat$DateTime, format="%m/%d/%y %H:%M" )
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" )
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" )
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"))
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
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( 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=F, radius=50*(1+0.33*point.size),
popup=crash.details )
})
```
Driver Characteristics {data-orientation=rows}
=====================================
Sidebar {.sidebar}
-------------------------------------
Driver Characteristics
```{r}
sliderInput("d1age", label = h4("Driver 1 Age"),
min = 15, max = 100, value = c(18,36) )
sliderInput("d2age", label = h4("Driver 2 Age"),
min = 15, max = 100, value = c(18,36) )
selectInput("d1gender", label = h4("Driver 1 Gender"),
choices = c("Male","Female", "Unknown"), selected = c("Male"))
selectInput("d2gender", label = h4("Driver 2 Gender"),
choices = c("Male","Female", "Unknown"), selected = c("Male"))
radioButtons("d1pedcy", label = h4("Driver 1 Transportation"),
choices = c("Driver", "Pedalcyclist", "Pedestrian"), selected = c("Driver"))
radioButtons("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 )
})
```
Drivers 2 {data-orientation=rows}
=====================================
Sidebar {.sidebar}
-------------------------------------
Driver Characteristics
```{r}
sliderInput("driver.1.age", label = h4("Driver 1 Age"),
min = 15, max = 100, value = c(18,36) )
sliderInput("driver.2.age", label = h4("Driver 2 Age"),
min = 15, max = 100, value = c(18,36) )
selectInput("driver.1.gender", label = h4("Driver 1 Gender"),
choices = c("Male","Female", "Unknown"), selected = c("Male"))
selectInput("driver.2.gender", label = h4("Driver 2 Gender"),
choices = c("Male","Female", "Unknown"), selected = c("Male"))
radioButtons("driver.1.pedcy", label = h4("Driver 1 Transportation"),
choices = c("Driver", "Pedalcyclist", "Pedestrian"), selected = c("Driver"))
radioButtons("driver.2.pedcy", 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"))
})
```
Column
-------------------------------------
### Driver 1
```{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]
d10 <-
dat %>%
filter( Age_Drv1 >= input$driver.1.age[1] & Age_Drv1 <= input$driver.1.age[2],
Gender_Drv1 %in% input$driver.1.gender,
Unittype_One %in% input$driver.1.pedcy )
d10$col.vec <- ifelse( d10$nohurt, "gray20", ifelse(d10$inj, "steelblue", "darkorange") )
point.size <- d10$Totalinjuries + d10$Totalfatalities
crash.details <- paste0( "Time: ", d10$DateTime, "
",
"Total Fatalities: ", d10$Totalfatalities, "
",
"Total Injuries: ", d10$Totalinjuries, "
",
"Collision type: ", d10$Collisionmanner)
tempe <- leaflet( ) %>%
addProviderTiles( "CartoDB.Positron" ) %>%
setView( lng=-111.9278, lat=33.39951, zoom=13 )
addCircles( tempe, lng=d10$Longitude, lat=d10$Latitude,
fillColor=d10$col.vec, fillOpacity=0.5,
stroke=F, radius=50*(1+0.33*point.size),
popup=crash.details )
})
```
### Driver 2
```{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]
d11 <-
dat %>%
filter( Age_Drv2 >= input$driver.2.age[1] & Age_Drv2 <= input$driver.2.age[2],
Gender_Drv2 %in% input$driver.2.gender,
Unittype_Two %in% input$driver.2.pedcy )
d11$col.vec <- ifelse( d11$nohurt, "gray20", ifelse(d11$inj, "steelblue", "darkorange") )
point.size2 <- d11$Totalinjuries + d11$Totalfatalities
crash.details2 <- paste0( "Time: ", d11$DateTime, "
",
"Total Fatalities: ", d11$Totalfatalities, "
",
"Total Injuries: ", d11$Totalinjuries, "
",
"Collision type: ", d11$Collisionmanner)
tempe2 <- leaflet( ) %>%
addProviderTiles( "CartoDB.Positron" ) %>%
setView( lng=-111.9278, lat=33.39951, zoom=13 )
addCircles( tempe2, lng=d11$Longitude, lat=d11$Latitude,
fillColor=d11$col.vec, fillOpacity=0.5,
stroke=F, radius=50*(1+0.33*point.size2),
popup=crash.details2 )
})
```
About
=====================================
Row
-------------------------------------
### About this Dashboard
### Dashboard Author
Row
-------------------------------------
DATA DICTIONARY
```{r}
URL.dd <- "https://raw.githubusercontent.com/DS4PS/cpp-526-fall-2019/master/labs/final-project/TempeTrafficAccidentsDataDictionary.csv"
data.dictionary <- read.csv( URL.dd, stringsAsFactors=F )
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 ) )
})
```