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