diff --git a/.gitignore b/.gitignore index a4a3691..53fdbfa 100644 --- a/.gitignore +++ b/.gitignore @@ -1,9 +1,3 @@ -data/TOPS/* -basemaps/* -figures/school_maps/* -figures/municipalities/* -api_keys/* -basemaps/* .Rproj.user .Rhistory -other/districts_done.csv +districts_done.csv diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..9f4f938 --- /dev/null +++ b/Makefile @@ -0,0 +1,18 @@ +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 diff --git a/R/TOPS_data_process.Rmd b/R/TOPS_data_process.Rmd new file mode 100644 index 0000000..4da5da8 --- /dev/null +++ b/R/TOPS_data_process.Rmd @@ -0,0 +1,108 @@ +--- +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") +``` diff --git a/scripts/school_maps.R b/R/archive/school_maps.R similarity index 100% rename from scripts/school_maps.R rename to R/archive/school_maps.R diff --git a/scripts/school_maps_parallel.R b/R/archive/school_maps_parallel.R similarity index 100% rename from scripts/school_maps_parallel.R rename to R/archive/school_maps_parallel.R diff --git a/scripts/city_maps.R b/R/city_maps.R similarity index 100% rename from scripts/city_maps.R rename to R/city_maps.R diff --git a/scripts/crash_summaries.R b/R/crash_summaries.R similarity index 100% rename from scripts/crash_summaries.R rename to R/crash_summaries.R diff --git a/scripts/crash_summary_charts.R b/R/crash_summary_charts.R similarity index 100% rename from scripts/crash_summary_charts.R rename to R/crash_summary_charts.R diff --git a/scripts/dynamic_crash_map.R b/R/dynamic_crash_map.R similarity index 100% rename from scripts/dynamic_crash_map.R rename to R/dynamic_crash_map.R diff --git a/scripts/dynamic_crash_map_milwaukee.R b/R/dynamic_crash_map_milwaukee.R similarity index 100% rename from scripts/dynamic_crash_map_milwaukee.R rename to R/dynamic_crash_map_milwaukee.R diff --git a/scripts/municipality_maps.R b/R/municipality_maps.R similarity index 100% rename from scripts/municipality_maps.R rename to R/municipality_maps.R diff --git a/R/schoolmaps_PDFs.Rmd b/R/schoolmaps_PDFs.Rmd new file mode 100644 index 0000000..4fd07cb --- /dev/null +++ b/R/schoolmaps_PDFs.Rmd @@ -0,0 +1,441 @@ +--- +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) +unique(WI_schools %>% + filter(district_school %in% (double_check %>% + filter(exists == FALSE) %>% + pull(district_school)), + !st_is_empty(SHAPE)) %>% + pull(DISTRICT_NAME)) +write_csv(double_check, file = "parameters/double_check.csv") +``` \ No newline at end of file diff --git a/README.md b/README.md index 16237fd..399b5f3 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,23 @@ -## Scripts +This is a series of RMarkdown files that generates maps of crashes between motor vehicles and bikers and pedestrians in Wisconsin. -- 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 csv’s that you’ve 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 +## Data sources +- 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 csv’s that you’ve 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 csv’s that you’ve 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 csv’s that you’ve 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 \ No newline at end of file diff --git a/api_keys/.gitignore b/api_keys/.gitignore new file mode 100644 index 0000000..5e7d273 --- /dev/null +++ b/api_keys/.gitignore @@ -0,0 +1,4 @@ +# Ignore everything in this directory +* +# Except this file +!.gitignore diff --git a/basemaps/.gitignore b/basemaps/.gitignore new file mode 100644 index 0000000..5e7d273 --- /dev/null +++ b/basemaps/.gitignore @@ -0,0 +1,4 @@ +# Ignore everything in this directory +* +# Except this file +!.gitignore diff --git a/data/.gitignore b/data/.gitignore new file mode 100644 index 0000000..5e7d273 --- /dev/null +++ b/data/.gitignore @@ -0,0 +1,4 @@ +# Ignore everything in this directory +* +# Except this file +!.gitignore diff --git a/data/Schools/WI_schools.gpkg b/data/Schools/WI_schools.gpkg deleted file mode 100644 index c255ffd..0000000 Binary files a/data/Schools/WI_schools.gpkg and /dev/null differ diff --git a/data_summaries/.gitignore b/data_summaries/.gitignore new file mode 100644 index 0000000..5e7d273 --- /dev/null +++ b/data_summaries/.gitignore @@ -0,0 +1,4 @@ +# Ignore everything in this directory +* +# Except this file +!.gitignore diff --git a/docker/.gitignore b/docker/.gitignore new file mode 100644 index 0000000..c9615a6 --- /dev/null +++ b/docker/.gitignore @@ -0,0 +1,7 @@ +# Ignore everything in this directory +* +# Except this file +!.gitignore +!docker-compose.yml +!data-raw/ +!data-foot/ diff --git a/examples/example-school.pdf b/examples/example-school.pdf new file mode 100644 index 0000000..ef1e817 Binary files /dev/null and b/examples/example-school.pdf differ diff --git a/examples/example-school.png b/examples/example-school.png new file mode 100644 index 0000000..35e1dd9 Binary files /dev/null and b/examples/example-school.png differ diff --git a/figures/.gitignore b/figures/.gitignore new file mode 100644 index 0000000..5e7d273 --- /dev/null +++ b/figures/.gitignore @@ -0,0 +1,4 @@ +# Ignore everything in this directory +* +# Except this file +!.gitignore diff --git a/html/.gitignore b/html/.gitignore new file mode 100644 index 0000000..5e7d273 --- /dev/null +++ b/html/.gitignore @@ -0,0 +1,4 @@ +# Ignore everything in this directory +* +# Except this file +!.gitignore diff --git a/other/BFW_Logo_180_x_200_transparent_background.png b/icons/BFW_Logo_180_x_200_transparent_background.png similarity index 100% rename from other/BFW_Logo_180_x_200_transparent_background.png rename to icons/BFW_Logo_180_x_200_transparent_background.png diff --git a/other/school_FILL0_wght400_GRAD0_opsz24.png b/icons/school_FILL0_wght400_GRAD0_opsz24.png similarity index 100% rename from other/school_FILL0_wght400_GRAD0_opsz24.png rename to icons/school_FILL0_wght400_GRAD0_opsz24.png diff --git a/other/school_FILL0_wght400_GRAD0_opsz24.svg b/icons/school_FILL0_wght400_GRAD0_opsz24.svg similarity index 100% rename from other/school_FILL0_wght400_GRAD0_opsz24.svg rename to icons/school_FILL0_wght400_GRAD0_opsz24.svg diff --git a/parameters/.gitignore b/parameters/.gitignore new file mode 100644 index 0000000..5e7d273 --- /dev/null +++ b/parameters/.gitignore @@ -0,0 +1,4 @@ +# Ignore everything in this directory +* +# Except this file +!.gitignore diff --git a/crash_data.Rproj b/wisconsin_crashes.Rproj similarity index 74% rename from crash_data.Rproj rename to wisconsin_crashes.Rproj index 8e3c2eb..5dea28e 100644 --- a/crash_data.Rproj +++ b/wisconsin_crashes.Rproj @@ -1,4 +1,5 @@ Version: 1.0 +ProjectId: 0da73295-ef24-454f-bd60-31bef147eca9 RestoreWorkspace: Default SaveWorkspace: Default @@ -11,3 +12,5 @@ Encoding: UTF-8 RnwWeave: Sweave LaTeX: pdfLaTeX + +BuildType: Makefile