HSM_9_35

The 2010 Highway Safety Manual (HSM) Section 9-35 Site Specific Empirical Bayes (EB) Analysis is included in version 1.0 of HSM package. The vignette provides instructions to use the section 9-35 “HSM_9_35” and “spf” functions.

#install.packages("devtools")   
library(devtools)
#> Loading required package: usethis

Install package via GitHub.

#install_github("https://github.com/cn838/HSM.git")
library(HSM)
#> Loading required package: dplyr
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
#> Loading required package: tidyr

The spf function

Predicted crashes can be computed using the spf function.

spf(
  AADTMAJ=1000,
  AADTMIN=100,
  L=NULL,
  Base_Condition="HSM-RUR2-4ST-KABCO",
  Provide_Overdispersion_Factor=FALSE,
  Segment=FALSE
)
#> [1] 0.20065

The overdispersion parameter (k) is provided by specifying TRUE within the provide overdispersion factor parameter. Please note that version 1.0 only includes intersection SPFs from the 2010 HSM found in the SPF_table.RData.

spf(
  AADTMAJ=1000,
  AADTMIN=100,
  L=NULL,
  Base_Condition="HSM-RUR2-4ST-KABCO",
  Provide_Overdispersion_Factor=TRUE,
  Segment=FALSE
)
#> [1] 0.24

The HSM Section 9-35 function

The HSM_9_35 function is demonstrated within two examples. The two examples demonstrate the accuracy and the use of the function with HSM example and user defined data, respectively.

A sample problem to illustrate the HSM_9_35 function with the EB Before/After Safety Effectiveness Evaluation Method

Excel friendly users may import data into Rstudio. It is recommended to use the X9_10_template with version 1.0. Take for example, section 9.10 saved as “X9_10_seg.RData” (pg. 9-17). The script supports a total of 20 years of data (e.g. 10 years before and after).

