edited MilWALKeeWalks.Rmd again
This commit is contained in:
parent
fe8063e802
commit
ac3decc6fb
1 changed files with 100 additions and 15 deletions
|
|
@ -254,7 +254,9 @@ hex_crashes <- st_join(hexgrid,
|
|||
hex_crashes <- st_as_sf(left_join(hexgrid, hex_crashes), crs = 4326)
|
||||
|
||||
hex_crashes <- hex_crashes %>%
|
||||
mutate(lastyearchange = (lastyear - prior/yearsforprior)/(prior/yearsforprior))
|
||||
mutate(prioryearlyaverage = prior/yearsforprior) %>%
|
||||
mutate(lastyearchangepercent = (lastyear - prioryearlyaverage)/prioryearlyaverage,
|
||||
lastyearchangecrashes = lastyear - prioryearlyaverage)
|
||||
|
||||
hex_crashes_points <- st_centroid(hex_crashes)
|
||||
|
||||
|
|
@ -289,7 +291,9 @@ hex_crashes_small <- st_join(hexgrid_small,
|
|||
hex_crashes_small <- st_as_sf(left_join(hexgrid_small, hex_crashes_small), crs = 4326)
|
||||
|
||||
hex_crashes_small <- hex_crashes_small %>%
|
||||
mutate(lastyearchange = (lastyear - prior/yearsforprior)/(prior/yearsforprior))
|
||||
mutate(prioryearlyaverage = prior/yearsforprior) %>%
|
||||
mutate(lastyearchangepercent = (lastyear - prioryearlyaverage)/prioryearlyaverage,
|
||||
lastyearchangecrashes = lastyear - prioryearlyaverage)
|
||||
|
||||
hex_crashes_small_points <- st_centroid(hex_crashes_small)
|
||||
|
||||
|
|
@ -339,7 +343,7 @@ ggmap(basemap) +
|
|||
geom_sf(data = hex_crashes_points %>% filter(is.double(total), !is.na(total)),
|
||||
inherit.aes = FALSE,
|
||||
aes(size = total,
|
||||
fill = lastyearchange),
|
||||
fill = lastyearchangepercent),
|
||||
linewidth = 0,
|
||||
shape = 21,
|
||||
color = "black") +
|
||||
|
|
@ -379,9 +383,9 @@ ggmap(basemap) +
|
|||
axis.ticks=element_blank(),
|
||||
plot.caption = element_text(color = "grey", size = 8)) +
|
||||
# add crash locations
|
||||
geom_sf(data = hex_crashes %>% mutate(lastyearchange = (lastyear - prior/yearsforprior)),
|
||||
geom_sf(data = hex_crashes,
|
||||
inherit.aes = FALSE,
|
||||
aes(fill = lastyearchange),
|
||||
aes(fill = lastyearchangecrashes),
|
||||
alpha = 0.5) +
|
||||
scale_size_area() +
|
||||
scale_fill_gradient2(
|
||||
|
|
@ -389,7 +393,7 @@ ggmap(basemap) +
|
|||
mid = "white",
|
||||
high = "red",
|
||||
midpoint = 0,
|
||||
# limits = c(-2, 2),
|
||||
# limits = c(-20, 20),
|
||||
# oob = scales::squish
|
||||
) # + geom_sf(data = projects_2023, inherit.aes = FALSE)
|
||||
|
||||
|
|
@ -429,11 +433,11 @@ ggmap(basemap) +
|
|||
# add crash locations
|
||||
geom_sf(data = hex_crashes %>% filter(ID %in% highlighted_areas),
|
||||
inherit.aes = FALSE,
|
||||
aes(fill = lastyearchange),
|
||||
aes(fill = lastyearchangepercent),
|
||||
alpha = 0.5) +
|
||||
geom_sf_text(data = hex_crashes_points %>% filter(ID %in% highlighted_areas),
|
||||
inherit.aes = FALSE,
|
||||
aes(label = paste0(ifelse(lastyearchange > 0, "+",""),round(lastyearchange * 100, 0), "%")),
|
||||
aes(label = paste0(ifelse(lastyearchangepercent > 0, "+",""),round(lastyearchangepercent * 100, 0), "%")),
|
||||
size = 3) +
|
||||
scale_size_area() +
|
||||
scale_fill_gradient2(
|
||||
|
|
@ -483,10 +487,9 @@ ggmap(basemap) +
|
|||
#add hexagons
|
||||
new_scale_fill() +
|
||||
geom_sf(data = hex_crashes_small %>%
|
||||
mutate(lastyearchange = (lastyear - prior/yearsforprior)) %>%
|
||||
filter(!is.na(lastyearchange)),
|
||||
filter(!is.na(lastyearchangecrashes)),
|
||||
inherit.aes = FALSE,
|
||||
aes(fill = lastyearchange),
|
||||
aes(fill = lastyearchangecrashes),
|
||||
alpha = 0.5) +
|
||||
scale_size_area() +
|
||||
scale_fill_gradient2(
|
||||
|
|
@ -494,8 +497,8 @@ ggmap(basemap) +
|
|||
mid = "white",
|
||||
high = "red",
|
||||
midpoint = 0,
|
||||
# limits = c(-2, 2),
|
||||
# oob = scales::squish
|
||||
# limits = c(-10, 10),
|
||||
# oob = scales::squish,
|
||||
name = "Crashes last year\ncompared to previous average") +
|
||||
# add crash locations
|
||||
new_scale_fill() +
|
||||
|
|
@ -513,7 +516,7 @@ ggmap(basemap) +
|
|||
fill = ped_inj_name),
|
||||
shape = 23,
|
||||
size = 3) +
|
||||
scale_fill_manual(values = setNames(injury_severity$color, injury_severity$InjSevName), name = paste0("Crashes ", previousyearstring))# + geom_sf(data = projects_2023, inherit.aes = FALSE)
|
||||
scale_fill_manual(values = setNames(injury_severity$color, injury_severity$InjSevName), name = paste0("Crashes ", previousyearstring)) + geom_sf(data = projects_2023, inherit.aes = FALSE)
|
||||
|
||||
ggsave(file = paste0("figures/MilWALKee_Walks/",
|
||||
"milwaukee_map_zoomchange.png"),
|
||||
|
|
@ -523,7 +526,89 @@ ggsave(file = paste0("figures/MilWALKee_Walks/",
|
|||
units = "in",
|
||||
create.dir = TRUE)
|
||||
|
||||
##highland ave
|
||||
|
||||
bbox <- c(left = -87.967,
|
||||
bottom = 43.043,
|
||||
right = -87.944,
|
||||
top = 43.051)
|
||||
basemap <- get_stadiamap(bbox = bbox, zoom = 15, maptype = "stamen_toner_lite")
|
||||
ggmap(basemap) +
|
||||
labs(title = paste0("Crashes between cars and pedestrians"),
|
||||
subtitle = paste0(str_to_title(focus_county),
|
||||
" County | ",
|
||||
min(year(TOPS_data$date), na.rm = TRUE),
|
||||
" - ",
|
||||
max(year(TOPS_data$date), na.rm = TRUE)),
|
||||
caption = paste0("crash data from UW TOPS lab - retrieved ",
|
||||
strftime(retrieve_date, format = "%m/%Y"),
|
||||
"\nper direction of the WisDOT Bureau of Transportation Safety",
|
||||
"\nbasemap from StadiaMaps and OpenStreetMap Contributers"),
|
||||
x = NULL,
|
||||
y = NULL,
|
||||
size = paste0("Total crashes"),
|
||||
fill = paste0("last 12 months\ncompared to previous\n", yearsforprior, " years")) +
|
||||
theme(axis.text=element_blank(),
|
||||
axis.ticks=element_blank(),
|
||||
plot.caption = element_text(color = "grey", size = 8)) +
|
||||
# add crash locations
|
||||
new_scale_fill() +
|
||||
geom_point(data = TOPS_data_filtered %>%
|
||||
filter(year == 2025) %>%
|
||||
#filter(ped_inj %in% c("K", "A", "B")) %>%
|
||||
filter(vulnerable_role %in% "Pedestrian") %>%
|
||||
filter(longitude >= as.double(bbox[1]),
|
||||
latitude >= as.double(bbox[2]),
|
||||
longitude <= as.double(bbox[3]),
|
||||
latitude <= as.double(bbox[4])) %>%
|
||||
arrange(ped_inj_name),
|
||||
aes(x = longitude,
|
||||
y = latitude,
|
||||
fill = ped_inj_name),
|
||||
shape = 23,
|
||||
size = 3) +
|
||||
scale_fill_manual(values = setNames(injury_severity$color, injury_severity$InjSevName), name = paste0("Crashes ", previousyearstring))
|
||||
|
||||
bbox <- c(left = -87.910,
|
||||
bottom = 43.032,
|
||||
right = -87.896,
|
||||
top = 43.044)
|
||||
basemap <- get_stadiamap(bbox = bbox, zoom = 15, maptype = "stamen_toner_lite")
|
||||
ggmap(basemap) +
|
||||
labs(title = paste0("Crashes between cars and pedestrians"),
|
||||
subtitle = paste0(str_to_title(focus_county),
|
||||
" County | ",
|
||||
min(year(TOPS_data$date), na.rm = TRUE),
|
||||
" - ",
|
||||
max(year(TOPS_data$date), na.rm = TRUE)),
|
||||
caption = paste0("crash data from UW TOPS lab - retrieved ",
|
||||
strftime(retrieve_date, format = "%m/%Y"),
|
||||
"\nper direction of the WisDOT Bureau of Transportation Safety",
|
||||
"\nbasemap from StadiaMaps and OpenStreetMap Contributers"),
|
||||
x = NULL,
|
||||
y = NULL,
|
||||
size = paste0("Total crashes"),
|
||||
fill = paste0("last 12 months\ncompared to previous\n", yearsforprior, " years")) +
|
||||
theme(axis.text=element_blank(),
|
||||
axis.ticks=element_blank(),
|
||||
plot.caption = element_text(color = "grey", size = 8)) +
|
||||
# add crash locations
|
||||
new_scale_fill() +
|
||||
geom_point(data = TOPS_data_filtered %>%
|
||||
filter(year != 2025) %>%
|
||||
#filter(ped_inj %in% c("K", "A", "B")) %>%
|
||||
filter(vulnerable_role %in% "Pedestrian") %>%
|
||||
filter(longitude >= as.double(bbox[1]),
|
||||
latitude >= as.double(bbox[2]),
|
||||
longitude <= as.double(bbox[3]),
|
||||
latitude <= as.double(bbox[4])) %>%
|
||||
arrange(ped_inj_name),
|
||||
aes(x = longitude,
|
||||
y = latitude,
|
||||
fill = ped_inj_name),
|
||||
shape = 23,
|
||||
size = 3) +
|
||||
scale_fill_manual(values = setNames(injury_severity$color, injury_severity$InjSevName), name = paste0("Crashes ", previousyearstring))
|
||||
```
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue