2024-04-02 17:53:52 -05:00
|
|
|
library(tidyverse)
|
|
|
|
|
library(sf)
|
|
|
|
|
library(tmap)
|
|
|
|
|
remotes::install_github('r-tmap/tmap')
|
2024-04-03 13:32:55 -05:00
|
|
|
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))
|