str(X9_10_seg) 
#> tibble [13 × 48] (S3: tbl_df/tbl/data.frame)
#>  $ Site_No.            : num [1:13] 1 2 3 4 5 6 7 8 9 10 ...
#>  $ Yrs_Before          : num [1:13] 5 5 5 5 5 5 5 5 5 5 ...
#>  $ Yrs_After           : num [1:13] 2 2 2 2 2 2 2 2 2 2 ...
#>  $ Base_Past           : chr [1:13] "HSM-RUR2U-KABCO" "HSM-RUR2U-KABCO" "HSM-RUR2U-KABCO" "HSM-RUR2U-KABCO" ...
#>  $ Base_Current        : chr [1:13] "HSM-RUR2U-KABCO" "HSM-RUR2U-KABCO" "HSM-RUR2U-KABCO" "HSM-RUR2U-KABCO" ...
#>  $ L                   : num [1:13] 1.114 0.88 0.479 1 0.459 ...
#>  $ CMF                 : num [1:13] 1 1 1 1 1 1 1 1 1 1 ...
#>  $ C                   : num [1:13] 1 1 1 1 1 1 1 1 1 1 ...
#>  $ Before.AADT.Major_1 : num [1:13] 8858 11190 11190 6408 6402 ...
#>  $ Before.AADT.Major_2 : num [1:13] 8858 11190 11190 6408 6402 ...
#>  $ Before.AADT.Major_3 : num [1:13] 8858 11190 11190 6408 6402 ...
#>  $ Before.AADT.Major_4 : num [1:13] 8858 11190 11190 6408 6402 ...
#>  $ Before.AADT.Major_5 : num [1:13] 8858 11190 11190 6408 6402 ...
#>  $ Before.AADT.Major_6 : logi [1:13] NA NA NA NA NA NA ...
#>  $ Before.AADT.Major_7 : logi [1:13] NA NA NA NA NA NA ...
#>  $ Before.AADT.Major_8 : logi [1:13] NA NA NA NA NA NA ...
#>  $ Before.AADT.Major_9 : logi [1:13] NA NA NA NA NA NA ...
#>  $ Before.AADT.Major_10: logi [1:13] NA NA NA NA NA NA ...
#>  $ After.AADT.Major_1  : num [1:13] 8832 11156 11156 6388 6382 ...
#>  $ After.AADT.Major_2  : num [1:13] 8832 11156 11156 6388 6382 ...
#>  $ After.AADT.Major_3  : logi [1:13] NA NA NA NA NA NA ...
#>  $ After.AADT.Major_4  : logi [1:13] NA NA NA NA NA NA ...
#>  $ After.AADT.Major_5  : logi [1:13] NA NA NA NA NA NA ...
#>  $ After.AADT.Major_6  : logi [1:13] NA NA NA NA NA NA ...
#>  $ After.AADT.Major_7  : logi [1:13] NA NA NA NA NA NA ...
#>  $ After.AADT.Major_8  : logi [1:13] NA NA NA NA NA NA ...
#>  $ After.AADT.Major_9  : logi [1:13] NA NA NA NA NA NA ...
#>  $ After.AADT.Major_10 : logi [1:13] NA NA NA NA NA NA ...
#>  $ Before.Yr_1         : num [1:13] 4 2 1 2 0 1 4 4 2 1 ...
#>  $ Before.Yr_2         : num [1:13] 4 0 0 5 0 1 3 3 0 0 ...
#>  $ Before.Yr_3         : num [1:13] 1 0 2 4 1 0 3 1 6 1 ...
#>  $ Before.Yr_4         : num [1:13] 5 2 1 3 0 2 4 1 0 1 ...
#>  $ Before.Yr_5         : num [1:13] 2 2 0 2 0 1 3 3 0 0 ...
#>  $ Before.Yr_6         : logi [1:13] NA NA NA NA NA NA ...
#>  $ Before.Yr_7         : logi [1:13] NA NA NA NA NA NA ...
#>  $ Before.Yr_8         : logi [1:13] NA NA NA NA NA NA ...
#>  $ Before.Yr_9         : logi [1:13] NA NA NA NA NA NA ...
#>  $ Before.Yr_10        : logi [1:13] NA NA NA NA NA NA ...
#>  $ After.Yr_1          : num [1:13] 1 0 1 0 0 1 6 0 0 0 ...
#>  $ After.Yr_2          : num [1:13] 1 2 1 1 1 0 3 0 0 0 ...
#>  $ After.Yr_3          : logi [1:13] NA NA NA NA NA NA ...
#>  $ After.Yr_4          : logi [1:13] NA NA NA NA NA NA ...
#>  $ After.Yr_5          : logi [1:13] NA NA NA NA NA NA ...
#>  $ After.Yr_6          : logi [1:13] NA NA NA NA NA NA ...
#>  $ After.Yr_7          : logi [1:13] NA NA NA NA NA NA ...
#>  $ After.Yr_8          : logi [1:13] NA NA NA NA NA NA ...
#>  $ After.Yr_9          : logi [1:13] NA NA NA NA NA NA ...
#>  $ After.Yr_10         : logi [1:13] NA NA NA NA NA NA ...

Check the “Basic Input Data” using the “testthat” package.

library(testthat)
#> 
#> Attaching package: 'testthat'
#> The following object is masked from 'package:tidyr':
#> 
#>     matches
#> The following object is masked from 'package:dplyr':
#> 
#>     matches
#> The following object is masked from 'package:devtools':
#> 
#>     test_file

testthat::test_that("Basic Input Data check", {
  expect_equal(sum(HSM::HSM_9_35(data = X9_10_seg, segment=TRUE, group = FALSE, group_base_by = "Past")[[9]]), 122)
  expect_equal(sum(HSM::HSM_9_35(data = X9_10_seg, segment=TRUE, group = FALSE, group_base_by = "Past")[["Observed Crashes in the After Period"]]), 30)
  print("Basic input data matches.")
})
#> [1] "Basic input data matches."
#> Test passed 😸

The site specific results are obtained and cross verified with the HSM.

testthat::test_that("values from Eq. 9A.1-11", {
  expect_equal(sum(HSM::HSM_9_35(data = X9_10_seg, segment=TRUE, group = FALSE, group_base_by = "Past" )[["Variance (9A.1-11)"]]), 11.161 )
  print("The cumulative sum of the Variance terms match the expected output")
})
#> [1] "The cumulative sum of the Variance terms match the expected output"
#> Test passed 😸

Similarly, the “Estimation of the Precision of the Treatment Effectiveness” are verified.

