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