changed location of basemaps

This commit is contained in:
Ben Varick 2024-04-03 13:32:55 -05:00
parent e5017e9e8a
commit 18a527b165
Signed by: ben
SSH Key Fingerprint: SHA256:jWnpFDAcacYM5aPFpYRqlsamlDyKNpSj3jj+k4ojtUo
3 changed files with 161 additions and 31 deletions

151
.Rhistory
View File

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

View File

@ -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 csvs that youve downloaded from the data retrieval tool. I recommend downloading the whole state and filtering the data with the script.
You can edit the variables: municipality_focus, county_focus to adjust what city you're looking at. Line 50
- City maps - generates maps for cities in Wisconsin where pedestrian fatalities occur
This script pulls in the TOPS data from a folder of csvs that youve downloaded from the data retrieval tool.
It also needs access to an API key for StadiaMaps to download all the basemap tiles.
You can specify the cities by changing the focus parameters at line ~80
- School Crash maps - generates maps of all the schools in Wisconsin and where cars are hitting kids
This script pulls in the TOPS data from a folder of csvs that youve downloaded from the data retrieval tool.
It also draws the walk boundary around each school, this is done with a OpenStreetMap routing engine that is running in a docker container.
It also needs access to an API key for StadiaMaps to download all the basemap tiles.
It took my computer 12 hours to generate all the maps for the state. The script that ends “parallel” runs it in parallel to speed this up. Use that script for bulk map generation, use the other one for generating the maps of a couple school districts.
You can change what districts or counties or school types you are generating maps for by editing the variables at line 116 or so.
- Crash Summaries - generates summary csv files that summarize the crash data for a given municipality and county by age, sex, race. This script pulls in the TOPS data from a folder of csvs that youve downloaded from the data retrieval tool. I recommend downloading the whole state and filtering the data with the script. You can edit the variables: municipality_focus, county_focus to adjust what city you're looking at. Line 50
- City maps - generates maps for cities in Wisconsin where pedestrian fatalities occur This script pulls in the TOPS data from a folder of csvs that youve downloaded from the data retrieval tool. It also needs access to an API key for StadiaMaps to download all the basemap tiles. You can specify the cities by changing the focus parameters at line ~80
- School Crash maps - generates maps of all the schools in Wisconsin and where cars are hitting kids This script pulls in the TOPS data from a folder of csvs that youve downloaded from the data retrieval tool. It also draws the walk boundary around each school, this is done with a OpenStreetMap routing engine that is running in a docker container. It also needs access to an API key for StadiaMaps to download all the basemap tiles. It took my computer 12 hours to generate all the maps for the state. The script that ends “parallel” runs it in parallel to speed this up. Use that script for bulk map generation, use the other one for generating the maps of a couple school districts. You can change what districts or counties or school types you are generating maps for by editing the variables at line 116 or so.
- Dynamic Map: This takes the TOPS data and generates a dynamic map to host

View File

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