testthat::test_that("Precision tests", {expect_equal(HSM::HSM_9_35(data = X9_10_seg, segment=TRUE, group = TRUE, group_base_by = "Past")[["Standard Error of Safety Effectiveness (9A.1-13)"]], 13.882)
  expect_equal(HSM::HSM_9_35(data = X9_10_seg, segment=TRUE, group = TRUE, group_base_by = "Past")[["Test Statistic (Step 14)"]], 2.194)
  print("The percision outputs match the results from Steps 13 & 14")
  })
#> [1] "The percision outputs match the results from Steps 13 & 14"
#> Test passed 🌈

The site specific results table is now ready to be copied and pasted into a spreadsheet, for word processing.

HSM::HSM_9_35(data = X9_10_seg, segment=TRUE, group = FALSE, group_base_by = "Past") %>% knitr::kable(digits = 3, format.args = list(decimal.mark = ".", big.mark = ","), align= 'c', caption = "Example 9.10 Emperical Bayes Total Crash Pooled Results ")
Example 9.10 Emperical Bayes Total Crash Pooled Results
Site_No. Years in the Before Period Years in the After Period Past Base Condition Current Base Condition Segment Length Crash Modification Factor Calibration Factor Observed Crashes in the Before Periods Average AADT in the Before Period Predicted Crashes in the Before Period Average AADT in the After Period Predicted Crashes in the After Period Overdisperion Factor Weight (9A.1-2) Adjustment Factor (9A.1-3) Expected Crashes in the Before Period (9A.1-2) Expected Crashes in the After Period (9A.1-4) Observed Crashes in the After Period Odds Ratio (9A.1-5) Variance (9A.1-11) Unbiased Odds Ratio (9A.1-8) Safety Effectiveness (9A.1-10) Variance Odds Ratio Standard Error Odds Ratio (9A.1-12) Standard Error of Safety Effectiveness (9A.1-13) Test Statistic (Step 14) Significance Level (Step 14)
1 5 2 HSM-RUR2U-KABCO HSM-RUR2U-KABCO 1.114 1 1 16 8,858 13.182 8,832 5.257 0.212 0.264 0.399 15.257 6.085 2 0.329 1.787 0.003 67.132 0.059 0.243 24.288 2.764 95%
2 5 2 HSM-RUR2U-KABCO HSM-RUR2U-KABCO 0.880 1 1 6 11,190 13.155 11,156 5.246 0.268 0.221 0.399 7.580 3.023 2 0.662 0.939 0.037 33.837 0.260 0.510 50.959 0.664 N.S.
3 5 2 HSM-RUR2U-KABCO HSM-RUR2U-KABCO 0.479 1 1 4 11,190 7.160 11,156 2.855 0.493 0.221 0.399 4.698 1.873 2 1.068 0.582 0.192 -6.753 0.732 0.856 85.553 0.079 N.S.
4 5 2 HSM-RUR2U-KABCO HSM-RUR2U-KABCO 1.000 1 1 16 6,408 8.560 6,388 3.413 0.236 0.331 0.399 13.537 5.398 1 0.185 1.440 0.003 81.474 0.036 0.190 18.957 4.298 95%
5 5 2 HSM-RUR2U-KABCO HSM-RUR2U-KABCO 0.459 1 1 1 6,402 3.925 6,382 1.565 0.514 0.331 0.399 1.969 0.785 1 1.274 0.209 1.708 -27.351 2.033 1.426 142.581 0.192 N.S.
6 5 2 HSM-RUR2U-KABCO HSM-RUR2U-KABCO 0.500 1 1 5 6,268 4.187 6,250 1.670 0.472 0.336 0.399 4.727 1.885 1 0.530 0.499 0.100 46.957 0.316 0.562 56.215 0.835 N.S.
7 5 2 HSM-RUR2U-KABCO HSM-RUR2U-KABCO 0.987 1 1 17 6,268 8.264 6,250 3.296 0.239 0.336 0.399 14.065 5.610 9 1.604 1.486 0.021 -60.436 0.402 0.634 63.406 0.953 N.S.
8 5 2 HSM-RUR2U-KABCO HSM-RUR2U-KABCO 0.710 1 1 12 5,503 5.219 5,061 1.920 0.332 0.366 0.368 9.521 3.502 0 0.000 0.817 0.000 100.000 NaN NaN NaN NaN NA
9 5 2 HSM-RUR2U-KABCO HSM-RUR2U-KABCO 0.880 1 1 8 5,523 6.493 5,024 2.362 0.268 0.365 0.364 7.450 2.711 0 0.000 0.627 0.000 100.000 NaN NaN NaN NaN NA
10 5 2 HSM-RUR2U-KABCO HSM-RUR2U-KABCO 0.720 1 1 3 5,523 5.312 5,024 1.933 0.328 0.365 0.364 3.843 1.398 0 0.000 0.323 0.000 100.000 NaN NaN NaN NaN NA
11 5 2 HSM-RUR2U-KABCO HSM-RUR2U-KABCO 0.780 1 1 9 5,523 5.755 5,024 2.094 0.303 0.365 0.364 7.816 2.844 5 1.758 0.657 0.131 -75.810 0.850 0.922 92.222 0.822 N.S.
12 5 2 HSM-RUR2U-KABCO HSM-RUR2U-KABCO 1.110 1 1 9 5,523 8.190 5,024 2.980 0.213 0.365 0.364 8.704 3.167 6 1.894 0.732 0.109 -89.444 0.842 0.918 91.773 0.975 N.S.
13 5 2 HSM-RUR2U-KABCO HSM-RUR2U-KABCO 0.920 1 1 16 5,523 6.788 5,024 2.470 0.257 0.365 0.364 12.639 4.599 1 0.217 1.063 0.005 78.256 0.050 0.223 22.258 3.516 95%

