Source Data

The following analysis uses data comprised of traffic accidents in the city of Tempe, Arizona. They constitute 28,470 observations and 32 variables. You can find more details in the dataset documentation at the Tempe Open Data Portal.


Preview

We can explore the first six observations in the following table using function head().

head(dat)



Preprocessing

All data preprocessing are available in Appendix A: Data Preprocessing.



Part I: Summaries

The following provides brief exploratory summaries on key data points.


1. Mondays Accidents

Question: How many accidents happened on Mondays?

Note: This solution has been completed for you.


sum(dat$day == "Mon", 
    na.rm = TRUE)
## [1] 4094


Answer: 4,094 accidents occurred on Mondays.


2. Monday Accidents (%)

Question: What proportion of accidents each week occur on Monday?


# Code

sum(dat$day == "Mon",
    na.rm = TRUE)
## [1] 4094
4094/28470
## [1] 0.1438005


Answer: [14.38005]% of all accidents occur on Mondays.


3. Harmful Monday Accidents (%)

Question: What proportion of accidents on Mondays result in harm?

Note: “Harm” is defined as any accident that causes at least one injury or fatality, a.k.a. a “casualty”.


# Code

dat %>%
  filter(day == "Mon" & Totalinjuries > 0, na.rm = TRUE )
sum( dat$day == "Mon" & dat$Totalinjuries > 0, na.rm = TRUE)
## [1] 1215
1215/28470
## [1] 0.0426765


Answer: [4.26765]% of all Monday accidents have at least one casualty.


4. Most Common Accidents

Question: What is the most common type of accident (Collisionmanner) that occurs on Mondays?


dat %>%
  filter(day == "Mon") %>%
  count(Collisionmanner) %>%
  arrange(desc(n))


Answer: [Rear End] collisions are the most common accident types.


5. Differences in Accidents

Question: Are there differences in the proportion of accidents that result in harm each day of the week?


# Code

table( x = dat$day, y = dat$ Totalinjuries > 0)
##      y
## x     FALSE TRUE
##   Mon  2879 1215
##   Tue  3160 1496
##   Wed  3235 1476
##   Thu  3247 1567
##   Fri  3531 1475
##   Sat  2245  799
##   Sun  1572  573
sum(dat$Totalinjuries & dat$day == "Mon")
## [1] 1215
sum(dat$Totalinjuries & dat$day == "Tue")
## [1] 1496
sum(dat$Totalinjuries & dat$day == "Wed")
## [1] 1476
sum(dat$Totalinjuries & dat$day == "Thu")
## [1] 1567
sum(dat$Totalinjuries & dat$day == "Fri")
## [1] 1475
sum(dat$Totalinjuries & dat$day == "Sat")
## [1] 799
sum(dat$Totalinjuries & dat$day == "Sun")
## [1] 573


Answer: Significantly more accidents occur [Thursday].


6. Accident Stats by Weekday

Instructions: Create a table that reports the following for each day of the week.

  • Total accidents
  • Total injuries
  • Total fatalities
  • Proportion of harmful accidents (i.e. casualties)


dat %>%
  group_by(day) %>%
  mutate(harm_acc = Totalinjuries > 0 | Totalfatalities > 0) %>%
  summarize(n = n(),
            injuries = sum(Totalinjuries),
            fatalities = sum(Totalfatalities),
            harm.rate = mean(harm_acc))



Part II: Age Groups

The following provides summaries of accidents by age groups.


1. Accidents by Hour & Age

Instructions: Create a table of counts of accidents by time of day (hour12) and age of driver (age).

Question: Which age group has the largest number of accidents at 7AM?


# Code


