This project uses the dataset called, “US Accidents (3.5 million records) A Countrywide Traffic Accident Dataset (2016 - 2020),” to analyze particular factors that contribute to accidents that cause most interference in traffic. The dataset contain all sorts of information about each accident. There are a total of 2974335 observations with 49 variables for each observation in this dataset. Some of the variables are categorical. They mention if something was present at the time of the accident or where exactly the accident occurred and the time of day. Other variables are quantititive. They mention how much of something was present during the accident, such as precipitation. This study uses the ordinal variable, Severity, as a response variable. Severity assigns a value from 1 to 4 to decribe how much impact the accident had on traffic with 4 being the most amount of interference and 1 being least amount of interference. This study is intended to use the other variables in this dataset to determine which of these variables contributes to some more traffic impacting accidents.

load packages

This code chunk loads each R package used in this project

library(plyr)
library(maps)
library(lubridate)
#library(tidyverse)
library(caret)

Imports data

This code chunk simply imports the US Accidents data into R.

#accidents = read.csv("C:/Users/Max Billante/Documents/Machine Learning/US_Accidents_Dec19.csv")
accidents = read.csv("C:/Users/Max Billante/Documents/Machine Learning/us accidents small.csv")

Make a frequency table for severity

This code chunk makes a bar plot of the variable severity for visualization purposes. From the table it is seen that the majority of the accidents has a severity factor of 2 or 3. 2 is most common. 3 is second most common. 4 is rare. 1 hardly ever is reported.

accidents$Severity <- as.integer(accidents$Severity)
#count_severity <- count(accidents$Severity)
count_severity <- c(sum(accidents$Severity==1), sum(accidents$Severity==2), sum(accidents$Severity==3), sum(accidents$Severity==4))
#rf <- count_severity$freq/sum(count_severity$freq)
rf <- count_severity/sum(count_severity)
#barplot(rf, names.arg = count_severity$x, main = "Relative Frequencies of Severity")
barplot(rf, names.arg = 1:4, main = "Relative Frequencies of Severity")

map latitude and longitude on USA

This chunk of code creates a map with two variable from the data set, Start_Lng and Start_Lat. We see that more accidents occur closer to the east and west borders of the United States than in the middle.

map("usa", fill = TRUE, col = "white", bg = "lightblue")
points(accidents$Start_Lng, accidents$Start_Lat, pch = 20, cex  = 0.01, col = "red")

### make histograms of latitude and longitude count_lat <- count(accidents\(Start_Lat) rf_lat <- count_lat\)freq/sum(count_lat\(freq) count_long <- count(accidents\)Start_Lng) rf_long <- count_long\(freq/sum(count_long\)freq) barplot(rf_lat, names.arg = count_lat\(x, main = "Table of latitude") barplot(rf_long, names.arg = count_long\)x, main = “Table of longitude”)

display time of accident

This code chunk calculates the time it took to clear the roadway of the accidents in hours, with the variables Start_Time and End_Time and displays a histogram of the times. We can see from histogram that the general trend of times it took to clear the accidents is right skewed with an unexpected peak around 6 hours and an outlier of 34.24 hours in North Bend, Oregon. This can be seem in the accompanying data frame. This outlier does not throw off the general trend of the distribution. It is a collective outlier.

interval <- interval(strptime(accidents$Start_Time, "%Y-%m-%d %H:%M:%S"), strptime(accidents$End_Time, "%Y-%m-%d %H:%M:%S"))
accidents$time_in_hours <- time_length(interval, unit = "hour")
#accidents$time_in_hours <- as.factor(accidents$time_in_hours)
#summary(accidents$time_in_hours)
hist(accidents$time_in_hours, breaks=seq(0,35,0.5), xlab = "Time in Hours")

time_in_hours_outliears <- accidents[ which(accidents$time_in_hours > 10), ]
time_in_hours_outliears[c(5,51,17,19)]
##      Severity time_in_hours            City State
## 22          2      34.23639      North Bend    OR
## 1410        2      11.58139 Point Mugu Nawc    CA
## 2209        4      19.05972      Blue River    OR

analyze distances