Lastly, the effectiveness is of the treatment effect or CMF is obtained, for word processing.

HSM::HSM_9_35(data = X9_10_seg, segment=TRUE, group = TRUE, group_base_by = "Past") %>% knitr::kable(digits = 3, format.args = list(decimal.mark = ".", big.mark = ","), align= 'c', caption = "Example 9.10 Emperical Bayes Total Crash Pooled Results ")
Example 9.10 Emperical Bayes Total Crash Pooled Results
Past Base Condition Total Sites Years in the Before Period Total Years in the After Period Total Observed Crashes in the Before Periods Total Observed Crashes in the After Period Total Predicted Crashes in the Before Period Expected Crashes in the Before Period (9A.1-2) Total Predicted Crashes in the After Period Total Expected Crashes in the After Period (9A.1-4) Average AADT in the Before Period Average AADT in the After Period Odds Ratio (9A.1-5) Variance (9A.1-11) Unbiased Odds Ratio (9A.1-8) Variance Odds Ratio Safety Effectiveness (9A.1-10) Standard Error Odds Ratio (9A.1-12) Standard Error of Safety Effectiveness (9A.1-13) Test Statistic (Step 14) Significance Level (Step 14)
HSM-RUR2U-KABCO 13 65 26 122 30 96.19 111.806 37.061 42.88 6,900.154 6,661.154 0.7 11.169 0.695 0.019 30.46 0.139 13.882 2.194 95%

HSM_9_35 for Intersections

Entering data is performed by implementing base R functions (i.e. concatenate c() and data.frame()). Please note that version 1.0 requires the column names to be exactly the same as contained in the “X9_10_template.RData”.

