From 18a527b1652df982149c02a27ac66e868614a5f7 Mon Sep 17 00:00:00 2001 From: Ben Varick Date: Wed, 3 Apr 2024 13:32:55 -0500 Subject: [PATCH 1/2] changed location of basemaps --- .Rhistory | 151 +++++++++++++++++++++++++++++++++ README.md | 19 ++--- scripts/school_maps_parallel.R | 22 ++--- 3 files changed, 161 insertions(+), 31 deletions(-) diff --git a/.Rhistory b/.Rhistory index 8e51e70..18cb993 100644 --- a/.Rhistory +++ b/.Rhistory @@ -2,3 +2,154 @@ library(tidyverse) library(sf) library(tmap) remotes::install_github('r-tmap/tmap') +library(tidyverse) +library(ggmap) +library(sf) +library(osrm) +library(smoothr) +library(ggnewscale) +library(RColorBrewer) +library(magick) +library(rsvg) +library(parallel) +## 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")) +TOPS_data[[file]] <- csv_run +} +rm(csv_run) +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))) +# 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("No apparent injury", "Possible Injury", "Suspected Minor Injury","Suspected Serious Injury","Fatality"), +code = c("O", "C", "B", "A", "K"), +color = c("#fafa6e", "#edc346", "#d88d2d", "#bd5721", "#9b1c1c")) +TOPS_data <- left_join(TOPS_data, injury_severity %>% select(InjSevName, code), join_by(INJSVR == code)) %>% mutate(InjSevName = factor(InjSevName, levels = injury_severity$InjSevName)) +# ---- add additional data +## 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/WI_schools.gpkg") +WI_schools <- left_join(WI_schools %>% mutate(district_school = paste0(SDID, SCH_CODE)), +enrollment_wide, +join_by(district_school)) +## 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 = "data/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("MILWAUKEE") +#county_focus <- c("WINNEBAGO") +#county_focus <- c("DANE", "MILWAUKEE", "BROWN") +#county_focus <- c("VILAS", "BROWN") +#county_focus <- c("BROWN") +school_type_focus <- unique(WI_schools %>% pull(SCHOOLTYPE)) +#school_type_focus <- unique(WI_schools %>% filter(CTY_DIST %in% str_to_title(county_focus)) %>% pull(SCHOOLTYPE)) +#school_type_focus <- c("High School") +district_focus <- unique(WI_schools %>% 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("Madison Metropolitan") +#district_focus <- c("Milwaukee") +#district_focus <- c("Charter") +#district_focus <- c("Madison Metropolitan", "Milwaukee") +#district_focus <- c("Middleton-Cross Plains Area") +#district_focus <- c("Oregon") +# WI_schools <- st_as_sf( +# data.frame(SCHOOL = c("Escuela Verde"), +# SCHOOLTYPE = c("High School"), +# CTY_DIST = c("Milwaukee"), +# DISTRICT_NAME = c("Charter"), +# district_school = c("001001"), +# latitude = c(43.02387627250446), +# longitude = c(-87.95981501028392) +# ), coords = c("longitude", "latitude"), crs = 4326) %>% mutate(geom = geometry) +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))) +# 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("~/temp/figures/crash_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")))) +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(geom)) %>% +pull(DISTRICT_NAME)) diff --git a/README.md b/README.md index 9c08521..16237fd 100644 --- a/README.md +++ b/README.md @@ -1,15 +1,6 @@ ## Scripts -- 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 -- 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 + +- 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 +- 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/scripts/school_maps_parallel.R b/scripts/school_maps_parallel.R index 92abd8c..1e119ca 100644 --- a/scripts/school_maps_parallel.R +++ b/scripts/school_maps_parallel.R @@ -127,19 +127,7 @@ district_focus <- unique(WI_schools %>% 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("Madison Metropolitan") #district_focus <- c("Milwaukee") -#district_focus <- c("Charter") -#district_focus <- c("Madison Metropolitan", "Milwaukee") -#district_focus <- c("Middleton-Cross Plains Area") -#district_focus <- c("Oregon") -# WI_schools <- st_as_sf( -# data.frame(SCHOOL = c("Escuela Verde"), -# SCHOOLTYPE = c("High School"), -# CTY_DIST = c("Milwaukee"), -# DISTRICT_NAME = c("Charter"), -# district_school = c("001001"), -# latitude = c(43.02387627250446), -# longitude = c(-87.95981501028392) -# ), coords = c("longitude", "latitude"), crs = 4326) %>% mutate(geom = geometry) + 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) %>% @@ -162,7 +150,7 @@ for(county in county_focus) { caption = "crash data from UW TOPS lab - retrieved 3/2024 per direction of the WisDOT Bureau of Transportation Safety", x = "Year", y = "Number of crashes") - ggsave(file = paste0("~/temp/figures/crash_maps/Crash Maps/", + ggsave(file = paste0("~/temp/wi_crashes/figures/crash_maps/Crash Maps/", str_to_title(county), " County/_", str_to_title(county), @@ -254,7 +242,7 @@ district_focus <- district_focus[! district_focus %in% districts_done$district] generate_school_maps <- function(district) { message(paste("***", district, "School District |", match(district, district_focus), "/", length(district_focus))) - options(ggmap.file_drawer = paste0("basemaps/districts/", district)) + options(ggmap.file_drawer = paste0("~/temp/wi_crashes/basemaps/districts/", district)) dir.create(file_drawer(), recursive = TRUE, showWarnings = FALSE) saveRDS(list(), file_drawer("index.rds")) readRDS(file_drawer("index.rds")) @@ -369,7 +357,7 @@ generate_school_maps <- function(district) { xmax = bbox['right'] + (bbox['right']-bbox['left']) * 0.20) + coord_sf(clip = "off") - ggsave(file = paste0("~/temp/figures/crash_maps/Crash Maps/", + ggsave(file = paste0("~/temp/wi_crashes/figures/crash_maps/Crash Maps/", str_to_title(school_data %>% pull(CTY_DIST)), " County/", school_data %>% pull(DISTRICT_NAME), @@ -402,7 +390,7 @@ 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("~/temp/figures/crash_maps/Crash Maps/", + exists = c(file.exists(paste0("~/temp/wi_crashes/figures/crash_maps/Crash Maps/", str_to_title(school_data %>% pull(CTY_DIST)), " County/", school_data %>% pull(DISTRICT_NAME), From ba4fb8b6c8e9c7f71377da39f5cc1ef677a2755b Mon Sep 17 00:00:00 2001 From: Ben Varick Date: Wed, 3 Apr 2024 13:34:39 -0500 Subject: [PATCH 2/2] removed .Rhistory --- .Rhistory | 155 ------------------------------------------------------ 1 file changed, 155 deletions(-) delete mode 100644 .Rhistory diff --git a/.Rhistory b/.Rhistory deleted file mode 100644 index 18cb993..0000000 --- a/.Rhistory +++ /dev/null @@ -1,155 +0,0 @@ -library(tidyverse) -library(sf) -library(tmap) -remotes::install_github('r-tmap/tmap') -library(tidyverse) -library(ggmap) -library(sf) -library(osrm) -library(smoothr) -library(ggnewscale) -library(RColorBrewer) -library(magick) -library(rsvg) -library(parallel) -## 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")) -TOPS_data[[file]] <- csv_run -} -rm(csv_run) -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))) -# 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("No apparent injury", "Possible Injury", "Suspected Minor Injury","Suspected Serious Injury","Fatality"), -code = c("O", "C", "B", "A", "K"), -color = c("#fafa6e", "#edc346", "#d88d2d", "#bd5721", "#9b1c1c")) -TOPS_data <- left_join(TOPS_data, injury_severity %>% select(InjSevName, code), join_by(INJSVR == code)) %>% mutate(InjSevName = factor(InjSevName, levels = injury_severity$InjSevName)) -# ---- add additional data -## 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/WI_schools.gpkg") -WI_schools <- left_join(WI_schools %>% mutate(district_school = paste0(SDID, SCH_CODE)), -enrollment_wide, -join_by(district_school)) -## 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 = "data/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("MILWAUKEE") -#county_focus <- c("WINNEBAGO") -#county_focus <- c("DANE", "MILWAUKEE", "BROWN") -#county_focus <- c("VILAS", "BROWN") -#county_focus <- c("BROWN") -school_type_focus <- unique(WI_schools %>% pull(SCHOOLTYPE)) -#school_type_focus <- unique(WI_schools %>% filter(CTY_DIST %in% str_to_title(county_focus)) %>% pull(SCHOOLTYPE)) -#school_type_focus <- c("High School") -district_focus <- unique(WI_schools %>% 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("Madison Metropolitan") -#district_focus <- c("Milwaukee") -#district_focus <- c("Charter") -#district_focus <- c("Madison Metropolitan", "Milwaukee") -#district_focus <- c("Middleton-Cross Plains Area") -#district_focus <- c("Oregon") -# WI_schools <- st_as_sf( -# data.frame(SCHOOL = c("Escuela Verde"), -# SCHOOLTYPE = c("High School"), -# CTY_DIST = c("Milwaukee"), -# DISTRICT_NAME = c("Charter"), -# district_school = c("001001"), -# latitude = c(43.02387627250446), -# longitude = c(-87.95981501028392) -# ), coords = c("longitude", "latitude"), crs = 4326) %>% mutate(geom = geometry) -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))) -# 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("~/temp/figures/crash_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")))) -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(geom)) %>% -pull(DISTRICT_NAME))