added better attribution to maps

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
.gitignore
figures/school_maps/Crash Maps
Adams County
Ashland County
Barron County
Bayfield County
Brown County
Buffalo County
Burnett County
Calumet County
Chippewa County
Clark County
Columbia County
Crawford County
Dane County
Dodge County
Door County
Douglas County
Dunn County
Eau Claire County
Florence County
Fond Du Lac County
Forest County
Grant County
Green County
Green Lake County
Iowa County
Iron County
Jackson County
Jefferson County
Juneau County
Kenosha County
Kewaunee County
La Crosse County
Lafayette County
Langlade County
Lincoln County
Manitowoc County
Marathon County
Marinette County
Marquette County
Menominee County
Milwaukee County
Monroe County
Oconto County
Oneida County
Outagamie County
Ozaukee County
Pepin County
Pierce County
Polk County
Portage County
Price County
Racine County
Richland County
Rock County
Rusk County
Saint Croix County
Sauk County
Sawyer County
Shawano County
Sheboygan County
Taylor County
Trempealeau County
Vernon County
Vilas County
Walworth County
Washburn County
Washington County
Waukesha County
Waupaca County
Waushara County
Winnebago County
Wood County
scripts

2
.gitignore vendored

@ -1,4 +1,6 @@
data/TOPS/*
basemaps/*
figures/school_maps/*
api_keys/*
basemaps/*
.Rproj.user

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

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

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