data=data.frame(
Site_No.=c(1,2,3,4,5,6), # id number 
Yrs_Before=c(3,3,3,3,3,3), # years in the before period
Yrs_After=c(3,3,3,3,3,3), # years in the after period
Base_Past=c(
  "HSM-RUR2-3ST-KABCO", #SPF associated with the intersection or treatment for KABCO or KABC crash types.
  "HSM-RUR2-4ST-KABCO", 
  "HSM-RUR2-4SG-KABCO",
  "HSM-RUR2-3ST-KABCO", 
  "HSM-RUR2-4ST-KABCO",
  "HSM-RUR2-4SG-KABCO"
),
Base_Current=c(
  "RUR2-4RA",
  "RUR2-4RA",
  "RUR2-4RA",
  "Urban Single Lane Roundabout",
  "RUR2-4RA",
  "RUR2-4RA"),
L=c(NA,NA,NA,NA,NA,NA), # omit for intersection analysis
CMF=c(1.1,0.90,0.98,1,1,1.0), #crash modification factor. User specifies 1.0 if none was used.
C=c(1.2,1.2,1.2,1.2,1.2,1.2), #calibration factor. User specifies 1.0 if none was used.

Before.AADT.Major_1=c(1100,1190,1100,1150,900,500), #traffic volumes on the major approach during year one for site one ect.
Before.AADT.Major_2=c(1000,900,1150,1150,900,550),
Before.AADT.Major_3=c(1000,950,1125,1150,900,550),
Before.AADT.Major_4=c(1000,950,1125,1150,900,550),
Before.AADT.Major_5=c(1050,900,1125,1150,900,550),
Before.AADT.Major_6=c(1050,900,1125,1150,900,550),

Before.AADT.Minor_1=c(100,90,1100,110,90,550), #traffic volumes for minor approaches
Before.AADT.Minor_2=c(100,90,1100,110,90,550),
Before.AADT.Minor_3=c(100,90,1100,110,90,550),
Before.AADT.Minor_4=c(100,90,1100,110,90,550),
Before.AADT.Minor_5=c(100,90,1100,110,90,550),
Before.AADT.Minor_6=c(100,90,1100,110,90,550),

After.AADT.Major_1=c(1000,1000,1000,1000,1000,1000), #major approach traffic volumes in the after period 
After.AADT.Major_2=c(1000,1000,1000,1000,1000,1000),
After.AADT.Major_3=c(1000,1000,1000,1000,1000,1000),
After.AADT.Major_4=c(1000,1000,1000,1000,1000,1000),
After.AADT.Major_5=c(1000,1000,1000,1000,1000,1000),
After.AADT.Major_6=c(1000,1000,1000,1000,1000,1000),

After.AADT.Minor_1=c(200,200,80,700,80,90),#minor approach traffic volumes in the after period 
After.AADT.Minor_2=c(200,200,80,700,80,90),
After.AADT.Minor_3=c(200,200,80,700,80,90),
After.AADT.Minor_4=c(200,200,80,700,80,90),
After.AADT.Minor_5=c(200,200,80,700,80,90),
After.AADT.Minor_6=c(200,200,80,700,80,90),

Before.Yr_1=c(0,2,3,1,1,3), # crashes in the before periods 1,2,3,..,6
Before.Yr_2=c(0,0,0,0,0,0),
Before.Yr_3=c(1,0,1,3,0,0),
Before.Yr_4=c(0,1,0,1,0,1),
Before.Yr_5=c(1,0,0,1,0,1),
Before.Yr_6=c(0,0,0,1,1,0),

After.Yr_1=c(0,0,0,0,0,1), # crashes in the after periods 1,2,3,..,6
After.Yr_2=c(0,0,0,0,0,0),
After.Yr_3=c(0,0,1,0,0,1),
After.Yr_4=c(0,1,0,0,0,0),
After.Yr_5=c(0,0,0,0,0,0),
After.Yr_6=c(1,0,0,1,0,0))

Specify the “group” parameter equal to “FALSE” to provide a tibble that contains the site specific results.

HSM::HSM_9_35(data = data, segment=FALSE, group = FALSE)
#> # A tibble: 6 × 29
#> # Rowwise: 
#>   Site_No. `Years in the Be…` `Years in the …` `Past Base Con…` `Current Base …`
#>      <dbl>              <dbl>            <dbl> <chr>            <chr>           
#> 1        1                  3                3 HSM-RUR2-3ST-KA… RUR2-4RA        
#> 2        2                  3                3 HSM-RUR2-4ST-KA… RUR2-4RA        
#> 3        3                  3                3 HSM-RUR2-4SG-KA… RUR2-4RA        
#> 4        4                  3                3 HSM-RUR2-3ST-KA… Urban Single La…
#> 5        5                  3                3 HSM-RUR2-4ST-KA… RUR2-4RA        
#> 6        6                  3                3 HSM-RUR2-4SG-KA… RUR2-4RA        
#> # … with 24 more variables: `Crash Modification Factor` <dbl>,
#> #   `Calibration Factor` <dbl>, `Observed Crashes in the Before Periods` <dbl>,
#> #   `Average Major AADT in the Before Period` <dbl>,
#> #   `Average Minor AADT in the Before Period` <dbl>,
#> #   `Predicted Crashes in the Before Period` <dbl>,
#> #   `Average Major AADT in the After Period` <dbl>,
#> #   `Average Minor AADT in the After Period` <dbl>, …

