85 lines
4.0 KiB
R
85 lines
4.0 KiB
R
library(tidyverse)
|
|
library(sf)
|
|
library(tmap)
|
|
|
|
## Load TOPS data ----
|
|
## To load TOPS data for the whole state for crashes involving bikes and pedestrians):
|
|
## Step 1 - download csv from the TOPS Data Retrieval Tool with the query: SELECT * FROM DTCRPRD.SUMMARY_COMBINED C WHERE C.CRSHDATE BETWEEN TO_DATE('2023-JAN','YYYY-MM') AND LAST_DAY(TO_DATE('2023-DEC','YYYY-MM')) AND (C.BIKEFLAG = 'Y' OR C.PEDFLAG = 'Y') ORDER BY C.DOCTNMBR
|
|
## Step 2 - include RACE1 and RACE2 for download in preferences
|
|
## Step 3 - save the csv in the "data" directory as crash-data-download_2023.csv
|
|
TOPS_data <- as.list(NULL)
|
|
for (file in list.files(path = "data/TOPS/", pattern = "crash-data-download")) {
|
|
message(paste("importing data from file: ", file))
|
|
year <- substr(file, 21, 24)
|
|
csv_run <- read_csv(file = paste0("data/TOPS/",file), col_types = cols(.default = "c"))
|
|
TOPS_data[[file]] <- csv_run
|
|
}
|
|
rm(csv_run, file, year)
|
|
TOPS_data <- bind_rows(TOPS_data)
|
|
|
|
## clean up data ----
|
|
TOPS_data <- TOPS_data %>%
|
|
mutate(date = mdy(CRSHDATE),
|
|
age1 = as.double(AGE1),
|
|
age2 = as.double(AGE2),
|
|
latitude = as.double(LATDECDG),
|
|
longitude = as.double(LONDECDG)) %>%
|
|
mutate(month = month(date, label = TRUE),
|
|
year = as.factor(year(date)))
|
|
|
|
# Injury Severy Index and Color -----
|
|
injury_severity <- data.frame(InjSevName = c("No apparent injury", "Possible Injury", "Suspected Minor Injury","Suspected Serious Injury","Fatality"),
|
|
code = c("O", "C", "B", "A", "K"),
|
|
color = c("#fafa6e", "#edc346", "#d88d2d", "#bd5721", "#9b1c1c"))
|
|
|
|
TOPS_data <- left_join(TOPS_data, injury_severity %>% select(InjSevName, code), join_by(INJSVR1 == code)) %>%
|
|
mutate(InjSevName = factor(InjSevName, levels = injury_severity$InjSevName)) %>%
|
|
rename(InjSevName1 = InjSevName)
|
|
TOPS_data <- left_join(TOPS_data, injury_severity %>% select(InjSevName, code), join_by(INJSVR2 == code)) %>%
|
|
mutate(InjSevName = factor(InjSevName, levels = injury_severity$InjSevName)) %>%
|
|
rename(InjSevName2 = InjSevName)
|
|
|
|
TOPS_data <- TOPS_data %>% mutate(ped_inj = ifelse(ROLE1 %in% c("BIKE", "PED"),
|
|
INJSVR1,
|
|
ifelse(ROLE2 %in% c("BIKE", "PED"),
|
|
INJSVR2,
|
|
NA)))
|
|
|
|
TOPS_data <- left_join(TOPS_data, injury_severity %>% select(InjSevName, code), join_by(ped_inj == code)) %>%
|
|
mutate(InjSevName = factor(InjSevName, levels = injury_severity$InjSevName)) %>%
|
|
rename(ped_inj_name = InjSevName)
|
|
|
|
# Race names
|
|
race <- data.frame(race_name = c("Asian", "Black", "Indian","Hispanic","White"),
|
|
code = c("A", "B", "I", "H", "W"))
|
|
|
|
TOPS_data <- left_join(TOPS_data, race %>% select(race_name, code), join_by(RACE1 == code)) %>% rename(race_name1 = race_name)
|
|
TOPS_data <- left_join(TOPS_data, race %>% select(race_name, code), join_by(RACE2 == code)) %>% rename(race_name2 = race_name)
|
|
|
|
## make mutate TOPS_data
|
|
TOPS_data <- TOPS_data %>%
|
|
mutate(Year = year,
|
|
PedestrianInjurySeverity = ped_inj_name,
|
|
CrashDate = CRSHDATE,
|
|
CrashTime = CRSHTIME,
|
|
Street = ONSTR,
|
|
CrossStreet = ATSTR) %>%
|
|
mutate(PedestrianAge = ifelse(ROLE1 %in% c("BIKE", "PED"), age1, age2))
|
|
|
|
|
|
TOPS_geom <- st_as_sf(TOPS_data %>% filter(!is.na(latitude)), coords = c("longitude", "latitude"), crs = 4326)
|
|
|
|
## generate map ----
|
|
tmap_mode("view")
|
|
focus_columns <- c("PedestrianInjurySeverity", "CrashDate", "CrashTime", "Street", "CrossStreet", "PedestrianAge")
|
|
focus_county <- "DANE"
|
|
Pedestrian_Crash_Data <- TOPS_geom %>%
|
|
# filter(CNTYNAME == focus_county) %>%
|
|
select(all_of(focus_columns))
|
|
|
|
tm_basemap("Stadia.AlidadeSmooth") +
|
|
tm_shape(Pedestrian_Crash_Data) +
|
|
tm_dots("PedestrianInjurySeverity", palette = injury_severity$color, popup.vars = focus_columns)
|
|
|
|
tmap_save(file = "figures/dynamic_crash_maps/dynamic_crash_map.html")
|