ben/wisconsin_crashes
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

added better attribution to maps

Browse source
This commit is contained in:
Ben Varick 2024-04-03 11:11:37 -05:00
parent 16d8856ed7
commit fe10b60079
Signed by: ben
SSH key fingerprint: SHA256:758jG979jvr5HnQJl1AQ/NYTyzXRgnuoVM/yCR024sE
83 changed files with 27 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

2
scripts/dynamic_crash_map.R
View file

@ -157,7 +157,7 @@ tag.map.subtitle <- tags$style(HTML("
subtitle <- tags$div(
tag.map.subtitle, HTML("data from UW TOPS lab - retrieved 4/2024</br>per direction of the WisDOT Bureau of Transportation Safety")
)
)
leaflet() %>%
addControl(title, position = "topleft", className="map-title") %>%

30
scripts/school_maps.R
View file

@ -95,11 +95,11 @@ bike_lts_scale <- data.frame(code = c(1, 2, 3, 4, 9),
# register stadia API key ----
register_stadiamaps(key = substr(read_file(file = "api_keys/stadia_api_key"), 1, 36))
options(ggmap.file_drawer = "basemaps")
#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")
#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))
@ -111,16 +111,16 @@ school_symbol <- image_read_svg(path = "other/school_FILL0_wght400_GRAD0_opsz24.
## ---- generate charts/maps ----
## set parameters of run
county_focus <- str_to_upper(unique(WI_schools %>% pull(CTY_DIST)))
#county_focus <- str_to_upper(unique(WI_schools %>% pull(CTY_DIST)))
#county_focus <- c("DANE")
#county_focus <- c("MILWAUKEE")
county_focus <- c("MILWAUKEE")
school_type_focus <- unique(WI_schools %>% filter(CTY_DIST %in% str_to_title(county_focus)) %>% pull(SCHOOLTYPE))
#school_type_focus <- c("High School")
#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 %>% filter(CTY_DIST %in% str_to_title(county_focus), SCHOOLTYPE %in% school_type_focus, !is.na(DISTRICT_NAME)) %>% 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("Milwaukee")
school_number <- length(unique(WI_schools %>% filter(CTY_DIST %in% str_to_title(county_focus),
SCHOOLTYPE %in% school_type_focus,
@ -238,6 +238,11 @@ i <- 0
for(district in district_focus) {
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,
@ -275,7 +280,7 @@ for(district in district_focus) {
top = as.double(bbox[4]))
#get basemap
basemap <- get_stadiamap(bbox = bbox, zoom = 16, maptype = "stamen_toner_lite")
basemap <- get_stadiamap(bbox = bbox, zoom = 15, maptype = "stamen_toner_lite")
# generate map
ggmap(basemap) +
@ -287,11 +292,12 @@ for(district in district_focus) {
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",
caption = "crash data from UW TOPS lab - retrieved 3/2024 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()) +
axis.ticks=element_blank(),
plot.caption = element_text(color = "grey")) +
## add bike lts
#geom_sf(data = bike_lts[[county]],

11
scripts/school_maps_parallel.R
View file

@ -252,7 +252,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), "/271"))
options(ggmap.file_drawer = paste0("data/basemaps/districts/", 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"))
@ -293,7 +293,7 @@ generate_school_maps <- function(district) {
top = as.double(bbox[4]))
#get basemap
basemap <- get_stadiamap(bbox = bbox, zoom = 16, maptype = "stamen_toner_lite")
basemap <- get_stadiamap(bbox = bbox, zoom = 15, maptype = "stamen_toner_lite")
# generate map
ggmap(basemap) +
@ -305,11 +305,12 @@ generate_school_maps <- function(district) {
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",
caption = "crash data from UW TOPS lab - retrieved 3/2024 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()) +
axis.ticks=element_blank(),
plot.caption = element_text(color = "grey")) +
## add bike lts
#geom_sf(data = bike_lts[[county]],
@ -389,7 +390,7 @@ generate_school_maps <- function(district) {
## generate maps in parallel ----
mclapply(district_focus,
generate_school_maps,
mc.cores = 4,
mc.cores = 8,
mc.cleanup = TRUE,
mc.preschedule = TRUE,
mc.silent = FALSE)