table( dat$hour12, dat$age)
##        
##         Age 16-18 Age 18-25 Age 25-35 Age 35-45 Age 45-55 Age 55-65 Age 65-75
##   12 AM        10       109        90        16        11         4         1
##   1 AM         84       587       324       190       184       153        85
##   2 AM          5       154        82        28         9         5         1
##   3 AM        109       585       349       206       187       138        85
##   4 AM          3        80        35        15         5         3         0
##   5 AM        134       674       419       270       228       155        92
##   6 AM          4        43        24        11        16         4         3
##   7 AM        157       835       563       314       280       184        83
##   8 AM          4        98        46        39        40        26         8
##   9 AM        152       989       582       356       262       168        68
##   10 AM        24       164       122        90        79        57        21
##   11 AM       106       635       381       226       174       119        59
##   12 PM        77       408       371       243       175       116        39
##   1 PM         74       376       213       126       101        62        37
##   2 PM         72       419       329       205       149       107        56
##   3 PM         48       338       170        91        71        44        20
##   4 PM         42       276       200       136       111        94        59
##   5 PM         58       295       135        70        52        51        13
##   6 PM         36       298       207       115       108        95        59
##   7 PM         54       241       100        46        38        19        13
##   8 PM         66       387       249       144       154       121        81
##   9 PM         38       169        88        40        35        15         8
##   10 PM        24       129        76        43        11         9         2
##   11 PM        77       507       301       230       199       129        77
##        
##         Age 75-100
##   12 AM          0
##   1 AM          43
##   2 AM           0
##   3 AM          50
##   4 AM           0
##   5 AM          55
##   6 AM           1
##   7 AM          46
##   8 AM           5
##   9 AM          41
##   10 AM          7
##   11 AM         41
##   12 PM         17
##   1 PM          13
##   2 PM          31
##   3 PM          12
##   4 PM          38
##   5 PM           6
##   6 PM          46
##   7 PM           2
##   8 PM          56
##   9 PM           3
##   10 PM          0
##   11 PM         57


Answer: Drivers of [18-25] have the greatest number of accidents from 7:00 to 7:59 AM.


2. Accidents by Hour & Age (%)

Instructions: Create a new table of time of day and age group that reports the proportion of accidents at “7 AM” (hour12) for each age group (age). The proportions within each age group should sum to one.



Objective: The table should contain the following columns and initial values:

age hour12 n n.age n.hour p p.age p.hour
Age 16-18 7 AM 77 1458 1606 0.05 0.05 0.05
Age 18-25 7 AM 408 8796 1606 0.25 0.05 0.25
Age 25-35 7 AM 371 5456 1606 0.23 0.07 0.23



Solution: The solution has been partially provided. Use the hints provided to create the table.

dat %>% 
  group_by(hour12, age) %>% 
  summarize(n = n()) %>%      # Partial solution
  group_by(age) %>%           # Requires two new variables in 'mutate()'
  mutate()                    # Lastly, requires function 'filter()
sum(dat$hour12 == "7 AM" & dat$age == "Age 16-18", na.rm = TRUE)
## [1] 157
sum(dat$hour12 == "7 AM" & dat$age == "Age 18-25", na.rm = TRUE)
## [1] 835
sum(dat$hour12 == "7 AM" & dat$age == "Age 25-35", na.rm = TRUE)
## [1] 563
dat %>%
  group_by(hour12, age) %>%
  mutate( prop_7_AM_16to18 = 157/28470) %>%
  mutate( prop_7_AM_18to25 = 835/28470) %>%
  mutate( prop_7_AM_25to35 = 563/28470) %>%
  summarize(prop_7_AM_16to18, prop_7_AM_18to25, prop_7_AM_25to35,
    n = n())



Part III: Rates of Harm

The following reports the accidents, casualties, proportion, and average casualties per harmful accident.


1. Accidents by Hour

Instructions: Visualize total accidents by time of day (hour).

Note: This solution has been completed for you.


dat %>%
  group_by(hour) %>%
  summarize(n = n()) %>%
  plot(type = "b",
       bty = "n",
       pch = 19,
       cex = 2,
       xlab = "Hour",
       ylab = "Total Number of Accidents",
       main = "Total Number of Accidents by Time of Day")


2. Total Casualties by Hour

Instructions: Visualize total injuries and fatalities by time of day (hour).


# Code

