changed location of basemaps

.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))

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.
+- 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
-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
-- City maps - generates maps for cities in Wisconsin where pedestrian fatalities occur
+- 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.
-This script pulls in the TOPS data from a folder of csv’s that you’ve downloaded from the data retrieval tool. 
+- Dynamic Map: This takes the TOPS data and generates a dynamic map to host
-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

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),