This code chunk makes a histogram of the Distance.mi variable, which is the reported distance in miles, of road affected by the accident. We see from the histogram that the distribution of distances is right skewed with most reported distances being 0 miles. This is probably misleading though since most car accidents do not even affect more than a mile of the road, but only a few feet. There is one collective outlier of 62.360 miles. This accident occurred in Spring Creek, Nevada. This can be seen in the accompanying data frame. We also see in the scatterplot that this accidents has a severity factor of 2, opposite of what would be expected. It is possible however, that an accident affecting this amount of road space would be highly regulated by police that it would be reported with a lower amount of severity in terms of traffic interference.

#accidents$Distance.mi. <- as.factor(accidents$Distance.mi.)
hist(accidents$Distance.mi., breaks=seq(0,63,0.5), xlab = "Distance.mi")

distance_outliers <- accidents[ which(accidents$Distance.mi. > 10), ]
distance_outliers[c(5,12,17,19)]
##      Severity Distance.mi.         City State
## 561         3       19.710    Paragonah    UT
## 987         2       23.880     Syracuse    NY
## 1225        3       23.530    Weedsport    NY
## 1614        3       28.410    Westfield    NY
## 1767        3       11.720        Mayer    AZ
## 1828        4       27.650 Fort Bridger    WY
## 2072        2       11.545       Morton    IL
## 2489        3       29.370 Wilkes Barre    PA
## 2938        3       10.290   Tuscaloosa    AL
## 2959        3       29.780    Lehighton    PA
## 3198        3       22.590     Hillburn    NY
## 3304        3       15.540   Saugerties    NY
## 3504        3       23.760     Kingston    NY
## 3922        4       20.605       Ganado    AZ
## 4565        2       62.360 Spring Creek    NV
plot(accidents$Severity, accidents$Distance.mi.)

analyze street number

#accidents\(Number <- as.factor(accidents\)Number) hist(accidents$Number, breaks=seq(0,100000, 1000))

analyze side

This code chunk create a bar plot of the variable Side, which indicates which side of the road in which the accident was located. We see from the table that most the accidents were located on the right side of the road as opposed from the left, which make sense since people drive on the right side of the road on one way streets and highways and steer to the left to avoid coming into contact with stopped vehicles on the right side of the road.

count_side <- count(accidents$Side)
rf_side <- count_side$freq/sum(count_side$freq)
barplot(rf_side, names.arg = count_side$x, main = "Relative Frequency of Side")

plot(accidents$Severity, accidents$Side)

analyze state

count_state <- count(accidents\(State) rf_state <- count_state\)freq/sum(count_state\(freq) barplot(rf_state, names.arg = count_state\)x, main = “Frequency Table of State”, cex.names = 0.28, xlab = “State”, ylab = “Frequency”)

analyze simple zipcodes

accidents\(Simplezip <- substring(accidents\)Zipcode, 1, 5) hist(accidents$Simplezip)

make a frequency table for timezone

This code chunk makes a barplot of the variable Timezone. It helps determine which areas of the Unites States have more accidents. We see that most of the accidents occured in the eastern region. The western and central region are about the same, but the western region has slightly more accidents than the central regaion. The mountain region does not have a lot of accidents, which makes sense since not many people live there. The unlabled flat bar is the data that was not available.

count_timezone <- count(accidents$Timezone)
rf_timezone <- count_timezone$freq/sum(count_timezone$freq)
barplot(rf_timezone, names.arg = count_timezone$x, main = "Relative Frequency of timezone")

analyze temperature

This code chunk create a histogram of the temperatures in Fahrenheit for each accident. The histogram shows the distribution of the temperatures are roughly skewed to the left with plenty of variation. At 0 degrees Fahrenheit, there are few accidents probably because these temperatures are not common in the United States. As the temperature starts to increase, the number of accidents goes up since more people are out when it is warmer. When the temperature continues to increase from there, the number of accidents starts to go back down since fewer people are out if it is too hot. This is the general pattern, but there are also some moments of the number of accidents getting higher than the general trend. For instance, in temperatures around 30 degrees Fahrenheit, there may be more accidents because more people are out because of the holidays. In some of the warmer temperatures, more people may be out for summer vacations. Seasonal factors are a play with the distribution.

#accidents$Temperature.F. <- as.factor(accidents$Temperature.F.)
hist(accidents$Temperature.F., breaks=seq(-40, 120, 5), xlab = "Temperature.F")

