Compare commits

..

No commits in common. "fbc49fa518a979bb055fa4a8a7d43bee8c3ae495" and "46d41b4ea1ed5a804e574f0ce6f2b9bafcdca65d" have entirely different histories.

28 changed files with 9 additions and 627 deletions

8
.gitignore vendored
View File

@ -1,3 +1,9 @@
data/TOPS/*
basemaps/*
figures/school_maps/*
figures/municipalities/*
api_keys/*
basemaps/*
.Rproj.user .Rproj.user
.Rhistory .Rhistory
districts_done.csv other/districts_done.csv

View File

@ -1,18 +0,0 @@
osrm: osrm-data osrm-containers
TOPS_data_process: R/TOPS_data_process.Rmd
R -e 'library("rmarkdown"); old_path <- Sys.getenv("PATH"); Sys.setenv(PATH = paste(old_path, "/usr/local/bin", sep = ":")); rmarkdown::render(knit_root_dir = "../", output_dir = "./html", input = "./R/TOPS_data_process.Rmd", output_file = "./html/TOPS_data_process.html")'
schoolmaps_PDFs: R/schoolmaps_PDFs.Rmd
R -e 'library("rmarkdown"); old_path <- Sys.getenv("PATH"); Sys.setenv(PATH = paste(old_path, "/usr/local/bin", sep = ":")); rmarkdown::render(knit_root_dir = "../", output_dir = "./html", input = "./R/schoolmaps_PDFs.Rmd", output_file = "./html/schoolmaps_PDFs.html")'
crashmaps_dynamic:
osrm-data:
cd ./docker/osrm/; wget https://download.geofabrik.de/north-america/us/wisconsin-latest.osm.pbf -O ./data-raw/wisconsin-latest.osm.pbf
cd ./docker/osrm/; docker run --rm -t -v "./data-foot:/data" -v "./data-raw/wisconsin-latest.osm.pbf:/data/wisconsin-latest.osm.pbf" osrm/osrm-backend osrm-extract -p /opt/foot.lua /data/wisconsin-latest.osm.pbf
cd ./docker/osrm/; docker run --rm -t -v "./data-foot:/data" -v "./data-raw/wisconsin-latest.osm.pbf:/data/wisconsin-latest.osm.pbf" osrm/osrm-backend osrm-partition /data/wisconsin-latest.osrm
cd ./docker/osrm/; docker run --rm -t -v "./data-foot:/data" -v "./data-raw/wisconsin-latest.osm.pbf:/data/wisconsin-latest.osm.pbf" osrm/osrm-backend osrm-customize /data/wisconsin-latest.osrm
osrm-containers: ./docker/osrm/docker-compose.yml
cd ./docker/osrm/; docker compose up -d

View File

@ -1,108 +0,0 @@
---
title: "TOPS data process"
output:
html_document:
toc: true
toc_depth: 5
toc_float:
collapsed: false
smooth_scroll: true
editor_options:
chunk_output_type: console
---
# Input Data & Configuration
## Libraries
```{r libs, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
date()
rm(list=ls())
library(tidyverse)
```
## Compile TOPS data from multiple years
```{r topsdata, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
## 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
```{r cleandata, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
TOPS_data <- TOPS_data %>%
mutate(date = ymd(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))
```
## Add injury severity index and assign bike/ped roles
```{r injuryseverity, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
# Injury Severity 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"))
#injury_severity_pal <- colorFactor(palette = injury_severity$color, levels = injury_severity$InjSevName)
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)))
```
## Save resulting data table as an Rda file for use in other documents
```{r savecleaneddata, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
save(TOPS_data, file = "data/TOPS/TOPS_data.Rda")
save(vuln_roles, file = "data/TOPS/vuln_roles.Rda")
save(retrieve_date, file = "data/TOPS/retrieve_date.Rda")
save(injury_severity, file = "data/TOPS/injury_severity.Rda")
```

View File

@ -1,443 +0,0 @@
---
title: "School Maps PDFs"
output:
html_document:
toc: true
toc_depth: 5
toc_float:
collapsed: false
smooth_scroll: true
editor_options:
chunk_output_type: console
---
# Input Data & Configuration
## Libraries
```{r libs, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
date()
rm(list=ls())
library(tidyverse)
library(ggmap)
library(sf)
library(osrm)
library(smoothr)
library(ggnewscale)
library(RColorBrewer)
library(magick)
library(rsvg)
library(parallel)
```
## Load TOPS data
```{r cleandata, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
load(file = "data/TOPS/TOPS_data.Rda")
load(file = "data/TOPS/vuln_roles.Rda")
load(file = "data/TOPS/retrieve_date.Rda")
load(file = "data/TOPS/injury_severity.Rda")
```
## Load school data
```{r schooldata, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
## add school enrollment data
enrollment <- read_csv(file = "data/Schools/Enrollement_2022-2023/enrollment_by_gradelevel_certified_2022-23.csv",
col_types = "ccccccccccccciid")
enrollment_wide <-
enrollment %>%
mutate(district_school = paste0(DISTRICT_CODE, SCHOOL_CODE),
variable_name = paste0(GROUP_BY, "__", GROUP_BY_VALUE)) %>%
mutate(variable_name = str_replace_all(variable_name, "[ ]", "_")) %>%
pivot_wider(id_cols = c(district_school, GRADE_LEVEL, SCHOOL_NAME, DISTRICT_NAME, GRADE_GROUP, CHARTER_IND), names_from = variable_name, values_from = PERCENT_OF_GROUP) %>%
group_by(district_school, SCHOOL_NAME, DISTRICT_NAME, GRADE_GROUP, CHARTER_IND) %>%
summarise_at(vars("Disability__Autism":"Migrant_Status__[Data_Suppressed]"), mean, na.rm = TRUE)
district_info <- data.frame(name = c("Madison Metropolitan", "Milwaukee"),
code = c("3269","3619"),
walk_boundary_hs = c(1.5, 2),
walk_boundary_ms = c(1.5, 2),
walk_boundary_es = c(1.5, 1))
## load school locations
WI_schools <- st_read(dsn = "data/Schools/Wisconsin_Public_Schools_-5986231931870160084.gpkg")
WI_schools <- left_join(WI_schools %>% mutate(district_school = paste0(SDID, SCH_CODE)),
enrollment_wide,
join_by(district_school))
```
## Load bike LTS networks
```{r bikeLTS, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
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"))
```
## Load API keys from StadiaMaps and the census
```{r APIkeys, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
# 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 logos
```{r logos, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
logo <- image_read(path = "icons/BFW_Logo_180_x_200_transparent_background.png")
school_symbol <- image_read_svg(path = "icons/school_FILL0_wght400_GRAD0_opsz24.svg")
```
## Set parameters of run
```{r runparameters, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
run_parameters <- read_csv(file = "parameters/run_parameters.csv")
# set which counties to generate figures for
county_focus <- run_parameters$county_focus
if(str_to_lower(county_focus) == "all") {
county_focus <- str_to_upper(unique(WI_schools %>% pull(CTY_DIST)))
}
# set which school types to generate figures for
school_type_focus <- run_parameters$school_type_focus
if(str_to_lower(school_type_focus) == "all") {
school_type_focus <- unique(WI_schools %>% filter(CTY_DIST %in% str_to_title(county_focus)) %>% pull(SCHOOLTYPE))
}
# set which school types to generate figures for
district_focus <- run_parameters$district_focus
if(str_to_lower(district_focus) == "all") {
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))
}
school_number <- length(unique(WI_schools %>% filter(CTY_DIST %in% str_to_title(county_focus),
SCHOOLTYPE %in% school_type_focus,
DISTRICT_NAME %in% district_focus) %>%
pull(district_school)))
```
## generate county charts
```{r countyfigures, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
for(county in county_focus) {
message(county)
TOPS_data %>%
filter(CNTYNAME %in% county) %>%
filter(ROLE1 %in% vuln_roles & age1 < 18 | ROLE2 %in% vuln_roles & age2 < 18) %>%
group_by(year) %>% summarise(count = n_distinct(DOCTNMBR)) %>%
ggplot() +
geom_col(aes(x = year,
y = count),
fill = "darkred") +
scale_y_continuous(expand = expansion(mult = c(0,0.07))) +
labs(title = paste0("Pedestrians/bicyclists under 18 years old hit by cars in ",
str_to_title(county),
" County"),
x = "Year",
y = "Number of crashes",
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"))
ggsave(file = paste0("figures/school_maps/Crash Maps/",
str_to_title(county),
" County/_",
str_to_title(county),
" County_year.pdf"),
title = paste0(county, " County Youth Pedestrian/Bike crashes"),
device = pdf,
height = 8.5,
width = 11,
units = "in",
create.dir = TRUE)
# # generate map for county
# county_data <- WI_schools %>% filter(CTY_DIST %in% str_to_title(county))
# bbox <- st_bbox(st_transform(st_buffer(county_data %>% pull(SHAPE), dist = 4000), crs = 4326))
# 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 = 12, maptype = "stamen_toner_lite")
#
# # generate map
# ggmap(basemap) +
# labs(title = paste0("Crashes between cars and youth (under 18) pedestrians/bicyclists in ",
# str_to_title(county),
# " County"),
# subtitle = paste0(min(year(TOPS_data$date), na.rm = TRUE), " - ", max(year(TOPS_data$date), na.rm = TRUE)),
# caption = "data from Wisconsin DOT, UW TOPS Laboratory, Wisconsin DPI, and OpenStreetMap",
# x = NULL,
# y = NULL) +
# theme(axis.text=element_blank(),
# axis.ticks=element_blank()) +
#
# # add crash heatmap
# # stat_density_2d(data = TOPS_data %>%
# # filter(ROLE1 %in% c("BIKE", "PED") & age1 < 18 | ROLE2 %in% c("BIKE", "PED") & age2 < 18),
# # inherit.aes = FALSE,
# # geom = "polygon",
# # aes(fill = after_stat(level),
# # x = longitude,
# # y = latitude),
# # alpha = 0.2,
# # color = NA,
# # na.rm = TRUE,
# # bins = 12,
# # n = 300) +
# # scale_fill_distiller(type = "div", palette = "YlOrRd", guide = "none", direction = 1) +
#
# # add crashes
# new_scale_color() +
# 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,
# color = InjSevName),
# shape = 18,
# size = 1) +
# scale_color_manual(values = injury_severity$color, name = "Crash Severity")
#
# # add school location
# # new_scale_color() +
# # geom_sf(data = st_transform(WI_schools, crs = 4326),
# # inherit.aes = FALSE,
# # aes(color = "school"),
# # size = 2,
# # shape = 0) +
# # scale_color_manual(values = "black", name = NULL)
#
# ggsave(file = paste0("figures/school_maps/Crash Maps/",
# str_to_title(county), " County/_",
# str_to_title(county), " County.pdf"),
# title = paste0(str_to_title(county), " County Youth Pedestrian/Bike crashes"),
# device = pdf,
# height = 8.5,
# width = 11,
# units = "in",
# create.dir = TRUE)
}
```
# Generate school maps
## Set OpenStreetMap Routing Machine parameters
```{r OSRM, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
options(osrm.server = "http://127.0.0.1:5000/")
options(osrm.profile = "walk")
```
## Function to generate maps
```{r schoolmaps, eval = TRUE, echo = TRUE, results = "show", warning = NA, error = TRUE, message = NA}
generate_school_maps <- function(district) {
message(paste("***", district, "School District |"))
options(ggmap.file_drawer = paste0("basemaps/districts/", district))
dir.create(file_drawer(), recursive = TRUE, showWarnings = FALSE)
saveRDS(list(), file_drawer("index.rds"))
readRDS(file_drawer("index.rds"))
file_drawer("index.rds")
for(school in WI_schools %>%
filter(DISTRICT_NAME %in% district,
SCHOOLTYPE %in% school_type_focus,
!st_is_empty(SHAPE)) %>%
pull(district_school)) {
school_data <- WI_schools %>% filter(district_school == school)
i <- i + 1
message(paste(school_data %>% pull(SCHOOL_NAME), "-", district, "School District", "-", school_data %>% pull(CTY_DIST), "County |", i, "/", school_number, "|", round(i/school_number*100, 2), "%"))
#find walk boundary distance for school
if(length(which(district_info$name == district)) > 0) {
ifelse((school_data %>% pull(SCHOOLTYPE)) %in% "High School",
walk_boundary_mi <- district_info$walk_boundary_hs[district_info$name == district],
ifelse((school_data %>% pull(SCHOOLTYPE)) %in% c("Junior High School", "Middle School"),
walk_boundary_mi <- district_info$walk_boundary_ms[district_info$name == district],
ifelse((school_data %>% pull(SCHOOLTYPE)) %in% c("Combined Elementary/Secondary School", "Elementary School"),
walk_boundary_mi <- district_info$walk_boundary_es[district_info$name == district],
walk_boundary <- 2)))
} else {
walk_boundary_mi <- 2
}
walk_boundary_m <- walk_boundary_mi * 1609
walk_boundary_poly <- fill_holes(st_make_valid(osrmIsodistance(
loc = st_transform(school_data %>% pull(SHAPE), crs = 4326),
breaks = c(walk_boundary_m),
res = 80)
), units::set_units(1, km^2))
# create bounding box from school, 5km away.
bbox <- st_bbox(st_transform(st_buffer(school_data %>% pull(SHAPE), dist = walk_boundary_m + 500), crs = 4326))
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 near ",
school_data %>% pull(SCHOOL_NAME),
" School"),
subtitle = paste0(school_data %>% pull(DISTRICT_NAME),
" School District | ",
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]],
# inherit.aes = FALSE,
# aes(color = lts)) +
# scale_color_manual(values = bike_lts_scale$color, name = "Bike Level of Traffic Stress") +
# add walk boundary
new_scale_color() +
new_scale_fill() +
geom_sf(data = walk_boundary_poly,
inherit.aes = FALSE,
aes(color = paste0(walk_boundary_mi, " mile walking boundary")),
fill = NA,
linewidth = 1) +
scale_color_manual(values = "black", name = NULL) +
# add school location
# geom_sf(data = st_transform(school_data, crs = 4326), inherit.aes = FALSE) +
annotation_raster(school_symbol,
# Position adjustments here using plot_box$max/min/range
ymin = as.double((st_transform(school_data, crs = 4326) %>% pull(SHAPE))[[1]])[2] - 0.001,
ymax = as.double((st_transform(school_data, crs = 4326) %>% pull(SHAPE))[[1]])[2] + 0.001,
xmin = as.double((st_transform(school_data, crs = 4326) %>% pull(SHAPE))[[1]])[1] - 0.0015,
xmax = as.double((st_transform(school_data, crs = 4326) %>% pull(SHAPE))[[1]])[1] + 0.0015) +
geom_sf_label(data = st_transform(school_data, crs = 4326),
inherit.aes = FALSE,
mapping = aes(label = paste(SCHOOL_NAME, "School")),
nudge_y = 0.0015,
label.size = 0.04,
size = 2) +
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") +
# 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])) %>%
arrange(ped_inj_name),
aes(x = longitude,
y = latitude,
fill = ped_inj_name),
shape = 23,
size = 3) +
scale_fill_manual(values = setNames(injury_severity$color, injury_severity$InjSevName), name = "Crash Severity")
ggsave(file = paste0("figures/school_maps/Crash Maps/",
str_to_title(school_data %>% pull(CTY_DIST)),
" County/",
school_data %>% pull(DISTRICT_NAME),
" School District/",
str_replace_all(school_data %>% pull(SCHOOLTYPE), "/","-"),
"s/",
str_replace_all(school_data %>% pull(SCHOOL_NAME), "/", "-"),
# " School_all.pdf"),
" School.pdf"),
title = paste0(school_data %>% pull(SCHOOL), " Youth Pedestrian/Bike crashes"),
#title = paste0(school_data %>% pull(SCHOOL), " All Pedestrian/Bike crashes"),
device = pdf,
height = 8.5,
width = 11,
units = "in",
create.dir = TRUE)
}
}
```
## Generate the school maps
```{r generatemaps, eval = TRUE, echo = TRUE, results = "show", warning = NA, error = TRUE, message = NA}
i <- 0
if (run_parameters$parallel) {
mclapply(district_focus,
generate_school_maps,
mc.cores = 10,
mc.cleanup = TRUE,
mc.preschedule = TRUE,
mc.silent = FALSE)
} else {
lapply(district_focus,
generate_school_maps)
}
# double check that all schools have a map ----
double_check <- list(NULL)
for(school in WI_schools$district_school) {
school_data <- WI_schools %>% filter(district_school %in% school)
school_check <- data.frame(district_school = c(school),
exists = c(file.exists(paste0("figures/school_maps/Crash Maps/",
str_to_title(school_data %>% pull(CTY_DIST)),
" County/",
school_data %>% pull(DISTRICT_NAME),
" School District/",
str_replace_all(school_data %>% pull(SCHOOLTYPE), "/","-"),
"s/",
str_replace_all(school_data %>% pull(SCHOOL_NAME), "/", "-"),
#" School.pdf"))))
" School.pdf"))))
double_check[[school]] <- school_check
}
double_check <- bind_rows(double_check)
write_csv(double_check, file = "parameters/double_check.csv")
districts_not_done <- data.frame(districts = c(unique(WI_schools %>%
filter(district_school %in% (double_check %>%
filter(exists == FALSE) %>%
pull(district_school)),
!st_is_empty(SHAPE)) %>%
pull(DISTRICT_NAME))))
write_csv(districts_not_done, file = "parameters/districts_not_done.csv")
```

View File

@ -1,23 +1,6 @@
This is a series of RMarkdown files that generates maps of crashes between motor vehicles and bikers and pedestrians in Wisconsin. ## Scripts
## Data sources - Crash Summaries - generates summary csv files that summarize the crash data for a given municipality and county by age, sex, race. This script pulls in the TOPS data from a folder of csvs that youve downloaded from the data retrieval tool. I recommend downloading the whole state and filtering the data with the script. You can edit the variables: municipality_focus, county_focus to adjust what city you're looking at. Line 50
- The crash data is from the UW TOPS lab: https://topslab.wisc.edu/
- School location data is from the Wisconsin DPI: https://data-wi-dpi.opendata.arcgis.com/
- County data is from the US census
- Basemaps are from StadiaMaps: https://stadiamaps.com/
## Example figures
### A map of crashes near East High School in Madison, WI:
![example routes figure](examples/example-school.png)
## To process data and generate figures
- Pre Process TOPS data `make TOPS_data_process`: This combines TOPS data exports from different years and reformats the data.
- OpenStreetMap Routing Machine `make osrm`: this downloads the most recent OpenStreetMap data for Wisconsin, and starts docker containers to run the OpenStreetMap Routing Machine to calculate IsoDistances.
- School Crash Maps `make schoolpdfs`: generates summary csv files that summarize the crash data for a given municipality and county by age, sex, race. This script pulls in the TOPS data from a folder of csvs that youve downloaded from the data retrieval tool. I recommend downloading the whole state and filtering the data with the script. You can edit the variables: municipality_focus, county_focus to adjust what city you're looking at. Line 50
## R Scripts
I'm working to move these to RMarkdown files
- City maps - generates maps for cities in Wisconsin where pedestrian fatalities occur This script pulls in the TOPS data from a folder of csvs that youve downloaded from the data retrieval tool. It also needs access to an API key for StadiaMaps to download all the basemap tiles. You can specify the cities by changing the focus parameters at line ~80 - City maps - generates maps for cities in Wisconsin where pedestrian fatalities occur This script pulls in the TOPS data from a folder of csvs that youve downloaded from the data retrieval tool. It also needs access to an API key for StadiaMaps to download all the basemap tiles. You can specify the cities by changing the focus parameters at line ~80
- School Crash maps - generates maps of all the schools in Wisconsin and where cars are hitting kids This script pulls in the TOPS data from a folder of csvs that youve downloaded from the data retrieval tool. It also draws the walk boundary around each school, this is done with a OpenStreetMap routing engine that is running in a docker container. It also needs access to an API key for StadiaMaps to download all the basemap tiles. It took my computer 12 hours to generate all the maps for the state. The script that ends “parallel” runs it in parallel to speed this up. Use that script for bulk map generation, use the other one for generating the maps of a couple school districts. You can change what districts or counties or school types you are generating maps for by editing the variables at line 116 or so. - School Crash maps - generates maps of all the schools in Wisconsin and where cars are hitting kids This script pulls in the TOPS data from a folder of csvs that youve downloaded from the data retrieval tool. It also draws the walk boundary around each school, this is done with a OpenStreetMap routing engine that is running in a docker container. It also needs access to an API key for StadiaMaps to download all the basemap tiles. It took my computer 12 hours to generate all the maps for the state. The script that ends “parallel” runs it in parallel to speed this up. Use that script for bulk map generation, use the other one for generating the maps of a couple school districts. You can change what districts or counties or school types you are generating maps for by editing the variables at line 116 or so.
- Dynamic Map: This takes the TOPS data and generates a dynamic map to host - Dynamic Map: This takes the TOPS data and generates a dynamic map to host

4
api_keys/.gitignore vendored
View File

@ -1,4 +0,0 @@
# Ignore everything in this directory
*
# Except this file
!.gitignore

4
basemaps/.gitignore vendored
View File

@ -1,4 +0,0 @@
# Ignore everything in this directory
*
# Except this file
!.gitignore

View File

@ -1,5 +1,4 @@
Version: 1.0 Version: 1.0
ProjectId: 0da73295-ef24-454f-bd60-31bef147eca9
RestoreWorkspace: Default RestoreWorkspace: Default
SaveWorkspace: Default SaveWorkspace: Default
@ -12,5 +11,3 @@ Encoding: UTF-8
RnwWeave: Sweave RnwWeave: Sweave
LaTeX: pdfLaTeX LaTeX: pdfLaTeX
BuildType: Makefile

4
data/.gitignore vendored
View File

@ -1,4 +0,0 @@
# Ignore everything in this directory
*
# Except this file
!.gitignore

Binary file not shown.

View File

@ -1,4 +0,0 @@
# Ignore everything in this directory
*
# Except this file
!.gitignore

7
docker/.gitignore vendored
View File

@ -1,7 +0,0 @@
# Ignore everything in this directory
*
# Except this file
!.gitignore
!docker-compose.yml
!data-raw/
!data-foot/

Binary file not shown.

Binary file not shown.

Before

Width:  |  Height:  |  Size: 3.2 MiB

4
figures/.gitignore vendored
View File

@ -1,4 +0,0 @@
# Ignore everything in this directory
*
# Except this file
!.gitignore

4
html/.gitignore vendored
View File

@ -1,4 +0,0 @@
# Ignore everything in this directory
*
# Except this file
!.gitignore

View File

Before

Width:  |  Height:  |  Size: 7.5 KiB

After

Width:  |  Height:  |  Size: 7.5 KiB

View File

Before

Width:  |  Height:  |  Size: 1.0 KiB

After

Width:  |  Height:  |  Size: 1.0 KiB

View File

Before

Width:  |  Height:  |  Size: 288 B

After

Width:  |  Height:  |  Size: 288 B

View File

@ -1,4 +0,0 @@
# Ignore everything in this directory
*
# Except this file
!.gitignore