working r script
This commit is contained in:
parent
8e1de6a7fc
commit
0f0cc0b0a5
107
bay_creek_data.R
107
bay_creek_data.R
@ -0,0 +1,107 @@
|
||||
# ---- load libraries
|
||||
library(tidyverse)
|
||||
library(sf)
|
||||
library(ggmap)
|
||||
library(scales)
|
||||
library(ggrepel)
|
||||
|
||||
setwd("~/Documents/Bay_Creek/bay_creek_data")
|
||||
|
||||
# ---- load data
|
||||
block_data_2022 <- sf::read_sf("data/nip_bg_22/nip_bg_22.shp")
|
||||
metadata_2022 <- read_csv("data/nip_bg_22/nip_metadata_22.csv")
|
||||
extent <- st_bbox(block_data_2022)
|
||||
|
||||
# ---- define areas of interest
|
||||
block_groups <- data.frame(name = c("Bay Creek 1", "Bay Creek 2"), geo_id = c("550250013001", "550250013002"))
|
||||
|
||||
centroids <- block_data_2022 %>%
|
||||
left_join(block_groups, by = "geo_id") %>%
|
||||
filter(geo_id %in% block_groups$geo_id) %>%
|
||||
st_centroid() %>%
|
||||
pull(geometry) %>%
|
||||
transpose()
|
||||
|
||||
block_groups["lon"] <- unlist(centroids[[1]])
|
||||
block_groups["lat"] <- unlist(centroids[[2]])
|
||||
|
||||
# ---- download basemap
|
||||
zoom_level <- 12
|
||||
if(file.exists(paste0("data/basemap_cache/basemap_", zoom_level, ".RData"))){
|
||||
load(file = paste0("data/basemap_cache/basemap_", zoom_level, ".RData"))
|
||||
} else {
|
||||
register_stadiamaps(substr(read_file("data/stadia_api_key.txt"), 1, 36),
|
||||
write = FALSE)
|
||||
basemap <- ggmap::get_stadiamap(bbox = c(left = as.double(extent[1]),
|
||||
bottom = as.double(extent[2]),
|
||||
right = as.double(extent[3]),
|
||||
top = as.double(extent[4])),
|
||||
zoom = zoom_level,
|
||||
maptype = "alidade_smooth",
|
||||
color = "bw",
|
||||
force = TRUE)
|
||||
|
||||
save(basemap_raster, file = paste0("data/basemap_cache/basemap_", zoom_level, ".RData"))
|
||||
}
|
||||
|
||||
# ---- plot figures
|
||||
# --- plot maps
|
||||
ggmap(basemap) +
|
||||
geom_sf(data = block_data_2022,
|
||||
aes(fill = medhhinc),
|
||||
inherit.aes = FALSE,
|
||||
alpha = 0.6) +
|
||||
geom_label_repel(data = block_groups,
|
||||
aes(label = name,
|
||||
y = lat,
|
||||
x = lon),
|
||||
min.segment.length = 0,
|
||||
nudge_y = -0.03) +
|
||||
# geom_sf_label(data = block_data_2022 %>% left_join(block_groups, by = "geo_id"),
|
||||
# aes(label = name),
|
||||
# inherit.aes = FALSE,
|
||||
# nudge_x = 1,
|
||||
# size = 2) +
|
||||
theme(axis.text.x=element_blank(),
|
||||
axis.text.y=element_blank(),
|
||||
axis.ticks=element_blank(),
|
||||
axis.title.x=element_blank(),
|
||||
axis.title.y=element_blank()) +
|
||||
scale_fill_continuous(label = scales::label_dollar(),
|
||||
type = "viridis") +
|
||||
labs(title = "Median Income",
|
||||
fill = NULL)
|
||||
ggsave(file = "figures/median_income_map.png",
|
||||
device = "png",
|
||||
width = 11,
|
||||
height = 8.5,
|
||||
units = "in")
|
||||
|
||||
# ---- plot graphs
|
||||
ggplot(data = block_data_2022 %>% mutate(baycreek = geo_id %in% block_groups$geo_id) %>% left_join(block_groups, by = "geo_id") %>% arrange(medhhinc)) +
|
||||
geom_hline(data = block_data_2022 %>% filter(geo_id == "Madison"),
|
||||
aes(yintercept = medhhinc),
|
||||
linetype = "dashed") +
|
||||
geom_label(data = block_data_2022 %>% filter(geo_id == "Madison"),
|
||||
aes(y = medhhinc,
|
||||
x = 20),
|
||||
label = "Madison median") +
|
||||
geom_col(aes(x = reorder(geo_id, medhhinc, sum),
|
||||
y = medhhinc,
|
||||
fill = baycreek)) +
|
||||
geom_label(aes(x = reorder(geo_id, medhhinc, sum),
|
||||
y = medhhinc + 10000,
|
||||
label = name)) +
|
||||
scale_x_discrete(labels = NULL, breaks = NULL) +
|
||||
scale_y_continuous(label = scales::label_dollar()) +
|
||||
scale_fill_discrete(guide="none") +
|
||||
theme(axis.text.x=element_blank(),
|
||||
axis.title.x=element_blank()) +
|
||||
labs(title = "Median Income by Block Group",
|
||||
x = NULL,
|
||||
y = NULL)
|
||||
ggsave(file = "figures/median_income.png",
|
||||
device = "png",
|
||||
width = 11,
|
||||
height = 8.5,
|
||||
units = "in")
|
Loading…
x
Reference in New Issue
Block a user