accidents\(Temperature.F. <- as.factor(accidents\)Temperature.F.) hist(accidents\(Temperature.F.[accidents\)State==“NJ”], breaks=seq(-40, 120, 5), xlab = “Temperature.F”)

analyze wind_chill

This code chunk creates a histogram of the variable Wind_Chill.F. The distribution is similar to that of the Temperature.F variable, but it takes a dive around 50 degrees and comes back up, causing the distribution to be bimodal. It is a fact that wind chill temperatures are only defined at temperatures below 50 degrees. We can see in the scatterplot that the wind chill temperatures are only colder than the normal temperatures below 50 degrees, which is expected. It is hard to see why the distribution of accidents given wind chill is bimodal. The histogram seem to indicate that less accidents occur at wind chill temperatures around 50, but this is probably because this particular wind chill temperature is not very common.

#accidents$Wind_Chill.F. <- as.factor(accidents$Wind_Chill.F.)
hist(accidents$Wind_Chill.F., breaks=seq(-50, 120, 5), xlab = "Wind Chill (Fahrenheit)")

plot(accidents$Temperature.F., accidents$Wind_Chill.F.)
abline(0, 1)

### analyze humidity

This code chunk creates a histogram for the Humidity variable. We see from the histogram that the number of accidents appears to increase as the humidity goes up until the humidity level reaches 50 in which the number of accidents are generally stable. There is a dive in the graph around humidity levels of 90 to 100. It makes sense for there to be less accidents in lower humidity levels because less people would not be out as often if it is to dry or these humidity levels are rare. It might be believable to have some variability in humidity levels around 100 because too much air moisture could cause some people to not want to go out, but other people would not mind. The accompanying scatter plot shows plenty of variability in humidity and temperature, so there is no apparent relationship between these two variables.

#accidents$Humidity... <- as.factor(accidents$Humidity...)
hist(accidents$Humidity..., breaks=seq(0,105,3), xlab = "Humidity", main = "Histogram of Humidity")

plot(accidents$Temperature.F., accidents$Humidity..., cex = 0.01)

analyze pressure

This code chunk creates a Histogram of the Pressure.in. variable. We see from the histogram that the distribution of accidents is approximately normal with a mean around 30 inches of air pressure. There are some collective outliers between air pressure of 24 to 26 inches.

#accidents$Pressure.in. <- as.factor(accidents$Pressure.in.)
hist(accidents$Pressure.in., breaks=seq(23,32,0.3), xlab = "Pressure (in.)", main = "Histogram of Pressure")

analyze visibility

This code chunk creates a histogram of the Visibility.mi. variable. As expected more accidents occur in when visibility is low. However, the histogram shows much more accidents occurring when the visibility is around 10 miles as opposed to accidents in which the visibility is less than 9 miles. This could be explained by people being unwilling to drive if visibility is to low, but 10 miles could be the one visibility that most people think is okay to drive in and end up underestimating the difficulty of the drive. Accidents in visibilities greater than 20 miles are listed in the accompanying data frame.

#accidents$Visibility.mi. <- as.factor(accidents$Visibility.mi.)
hist(accidents$Visibility.mi., breaks=seq(0,55,2), xlab = "Visibility (miles)", main = "Histogram of Visibility")

visibility_outliers <- accidents[ which(accidents$Visibility.mi. > 20), ]
visibility_outliers[c(5,29,17,19)]
##      Severity Visibility.mi.        City State
## 283         2             30        Mesa    AZ
## 353         2             25  Broomfield    CO
## 533         3             40        Mesa    AZ
## 767         2             40        Mesa    AZ
## 946         2             30      Denver    CO
## 1254        2             30      Denver    CO
## 1256        2             30      Denver    CO
## 1821        3             30      Denver    CO
## 2224        3             30      Denver    CO
## 2540        2             40        Mesa    AZ
## 2620        3             30      Denver    CO
## 2639        2             50 Westminster    CO
## 2834        2             50      Denver    CO
## 2921        2             40      Denver    CO
## 3598        3             30    Morrison    CO
## 3849        3             40      Denver    CO
## 4103        3             50      Denver    CO

analyze wind direction

count_wd <- count(accidents\(Wind_Direction) rf_wd <- count_wd\)freq/sum(count_wd\(freq) barplot(rf_wd, names.arg = count_wd\)x, main = “Frequency Table of wind direction”)

