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/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/scripts/school_maps.R b/R/school_maps.R similarity index 100% rename from scripts/school_maps.R rename to R/school_maps.R diff --git a/scripts/school_maps_parallel.R b/R/school_maps_parallel.R similarity index 100% rename from scripts/school_maps_parallel.R rename to R/school_maps_parallel.R diff --git a/R/schoolmaps_PDFs.Rmd b/R/schoolmaps_PDFs.Rmd new file mode 100644 index 0000000..c9c5f01 --- /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 = FALSE, error = TRUE, message = FALSE} +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 = FALSE, error = TRUE, message = FALSE} +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/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/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