Ohio Conflated Data (Rural Multilane Divided)
library(data.table)
library(dplyr)
library(tidyr)
library(naniar)
library(stringr)
library(ggplot2)
library(DT)
library(lubridate)
library(ggpubr)
mytype = 'RMD'
setwd("/scratch/user/cma16/Task4_Deliverable2/OHprocess4/AllCrash/FacilityBased/")
load("./multi-lane_divided_OH_reduce_withCrash.rData")
setwd(paste0("/scratch/user/cma16/Task4_Deliverable2/OHprocess4/AllCrash/FacilityBased/",mytype))
df_RMD<- OH_mun_med
dim(df_RMD)
## [1] 4005288 48
### Calculating Speed
df_RMD$spd_av = 3600*df_RMD$DISTANCE/df_RMD$Travel_TIME_ALL_VEHICLES
df_RMD$spd_pv = 3600*df_RMD$DISTANCE/df_RMD$Travel_TIME_PASSENGER_VEHICLES
df_RMD$spd_ft = 3600*df_RMD$DISTANCE/df_RMD$Travel_TIME_FREIGHT_TRUCKS
### Remove outliers
df_RMD$spd_av = ifelse(df_RMD$spd_av <120, df_RMD$spd_av, NA)
df_RMD$spd_pv = ifelse(df_RMD$spd_pv <120, df_RMD$spd_pv, NA)
df_RMD$spd_ft = ifelse(df_RMD$spd_ft <120, df_RMD$spd_ft, NA)
### Month, Day
df_RMD$date <- as.character(df_RMD$DATE)
df_RMD$date <- str_pad(df_RMD$DATE, 8, pad = "0")
df_RMD$Month <- substr(df_RMD$date, start = 1, stop = 2)
df_RMD$Day <- substr(df_RMD$date, start = 3, stop = 4)
df_RMD$Year <- substr(df_RMD$date, start = 5, stop = 8)
ConvEpoc2HM <- function(x) {
# for a given epoc number, get its hour:min
y.hr <- x
y.min <- 0
x <- paste(str_pad(y.hr, 2, side = 'left', pad='0'),
str_pad(y.min, 2, side = 'left', pad='0'),
'00', sep = ':')
}
df_RMD$Hour1 <- ConvEpoc2HM(df_RMD$EPOCH1h)
DATE4 <- paste(strptime(df_RMD$date, format = "%m%d%Y", tz =""), df_RMD$Hour1, sep = ' ')
df_RMD$PCT_TIME <- as.POSIXct(DATE4, tz ="", format = "%Y-%m-%d %H:%M:%OS")
df_RMD$Hour <- strftime(df_RMD$PCT_TIME, format="%H")
df_RMD$DOW <- wday(df_RMD$PCT_TIME, label = TRUE)
head(df_RMD,2)
## TimeStamp TMC DATE EPOCH1h Travel_TIME_ALL_VEHICLES
## 1: 108N05217_0101_0 108N05217 1012015 0 NA
## 2: 108N05217_0101_1 108N05217 1012015 1 52
## Travel_TIME_PASSENGER_VEHICLES Travel_TIME_FREIGHT_TRUCKS ADMIN_LEVE
## 1: NA NA USA
## 2: NA 52 USA
## ADMIN_LE_1 ADMIN_LE_2 DISTANCE ROAD_NUMBE ROAD_NAME LATITUDE LONGITUDE
## 1: Ohio Ottawa 0.72476 OH-2 41.50337 -82.83927
## 2: Ohio Ottawa 0.72476 OH-2 41.50337 -82.83927
## ROAD_DIREC ORN_FID COUNTY divided SURF_TYP NHS_CDE HPMS ACCESS AADT_YR
## 1: Eastbound 21383.24 OTT D G N * F 12
## 2: Eastbound 21383.24 OTT D G N * F 12
## FED_FACI PK_LANES MED_TYPE FED_MEDW BEGMP ENDMP SEG_LNG cnty_rte
## 1: 2 NA 2.359726 47.44576 26.36 26.99 0.4302199 OTT0002R
## 2: 2 NA 2.359726 47.44576 26.36 26.99 0.4302199 OTT0002R
## rte_nbr aadt aadt_bc aadt_pt surf_wid no_lanes func_cls rodwycls Total
## 1: 0002R 17640 2340 15300 48 4 2 9 0
## 2: 0002R 17640 2340 15300 48 4 2 9 0
## K A B C O DAYMTH Crash spd_av spd_pv spd_ft date Month Day Year
## 1: 0 0 0 0 0 0101 0 NA NA NA 01012015 01 01 2015
## 2: 0 0 0 0 0 0101 0 50.17569 NA 50.17569 01012015 01 01 2015
## Hour1 PCT_TIME Hour DOW
## 1: 00:00:00 2015-01-01 00:00:00 00 Thu
## 2: 01:00:00 2015-01-01 01:00:00 01 Thu
#####
df1= df_RMD[,c("spd_av", "spd_pv", "spd_ft")]
df2= df_RMD[,c("date","spd_av","spd_pv","spd_ft")]
df3= df_RMD[,c("Month","spd_av","spd_pv","spd_ft")]
df4= df_RMD[,c("Day","spd_av","spd_pv","spd_ft")]
df5= df_RMD[,c("Year","spd_av","spd_pv","spd_ft")]
df6= df_RMD[,c("Hour","spd_av","spd_pv","spd_ft")]
df7= df_RMD[,c("DOW","spd_av","spd_pv","spd_ft")]
Operating Speed
#### Operating Speed by Month
long <- melt(df3, id.vars = c("Month"))
ggviolin(long, "Month", "value", fill = "Month",
add = "boxplot", add.params = list(fill = "white"))+coord_flip()+facet_grid(. ~ "variable")+
geom_hline(yintercept=61, linetype="dashed",
color = "red", size=1)+labs(title="Operating Speed by Month", x="Month",y="Speed (mph)")+ theme(legend.position="none")
#### Operating Speed by Month [All Vehicles]
long <- melt(df3[,c(1,2)], id.vars = c("Month"))
ggviolin(long, "Month", "value", fill = "Month",
add = "boxplot", add.params = list(fill = "white"))+coord_flip()+
geom_hline(yintercept=61, linetype="dashed",
color = "red", size=1)+labs(title="Operating Speed (All vehicles) by Month", x="Month",y="Speed (mph)")+ theme(legend.position="none")
#### Operating Speed by Month [Passenger Cars]
long <- melt(df3[,c(1,3)], id.vars = c("Month"))
ggviolin(long, "Month", "value", fill = "Month",
add = "boxplot", add.params = list(fill = "white"))+coord_flip()+
geom_hline(yintercept=63, linetype="dashed",
color = "red", size=1)+labs(title="Operating Speed (Passenger Cars) by Month", x="Month",y="Speed (mph)")+ theme(legend.position="none")
#### Operating Speed by Month [Fright Trucks]
long <- melt(df3[,c(1,4)], id.vars = c("Month"))
ggviolin(long, "Month", "value", fill = "Month",
add = "boxplot", add.params = list(fill = "white"))+coord_flip()+
geom_hline(yintercept=60, linetype="dashed",
color = "red", size=1)+labs(title="Operating Speed (Freight Trucks) by Month", x="Month",y="Speed (mph)")+ theme(legend.position="none")
#### Operating Speed by DOW
long <- melt(df7, id.vars = c("DOW"))
ggviolin(long, "DOW", "value", fill = "DOW",
add = "boxplot", add.params = list(fill = "white"))+coord_flip()+
geom_hline(yintercept=61, linetype="dashed",
color = "red", size=1)+labs(title="Operating Speed by Day of Week", x="Day of Week",y="Speed (mph)")+ theme(legend.position="none")
#### Operating Speed by Hour
long <- melt(df6, id.vars = c("Hour"))
long$Hour <- as.factor(long$Hour)
ggviolin(long, "Hour", "value", fill = "Hour",
add = "boxplot", add.params = list(fill = "white"))+coord_flip()+
geom_hline(yintercept=61, linetype="dashed",
color = "red", size=1)+labs(title="Operating Speed by Hour", x="Hour",y="Speed (mph)")+ theme(legend.position="none")
## Warning: Removed 2405567 rows containing non-finite values (stat_ydensity).
## Warning: Removed 2405567 rows containing non-finite values (stat_boxplot).
#### Operating Speed by Hour
long <- melt(df6, id.vars = c("Hour"))
long$Hour <- as.factor(long$Hour)
ggviolin(long, "Hour", "value", fill = "Hour",
add = "boxplot", add.params = list(fill = "white"))+coord_flip()+
geom_hline(yintercept=61, linetype="dashed",
color = "red", size=1)+labs(title="Operating Speed by Hour", x="Hour",y="Speed (mph)")+ theme(legend.position="none")
## Warning: Removed 2405567 rows containing non-finite values (stat_ydensity).
## Warning: Removed 2405567 rows containing non-finite values (stat_boxplot).
Missing Value Plots
# vis_miss(df1, warn_large_data=F)
theme_set(theme_bw(base_size = 18))
gg_miss_var(df3, facet = Month, show_pct = TRUE)
gg_miss_var(df4, facet = Day, show_pct = TRUE)
gg_miss_var(df5, facet = Year, show_pct = TRUE)
gg_miss_var(df6, facet = Hour, show_pct = TRUE)
gg_miss_var(df7, facet = DOW, show_pct = TRUE)
gg_miss_var(df2, facet = date, show_pct = TRUE)
Missing Value Tables
### Missingness by Date
df2a <- df2 %>%
group_by(date) %>%
miss_var_summary()
datatable(
df2a, extensions = 'Buttons', options = list(
dom = 'Bfrtip',
buttons = c('csv', 'excel', 'print')
)
)
### Missingness by Hour
df6a <- df6 %>%
group_by(Hour) %>%
miss_var_summary()
datatable(
df6a, extensions = 'Buttons', options = list(
dom = 'Bfrtip',
buttons = c('csv', 'excel', 'print')
)
)
### Missingness by Month
df3a <- df3 %>%
group_by(Month) %>%
miss_var_summary()
datatable(
df3a, extensions = 'Buttons', options = list(
dom = 'Bfrtip',
buttons = c('csv', 'excel', 'print')
)
)
### Missingness by DOW
df7a <- df7 %>%
group_by(DOW) %>%
miss_var_summary()
datatable(
df7a, extensions = 'Buttons', options = list(
dom = 'Bfrtip',
buttons = c('csv', 'excel', 'print')
)
)
### Missingness by Day
df4a <- df4 %>%
group_by(Day) %>%
miss_var_summary()
datatable(
df4a, extensions = 'Buttons', options = list(
dom = 'Bfrtip',
buttons = c('csv', 'excel', 'print')
)
)
### Missingness by Year
df5a <- df5 %>%
group_by(Year) %>%
miss_var_summary()
datatable(
df5a, extensions = 'Buttons', options = list(
dom = 'Bfrtip',
buttons = c('csv', 'excel', 'print')
)
)
### TMC Level
tmc1 <- df_RMD[,c("TMC")] %>%
group_by(TMC) %>%
summarize(Count=n())
datatable(
tmc1, extensions = 'Buttons', options = list(
dom = 'Bfrtip',
buttons = c('csv', 'excel', 'print')
)
)