analyze wind speed

This code chunk creates a histogram for the Wind_Speed.mph. variable. The histogram shows that distribution of accidents by wind speed is skewed to the right. Opposite of what we would expect, more accidents appear to generally occur with lower wind speeds. It is hard to explain how general wind speed could affect accidents as the direction of the wind relative to the car would need to considered. It is plausible to say that less people would be driving if the wind were too strong, which would yield less accidents. It is also plausible to say that wind speeds too fast are not common and there would not be many accidents given these wind speeds.

#accidents$Wind_Speed.mph. <- as.factor(accidents$Wind_Speed.mph.)
hist(accidents$Wind_Speed.mph., breaks=seq(0,40,3), xlab = "Wind Speed (mph)", main = "Histogram of Wind Speed")

analyze precipitation

This code chunk creates a histogram of the Precipitation.in. variable. The histogram shows that the distribution of accidents by precipitation is right skewed. Opposite of what we would expect, much of accidents in this data set have almost zero inches of precipitation. (This may be misleading since some of the observations in the Precipitation.in. variable are not available.). Other than this, there are few accidents that occur with small amounts of precipitation and an outlier with 9.99 inches of precipitation in Brooklyn, New York. This could be explained with less people driving if there is too much precipitation or very high amounts of precipitation being very rare.

#accidents$Precipitation.in. <- as.factor(accidents$Precipitation.in.)
hist(accidents$Precipitation.in., breaks=seq(0,10,0.1), xlab = "Precipitation (in.)", main = "Histogram of Precipitation")

precipitation_outliers <- accidents[ which(accidents$Precipitation.in. > 1), ]
precipitation_outliers[c(5,32,17,19)]
##      Severity Precipitation.in.     City State
## 1676        3              9.99 Brooklyn    NY

analyze weather condition

count_weather_condition <- count(accidents\(Weather_Condition) rf_count_weather_condition <- count_weather_condition\)freq/sum(count_weather_condition\(freq) barplot(rf_count_weather_condition, names.arg = count_weather_condition\)x, main = “Frequency Table of weather condition”)

The following bar plots are all true/false variables. They mostly indicate the presence of a particular road characteristic that could possibly interfere with the amount of accidents that take place. As shown, most of the bar plots have more false characteristics than true, so the future models involve a column that counts the true characteristics for each accident in the data set.

analyze amenity

count_amenity <- count(accidents$Amenity)
rf_amenity <- count_amenity$freq/sum(count_amenity$freq)
barplot(rf_amenity, names.arg = count_amenity$x, main = "Table of amenity")

analyze bump

count_bump <- count(accidents$Bump)
rf_bump <- count_bump$freq/sum(count_bump$freq)
barplot(rf_bump, names.arg = count_bump$x, main = "Table of bump")

analyze crossing

count_crossing <- count(accidents$Crossing)
rf_crossing <- count_crossing$freq/sum(count_crossing$freq)
barplot(rf_crossing, names.arg = count_crossing$x, main = "Table of crossing")

analyze give way

count_give_way <- count(accidents$Give_Way)
rf_give_way <- count_give_way$freq/sum(count_give_way$freq)
barplot(rf_give_way, names.arg = count_give_way$x, main = "Table of give way")

analyze junction

count_junction <- count(accidents$Junction)
rf_junction <- count_junction$freq/sum(count_junction$freq)
barplot(rf_junction, names.arg = count_junction$x, main = "Table of junction")

analyze no_exit

count_no_exit <- count(accidents$No_Exit)
rf_no_exit <- count_no_exit$freq/sum(count_no_exit$freq)
barplot(rf_no_exit, names.arg = count_no_exit$x, main = "Table of no exit")

analyze railway

count_railway <- count(accidents$Railway)
rf_railway <- count_railway$freq/sum(count_railway$freq)
barplot(rf_railway, names.arg = count_railway$x, main = "Table of railway")

analyze roundabout

count_roundabout <- count(accidents$Roundabout)
rf_roundabout <- count_roundabout$freq/sum(count_roundabout$freq)
barplot(rf_roundabout, names.arg = count_roundabout$x, main = "Table of roundabout")

analyze station