Specify the “group” and “group_base_by” parameters equal to “TRUE”, “Past” or “Current” to provide tibble that contains the “Estimation of the Precision of the Treatment Effectiveness”. The unbiased Odds Ratio is the Crash Modification Factor (CMF). Similar to the Comparison Group (CG) method, sites with zero crashes in the after periods will effect the precision of the estimate.

HSM::HSM_9_35(data = data, segment=FALSE, group = TRUE, group_base_by= "Past")
#> # A tibble: 3 × 23
#>   `Past Base Condition` `Total Sites` `Years in the Before Pe…` `Total Years i…`
#>   <chr>                         <dbl>                     <dbl>            <dbl>
#> 1 HSM-RUR2-3ST-KABCO                2                         6                6
#> 2 HSM-RUR2-4SG-KABCO                2                         6                6
#> 3 HSM-RUR2-4ST-KABCO                2                         6                6
#> # … with 19 more variables:
#> #   `Total Observed Crashes in the Before Periods` <dbl>,
#> #   `Total Observed Crashes in the After Period` <dbl>,
#> #   `Total Predicted Crashes in the Before Period` <dbl>,
#> #   `Expected Crashes in the Before Period (9A.1-2)` <dbl>,
#> #   `Total Predicted Crashes in the After Period` <dbl>,
#> #   `Total Expected Crashes in the After Period (9A.1-4)` <dbl>, …

Specify the the “group_base_by” parameter to obtain results aggregated by future or current base conditions.

HSM::HSM_9_35(data = data, segment=FALSE, group = TRUE, group_base_by = "Current") 
#> # A tibble: 2 × 23
#>   `Past Base Condition`        `Total Sites` `Years in the Be…` `Total Years i…`
#>   <chr>                                <dbl>              <dbl>            <dbl>
#> 1 RUR2-4RA                                 5                 15               15
#> 2 Urban Single Lane Roundabout             1                  3                3
#> # … with 19 more variables:
#> #   `Total Observed Crashes in the Before Periods` <dbl>,
#> #   `Total Observed Crashes in the After Period` <dbl>,
#> #   `Total Predicted Crashes in the Before Period` <dbl>,
#> #   `Expected Crashes in the Before Period (9A.1-2)` <dbl>,
#> #   `Total Predicted Crashes in the After Period` <dbl>,
#> #   `Total Expected Crashes in the After Period (9A.1-4)` <dbl>, …

The results are copied and pasted into an spreadsheet, for word processing using “kable()”.

HSM::HSM_9_35(data = data, segment=FALSE, group = TRUE, group_base_by = "Current" ) %>% knitr::kable(digits = 3, format.args = list(decimal.mark = ".", big.mark = ","), align= 'c', caption = "Table 1: Estimation of the Precision of the Treatment Effectiveness")
Table 1: Estimation of the Precision of the Treatment Effectiveness
Past Base Condition Total Sites Years in the Before Period Total Years in the After Period Total Observed Crashes in the Before Periods Total Observed Crashes in the After Period Total Predicted Crashes in the Before Period Expected Crashes in the Before Period (9A.1-2) Total Predicted Crashes in the After Period Total Expected Crashes in the After Period (9A.1-4) Average Major AADT in the Before Period Average Minor AADT in the Before Period Average Major AADT in the After Period Average Minor AADT in the After Period Odds Ratio (9A.1-5) Variance (9A.1-11) Unbiased Odds Ratio (9A.1-8) Variance Odds Ratio Safety Effectiveness (9A.1-10) Standard Error Odds Ratio (9A.1-12) Standard Error of Safety Effectiveness (9A.1-13) Test Statistic (Step 14) Significance Level (Step 14)
RUR2-4RA 5 15 15 11 3 10.714 10.309 8.741 8.786 921 386 1,000 130 0.341 2.042 0.333 0.042 66.735 0.205 20.462 3.261 95%
Urban Single Lane Roundabout 1 3 3 4 0 0.492 1.229 1.092 2.726 1,150 110 1,000 700 0.000 1.270 0.000 NaN 100.000 NaN NaN NaN NA

Please note more flexibility will be provided with future revisions.