added scripts

scripts/dynamic_crash_map.R

@@ -0,0 +1,84 @@
+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")