source/posts/explore-AU-road-fatalities.org

   1 #+date: <2017-10-10 16:56:56 +0800>
   2 #+filetags: :R:analysis:
   3 #+title: Explore Australian road fatalities.
   4
   5 Recently inspired to doing a little analysis again, I landed on a
   6 dataset from
   7 [[https://bitre.gov.au/statistics/safety/fatal_road_crash_database.aspx]],
   8 which I downloaded on 5 Oct 2017. Having open datasets for data is a
   9 great example of how governments are moving with the times!
  10
  11 ** Trends
  12 :PROPERTIES:
  13 :CUSTOM_ID: trends
  14 :HTML_CONTAINER_CLASS: card-body
  15 :END:
  16 I started by looking at the trends - what is the approximate number of
  17 road fatalities a year, and how is it evolving over time? Are there any
  18 differences noticeable between states? Or by gender?
  19
  20 #+CAPTION: Overall trendline
  21 #+ATTR_HTML: :class img-fluid :alt Overall trendline
  22 [[file:../assets/explore-AU-road-fatalities_files/fatalitiesTrends-1.png]]
  23 #+CAPTION: Trendlines by Australian state
  24 #+ATTR_HTML: :class img-fluid :alt Trendline by Australian state
  25 [[file:../assets/explore-AU-road-fatalities_files/fatalitiesTrends-2.png]]
  26 #+CAPTION: Trendlines by gender
  27 #+ATTR_HTML: :class img-fluid :alt Trendlines by gender
  28 [[file:../assets/explore-AU-road-fatalities_files/fatalitiesTrends-3.png]]
  29
  30 ** What age group is most at risk in city traffic?
  31 :PROPERTIES:
  32 :CUSTOM_ID: what-age-group-is-most-at-risk-in-city-traffic
  33 :HTML_CONTAINER_CLASS: card-body
  34 :END:
  35 Next, I wondered if there were any particular ages that were more at
  36 risk in city traffic. I opted to quickly bin the data to produce a
  37 histogram.
  38
  39 #+begin_example
  40 fatalities %>%
  41   filter(Year != 2017, Speed_Limit <= 50) %>%
  42   ggplot(aes(x=Age))+
  43   geom_histogram(binwidth = 5) +
  44   labs(title = "Australian road fatalities by age group",
  45        y = "Fatalities") +
  46   theme_economist()
  47
  48 ## Warning: Removed 2 rows containing non-finite values (stat_bin).
  49 #+end_example
  50
  51 #+CAPTION: histogram
  52 #+ATTR_HTLM: :class img-fluid :alt histogram
  53 [[file:../assets/explore-AU-road-fatalities_files/fatalities.cityTraffic-1.png]]
  54
  55 ** Hypothesis
  56 :PROPERTIES:
  57 :CUSTOM_ID: hypothesis
  58 :HTML_CONTAINER_CLASS: card-body
  59 :END:
  60 Based on the above, I wondered - are people above 65 more likely to die
  61 in slow traffic areas? To make this a bit easier, I added two variables
  62 to the dataset - one splitting people in younger and older than 65, and
  63 one based on the speed limit in the area of the crash being under or
  64 above 50 km per hour - city traffic or faster in Australia.
  65
  66 #+begin_example
  67 fatalities.pensioners <- fatalities %>%
  68   filter(Speed_Limit <= 110) %>% # less than 2% has this - determine why
  69   mutate(Pensioner = if_else(Age >= 65, TRUE, FALSE)) %>%
  70   mutate(Slow_Traffic = ifelse(Speed_Limit <= 50, TRUE, FALSE)) %>%
  71   filter(!is.na(Pensioner))
  72 #+end_example
  73
  74 To answer the question, I produce a density plot and a boxplot.
  75
  76 #+CAPTION: densityplot
  77 #+ATTR_HTML: :class img-fluid :alt densityplot
  78 [[file:../assets/explore-AU-road-fatalities_files/fatalitiesSegmentation-1.png]]
  79 #+CAPTION: boxplot
  80 #+ATTR_HTML: :class img-fluid :alt boxplot
  81 [[file:../assets/explore-AU-road-fatalities_files/fatalitiesSegmentation-2.png]]
  82
  83 Some further statistical analysis does confirm the hypothesis!
  84
  85 #+begin_example
  86 # Build a contingency table and perform prop test
  87 cont.table <- table(select(fatalities.pensioners, Slow_Traffic, Pensioner))
  88 cont.table
  89
  90 ##             Pensioner
  91 ## Slow_Traffic FALSE  TRUE
  92 ##        FALSE 36706  7245
  93 ##        TRUE   1985   690
  94
  95 prop.test(cont.table)
  96
  97 ##
  98 ##  2-sample test for equality of proportions with continuity
  99 ##  correction
 100 ##
 101 ## data:  cont.table
 102 ## X-squared = 154.11, df = 1, p-value < 2.2e-16
 103 ## alternative hypothesis: two.sided
 104 ## 95 percent confidence interval:
 105 ##  0.07596463 0.11023789
 106 ## sample estimates:
 107 ##    prop 1    prop 2
 108 ## 0.8351573 0.7420561
 109
 110 # Alternative approach to using prop test
 111 pensioners <- c(nrow(filter(fatalities.pensioners, Slow_Traffic == TRUE, Pensioner == TRUE)), nrow(filter(fatalities.pensioners, Slow_Traffic == FALSE, Pensioner == TRUE)))
 112 everyone <- c(nrow(filter(fatalities.pensioners, Slow_Traffic == TRUE)), nrow(filter(fatalities.pensioners, Slow_Traffic == FALSE)))
 113 prop.test(pensioners,everyone)
 114
 115 ##
 116 ##  2-sample test for equality of proportions with continuity
 117 ##  correction
 118 ##
 119 ## data:  pensioners out of everyone
 120 ## X-squared = 154.11, df = 1, p-value < 2.2e-16
 121 ## alternative hypothesis: two.sided
 122 ## 95 percent confidence interval:
 123 ##  0.07596463 0.11023789
 124 ## sample estimates:
 125 ##    prop 1    prop 2
 126 ## 0.2579439 0.1648427
 127 #+end_example
 128
 129 ** Conclusion
 130 :PROPERTIES:
 131 :CUSTOM_ID: conclusion
 132 :HTML_CONTAINER_CLASS: card-body
 133 :END:
 134 It's possible to conclude older people are over-represented in the
 135 fatalities in lower speed zones. Further ideas for investigation are
 136 understanding the impact of the driving age limit on the fatalities -
 137 the position in the car of the fatalities (driver or passenger) was not
 138 yet considered in this quick look at the contents of the dataset.
 139
 140 #+CAPTION: quantile-quantile plot
 141 #+ATTR_HTML: :class img-fluid :alt quantile-quantile plot
 142 [[file:../assets/explore-AU-road-fatalities_files/fatalitiesDistComp-1.png]]