Compare commits
No commits in common. "cba47e7bdd7790d885f304ce73f8cf0991629557" and "966c2d33fded918849ec35825f06bc681677c932" have entirely different histories.
cba47e7bdd
...
966c2d33fd
1
.gitignore
vendored
1
.gitignore
vendored
@ -1,7 +1,6 @@
|
|||||||
data/TOPS/*
|
data/TOPS/*
|
||||||
basemaps/*
|
basemaps/*
|
||||||
figures/school_maps/*
|
figures/school_maps/*
|
||||||
figures/municipalities/*
|
|
||||||
api_keys/*
|
api_keys/*
|
||||||
basemaps/*
|
basemaps/*
|
||||||
.Rproj.user
|
.Rproj.user
|
||||||
|
File diff suppressed because one or more lines are too long
@ -1,211 +0,0 @@
|
|||||||
library(tidyverse)
|
|
||||||
library(ggmap)
|
|
||||||
library(sf)
|
|
||||||
library(osrm)
|
|
||||||
library(smoothr)
|
|
||||||
library(ggnewscale)
|
|
||||||
library(RColorBrewer)
|
|
||||||
library(magick)
|
|
||||||
library(rsvg)
|
|
||||||
library(parallel)
|
|
||||||
library(tidycensus)
|
|
||||||
|
|
||||||
## add data from WiscTransPortal Crash Data Retrieval Facility ----
|
|
||||||
## query: SELECT *
|
|
||||||
## FROM DTCRPRD.SUMMARY_COMBINED C
|
|
||||||
## WHERE C.CRSHDATE BETWEEN TO_DATE('2022-JAN','YYYY-MM') AND
|
|
||||||
## LAST_DAY(TO_DATE('2022-DEC','YYYY-MM')) AND
|
|
||||||
## (C.BIKEFLAG = 'Y' OR C.PEDFLAG = 'Y')
|
|
||||||
## ORDER BY C.DOCTNMBR
|
|
||||||
|
|
||||||
## Load TOPS data ----
|
|
||||||
## load TOPS data for the whole state (crashes involving bikes and pedestrians),
|
|
||||||
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"))
|
|
||||||
csv_run["retreive_date"] <- file.info(file = paste0("data/TOPS/",file))$mtime
|
|
||||||
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)))
|
|
||||||
|
|
||||||
retrieve_date <- max(TOPS_data %>% filter(year %in% max(year(TOPS_data$date), na.rm = TRUE)) %>% pull(retreive_date))
|
|
||||||
|
|
||||||
# county index
|
|
||||||
counties <- data.frame(name = c("Dane", "Milwaukee"),
|
|
||||||
CNTYCODE = c(13, 40),
|
|
||||||
COUNTY = c("DANE", "MILWAUKEE"))
|
|
||||||
|
|
||||||
# Injury Severy Index and Color -------------------------------------------
|
|
||||||
# injury severity index
|
|
||||||
injury_severity <- data.frame(InjSevName = c("Injury severity unknown", "No apparent injury", "Possible Injury", "Suspected Minor Injury","Suspected Serious Injury","Fatality"),
|
|
||||||
code = c(NA, "O", "C", "B", "A", "K"),
|
|
||||||
color = c("grey", "#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)
|
|
||||||
# add bike or pedestrian roles ----
|
|
||||||
|
|
||||||
bike_roles <- c("BIKE", "O BIKE")
|
|
||||||
ped_roles <- c("PED", "O PED", "PED NO")
|
|
||||||
vuln_roles <- c(bike_roles, ped_roles)
|
|
||||||
|
|
||||||
TOPS_data <- TOPS_data %>% mutate(ped_inj = ifelse(ROLE1 %in% vuln_roles,
|
|
||||||
INJSVR1,
|
|
||||||
ifelse(ROLE2 %in% vuln_roles,
|
|
||||||
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)
|
|
||||||
|
|
||||||
# bike or ped
|
|
||||||
TOPS_data <- TOPS_data %>% mutate(vulnerable_role = ifelse(ROLE1 %in% bike_roles | ROLE2 %in% bike_roles,
|
|
||||||
"Bicyclist",
|
|
||||||
ifelse(ROLE1 %in% ped_roles | ROLE2 %in% ped_roles,
|
|
||||||
"Pedestrian",
|
|
||||||
NA)))
|
|
||||||
## load bike LTS networks
|
|
||||||
bike_lts <- as.list(NULL)
|
|
||||||
for(file in list.files("data/bike_lts")) {
|
|
||||||
county <- str_sub(file, 10, -9)
|
|
||||||
lts_run <- st_read(paste0("data/bike_lts/", file))
|
|
||||||
lts_run[["lts"]] <- as.factor(lts_run$LTS_F)
|
|
||||||
bike_lts[[county]] <- lts_run
|
|
||||||
}
|
|
||||||
bike_lts_scale <- data.frame(code = c(1, 2, 3, 4, 9),
|
|
||||||
color = c("#1a9641",
|
|
||||||
"#a6d96a",
|
|
||||||
"#fdae61",
|
|
||||||
"#d7191c",
|
|
||||||
"#d7191c"))
|
|
||||||
|
|
||||||
# register stadia API key ----
|
|
||||||
register_stadiamaps(key = substr(read_file(file = "api_keys/stadia_api_key"), 1, 36))
|
|
||||||
#options(ggmap.file_drawer = "basemaps")
|
|
||||||
# dir.create(file_drawer(), recursive = TRUE, showWarnings = FALSE)
|
|
||||||
# saveRDS(list(), file_drawer("index.rds"))
|
|
||||||
#readRDS(file_drawer("index.rds"))
|
|
||||||
#file_drawer("index.rds")
|
|
||||||
|
|
||||||
# load census api key ----
|
|
||||||
census_api_key(key = substr(read_file(file = "api_keys/census_api_key"), 1, 40))
|
|
||||||
|
|
||||||
# load logo
|
|
||||||
logo <- image_read(path = "other/BFW_Logo_180_x_200_transparent_background.png")
|
|
||||||
school_symbol <- image_read_svg(path = "other/school_FILL0_wght400_GRAD0_opsz24.svg")
|
|
||||||
|
|
||||||
## ---- generate charts/maps ----
|
|
||||||
## set parameters of run
|
|
||||||
|
|
||||||
#county_focus <- str_to_upper(unique(WI_schools %>% pull(CTY_DIST)))
|
|
||||||
#county_focus <- c("DANE")
|
|
||||||
county_focus <- c("DANE")
|
|
||||||
|
|
||||||
municipality_focus <- c("Monona", "Verona", "Fitchburg")
|
|
||||||
municipality_geom <- st_read("data/WI_Cities,_Towns_and_Villages_January_2024.geojson")
|
|
||||||
|
|
||||||
for(municipality in municipality_focus) {
|
|
||||||
|
|
||||||
message(paste("***", municipality))
|
|
||||||
options(ggmap.file_drawer = paste0("basemaps/municipalities/", municipality))
|
|
||||||
dir.create(file_drawer(), recursive = TRUE, showWarnings = FALSE)
|
|
||||||
saveRDS(list(), file_drawer("index.rds"))
|
|
||||||
readRDS(file_drawer("index.rds"))
|
|
||||||
file_drawer("index.rds")
|
|
||||||
|
|
||||||
# create bounding box from school, 5km away.
|
|
||||||
bbox_poly <- st_transform(st_buffer(municipality_geom %>% filter(MCD_NAME == municipality) %>% pull(geometry), 1000), crs = 4326)
|
|
||||||
bbox <- st_bbox(bbox_poly)
|
|
||||||
bbox <- c(left = as.double(bbox[1]),
|
|
||||||
bottom = as.double(bbox[2]),
|
|
||||||
right = as.double(bbox[3]),
|
|
||||||
top = as.double(bbox[4]))
|
|
||||||
|
|
||||||
#get basemap
|
|
||||||
basemap <- get_stadiamap(bbox = bbox, zoom = 15, maptype = "stamen_toner_lite")
|
|
||||||
|
|
||||||
# generate map
|
|
||||||
ggmap(basemap) +
|
|
||||||
labs(title = paste0(
|
|
||||||
# "Crashes between cars and youth (<18) pedestrians/bicyclists near ",
|
|
||||||
"Crashes between cars and all pedestrians/bicyclists in/near ",
|
|
||||||
municipality),
|
|
||||||
subtitle = paste0(min(year(TOPS_data$date), na.rm = TRUE),
|
|
||||||
" - ",
|
|
||||||
max(year(TOPS_data$date), na.rm = TRUE)),
|
|
||||||
caption = paste0("crash data from UW TOPS lab - retrieved ",
|
|
||||||
strftime(retrieve_date, format = "%m/%Y"),
|
|
||||||
" per direction of the WisDOT Bureau of Transportation Safety",
|
|
||||||
"\nbasemap from StadiaMaps and OpenStreetMap Contributers"),
|
|
||||||
x = NULL,
|
|
||||||
y = NULL) +
|
|
||||||
theme(axis.text=element_blank(),
|
|
||||||
axis.ticks=element_blank(),
|
|
||||||
plot.caption = element_text(color = "grey")) +
|
|
||||||
|
|
||||||
## add bike lts
|
|
||||||
geom_sf(data = bike_lts[[county]] %>% st_intersection(bbox_poly),
|
|
||||||
inherit.aes = FALSE,
|
|
||||||
aes(color = lts)) +
|
|
||||||
scale_color_manual(values = bike_lts_scale$color, name = "Bike Level of Traffic Stress") +
|
|
||||||
|
|
||||||
# add crash locations
|
|
||||||
new_scale_fill() +
|
|
||||||
geom_point(data = TOPS_data %>%
|
|
||||||
filter(ROLE1 %in% c("BIKE", "PED")
|
|
||||||
# & age1 < 18
|
|
||||||
| ROLE2 %in% c("BIKE", "PED")
|
|
||||||
# & age2 < 18
|
|
||||||
) %>%
|
|
||||||
filter(longitude >= as.double(bbox[1]),
|
|
||||||
latitude >= as.double(bbox[2]),
|
|
||||||
longitude <= as.double(bbox[3]),
|
|
||||||
latitude <= as.double(bbox[4])),
|
|
||||||
aes(x = longitude,
|
|
||||||
y = latitude,
|
|
||||||
fill = ped_inj_name),
|
|
||||||
shape = 23,
|
|
||||||
size = 3) +
|
|
||||||
scale_fill_manual(values = injury_severity$color, name = "Crash Severity") +
|
|
||||||
geom_sf(data = municipality_geom %>% filter(MCD_NAME == municipality),
|
|
||||||
inherit.aes = FALSE,
|
|
||||||
color = 'black',
|
|
||||||
fill = NA,
|
|
||||||
linewidth = 1) +
|
|
||||||
annotation_raster(logo,
|
|
||||||
# Position adjustments here using plot_box$max/min/range
|
|
||||||
ymin = bbox['top'] - (bbox['top']-bbox['bottom']) * 0.16,
|
|
||||||
ymax = bbox['top'],
|
|
||||||
xmin = bbox['right'] + (bbox['right']-bbox['left']) * 0.05,
|
|
||||||
xmax = bbox['right'] + (bbox['right']-bbox['left']) * 0.20) +
|
|
||||||
coord_sf(clip = "off")
|
|
||||||
|
|
||||||
ggsave(file = paste0("figures/municipalities/",
|
|
||||||
municipality,
|
|
||||||
".pdf"),
|
|
||||||
#title = paste0(municipality, " Youth Pedestrian/Bike crashes"),
|
|
||||||
title = paste0(municipality, " All Pedestrian/Bike crashes"),
|
|
||||||
device = pdf,
|
|
||||||
height = 8.5,
|
|
||||||
width = 11,
|
|
||||||
units = "in",
|
|
||||||
create.dir = TRUE)
|
|
||||||
}
|
|
@ -149,7 +149,7 @@ county_focus <- c("DANE")
|
|||||||
school_type_focus <- c("High School")
|
school_type_focus <- c("High School")
|
||||||
|
|
||||||
#district_focus <- unique(WI_schools %>% filter(CTY_DIST %in% str_to_title(county_focus), SCHOOLTYPE %in% school_type_focus, !is.na(DISTRICT_NAME)) %>% pull(DISTRICT_NAME))
|
#district_focus <- unique(WI_schools %>% filter(CTY_DIST %in% str_to_title(county_focus), SCHOOLTYPE %in% school_type_focus, !is.na(DISTRICT_NAME)) %>% pull(DISTRICT_NAME))
|
||||||
district_focus <- c("Monona Grove")
|
district_focus <- c("Madison Metropolitan")
|
||||||
|
|
||||||
school_number <- length(unique(WI_schools %>% filter(CTY_DIST %in% str_to_title(county_focus),
|
school_number <- length(unique(WI_schools %>% filter(CTY_DIST %in% str_to_title(county_focus),
|
||||||
SCHOOLTYPE %in% school_type_focus,
|
SCHOOLTYPE %in% school_type_focus,
|
||||||
@ -317,8 +317,8 @@ for(district in district_focus) {
|
|||||||
# generate map
|
# generate map
|
||||||
ggmap(basemap) +
|
ggmap(basemap) +
|
||||||
labs(title = paste0(
|
labs(title = paste0(
|
||||||
# "Crashes between cars and youth (<18) pedestrians/bicyclists near ",
|
"Crashes between cars and youth (<18) pedestrians/bicyclists near ",
|
||||||
"Crashes between cars and all pedestrians/bicyclists near ",
|
# "Crashes between cars and all pedestrians/bicyclists near ",
|
||||||
school_data %>% pull(SCHOOL_NAME),
|
school_data %>% pull(SCHOOL_NAME),
|
||||||
" School"),
|
" School"),
|
||||||
subtitle = paste0(school_data %>% pull(DISTRICT_NAME),
|
subtitle = paste0(school_data %>% pull(DISTRICT_NAME),
|
||||||
@ -337,18 +337,18 @@ for(district in district_focus) {
|
|||||||
plot.caption = element_text(color = "grey")) +
|
plot.caption = element_text(color = "grey")) +
|
||||||
|
|
||||||
## add bike lts
|
## add bike lts
|
||||||
geom_sf(data = bike_lts[[county]],
|
#geom_sf(data = bike_lts[[county]],
|
||||||
inherit.aes = FALSE,
|
# inherit.aes = FALSE,
|
||||||
aes(color = lts)) +
|
# aes(color = lts)) +
|
||||||
scale_color_manual(values = bike_lts_scale$color, name = "Bike Level of Traffic Stress") +
|
#scale_color_manual(values = bike_lts_scale$color, name = "Bike Level of Traffic Stress") +
|
||||||
|
|
||||||
# add crash locations
|
# add crash locations
|
||||||
new_scale_fill() +
|
new_scale_fill() +
|
||||||
geom_point(data = TOPS_data %>%
|
geom_point(data = TOPS_data %>%
|
||||||
filter(ROLE1 %in% c("BIKE", "PED")
|
filter(ROLE1 %in% c("BIKE", "PED")
|
||||||
# & age1 < 18
|
& age1 < 18
|
||||||
| ROLE2 %in% c("BIKE", "PED")
|
| ROLE2 %in% c("BIKE", "PED")
|
||||||
# & age2 < 18
|
& age2 < 18
|
||||||
) %>%
|
) %>%
|
||||||
filter(longitude >= as.double(bbox[1]),
|
filter(longitude >= as.double(bbox[1]),
|
||||||
latitude >= as.double(bbox[2]),
|
latitude >= as.double(bbox[2]),
|
||||||
@ -400,8 +400,8 @@ for(district in district_focus) {
|
|||||||
"s/",
|
"s/",
|
||||||
str_replace_all(school_data %>% pull(SCHOOL_NAME), "/", "-"),
|
str_replace_all(school_data %>% pull(SCHOOL_NAME), "/", "-"),
|
||||||
" School.pdf"),
|
" School.pdf"),
|
||||||
#title = paste0(school_data %>% pull(SCHOOL), " Youth Pedestrian/Bike crashes"),
|
|
||||||
title = paste0(school_data %>% pull(SCHOOL), " All Pedestrian/Bike crashes"),
|
title = paste0(school_data %>% pull(SCHOOL), " Youth Pedestrian/Bike crashes"),
|
||||||
device = pdf,
|
device = pdf,
|
||||||
height = 8.5,
|
height = 8.5,
|
||||||
width = 11,
|
width = 11,
|
||||||
@ -425,8 +425,7 @@ for(school in WI_schools$district_school) {
|
|||||||
str_replace_all(school_data %>% pull(SCHOOLTYPE), "/","-"),
|
str_replace_all(school_data %>% pull(SCHOOLTYPE), "/","-"),
|
||||||
"s/",
|
"s/",
|
||||||
str_replace_all(school_data %>% pull(SCHOOL_NAME), "/", "-"),
|
str_replace_all(school_data %>% pull(SCHOOL_NAME), "/", "-"),
|
||||||
#" School.pdf"))))
|
" School.pdf"))))
|
||||||
" School_all.pdf"))))
|
|
||||||
double_check[[school]] <- school_check
|
double_check[[school]] <- school_check
|
||||||
}
|
}
|
||||||
double_check <- bind_rows(double_check)
|
double_check <- bind_rows(double_check)
|
||||||
|
Loading…
x
Reference in New Issue
Block a user