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

fixed color bug

Browse Source
This commit is contained in:
Ben Varick 2024-08-06 15:26:51 -05:00
parent 185829df8b
commit 1ea2554372
Signed by: ben
SSH Key Fingerprint: SHA256:758jG979jvr5HnQJl1AQ/NYTyzXRgnuoVM/yCR024sE
1 changed files with 17 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
scripts/school_maps.R
View File

@ -47,13 +47,13 @@ counties <- data.frame(name = c("Dane", "Milwaukee"),
CNTYCODE = c(13, 40), CNTYCODE = c(13, 40),
COUNTY = c("DANE", "MILWAUKEE")) COUNTY = c("DANE", "MILWAUKEE"))
# Injury Severy Index and Color ------------------------------------------- # Injury Severity Index and Color -------------------------------------------
# injury severity index # injury severity index
injury_severity <- data.frame(InjSevName = c("Injury severity unknown", "No apparent injury", "Possible Injury", "Suspected Minor Injury","Suspected Serious Injury","Fatality"), injury_severity <- data.frame(InjSevName = c("Injury severity unknown", "No apparent injury", "Possible Injury", "Suspected Minor Injury","Suspected Serious Injury","Fatality"),
code = c(NA, "O", "C", "B", "A", "K"), code = c(NA, "O", "C", "B", "A", "K"),
color = c("grey", "#fafa6e", "#edc346", "#d88d2d", "#bd5721", "#9b1c1c")) color = c("grey", "#fafa6e", "#edc346", "#d88d2d", "#bd5721", "#9b1c1c"))
injury_severity_pal <- colorFactor(palette = injury_severity$color, levels = injury_severity$InjSevName) #injury_severity_pal <- colorFactor(palette = injury_severity$color, levels = injury_severity$InjSevName)
TOPS_data <- left_join(TOPS_data, injury_severity %>% select(InjSevName, code), join_by(INJSVR1 == code)) %>% TOPS_data <- left_join(TOPS_data, injury_severity %>% select(InjSevName, code), join_by(INJSVR1 == code)) %>%
mutate(InjSevName = factor(InjSevName, levels = injury_severity$InjSevName)) %>% mutate(InjSevName = factor(InjSevName, levels = injury_severity$InjSevName)) %>%
@ -147,8 +147,8 @@ school_symbol <- image_read_svg(path = "other/school_FILL0_wght400_GRAD0_opsz24.
#county_focus <- c("DANE") #county_focus <- c("DANE")
county_focus <- c("DANE") county_focus <- c("DANE")
#school_type_focus <- unique(WI_schools %>% filter(CTY_DIST %in% str_to_title(county_focus)) %>% pull(SCHOOLTYPE)) school_type_focus <- unique(WI_schools %>% filter(CTY_DIST %in% str_to_title(county_focus)) %>% pull(SCHOOLTYPE))
school_type_focus <- c("Elementary School") #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("Madison Metropolitan")
@ -319,8 +319,8 @@ for(district in district_focus) {
# generate map # generate map
ggmap(basemap) + ggmap(basemap) +
labs(title = paste0( labs(title = paste0(
# "Crashes between cars and youth (<18) pedestrians/bicyclists near ", "Crashes between cars and youth (<18) pedestrians/bicyclists near ",
"Crashes between cars and all pedestrians/bicyclists near ", # "Crashes between cars and all pedestrians/bicyclists near ",
school_data %>% pull(SCHOOL_NAME), school_data %>% pull(SCHOOL_NAME),
" School"), " School"),
subtitle = paste0(school_data %>% pull(DISTRICT_NAME), subtitle = paste0(school_data %>% pull(DISTRICT_NAME),
@ -339,18 +339,18 @@ for(district in district_focus) {
plot.caption = element_text(color = "grey")) + plot.caption = element_text(color = "grey")) +
## add bike lts ## add bike lts
geom_sf(data = bike_lts[[county]], # geom_sf(data = bike_lts[[county]],
inherit.aes = FALSE, # inherit.aes = FALSE,
aes(color = lts)) + # aes(color = lts)) +
scale_color_manual(values = bike_lts_scale$color, name = "Bike Level of Traffic Stress") + # scale_color_manual(values = bike_lts_scale$color, name = "Bike Level of Traffic Stress") +
# add crash locations # add crash locations
new_scale_fill() + new_scale_fill() +
geom_point(data = TOPS_data %>% geom_point(data = TOPS_data %>%
filter(ROLE1 %in% c("BIKE", "PED") filter(ROLE1 %in% c("BIKE", "PED")
# & age1 < 18 & age1 < 18
| ROLE2 %in% c("BIKE", "PED") | ROLE2 %in% c("BIKE", "PED")
# & age2 < 18 & age2 < 18
) %>% ) %>%
filter(longitude >= as.double(bbox[1]), filter(longitude >= as.double(bbox[1]),
latitude >= as.double(bbox[2]), latitude >= as.double(bbox[2]),
@ -361,7 +361,7 @@ for(district in district_focus) {
fill = ped_inj_name), fill = ped_inj_name),
shape = 23, shape = 23,
size = 3) + size = 3) +
scale_fill_manual(values = injury_severity_pal(injury_severity$color), name = "Crash Severity") + scale_fill_manual(values = setNames(injury_severity$color, injury_severity$InjSevName), name = "Crash Severity") +
# add walk boundary # add walk boundary
new_scale_color() + new_scale_color() +
new_scale_fill() + new_scale_fill() +
@ -401,9 +401,10 @@ for(district in district_focus) {
str_replace_all(school_data %>% pull(SCHOOLTYPE), "/","-"), str_replace_all(school_data %>% pull(SCHOOLTYPE), "/","-"),
"s/", "s/",
str_replace_all(school_data %>% pull(SCHOOL_NAME), "/", "-"), str_replace_all(school_data %>% pull(SCHOOL_NAME), "/", "-"),
# " School_all.pdf"),
" School.pdf"), " School.pdf"),
#title = paste0(school_data %>% pull(SCHOOL), " Youth Pedestrian/Bike crashes"), title = paste0(school_data %>% pull(SCHOOL), " Youth Pedestrian/Bike crashes"),
title = paste0(school_data %>% pull(SCHOOL), " All Pedestrian/Bike crashes"), #title = paste0(school_data %>% pull(SCHOOL), " All Pedestrian/Bike crashes"),
device = pdf, device = pdf,
height = 8.5, height = 8.5,
width = 11, width = 11,