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

Compare commits

base: ben:8748e0fa699caf9e10de861a016d5c1e524eed1c
Branches Tags
ben:main
...
compare: ben:07f4d38bd28076d4a060d3297553ea00e179b663
Branches Tags
ben:main

3 Commits
8748e0fa69 ... 07f4d38bd2

Author SHA1 Message Date
Ben Varick
07f4d38bd2
removed segments from bike_lts with an lts value of 9 2024-10-31 16:48:22 -05:00
Ben Varick
41f461b19a
removed html file from git 2024-10-31 16:40:48 -05:00
Ben Varick
49eba8eb71
removed unnecessary st_transform steps 2024-10-31 16:39:12 -05:00
2 changed files with 24 additions and 17 deletions
Show Stats Expand all files Collapse all files

1
.gitignore vendored
View File

@ -19,3 +19,4 @@ data-bkup
archive/ archive/
trash/ trash/
api_key api_key
R/route_analysis.html

40
R/route_analysis.Rmd
View File

@ -7,6 +7,8 @@ output:
toc_float: toc_float:
collapsed: false collapsed: false
smooth_scroll: true smooth_scroll: true
editor_options:
chunk_output_type: console
--- ---
```{r libs, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE} ```{r libs, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
@ -51,7 +53,7 @@ register_stadiamaps(key = substr(read_file(file = "api_keys/stadia_api_key"), 1,
## subset addresses within 1.5 miles ## subset addresses within 1.5 miles
walk_boundary_poly <- fill_holes(st_make_valid(osrmIsodistance( walk_boundary_poly <- fill_holes(st_make_valid(osrmIsodistance(
loc = st_transform(WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE), crs = 4326), loc = WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE),
breaks = c(walk_boundary_m), breaks = c(walk_boundary_m),
res = 80) res = 80)
), units::set_units(1, km^2)) ), units::set_units(1, km^2))
@ -60,8 +62,12 @@ addresses_near <- st_intersection(addresses, walk_boundary_poly)
## load bike tls ## load bike tls
bike_lts <- st_read("data/bike_lts/bike_lts_DANE.geojson") bike_lts <- st_read("data/bike_lts/bike_lts_DANE.geojson")
# make lts attribute a factor
bike_lts[["lts"]] <- as.factor(bike_lts$LTS_F) bike_lts[["lts"]] <- as.factor(bike_lts$LTS_F)
# remove segments with an LTS value of 9
bike_lts <- bike_lts %>% filter(lts != 9)
# set color scale
bike_lts_scale <- data.frame(code = c(1, 2, 3, 4, 9), bike_lts_scale <- data.frame(code = c(1, 2, 3, 4, 9),
color = c("#1a9641", color = c("#1a9641",
"#a6d96a", "#a6d96a",
@ -94,7 +100,7 @@ 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") school_symbol <- image_read_svg(path = "other/school_FILL0_wght400_GRAD0_opsz24.svg")
bbox <- st_bbox(st_transform(st_buffer(walk_boundary_poly, dist = 500), crs = 4326)) bbox <- st_bbox(st_buffer(walk_boundary_poly, dist = 500))
bbox <- c(left = as.double(bbox[1]), bbox <- c(left = as.double(bbox[1]),
bottom = as.double(bbox[2]), bottom = as.double(bbox[2]),
right = as.double(bbox[3]), right = as.double(bbox[3]),
@ -130,11 +136,11 @@ ggmap(basemap) +
scale_linewidth_continuous(range = c(0, 3)) + scale_linewidth_continuous(range = c(0, 3)) +
annotation_raster(school_symbol, annotation_raster(school_symbol,
# Position adjustments here using plot_box$max/min/range # Position adjustments here using plot_box$max/min/range
ymin = as.double((st_transform(WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE), crs = 4326) %>% pull(geom))[[1]])[2] - 0.001, ymin = as.double((WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE) %>% pull(geom))[[1]])[2] - 0.001,
ymax = as.double((st_transform(WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE), crs = 4326) %>% pull(geom))[[1]])[2] + 0.001, ymax = as.double((WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE) %>% pull(geom))[[1]])[2] + 0.001,
xmin = as.double((st_transform(WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE), crs = 4326) %>% pull(geom))[[1]])[1] - 0.0015, xmin = as.double((WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE) %>% pull(geom))[[1]])[1] - 0.0015,
xmax = as.double((st_transform(WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE), crs = 4326) %>% pull(geom))[[1]])[1] + 0.0015) + xmax = as.double((WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE) %>% pull(geom))[[1]])[1] + 0.0015) +
geom_sf_label(data = st_transform(WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE), crs = 4326), geom_sf_label(data = WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE),
inherit.aes = FALSE, inherit.aes = FALSE,
mapping = aes(label = school_focus %>% pull(name)), mapping = aes(label = school_focus %>% pull(name)),
nudge_y = 0.0015, nudge_y = 0.0015,
@ -178,11 +184,11 @@ ggmap(basemap) +
scale_linewidth_continuous(range = c(0, 3)) + scale_linewidth_continuous(range = c(0, 3)) +
annotation_raster(school_symbol, annotation_raster(school_symbol,
# Position adjustments here using plot_box$max/min/range # Position adjustments here using plot_box$max/min/range
ymin = as.double((st_transform(WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE), crs = 4326) %>% pull(geom))[[1]])[2] - 0.001, ymin = as.double((WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE) %>% pull(geom))[[1]])[2] - 0.001,
ymax = as.double((st_transform(WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE), crs = 4326) %>% pull(geom))[[1]])[2] + 0.001, ymax = as.double((WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE) %>% pull(geom))[[1]])[2] + 0.001,
xmin = as.double((st_transform(WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE), crs = 4326) %>% pull(geom))[[1]])[1] - 0.0015, xmin = as.double((WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE) %>% pull(geom))[[1]])[1] - 0.0015,
xmax = as.double((st_transform(WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE), crs = 4326) %>% pull(geom))[[1]])[1] + 0.0015) + xmax = as.double((WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE) %>% pull(geom))[[1]])[1] + 0.0015) +
geom_sf_label(data = st_transform(WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE), crs = 4326), geom_sf_label(data = WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE),
inherit.aes = FALSE, inherit.aes = FALSE,
mapping = aes(label = school_focus %>% pull(name)), mapping = aes(label = school_focus %>% pull(name)),
nudge_y = 0.0015, nudge_y = 0.0015,
@ -222,11 +228,11 @@ ggmap(basemap) +
new_scale_color() + new_scale_color() +
annotation_raster(school_symbol, annotation_raster(school_symbol,
# Position adjustments here using plot_box$max/min/range # Position adjustments here using plot_box$max/min/range
ymin = as.double((st_transform(WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE), crs = 4326) %>% pull(geom))[[1]])[2] - 0.001, ymin = as.double((WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE) %>% pull(geom))[[1]])[2] - 0.001,
ymax = as.double((st_transform(WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE), crs = 4326) %>% pull(geom))[[1]])[2] + 0.001, ymax = as.double((WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE) %>% pull(geom))[[1]])[2] + 0.001,
xmin = as.double((st_transform(WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE), crs = 4326) %>% pull(geom))[[1]])[1] - 0.0015, xmin = as.double((WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE) %>% pull(geom))[[1]])[1] - 0.0015,
xmax = as.double((st_transform(WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE), crs = 4326) %>% pull(geom))[[1]])[1] + 0.0015) + xmax = as.double((WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE) %>% pull(geom))[[1]])[1] + 0.0015) +
geom_sf_label(data = st_transform(WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE), crs = 4326), geom_sf_label(data = WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE),
inherit.aes = FALSE, inherit.aes = FALSE,
mapping = aes(label = school_focus %>% pull(name)), mapping = aes(label = school_focus %>% pull(name)),
nudge_y = 0.0015, nudge_y = 0.0015,