count_station <- count(accidents$Station)
rf_station <- count_station$freq/sum(count_station$freq)
barplot(rf_station, names.arg = count_station$x, main = "Table of station")

analyze stop

count_stop <- count(accidents$Stop)
rf_stop <- count_stop$freq/sum(count_stop$freq)
barplot(rf_stop, names.arg = count_stop$x, main = "Table of stop")

analyze traffic_calming

count_traffic_calming <- count (accidents$Traffic_Calming)
rf_traffic_calming <- count_traffic_calming$freq/sum(count_traffic_calming$freq)
barplot(rf_traffic_calming, names.arg = count_traffic_calming$x, main = "Table of traffic calming")

analyze traffic signal

count_traffic_signal <- count(accidents$Traffic_Signal)
rf_traffic_signal <- count_traffic_signal$freq/sum(count_traffic_signal$freq)
barplot(rf_traffic_signal, names.arg = count_traffic_signal$x, main = "Table of traffic signal")

analyze turning loop

count_turning_loop <- count(accidents$Turning_Loop)
rf_turning_loop <- count_turning_loop$freq/sum(count_turning_loop$freq)
barplot(rf_turning_loop, names.arg = count_turning_loop$x, main = "Table of turning loop")

Collapse object data

accidents$Amenity = as.logical(accidents$Amenity)
accidents$Bump = as.logical(accidents$Bump)
accidents$Crossing = as.logical(accidents$Crossing)
accidents$Give_Way = as.logical(accidents$Give_Way)
accidents$Junction = as.logical(accidents$Junction)
accidents$No_Exit = as.logical(accidents$No_Exit)
accidents$Railway = as.logical(accidents$Railway)
accidents$Roundabout = as.logical(accidents$Roundabout)
accidents$Station = as.logical(accidents$Station)
accidents$Stop = as.logical(accidents$Stop)
accidents$Traffic_Calming= as.logical(accidents$Traffic_Calming)
accidents$Traffic_Signal = as.logical(accidents$Traffic_Signal)
accidents$Turning_Loop = as.logical(accidents$Turning_Loop)
temp <- accidents[, 34:46]
temp = apply(temp, 1, sum)
accidents$num_objects <- temp
accidents$Amenity <- NULL
accidents$Bump <- NULL
accidents$Crossing <- NULL
accidents$Give_Way <- NULL
accidents$Junction <- NULL
accidents$No_Exit <- NULL
accidents$Railway <- NULL
accidents$Roundabout <- NULL
accidents$Station <- NULL
accidents$Stop <- NULL
accidents$Traffic_Calming <- NULL
accidents$Traffic_Signal <- NULL
accidents$Turning_Loop <- NULL