dat %>%
  group_by(Totalinjuries) %>%
  summarize(n = n()) %>%
  plot(type = "b",
       bty = "n",
       pch = 19,
       cex = 2,
       xlab = "Hour",
       ylab = "Total Number of Accidents",
       main = "Total Number of Accidents by Time of Day")


3. Accidents with Casualties (%)

Instructions: Visualize the proportion of harmful accidents out of all accidents by time of day (hour).


# Code

dat %>%
  group_by(hour12) %>%
  summarize(n = n()) %>%
  plot(type = "b",
       bty = "n",
       pch = 19,
       cex = 2,
       xlab = "Hour",
       ylab = "Total Number of Injuries",
       main = "Total Number of Injuries by Time of Day")


4. Avg. Harm by Harmful Accident

Instructions: Visualize average injuries or fatalities per harmful collision.


# Code


dat %>%
  group_by(Totalfatalities) %>%
  summarize(n = n()) %>%
  plot(type = "b",
       bty = "n",
       pch = 19,
       cex = 2,
       xlab = "Collision",
       ylab = "Total Number of Fatalities",
       main = "Total Number of Fatalities by Time of Day")


Appendix

The following code is used for preprocessing tasks in the above solutions.


A: Data Preprocessing

These expressions transform, format, and create myriad new variables used in this report.


date.vec <- strptime(dat$DateTime, 
                     format = "%m/%d/%y %H:%M")       # Create date fields

dat$hour   <- format(date.vec, format = "%H")
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$day <- factor(dat$day, 
                  levels = c("Mon",
                             "Tue",
                             "Wed",
                             "Thu",
                             "Fri",
                             "Sat",
                             "Sun"))                  # Order weekdays

dat$hour12 <- format(date.vec, 
                     format="%l %p")                  # Create 12-hour format

time.levels <- c("12 AM", paste(1:11, "AM"), 
                 "12 PM", paste(1:11, "PM"))

dat$hour12 <- factor(dat$hour12, 
                     levels = time.levels)            # Order time intervals

age.labels <- paste0("Age ", 
                     c(16,18,25,35,45,55,65,75), "-", 
                     c(18,25,35,45,55,65,75,100) )

dat$age <- cut(dat$Age_Drv1, 
               breaks = c(16,18,25,
                          35,45,55,
                          65,75,100), 
               labels = age.labels)                   # Discretize age ranges



————

DELETE THIS LINE & ALL LINES BELOW BEFORE SUBMITTING

————



How to Submit

Use the following instructions to submit your assignment, which may vary depending on your course’s platform.



Knitting to HTML

When you have completed your assignment, click the “Knit” button to render your .RMD file into a .HTML report.



Special Instructions

Perform the following depending on your course’s platform:

  • Canvas: Upload both your .RMD and .HTML files to the appropriate link
  • Blackboard or iCollege: Compress your .RMD and .HTML files in a .ZIP file and upload to the appropriate link

.HTML files are preferred but not allowed by all platforms.



Before You Submit

Remember to ensure the following before submitting your assignment.

  1. Name your files using this format: Lab-##-LastName.rmd and Lab-##-LastName.html
  2. Show both the solution for your code and write out your answers in the body text
  3. Do not show excessive output; truncate your output, e.g. with function head()
  4. Follow appropriate styling conventions, e.g. spaces after commas, etc.
  5. Above all, ensure that your conventions are consistent

See Google’s R Style Guide for examples of common conventions.



Common Knitting Issues

.RMD files are knit into .HTML and other formats procedural, or line-by-line.

  • An error in code when knitting will halt the process; error messages will tell you the specific line with the error
  • Certain functions like install.packages() or setwd() are bound to cause errors in knitting
  • Altering a dataset or variable in one chunk will affect their use in all later chunks
  • If an object is “not found”, make sure it was created or loaded with library() in a previous chunk

If All Else Fails: If you cannot determine and fix the errors in a code chunk that’s preventing you from knitting your document, add eval = FALSE inside the brackets of {r} at the beginning of a chunk to ensure that R does not attempt to evaluate it, that is: {r eval = FALSE}. This will prevent an erroneous chunk of code from halting the knitting process.