## ----message=F---------------------------------------------------------------- library(dplyr) library(ggplot2) library(tidyr) library(rfars) ## ----results='asis', eval=FALSE----------------------------------------------- # myFARS <- get_fars(years = 2023, proceed = TRUE) # counts(myFARS, involved = 'alcohol') %>% knitr::kable(format = "html") ## ----results='asis', echo=F--------------------------------------------------- vignette_data <- rfars:::vignette_data knitr::kable(vignette_data$alccounts_1, format = "html") message("Note: rfars::counts() uses the variables alc_res and dr_drink to determine alcohol involvement. NHTSA reports counts using multiple imputation to estimate missing BAC values. See vignette('Alcohol Counts', package = 'rfars') for more information.") ## ----results='asis', eval=F--------------------------------------------------- # counts( # df = myFARS, # what = "fatalities", # involved = 'alcohol' # ) %>% # knitr::kable(format = "html") ## ----results='asis', echo=F--------------------------------------------------- knitr::kable(vignette_data$alccounts_2, format = "html") message("Note: rfars::counts() uses the variables alc_res and dr_drink to determine alcohol involvement. NHTSA reports counts using multiple imputation to estimate missing BAC values. See vignette('Alcohol Counts', package = 'rfars') for more information.") ## ----eval=F------------------------------------------------------------------- # temp <- myFARS$flat %>% # select(year:per_no, age, sex, per_typ, inj_sev, alc_res, dr_drink, a1:a10) %>% # filter(inj_sev == "Fatal Injury (K)") # # for(i in 1:10) { # imputation_col <- paste0("a", i) # temp[[paste0("FPC", i)]] <- ifelse(temp[[imputation_col]] == 0, 1, 0) # BAC = 0.00 # temp[[paste0("SPC", i)]] <- ifelse(temp[[imputation_col]] >= 1 & temp[[imputation_col]] <= 7, 1, 0) # BAC = 0.01-0.07 # temp[[paste0("TPC", i)]] <- ifelse(temp[[imputation_col]] >= 8, 1, 0) # BAC = 0.08+ # } ## ----results='asis', eval=F--------------------------------------------------- # temp %>% # select(st_case, a1:a10, starts_with("FPC"), starts_with("SPC"), starts_with("TPC")) %>% # slice(1:10) %>% # t() %>% # knitr::kable(format = "html") ## ----results='asis', echo=F--------------------------------------------------- vignette_data$alccounts_3 %>% t() %>% knitr::kable(format = "html") ## ----results='asis', eval=F--------------------------------------------------- # temp %>% # slice(1) %>% # select(st_case, a1:a10, starts_with("FPC"), starts_with("SPC"), starts_with("TPC")) %>% # pivot_longer(-1) %>% # mutate( # iter = gsub("\\D", "", name), # name = gsub("[^A-Za-z]", "", name) # ) %>% # pivot_wider() %>% # knitr::kable(format = "html") ## ----results='asis', echo=F--------------------------------------------------- vignette_data$alccounts_4 %>% pivot_wider() %>% knitr::kable(format = "html") ## ----eval=F------------------------------------------------------------------- # case_results <- list() # # for(i in 1:10) { # fpc_col <- paste0("FPC", i) # spc_col <- paste0("SPC", i) # tpc_col <- paste0("TPC", i) # # case_results[[i]] <- # temp %>% # summarise( # TOTAL = n(), # !!paste0("FSBAC", i) := sum(!!sym(fpc_col), na.rm = TRUE), # !!paste0("SSBAC", i) := sum(!!sym(spc_col), na.rm = TRUE), # !!paste0("TSBAC", i) := sum(!!sym(tpc_col), na.rm = TRUE), # .groups = 'drop' # ) # } ## ----results='asis', eval=F--------------------------------------------------- # bind_rows( # data.frame(case_results[[1]]) %>% select(TOTAL, FSBAC=2, SSBAC=3, TSBAC=4) %>% mutate(iter=1), # data.frame(case_results[[2]]) %>% select(TOTAL, FSBAC=2, SSBAC=3, TSBAC=4) %>% mutate(iter=2), # data.frame(case_results[[3]]) %>% select(TOTAL, FSBAC=2, SSBAC=3, TSBAC=4) %>% mutate(iter=3), # data.frame(case_results[[4]]) %>% select(TOTAL, FSBAC=2, SSBAC=3, TSBAC=4) %>% mutate(iter=4), # data.frame(case_results[[5]]) %>% select(TOTAL, FSBAC=2, SSBAC=3, TSBAC=4) %>% mutate(iter=5), # data.frame(case_results[[6]]) %>% select(TOTAL, FSBAC=2, SSBAC=3, TSBAC=4) %>% mutate(iter=6), # data.frame(case_results[[7]]) %>% select(TOTAL, FSBAC=2, SSBAC=3, TSBAC=4) %>% mutate(iter=7), # data.frame(case_results[[8]]) %>% select(TOTAL, FSBAC=2, SSBAC=3, TSBAC=4) %>% mutate(iter=8), # data.frame(case_results[[9]]) %>% select(TOTAL, FSBAC=2, SSBAC=3, TSBAC=4) %>% mutate(iter=9), # data.frame(case_results[[10]]) %>% select(TOTAL, FSBAC=2, SSBAC=3, TSBAC=4) %>% mutate(iter=10) # ) %>% # knitr::kable(format = "html") ## ----results='asis', echo=F--------------------------------------------------- knitr::kable(vignette_data$alccounts_5, format = "html") ## ----eval=F------------------------------------------------------------------- # calc <- case_results[[1]] # # for(i in 2:10) { # calc <- calc %>% bind_cols(case_results[[i]] %>% select(-TOTAL)) # } # # calc <- # calc %>% # rowwise() %>% # mutate( # SBAC0 = round(mean(c_across(starts_with("FSBAC")), na.rm = TRUE)), # BAC 0.00 # SBAC1 = round(mean(c_across(starts_with("SSBAC")), na.rm = TRUE)), # BAC 0.01-0.07 # SBAC2 = round(mean(c_across(starts_with("TSBAC")), na.rm = TRUE)) # BAC 0.08+ # ) %>% # ungroup() ## ----results='asis', eval=F--------------------------------------------------- # select(calc, SBAC0:SBAC2) %>% knitr::kable(format = "html") ## ----results='asis', echo=F--------------------------------------------------- knitr::kable(vignette_data$alccounts_6, format = "html") ## ----eval=F------------------------------------------------------------------- # x <- # myFARS$flat %>% # select(year:per_no, age, sex, per_typ, inj_sev, alc_res, dr_drink, a1:a10) %>% # filter(inj_sev == "Fatal Injury (K)") %>% # mutate_at(paste0("a", 1:10), function(x) 1*(x>=8)) %>% # group_by(year) %>% # summarize_at(paste0("a", 1:10), sum, na.rm=T) %>% # rowwise() %>% # mutate(a = round(mean(c_across(a1:a10)))) # # x$a ## ----echo=F------------------------------------------------------------------- vignette_data$alccounts_7