A STUDY ON ROAD ACCIDENT CONTRIBUTING FACTORS
Alexandre Kouakou
2024-05-02
DESCRIPTION
Road accidents are the major cause of unnatural deaths around the world. All governments work hard to raise awareness about the rules and regulations that must be followed when driving a vehicle on the road in order to reduce fatalities. Thus, it is necessary to have knowledge about the contributing factors of these road accidents.I - PREREQUISITES
library(tidyverse)## Warning: package 'tidyverse' was built under R version 4.3.2## Warning: package 'ggplot2' was built under R version 4.3.3## Warning: package 'tibble' was built under R version 4.3.2## Warning: package 'tidyr' was built under R version 4.3.2## Warning: package 'readr' was built under R version 4.3.2## Warning: package 'purrr' was built under R version 4.3.2## Warning: package 'dplyr' was built under R version 4.3.2## Warning: package 'stringr' was built under R version 4.3.2## Warning: package 'forcats' was built under R version 4.3.2## Warning: package 'lubridate' was built under R version 4.3.3## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.0 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.0
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(gridExtra)## Warning: package 'gridExtra' was built under R version 4.3.3##
## Attaching package: 'gridExtra'
##
## The following object is masked from 'package:dplyr':
##
## combine # 1. Data acquisition
roadAccidentData <- read_csv("Road.csv")## Rows: 12316 Columns: 32
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (29): Day_of_week, Age_band_of_driver, Sex_of_driver, Educational_level...
## dbl (2): Number_of_vehicles_involved, Number_of_casualties
## time (1): Time
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.head(roadAccidentData)## # A tibble: 6 × 32
## Time Day_of_week Age_band_of_driver Sex_of_driver Educational_level
## <time> <chr> <chr> <chr> <chr>
## 1 17:02 Monday 18-30 Male Above high school
## 2 17:02 Monday 31-50 Male Junior high school
## 3 17:02 Monday 18-30 Male Junior high school
## 4 01:06 Sunday 18-30 Male Junior high school
## 5 01:06 Sunday 18-30 Male Junior high school
## 6 14:15 Friday 31-50 Male <NA>
## # ℹ 27 more variables: Vehicle_driver_relation <chr>, Driving_experience <chr>,
## # Type_of_vehicle <chr>, Owner_of_vehicle <chr>,
## # Service_year_of_vehicle <chr>, Defect_of_vehicle <chr>,
## # Area_accident_occured <chr>, Lanes_or_Medians <chr>, Road_allignment <chr>,
## # Types_of_Junction <chr>, Road_surface_type <chr>,
## # Road_surface_conditions <chr>, Light_conditions <chr>,
## # Weather_conditions <chr>, Type_of_collision <chr>, …# 2. Understanding my data by describing the variables in my dataset
glimpse(roadAccidentData)## Rows: 12,316
## Columns: 32
## $ Time <time> 17:02:00, 17:02:00, 17:02:00, 01:06:00, 0…
## $ Day_of_week <chr> "Monday", "Monday", "Monday", "Sunday", "S…
## $ Age_band_of_driver <chr> "18-30", "31-50", "18-30", "18-30", "18-30…
## $ Sex_of_driver <chr> "Male", "Male", "Male", "Male", "Male", "M…
## $ Educational_level <chr> "Above high school", "Junior high school",…
## $ Vehicle_driver_relation <chr> "Employee", "Employee", "Employee", "Emplo…
## $ Driving_experience <chr> "1-2yr", "Above 10yr", "1-2yr", "5-10yr", …
## $ Type_of_vehicle <chr> "Automobile", "Public (> 45 seats)", "Lorr…
## $ Owner_of_vehicle <chr> "Owner", "Owner", "Owner", "Governmental",…
## $ Service_year_of_vehicle <chr> "Above 10yr", "5-10yrs", NA, NA, "5-10yrs"…
## $ Defect_of_vehicle <chr> "No defect", "No defect", "No defect", "No…
## $ Area_accident_occured <chr> "Residential areas", "Office areas", "Recr…
## $ Lanes_or_Medians <chr> NA, "Undivided Two way", "other", "other",…
## $ Road_allignment <chr> "Tangent road with flat terrain", "Tangent…
## $ Types_of_Junction <chr> "No junction", "No junction", "No junction…
## $ Road_surface_type <chr> "Asphalt roads", "Asphalt roads", "Asphalt…
## $ Road_surface_conditions <chr> "Dry", "Dry", "Dry", "Dry", "Dry", "Dry", …
## $ Light_conditions <chr> "Daylight", "Daylight", "Daylight", "Darkn…
## $ Weather_conditions <chr> "Normal", "Normal", "Normal", "Normal", "N…
## $ Type_of_collision <chr> "Collision with roadside-parked vehicles",…
## $ Number_of_vehicles_involved <dbl> 2, 2, 2, 2, 2, 1, 1, 2, 2, 2, 2, 2, 2, 2, …
## $ Number_of_casualties <dbl> 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 2, 2, …
## $ Vehicle_movement <chr> "Going straight", "Going straight", "Going…
## $ Casualty_class <chr> "na", "na", "Driver or rider", "Pedestrian…
## $ Sex_of_casualty <chr> "na", "na", "Male", "Female", "na", "Male"…
## $ Age_band_of_casualty <chr> "na", "na", "31-50", "18-30", "na", "31-50…
## $ Casualty_severity <chr> "na", "na", "3", "3", "na", "3", "3", "na"…
## $ Work_of_casuality <chr> NA, NA, "Driver", "Driver", NA, "Driver", …
## $ Fitness_of_casuality <chr> NA, NA, NA, "Normal", NA, "Normal", "Norma…
## $ Pedestrian_movement <chr> "Not a Pedestrian", "Not a Pedestrian", "N…
## $ Cause_of_accident <chr> "Moving Backward", "Overtaking", "Changing…
## $ Accident_severity <chr> "Slight Injury", "Slight Injury", "Serious…II - DATA PREPROCESSING
Let’s extract hour in the Time column and create a new variable “hour_of_day” using lubridate and dplyr packages.
# 1) Extract hour in the Time column and create a new variable "hour_of_day" using lubridate & dplyr packages
roadAccidentData <- roadAccidentData %>%
mutate(hour_of_day = hour(Time)) %>%
relocate(hour_of_day, .after = Time)
head(roadAccidentData)## # A tibble: 6 × 33
## Time hour_of_day Day_of_week Age_band_of_driver Sex_of_driver
## <time> <int> <chr> <chr> <chr>
## 1 17:02 17 Monday 18-30 Male
## 2 17:02 17 Monday 31-50 Male
## 3 17:02 17 Monday 18-30 Male
## 4 01:06 1 Sunday 18-30 Male
## 5 01:06 1 Sunday 18-30 Male
## 6 14:15 14 Friday 31-50 Male
## # ℹ 28 more variables: Educational_level <chr>, Vehicle_driver_relation <chr>,
## # Driving_experience <chr>, Type_of_vehicle <chr>, Owner_of_vehicle <chr>,
## # Service_year_of_vehicle <chr>, Defect_of_vehicle <chr>,
## # Area_accident_occured <chr>, Lanes_or_Medians <chr>, Road_allignment <chr>,
## # Types_of_Junction <chr>, Road_surface_type <chr>,
## # Road_surface_conditions <chr>, Light_conditions <chr>,
## # Weather_conditions <chr>, Type_of_collision <chr>, …Now, let’s remove Time variable as it is not needed anymore to avoid data redundancy and other features not needed for the analysis as well.
# 2) Remove Time variable as it is not needed anymore to avoid data redundancy and other features not needed for the analysis as well
roadAccidentData <- roadAccidentData %>%
select(-Time, -Defect_of_vehicle,
-c(Casualty_class:Pedestrian_movement))
head(roadAccidentData)## # A tibble: 6 × 24
## hour_of_day Day_of_week Age_band_of_driver Sex_of_driver Educational_level
## <int> <chr> <chr> <chr> <chr>
## 1 17 Monday 18-30 Male Above high school
## 2 17 Monday 31-50 Male Junior high school
## 3 17 Monday 18-30 Male Junior high school
## 4 1 Sunday 18-30 Male Junior high school
## 5 1 Sunday 18-30 Male Junior high school
## 6 14 Friday 31-50 Male <NA>
## # ℹ 19 more variables: Vehicle_driver_relation <chr>, Driving_experience <chr>,
## # Type_of_vehicle <chr>, Owner_of_vehicle <chr>,
## # Service_year_of_vehicle <chr>, Area_accident_occured <chr>,
## # Lanes_or_Medians <chr>, Road_allignment <chr>, Types_of_Junction <chr>,
## # Road_surface_type <chr>, Road_surface_conditions <chr>,
## # Light_conditions <chr>, Weather_conditions <chr>, Type_of_collision <chr>,
## # Number_of_vehicles_involved <dbl>, Number_of_casualties <dbl>, …We can identify missing values (MVs) by using following statements.
# 3) Identify missing values (MVs)
anyNA(roadAccidentData)## [1] TRUEsum(is.na(roadAccidentData))## [1] 9797colSums(is.na(roadAccidentData))## hour_of_day Day_of_week
## 0 0
## Age_band_of_driver Sex_of_driver
## 0 0
## Educational_level Vehicle_driver_relation
## 741 579
## Driving_experience Type_of_vehicle
## 829 950
## Owner_of_vehicle Service_year_of_vehicle
## 482 3928
## Area_accident_occured Lanes_or_Medians
## 239 385
## Road_allignment Types_of_Junction
## 142 887
## Road_surface_type Road_surface_conditions
## 172 0
## Light_conditions Weather_conditions
## 0 0
## Type_of_collision Number_of_vehicles_involved
## 155 0
## Number_of_casualties Vehicle_movement
## 0 308
## Cause_of_accident Accident_severity
## 0 0Now identified, we can deal with MVs by replacing them by “Unknown” using tidyr package.
# 4) Deal with MVs by replacing them by "Unknown" using tidyr package
roadAccidentData <- roadAccidentData %>%
replace_na(list(Educational_level = "Unknown",
Vehicle_driver_relation = "Unknown",
Driving_experience = "Unknown",
Type_of_vehicle = "Unknown",
Owner_of_vehicle = "Unknown",
Service_year_of_vehicle = "Unknown",
Area_accident_occured = "Unknown",
Lanes_or_Medians = "Unknown",
Road_allignment = "Unknown",
Road_surface_type = "Unknown",
Types_of_Junction = "Unknown",
Type_of_collision = "Unknown",
Vehicle_movement = "Unknown"))
sum(is.na(roadAccidentData))## [1] 0III - Exploratory Data Analysis
A-) Identify high-risk areas
# 1) Analysis on time of the day
numAccHour <- roadAccidentData %>%
group_by(hour_of_day) %>%
summarise(number_of_accidents = n())
numAccHour %>%
ggplot(aes(factor(hour_of_day), number_of_accidents)) +
geom_segment(aes(x = factor(hour_of_day), xend = factor(hour_of_day),
y = 0, yend = number_of_accidents))+
geom_point(size = 5, color = "red", fill = alpha("orange", 0.3),
alpha = 0.7, shape = 21, stroke = 2)+
labs(title = "Relationship between hour of the day and number of accidents",
x = "Hour of the day",
y = "Number of accidents")+
theme_bw()
We can see by this chart most road accidents occurred from 7am to 20pm. And 17pm registered the highest number of accidents.
# 2) Analysis on day of the week
roadAccidentData$Day_of_week <- factor(roadAccidentData$Day_of_week,
levels = c("Monday", "Tuesday", "Wednesday",
"Thursday", "Friday", "Saturday", "Sunday"))
roadAccidentData %>%
ggplot(aes(Day_of_week, fill = Day_of_week)) +
geom_bar()+
scale_y_continuous(breaks = seq(0, 2500, by = 500))+
labs(title = "Relationship between day of the week and number of accidents",
x = "Day of the week",
y = "Number of accidents")+
scale_fill_discrete(name = "Day of week")+
theme_bw()
This bar chart shows that every day, there are road accidents no matter if it is week day or weekend.
# 3) Analysis on accident location
roadAccidentData %>%
ggplot(aes(fct_infreq(Area_accident_occured), fill = Area_accident_occured)) +
geom_bar() +
labs(title = "Relationship between accident location and number of accidents",
x = "Accident location",
y = "Number of accidents")+
theme(legend.position = "none")+
coord_flip()
Here, the areas where accidents occurred have been identified.
# 4) Analysis on the environment
numAccWeather <- table(roadAccidentData$Weather_conditions,
roadAccidentData$Light_conditions)
numAccWeather <- cbind(rownames(numAccWeather), numAccWeather)
rownames(numAccWeather) <- NULL
numAccWeather <- as.data.frame(numAccWeather) %>%
gather(key = "light_conditions", value = "frequency",
"Darkness - lights lit", "Darkness - lights unlit",
"Darkness - no lighting", "Daylight")
colnames(numAccWeather)[1] <- "weather_conditions"
numAccWeather$light_conditions <- factor(numAccWeather$light_conditions,
levels = c("Daylight","Darkness - lights lit",
"Darkness - lights unlit", "Darkness - no lighting"))
numAccWeather$frequency <- as.integer(numAccWeather$frequency)
head(numAccWeather)## weather_conditions light_conditions frequency
## 1 Cloudy Darkness - lights lit 52
## 2 Fog or mist Darkness - lights lit 2
## 3 Normal Darkness - lights lit 2454
## 4 Other Darkness - lights lit 126
## 5 Raining Darkness - lights lit 506
## 6 Raining and Windy Darkness - lights lit 26numAccWeather %>%
ggplot(aes(weather_conditions, frequency, fill = light_conditions))+
geom_bar(stat = "identity", position = "fill")+
labs(title = "Relationship between weather conditions, light conditions and number accidents",
x = "Weather conditions", y = "Frequency")+
scale_fill_discrete(name = "Light conditions")+
theme(panel.grid = element_blank(),
axis.text.x = element_blank(),
axis.ticks.x = element_blank())+
coord_flip()
Here, the number of accidents by weather conditions is not shown but normal weather condition lead the rank with about 72%. This stacked bar chart is the proof that most accidents occured during day hours (from 7am to 20pm).
B-) Identify high-risk groups
# 1) Analysis on age band
numAccAgeBand <- roadAccidentData %>%
group_by(Age_band_of_driver) %>%
summarise(number_of_accidents = n())
numAccAgeBand$percentage <- numAccAgeBand$number_of_accidents / sum(numAccAgeBand$number_of_accidents)
numAccAgeBand$ymax <- cumsum(numAccAgeBand$percentage)
numAccAgeBand$ymin <- c(0, head(numAccAgeBand$ymax, n = -1))
numAccAgeBand$labelposition <- (numAccAgeBand$ymax + numAccAgeBand$ymin) / 2
numAccAgeBand$label <- paste0(numAccAgeBand$Age_band_of_driver,
"\n value: ", numAccAgeBand$number_of_accidents)
head(numAccAgeBand)## # A tibble: 5 × 7
## Age_band_of_driver number_of_accidents percentage ymax ymin labelposition
## <chr> <int> <dbl> <dbl> <dbl> <dbl>
## 1 18-30 4271 0.347 0.347 0 0.173
## 2 31-50 4087 0.332 0.679 0.347 0.513
## 3 Over 51 1585 0.129 0.807 0.679 0.743
## 4 Under 18 825 0.0670 0.874 0.807 0.841
## 5 Unknown 1548 0.126 1 0.874 0.937
## # ℹ 1 more variable: label <chr>numAccAgeBand %>%
ggplot(aes(ymax = ymax, ymin = ymin, xmax = 4, xmin = 3, fill = Age_band_of_driver)) +
geom_rect()+
geom_label(x = 3.5, aes(y = labelposition, label = label), size =5 )+
labs(title = "Number of accidents by age band of driver")+
scale_fill_brewer(palette = 4)+
coord_polar(theta = "y")+
xlim(c(2, 4))+
theme_void()+
theme(legend.position = "none")
I used this pie chart to show the frequencies accidents by interval of ages of the drivers leading by the age group from 18 to 30 following by the group from 31 to 50.
# 2) Analysis on gender
numAccGender <- roadAccidentData %>%
group_by(Sex_of_driver) %>%
summarise(number_of_accidents = n())
numAccGender %>%
ggplot(aes(Sex_of_driver, number_of_accidents, fill = Sex_of_driver))+
geom_bar(stat = "identity")+
labs(title = "Number of accidents by gender",
x = "Vehicle movement",
y = "Number of accidents")+
scale_fill_discrete(name = "Sex of driver")+
theme_classic()
As we can see, Most accidents have been caused by male gender with about 11000 cases followed by female with a count of 700 cases only.
# 3) Analysis on educational level
numAccEduLevel <- roadAccidentData %>%
filter(!Educational_level == "Unknown") %>%
group_by(Educational_level) %>%
summarise(number_of_accidents = n())
numAccEduLevel %>%
ggplot(aes(reorder(Educational_level, -number_of_accidents), number_of_accidents,
fill = Educational_level))+
geom_bar(stat = "identity")+
scale_fill_discrete(name = "Level of education",
breaks = c("Junior high school","Elementary school",
"High school", "Above high school",
"Writing & reading", "Illiterate"))+
theme(legend.position = "none",
axis.text.x = element_text(angle = 45,
hjust = 1,
vjust = 0.9))+
labs(title = "Number of accidents by level of education",
x = "Level of Education",
y = "Number of accidents")
This part of our analysis shows, according to the level of education, that people from junior high school are the most involved in road accidents. Maybe due to their low driving experience.
# 4) Analysis on driving experience
numAccDrivExp <- roadAccidentData %>%
mutate(Driving_experience = if_else(Driving_experience == "unknown",
"Unknown",
Driving_experience)) %>%
filter(!Driving_experience == "Unknown") %>%
group_by(Driving_experience) %>%
summarise(number_of_accidents = n())
head(numAccDrivExp)## # A tibble: 6 × 2
## Driving_experience number_of_accidents
## <chr> <int>
## 1 1-2yr 1756
## 2 2-5yr 2613
## 3 5-10yr 3363
## 4 Above 10yr 2262
## 5 Below 1yr 1342
## 6 No Licence 118This analysis comes to contradict the analysis made above where we concluded that maybe it is due of their low driving experience that people from junior high school level caused many accidents. In fact, the result of the current analysis shows that people with driving experience from 2 to above 10 years are the most involved in road accidents.
Let’s see the type of vehicles involved in road accidents.
# 5) Analysis on type of vehicles
numAccVType <- roadAccidentData %>%
group_by(Type_of_vehicle) %>%
summarise(number_of_accidents = n())
numAccVType %>%
ggplot(aes(reorder(Type_of_vehicle, +number_of_accidents),
number_of_accidents,
fill = Type_of_vehicle))+
geom_segment(aes(x = Type_of_vehicle, xend = Type_of_vehicle,
y = 0, yend = number_of_accidents))+
geom_point(size = 5, color = "red", fill = alpha("orange", 0.3),
alpha = 0.7, shape = 21, stroke = 2)+
geom_text(aes(label = number_of_accidents),
hjust = 0.1,
col = "black")+
theme_minimal()+
coord_flip()
The analysis is lead by automobile followed by lorry and others.
# 6) Relationship
numAccVMove <- roadAccidentData %>%
group_by(Vehicle_movement) %>%
summarise(number_of_accidents = n())
numAccVMove %>%
ggplot(aes(reorder(Vehicle_movement, +number_of_accidents),
number_of_accidents,
fill = Vehicle_movement))+
geom_bar(stat = "identity")+
labs(title = "Relationship between vehicle movement and number of accidents",
x = "Vehicle movement",
y = "Number of accidents")+
theme(legend.position = "none")+
coord_flip()
numAccCause <- roadAccidentData %>%
group_by(Cause_of_accident) %>%
summarise(number_of_accidents = n())
numAccCause %>%
ggplot(aes(reorder(Cause_of_accident, +number_of_accidents),
number_of_accidents,
fill = Cause_of_accident))+
geom_bar(stat = "identity")+
labs(title = "Relationship between cause of accidents and number of accidents",
x = "Cause of accidents",
y = "Number of accidents")+
theme(legend.position = "none")+
coord_flip()
I called this question relationship because I wanted to make a conclusion based on two features, the movement of the vehicle and the cause of accidents. As a matter of fact, going straight caused most of the accidents and no distancing has been identified as the highest cause of accidents.
How do the patterns of accidents change during weekends compared to weekdays?
# 7) How do the patterns of accidents change during weekends compared to weekdays?
roadAccidentData <- roadAccidentData %>%
mutate(Weekday = if_else(Day_of_week %in% c("Monday", "Tuesday", "Wednesday",
"Thursday", "Friday"),
"Weekday",
"Weekend")) %>%
relocate(Weekday, .after = Day_of_week)
weekdaySeverity <- addmargins(table(roadAccidentData$Weekday, roadAccidentData$Accident_severity))
weekdaySeverity <- cbind(rownames(weekdaySeverity), weekdaySeverity)
rownames(weekdaySeverity) <- NULL
head(weekdaySeverity)## Fatal injury Serious Injury Slight Injury Sum
## [1,] "Weekday" "86" "1308" "7789" "9183"
## [2,] "Weekend" "72" "435" "2626" "3133"
## [3,] "Sum" "158" "1743" "10415" "12316"This table shows the number of accidents which caused three categories of injuries according to weekday. We can see also that most of the accidents occured during week days.
Let’s find the mean of vehicles involved in accident per day.
# 8) Find the mean of vehicles involved in accident per day
tapply(roadAccidentData$Number_of_vehicles_involved,
INDEX = roadAccidentData$Day_of_week,
FUN = mean)## Monday Tuesday Wednesday Thursday Friday Saturday Sunday
## 2.033908 2.068362 2.020652 2.014587 2.034297 2.065426 2.053851Every day, 2 vehicles in mean are involved in an accident.
# 9) Find the causes of accidents in specific areas
sampleRAData <- roadAccidentData %>%
filter(Area_accident_occured %in% c("Church areas", "Residential areas",
"Office areas"))
dummyTable <- table(sampleRAData$Cause_of_accident,
sampleRAData$Area_accident_occured)
dummyTable <- cbind(rownames(dummyTable), dummyTable)
rownames(dummyTable) <- NULL
colnames(dummyTable)[1:4] <- c("cause_of_accidents", "church_areas", "office_areas",
"residential_areas")
dummyTable <- as.data.frame(dummyTable)
dummyTable$church_areas = as.integer(dummyTable$church_areas)
dummyTable$office_areas = as.integer(dummyTable$office_areas)
dummyTable$residential_areas = as.integer(dummyTable$residential_areas)
head(dummyTable)## cause_of_accidents church_areas office_areas
## 1 Changing lane to the left 126 412
## 2 Changing lane to the right 154 532
## 3 Driving at high speed 13 46
## 4 Driving carelessly 118 374
## 5 Driving to the left 29 68
## 6 Driving under the influence of drugs 36 92
## residential_areas
## 1 234
## 2 310
## 3 34
## 4 238
## 5 51
## 6 63churchAreas <- dummyTable %>%
ggplot(aes(reorder(cause_of_accidents, +church_areas), church_areas)) +
geom_segment(aes(x = cause_of_accidents, xend = cause_of_accidents,
y = 0, yend = church_areas))+
geom_point(size = 5, color = "red", fill = alpha("orange", 0.3),
alpha = 0.7, shape = 21, stroke = 2)+
labs(title = "Relationship: cause of accident and number of accidents in church areas",
x = "Cause of accident",
y = "Number of accidents in church areas")+
theme(axis.text.x = element_text(angle = 45,
hjust = 1,
vjust = 0.9))
officeAreas <- dummyTable %>%
ggplot(aes(reorder(cause_of_accidents, +office_areas), office_areas)) +
geom_segment(aes(x = cause_of_accidents, xend = cause_of_accidents,
y = 0, yend = office_areas))+
geom_point(size = 5, color = "red", fill = alpha("orange", 0.3),
alpha = 0.7, shape = 21, stroke = 2)+
labs(title = "Relationship: cause of accident and number of accidents in office areas",
x = "Cause of accident",
y = "Number of accidents in office areas")+
theme(axis.text.x = element_text(angle = 45,
hjust = 1,
vjust = 0.9))
residentialAreas <- dummyTable %>%
ggplot(aes(reorder(cause_of_accidents, +residential_areas), residential_areas)) +
geom_segment(aes(x = cause_of_accidents, xend = cause_of_accidents,
y = 0, yend = residential_areas))+
geom_point(size = 5, color = "red", fill = alpha("orange", 0.3),
alpha = 0.7, shape = 21, stroke = 2)+
labs(title = "Relationship: cause of accident and number of accidents in residential areas",
x = "Cause of accident",
y = "Number of accidents in residential areas")+
theme(axis.text.x = element_text(angle = 45,
hjust = 1,
vjust = 0.9))
grid.arrange(churchAreas, officeAreas, residentialAreas, ncol = 2)
This grid shows the number of accidents by cause of accidents in three specific areas (church, office, and residential areas) where there had many road accidents. In each area, no distancing was the cause of most accidents.
What is the correlation between number of vehicles involved and number of casualties?
# 10) Find correlation between number of vehicles involved and number of casualties
corr <- roadAccidentData %>%
select(Number_of_vehicles_involved, Number_of_casualties) %>%
cor(method = "pearson")
corr## Number_of_vehicles_involved Number_of_casualties
## Number_of_vehicles_involved 1.0000000 0.2134268
## Number_of_casualties 0.2134268 1.0000000colnames(corr) <- c("Vehicles involved", "Casualties")
rownames(corr) <- c("Vehicles involved", "Casualties")
corr %>%
corrplot::corrplot(method = "square",
title = "Correlation plot between number of vehicle involved and number of casualties")
There is a low correlation (0.21) between number of vehicles involved and number of casualties.
CONCLUSION
- Most accidents occurred during day hours because of traffic volume.
- As factors, we have the characteristics of the road, vehicles, human factors, environment and others.
- By analyzing data on accident location, time of day, and other factors, high-risks ares can be identified and targeted for interventions such as increased enforcement or infrastructure improvements.
- By analyzing data on factors such as age, gender, and previous driving history, high-risk groups can be identified and targeted for interventions such as education and awareness.