Object_Presence <- merge(accidents\(Amenity, accidents\)Bump, accidents\(Crossing, accidents\)Give_Way, accidents\(Junction, accidents\)No_Exit, accidents\(Railway, accidents\)Roundabout, accidents\(Station, accidents\)Stop, accidents\(Traffic_Calming, accidents\)Traffic_Signal, accidents\(Turning_Loop, by x = "True", y = "False") #count_object_presence <- count(Object_Presence) #rf_object_presence <- count_object_presence\)freq/sum(count_object_presence\(freq) #barplot(rf_object_presence, names.arg = count_object_presence\)x, main = “Relative Frequancy of Object Presence”)

analyze sunrise_sunset

This code chunk creates a bar plot for the sunrise_sunset variable. The bar plot shows that more accidents occur during the day than overnight. This may seem contrary to what we would expect from a glance, but it is also known that less people are out on the road at night. This would explain way there are less accidents overnight.

count_sunrise_sunset <- count(accidents$Sunrise_Sunset)
rf_sunrise_sunset <- count_sunrise_sunset$freq/sum(count_sunrise_sunset$freq)
barplot(rf_sunrise_sunset, names.arg = count_sunrise_sunset$x, main = "Relative Frequency of sunrise_sunset")

analyze civil_twilight

count_civil_twilight <- count(accidents\(Civil_Twilight) rf_civil_twilight <- count_civil_twilight\)freq/sum(count_civil_twilight\(freq) barplot(rf_civil_twilight, names.arg = count_civil_twilight\)x, main = “Table of civil_twilight”)

analyze nautical_twilight

count_nautical_twilight <- count(accidents\(Nautical_Twilight) rf_nautical_twilight <- count_nautical_twilight\)freq/sum(count_nautical_twilight\(freq) barplot(rf_nautical_twilight, names.arg = count_nautical_twilight\)x, main = “Table of nautical_twilight”)

analyze astronomical_twilight

count_astronomical_twilight <- count(accidents\(Astronomical_Twilight) rf_astronomical_twilight <- count_astronomical_twilight\)freq/sum(count_astronomical_twilight\(freq) barplot(rf_astronomical_twilight, names.arg = count_astronomical_twilight\)x, main = “Table of astronomical_twilight”)

plot severity and distance

plot(accidents\(Distance.mi., accidents\)Severity, xlab = “Distance”, ylab = “Severity”)

plot severity and side

plot(accidents\(Side, accidents\)Severity, xlab = “Side”, ylab = “Severity”)

plot severity and temperature

plot(accidents\(Temperature.F., accidents\)Severity, xlab = “Temperature”, ylab = “Severity”)

plot severity and wind chill

plot(accidents\(Wind_Chill.F., accidents\)Severity, xlab = “wind chill”, ylab = “severity”)

plot severity and humidity

plot(accidents\(Humidity..., accidents\)Severity, xlab = “humidity”, ylab = “severity”)

plot severity and pressure

plot(accidents\(Pressure.in., accidents\)Severity, xlab = “Pressure”, ylab = “Severity”)

plot severity and visibility

plot(accidents\(Visibility.mi., accidents\)Severity, xlab = “Visibility”, ylab = “Severity”)

plot severity and wind speed

plot(accidents\(Wind_Speed.mph., accidents\)Severity, xlab = “wind speed”, ylab = “severity”)

plot severity and precipitation

plot(accidents\(Precipitation.in., accidents\)Severity, xlab = “Precipitation”, ylab = “severity”)

plot severity and weather condition

plot(accidents\(Weather_Condition, accidents\)Severity, xlab = “Precipitation”, ylab = “severity”)

remove unneeded data information

This chunk of code removes variables that are not significant in determining the severity of the accidents. ID is removed because it is different for each particular accident and does not provide meaningful information about the severity of the accident. Source indicates the company or group that reported that accident which is also not meaningful for finding the severity of the accident. TMC is the traffic message channel code of the accident if it has one. This is also not meaningful for predicting accident severity, so it was removed. Start_Lat and Start_Lng were used earlier for mapping the location of the accident, but they do not help predict the severity of the accident and are not needed to generate future models, so they are being removed as well. End_Lat and End_Lng contained only null values and were not meaningful. Description basically summarizes the effect the accidents had on traffic patterns in the area. This was different for every accident and therefore would not be best to visualize the data, so it was removed. Number, Street, City, County, State, and Country all had to do with the location of the accident. Only one such variable is needed for this analysis. I choose to use zipcodes for determining the location of the accidents and to tell if the accidents occurred at an Amenity depending on how many digits are in the zipcode. These other location variables are removed. Weather_Timestamp mentions the time in which the weather conditions were reported, which is not meaningful for determining the severity of the accident, so it is removed. Wind_direction tells the general direction the wind was blowing when the accident was reported. There is too much variation with this variable since the direction the car was going would also have to be considered in determining the severity of the accident, so this variable is removed. Weather_Condition tells what the general weather pattern was like when the accident was reported. This is also a categorical variable with a lot of variation and there are other columns that help describe the weather at the time of the accident, so this variable is not needed. Crossing is removed because there are other variables, such as junction and railway that, refer to the presence of any kind of crossing. Turning_Loop is removed because none of the accidents in this data involve a turning loop. Civil_Twilight, Nautical_Twilight, and Astronomical_Twilight were three of the four ways to describe the time of day during the accidents (i.e. day/night). Only one of these methods is needed for such purposes in this study, so one of these variables, Sunrise_Sunset, is kept and the others are removed.

accidents$X <- NULL
accidents$ID <- NULL #unique for every accident
accidents$Source <- NULL #not meaningful in accident severity
accidents$TMC <- NULL #not meaningful in accident severity
accidents$Start_Lat <- NULL #kept zipcode instead & do not have end_Lat
accidents$Start_Lng <- NULL #kept zipcode instead & do not have end_Lng
accidents$End_Lat <- NULL #all null
accidents$End_Lng <- NULL #all null
accidents$Description <- NULL #unique for every accident
accidents$Number <- NULL #using zipcode instead
accidents$Street <- NULL #kept street number instead
accidents$City <- NULL #kept zip code instead
accidents$County <- NULL #kept zip code instead
accidents$State <- NULL #kept zip code instead
accidents$Country <- NULL #kept zip code instead
accidents$Airport_Code <- NULL #not meaningfull in accident severity
accidents$Weather_Timestamp <- NULL #not meaningfull in accident severity
accidents$Wind_Direction <- NULL #to much variation
accidents$Weather_Condition <- NULL #kept other columns instead
accidents$Crossing <- NULL #kept junction and railway columns instead
accidents$Turning_Loop <- NULL #all false
accidents$Civil_Twilight <- NULL #kept sunrise/sunset instead
accidents$Nautical_Twilight <- NULL #kept sunrise/sunset instead
accidents$Astronomical_Twilight <- NULL #kept sunrise/sunset instead

define null values

This code chunk defines the null values of the unremoved variables in the accidents data.

accidents$Severity[is.na(accidents$Severity)] = "No label"
accidents$Start_Time[is.na(accidents$Start_Time)] = "Not recorded"
accidents$End_Time[is.na(accidents$End_Time)] = "Not recorded"
accidents$Distance.mi.[is.na(accidents$Distance.mi.)] = 0
accidents$Side[is.na(accidents$Side)] = "Neither"
accidents$Zipcode[is.na(accidents$Zipcode)] = "None"
accidents$Timezone[is.na(accidents$Timezone)] = "Unknown"
accidents$Temperature.F.[is.na(accidents$Temperature.F.)] = 0
accidents$Wind_Chill.F.[is.na(accidents$Wind_Chill.F.)] = 0
accidents$Humidity...[is.na(accidents$Humidity...)] = 0
accidents$Pressure.in.[is.na(accidents$Pressure.in.)] = 0
accidents$Visibility.mi.[is.na(accidents$Visibility.mi.)] = 0
accidents$Wind_Speed.mph.[is.na(accidents$Wind_Speed.mph.)] = 0
accidents$Precipitation.in.[is.na(accidents$Precipitation.in.)] = 0
#accidents$Amenity[is.na(accidents$Amenity)] = "False"
#accidents$Bump[is.na(accidents$Bump)] = "False"
#accidents$Give_Way[is.na(accidents$Give_Way)] = "False"
#accidents$Junction[is.na(accidents$Junction)] = "False"
#accidents$No_Exit[is.na(accidents$No_Exit)] = "False"
#accidents$Railway[is.na(accidents$Railway)] = "False"
#accidents$Roundabout[is.na(accidents$Roundabout)] = "False"
#accidents$Station[is.na(accidents$Station)] = "False"
#accidents$Stop[is.na(accidents$Stop)] = "False"
#accidents$Traffic_Calming[is.na(accidents$Traffic_Calming)] = "False"
#accidents$Traffic_Signal[is.na(accidents$Traffic_Signal)] = "False"
accidents$Sunrise_Sunset[is.na(accidents$Sunrise_Sunset)] = "Unknown"

Split start and end time columns and calculate the time it took to clear the roadway of accident

This code chunk displays the time it took to clean up the roadway of the accidents and removes the unneeded variables created in the process.

int <- interval(strptime(accidents\(Start_Time, "%Y-%m-%d %H:%M:%S"), strptime(accidents\)End_Time, “%Y-%m-%d %H:%M:%S”)) accidents$time_in_hours <- time_length(int, unit = “hour”)

accidents <- separate(accidents, Start_Time, c(“Date”, “Start_Time”), " “) accidents <- separate(accidents, End_Time, c(”Date2“,”End_Time“),” “) accidents\(Date2 <- NULL accidents\)day_of_week <- weekdays(as.Date(accidents$Date)) accidents <- separate(accidents, Date, c(”Year“,”Month“,”Day“),”-")

accidents$Start_Time <- NULL
accidents$End_Time <- NULL
#accidents$Year <- NULL
#accidents$Day <- NULL

Convert to factor variables

#library(stringr) #library(naniar) #accidents\(Severity <- as.factor(accidents\)Severity) #accidents\(Month <- as.factor(accidents\)Month) #accidents\(Distance.mi. <- as.factor(accidents\)Distance.mi.) accidents\(Zipcode <- as.character(accidents\)Zipcode) accidents\(lengthzip <- (str_length(accidents\)Zipcode) - 5)/5 accidents\(Simplezip <- substring(accidents\)Zipcode, 1, 5) accidents\(Zipcode <- NULL #accidents\)Temperature.F. <- as.factor(accidents\(Temperature.F.) #accidents\)Wind_Chill.F. <- as.factor(accidents\(Wind_Chill.F.) #accidents\)Humidity… <- as.factor(accidents\(Humidity...) #accidents\)Pressure.in. <- as.factor(accidents\(Pressure.in.) #accidents\)Visibility.mi. <- as.factor(accidents\(Visibility.mi.) #accidents\)Wind_Speed.mph. <- as.factor(accidents\(Wind_Speed.mph.) #accidents\)Precipitation.in. <- as.factor(accidents\(Precipitation.in.) accidents\)time_in_hours <- as.numeric(accidents\(time) accidents\)lengthzip <- as.factor(accidents\(lengthzip) accidents\)Simplezip <- as.factor(accidents\(Simplezip) accidents\)Simplezip <- NULL accidents\(day_of_week <- as.factor(accidents\)day_of_week) #accidents <- replace_with_na(accidents, replace = list(lengthzip = -1)) #accidents\(lengthzip[is.na(accidents\)lengthzip)] = “No Zip Code”

accidents\(Simplezip <- NULL accidents\)Temperature.F. <- as.numeric(accidents\(Temperature.F.) accidents\)Wind_Chill.F. <- as.numeric(accidents\(Wind_Chill.F.) accidents\)Humidity… <- as.numeric(accidents\(Humidity...) accidents\)Pressure.in. <- as.numeric(accidents\(Pressure.in.) accidents\)Visibility.mi. <- as.numeric(accidents\(Visibility.mi.) accidents\)Wind_Speed.mph. <- as.numeric(accidents\(Wind_Speed.mph.) accidents\)Precipitation.in. <- as.numeric(accidents\(Precipitation.in.) accidents\)Distance.mi. <- as.numeric(accidents\(Distance.mi.) accidents\)time_in_hours <- NULL

make simple zipcodes

This code chunk makes simple 5 digit zip codes with the zip codes presented in the data.

library(tidyverse)
accidents$Zipcode <- as.character(accidents$Zipcode)
accidents$lengthzip <- (str_length(accidents$Zipcode) - 5)/5
accidents$Simplezip <- substring(accidents$Zipcode, 1, 5)
accidents$Zipcode <- NULL

Make a map of zipcodes

library(usmap) plot_usmap(data = accidents, labels=TRUE, values = “Simplezip”, label_color = “red”)

Create data partition for severity

set.seed(12345) accidents\(Severity <- as.factor(accidents\)Severity) accidents = accidents[1:100, ] trainingIndices <- createDataPartition(accidents$Severity, p = 0.7, list = FALSE) training <- accidents[trainingIndices, ] testing <- accidents[-trainingIndices, ]

Perform a linear model for severity (wrong model type for classification)

Linear_Model <- train(Severity~., data = accidents, method = ‘lm’, preProcess=c(“center”,“scale”) ) summary(Linear_Model)

Run an ordinal regression model for severity (failed to find starting value)

memory.size(max = T) library(MASS) ORD <- polr(Severity~., data = accidents, ) ORD

predictedORD <- predict(ORD, newdata = testing) predict(ORD, predictedORD, type=“prob”)

Run CART model for severity

accidents$Severity <- as.factor(accidents$Severity)
CART <- train(Severity~., data = accidents,
              method="rpart",
              trControl=trainControl(method="CV", 10),
              preProcess=c("center", "scale"))

Run Random Forest model for severity (got stuck)

RF <- train(Severity~., data = accidents, method=“rf”, trControl=trainControl(method=“CV”, 10), preProcess=c(“center”, “scale”))

Run gradiant boosting machine model for severity (got stuck)

GBM <- train(Severity~., data=accidents, method=“gbm”, trControl=trainControl(method=“CV”, 10), preProcess=c(“center”, “scale”))