Day12 Choropleth
Jiatong Su
# load dependencies
library(biscale)
library(tidycensus)
library(ggplot2)
library(cowplot)
library(rgeoboundaries)
library(glue)
library(ggtext)
library(dplyr)
library(showtext)
library(sf)
NJ_county <-
get_acs(geography = "county",
variables = c("B01003_001", "B19013_001",
"B02001_002", "B08013_001",
"B08012_001", "B08301_001",
"B08301_010", "B01002_001"),
year = 2022,
state = "NJ",
geometry = TRUE,
output = "wide") %>%
rename(Total_Pop = B01003_001E,
Med_Inc = B19013_001E,
Med_Age = B01002_001E,
White_Pop = B02001_002E,
Travel_Time = B08013_001E,
Num_Commuters = B08012_001E,
Means_of_Transport = B08301_001E,
Total_Public_Trans = B08301_010E) %>%
select(Total_Pop, Med_Inc, White_Pop, Travel_Time,
Means_of_Transport, Total_Public_Trans,
Med_Age,
GEOID, geometry) %>%
mutate(Percent_White = White_Pop / Total_Pop,
Mean_Commute_Time = Travel_Time / Total_Public_Trans,
Percent_Taking_Public_Trans = Total_Public_Trans / Means_of_Transport) %>%
st_transform(crs = 4326)##
|
| | 0%
|
| | 1%
|
|= | 1%
|
|= | 2%
|
|== | 2%
|
|== | 3%
|
|== | 4%
|
|=== | 4%
|
|=== | 5%
|
|==== | 5%
|
|==== | 6%
|
|===== | 6%
|
|===== | 7%
|
|===== | 8%
|
|====== | 8%
|
|====== | 9%
|
|======= | 10%
|
|======= | 11%
|
|======== | 11%
|
|======== | 12%
|
|========= | 12%
|
|========= | 13%
|
|========== | 14%
|
|========== | 15%
|
|=========== | 15%
|
|=========== | 16%
|
|============ | 17%
|
|============ | 18%
|
|============= | 18%
|
|============= | 19%
|
|============== | 19%
|
|============== | 20%
|
|=============== | 21%
|
|=============== | 22%
|
|================ | 22%
|
|================ | 23%
|
|================= | 24%
|
|================= | 25%
|
|================== | 25%
|
|================== | 26%
|
|=================== | 26%
|
|=================== | 27%
|
|=================== | 28%
|
|==================== | 28%
|
|==================== | 29%
|
|===================== | 30%
|
|====================== | 31%
|
|====================== | 32%
|
|======================= | 32%
|
|======================= | 33%
|
|======================= | 34%
|
|======================== | 34%
|
|======================== | 35%
|
|========================= | 35%
|
|========================= | 36%
|
|========================== | 37%
|
|========================== | 38%
|
|=========================== | 38%
|
|=========================== | 39%
|
|============================ | 39%
|
|============================ | 40%
|
|============================= | 41%
|
|============================= | 42%
|
|============================== | 42%
|
|============================== | 43%
|
|=============================== | 44%
|
|=============================== | 45%
|
|================================ | 45%
|
|================================ | 46%
|
|================================= | 47%
|
|================================= | 48%
|
|================================== | 48%
|
|================================== | 49%
|
|=================================== | 49%
|
|=================================== | 50%
|
|==================================== | 51%
|
|==================================== | 52%
|
|===================================== | 53%
|
|====================================== | 54%
|
|====================================== | 55%
|
|======================================= | 55%
|
|======================================= | 56%
|
|======================================== | 56%
|
|======================================== | 57%
|
|======================================== | 58%
|
|========================================= | 58%
|
|========================================= | 59%
|
|========================================== | 59%
|
|========================================== | 60%
|
|========================================== | 61%
|
|=========================================== | 61%
|
|=========================================== | 62%
|
|============================================ | 62%
|
|============================================ | 63%
|
|============================================== | 65%
|
|============================================== | 66%
|
|=============================================== | 66%
|
|=============================================== | 67%
|
|================================================ | 68%
|
|================================================ | 69%
|
|================================================= | 70%
|
|================================================= | 71%
|
|================================================== | 71%
|
|================================================== | 72%
|
|=================================================== | 73%
|
|==================================================== | 74%
|
|==================================================== | 75%
|
|===================================================== | 75%
|
|===================================================== | 76%
|
|====================================================== | 77%
|
|====================================================== | 78%
|
|======================================================= | 78%
|
|======================================================= | 79%
|
|======================================================== | 80%
|
|========================================================= | 81%
|
|========================================================= | 82%
|
|========================================================== | 82%
|
|========================================================== | 83%
|
|========================================================== | 84%
|
|=========================================================== | 84%
|
|=========================================================== | 85%
|
|============================================================ | 85%
|
|============================================================ | 86%
|
|============================================================= | 87%
|
|============================================================= | 88%
|
|============================================================== | 88%
|
|============================================================== | 89%
|
|=============================================================== | 89%
|
|=============================================================== | 90%
|
|=============================================================== | 91%
|
|================================================================ | 91%
|
|================================================================ | 92%
|
|================================================================= | 92%
|
|================================================================= | 93%
|
|================================================================= | 94%
|
|================================================================== | 94%
|
|================================================================== | 95%
|
|=================================================================== | 95%
|
|=================================================================== | 96%
|
|==================================================================== | 97%
|
|==================================================================== | 98%
|
|===================================================================== | 98%
|
|===================================================================== | 99%
|
|======================================================================| 100%usa <- geoboundaries(country = "United States", adm_lvl = "adm1") %>%
st_transform(crs = 4326)data <- bi_class(NJ_county, x = Percent_White, y = Med_Inc, dim = 3, style = "quantile", keep_factors = TRUE)
monmouth_coords <- c(-74.2, 40.3) # You can adjust this based on Monmouth County's centroid coordinates
cape_may <- c(-74.9, 38.94)
sussex <- c(-74.7051, 41.705)# draw legend with adjusted font size
legend <- bi_legend(pal = "DkBlue",
xlab = "Higher % White",
ylab = "Higher Income",
size = 6)# draw map
map <- ggplot() +
geom_sf(data = usa, fill="lightgrey", color = "white", lwd = 0.9) +
geom_sf(data = data, aes(fill = bi_class), color = "white", size = 0.1, show.legend = FALSE) +
coord_sf(xlim = c(-78, -71),
ylim = c(38, 42),
expand = FALSE # Ensure the frame does not auto-expand
) +
bi_scale_fill(pal = "DkBlue", dim = 3) +
# Add annotation text for Monmouth County
annotate("text", x = sussex[1] - 1.3, y = sussex[2]-0.3, label = "Higher Income\nHigher % White",
color = "#00008B", size = 3.5, hjust = 0.5, vjust = 1) +
# Add a line segment pointing to the annotation
geom_segment(aes(x = sussex[1] - 0.7 , y = sussex[2] - 0.5 ,
xend = sussex[1] ,
yend = sussex[2] - 0.5 ),
color = "#00008B", size = 0.8,
arrow = arrow(type = "closed", length = unit(0.1, "inches"))) +
# Add annotation text for Monmouth County
annotate("text", x = cape_may[1]+ 1.2, y = cape_may[2] + 0.2 , label = "Lower Income\nHigher % White",
color = "#008B8B", size = 3.5, hjust = 0.5, vjust = 1) +
# Add a line segment pointing to the annotation
geom_segment(aes(x = cape_may[1] + 0.65, y = cape_may[2] ,
xend = cape_may[1] ,
yend = cape_may[2] + 0.1 ),
color = "#008B8B", size = 0.8,
arrow = arrow(type = "closed", length = unit(0.1, "inches"))) +
labs(
title = "<span style='color:#A25F99;'>**Income**</span> and <span style='color:#008B8B;'>Percentage of White Population </span> in 2022",
subtitle = "By County in New Jersey, Based on Census Tract Data",
caption = "30 day map challenge | Day 16 - Choropleth\nAuthor: Jiatong Su\nData Source: Census tract data\n@weitzman_musa"
) +
bi_theme() +
theme(
plot.title = element_markdown(size = 15, color = "#4e4d47", margin=margin(0,0,0,1)),
plot.subtitle = element_text(size = 10, margin = margin(5,0,0,1), face="bold"),
plot.caption = element_text(hjust = 0, size = 5, face="bold"),
axis.text = element_blank(),
axis.ticks = element_blank(),
axis.title = element_blank())
finalPlot <- ggdraw() +
draw_plot(map, 0, 0, 1, 1) +
draw_plot(legend, 0.62, 0, 0.25, 0.25)
finalPlot
ggsave("jiatong_day16.png", plot = finalPlot, width = 8, height = 6, dpi = 300)LS0tCnRpdGxlOiAiRGF5MTIgQ2hvcm9wbGV0aCIKYXV0aG9yOiBKaWF0b25nIFN1Cm91dHB1dDoKICBodG1sX2RvY3VtZW50OgogICAgdGhlbWU6IHNpbXBsZXgKICAgIHRvYzogeWVzCiAgICB0b2NfZmxvYXQ6IHllcwogICAgcHJvZ3Jlc3M6IGhpZGUKICAgIGNvZGVfZG93bmxvYWQ6IHllcwotLS0KCmBgYHtyIHNldHVwLCBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFfQojICBsb2FkIGRlcGVuZGVuY2llcwpsaWJyYXJ5KGJpc2NhbGUpCmxpYnJhcnkodGlkeWNlbnN1cykKbGlicmFyeShnZ3Bsb3QyKQpsaWJyYXJ5KGNvd3Bsb3QpCmxpYnJhcnkocmdlb2JvdW5kYXJpZXMpCmxpYnJhcnkoZ2x1ZSkKbGlicmFyeShnZ3RleHQpCmxpYnJhcnkoZHBseXIpCmxpYnJhcnkoc2hvd3RleHQpCmxpYnJhcnkoc2YpCgpOSl9jb3VudHkgPC0gCiAgZ2V0X2FjcyhnZW9ncmFwaHkgPSAiY291bnR5IiwgCiAgICAgICAgICB2YXJpYWJsZXMgPSBjKCJCMDEwMDNfMDAxIiwgIkIxOTAxM18wMDEiLCAKICAgICAgICAgICAgICAgICAgICAgICAgIkIwMjAwMV8wMDIiLCAiQjA4MDEzXzAwMSIsCiAgICAgICAgICAgICAgICAgICAgICAgICJCMDgwMTJfMDAxIiwgIkIwODMwMV8wMDEiLCAKICAgICAgICAgICAgICAgICAgICAgICAgIkIwODMwMV8wMTAiLCAiQjAxMDAyXzAwMSIpLCAKICAgICAgICAgIHllYXIgPSAyMDIyLCAKICAgICAgICAgIHN0YXRlID0gIk5KIiwgCiAgICAgICAgICBnZW9tZXRyeSA9IFRSVUUsIAogICAgICAgICAgb3V0cHV0ID0gIndpZGUiKSAlPiUKICByZW5hbWUoVG90YWxfUG9wID0gIEIwMTAwM18wMDFFLAogICAgICAgICBNZWRfSW5jID0gQjE5MDEzXzAwMUUsCiAgICAgICAgIE1lZF9BZ2UgPSBCMDEwMDJfMDAxRSwKICAgICAgICAgV2hpdGVfUG9wID0gQjAyMDAxXzAwMkUsCiAgICAgICAgIFRyYXZlbF9UaW1lID0gQjA4MDEzXzAwMUUsCiAgICAgICAgIE51bV9Db21tdXRlcnMgPSBCMDgwMTJfMDAxRSwKICAgICAgICAgTWVhbnNfb2ZfVHJhbnNwb3J0ID0gQjA4MzAxXzAwMUUsCiAgICAgICAgIFRvdGFsX1B1YmxpY19UcmFucyA9IEIwODMwMV8wMTBFKSAlPiUKICBzZWxlY3QoVG90YWxfUG9wLCBNZWRfSW5jLCBXaGl0ZV9Qb3AsIFRyYXZlbF9UaW1lLAogICAgICAgICBNZWFuc19vZl9UcmFuc3BvcnQsIFRvdGFsX1B1YmxpY19UcmFucywKICAgICAgICAgTWVkX0FnZSwKICAgICAgICAgR0VPSUQsIGdlb21ldHJ5KSAlPiUKICBtdXRhdGUoUGVyY2VudF9XaGl0ZSA9IFdoaXRlX1BvcCAvIFRvdGFsX1BvcCwKICAgICAgICAgTWVhbl9Db21tdXRlX1RpbWUgPSBUcmF2ZWxfVGltZSAvIFRvdGFsX1B1YmxpY19UcmFucywKICAgICAgICAgUGVyY2VudF9UYWtpbmdfUHVibGljX1RyYW5zID0gVG90YWxfUHVibGljX1RyYW5zIC8gTWVhbnNfb2ZfVHJhbnNwb3J0KSAlPiUgCiAgc3RfdHJhbnNmb3JtKGNycyA9IDQzMjYpCgp1c2EgPC0gZ2VvYm91bmRhcmllcyhjb3VudHJ5ID0gIlVuaXRlZCBTdGF0ZXMiLCBhZG1fbHZsID0gImFkbTEiKSAlPiUgCiAgc3RfdHJhbnNmb3JtKGNycyA9IDQzMjYpCgoKCmBgYAoKYGBge3IsIHdhcm5pbmc9RkFMU0V9CmRhdGEgPC0gYmlfY2xhc3MoTkpfY291bnR5LCB4ID0gUGVyY2VudF9XaGl0ZSwgeSA9IE1lZF9JbmMsIGRpbSA9IDMsIHN0eWxlID0gInF1YW50aWxlIiwga2VlcF9mYWN0b3JzID0gVFJVRSkKCm1vbm1vdXRoX2Nvb3JkcyA8LSBjKC03NC4yLCA0MC4zKSAgIyBZb3UgY2FuIGFkanVzdCB0aGlzIGJhc2VkIG9uIE1vbm1vdXRoIENvdW50eSdzIGNlbnRyb2lkIGNvb3JkaW5hdGVzCgpjYXBlX21heSA8LSBjKC03NC45LCAzOC45NCkKCnN1c3NleCA8LSAgYygtNzQuNzA1MSwgNDEuNzA1KQpgYGAKCgpgYGB7ciwgd2FybmluZz1GQUxTRX0KIyBkcmF3IGxlZ2VuZCB3aXRoIGFkanVzdGVkIGZvbnQgc2l6ZQpsZWdlbmQgPC0gYmlfbGVnZW5kKHBhbCA9ICJEa0JsdWUiLAogICAgICAgICAgICAgICAgICAgIHhsYWIgPSAiSGlnaGVyICUgV2hpdGUiLAogICAgICAgICAgICAgICAgICAgIHlsYWIgPSAiSGlnaGVyIEluY29tZSIsCiAgICAgICAgICAgICAgICAgICAgc2l6ZSA9IDYpCmBgYAoKCmBgYHtyLCB3YXJuaW5nPUZBTFNFfQojIGRyYXcgbWFwCm1hcCA8LSBnZ3Bsb3QoKSArCiAgICBnZW9tX3NmKGRhdGEgPSB1c2EsIGZpbGw9ImxpZ2h0Z3JleSIsIGNvbG9yID0gIndoaXRlIiwgbHdkID0gMC45KSArCgogIGdlb21fc2YoZGF0YSA9IGRhdGEsIGFlcyhmaWxsID0gYmlfY2xhc3MpLCBjb2xvciA9ICJ3aGl0ZSIsIHNpemUgPSAwLjEsIHNob3cubGVnZW5kID0gRkFMU0UpICsKIGNvb3JkX3NmKHhsaW0gPSBjKC03OCwgLTcxKSwgCiAgICAgICAgIHlsaW0gPSBjKDM4LCA0MiksICAgICAgICAgCiAgICAgICAgIGV4cGFuZCA9IEZBTFNFICAgICAgICAgICAjIEVuc3VyZSB0aGUgZnJhbWUgZG9lcyBub3QgYXV0by1leHBhbmQKKSArCiAgYmlfc2NhbGVfZmlsbChwYWwgPSAiRGtCbHVlIiwgZGltID0gMykgKwogIAogICMgQWRkIGFubm90YXRpb24gdGV4dCBmb3IgTW9ubW91dGggQ291bnR5CiAgICBhbm5vdGF0ZSgidGV4dCIsIHggPSBzdXNzZXhbMV0gLSAxLjMsIHkgPSBzdXNzZXhbMl0tMC4zLCBsYWJlbCA9ICJIaWdoZXIgSW5jb21lXG5IaWdoZXIgJSBXaGl0ZSIsIAogICAgICAgICAgICAgY29sb3IgPSAiIzAwMDA4QiIsIHNpemUgPSAzLjUsIGhqdXN0ID0gMC41LCB2anVzdCA9IDEpICsKICAKICAjIEFkZCBhIGxpbmUgc2VnbWVudCBwb2ludGluZyB0byB0aGUgYW5ub3RhdGlvbgogICAgZ2VvbV9zZWdtZW50KGFlcyh4ID0gc3Vzc2V4WzFdIC0gMC43ICAsIHkgPSBzdXNzZXhbMl0gLSAwLjUgLCAKICAgICAgICAgICAgICAgICAgICAgeGVuZCA9IHN1c3NleFsxXSAsIAogICAgICAgICAgICAgICAgICAgICB5ZW5kID0gc3Vzc2V4WzJdIC0gMC41ICksIAogICAgICAgICAgICAgICAgIGNvbG9yID0gIiMwMDAwOEIiLCBzaXplID0gMC44LCAKICAgICAgICAgICAgICAgICBhcnJvdyA9IGFycm93KHR5cGUgPSAiY2xvc2VkIiwgbGVuZ3RoID0gdW5pdCgwLjEsICJpbmNoZXMiKSkpICsKICAKICAjIEFkZCBhbm5vdGF0aW9uIHRleHQgZm9yIE1vbm1vdXRoIENvdW50eQogICAgYW5ub3RhdGUoInRleHQiLCB4ID0gY2FwZV9tYXlbMV0rIDEuMiwgeSA9IGNhcGVfbWF5WzJdICsgMC4yICwgbGFiZWwgPSAiTG93ZXIgSW5jb21lXG5IaWdoZXIgJSBXaGl0ZSIsIAogICAgICAgICAgICAgY29sb3IgPSAiIzAwOEI4QiIsIHNpemUgPSAzLjUsIGhqdXN0ID0gMC41LCB2anVzdCA9IDEpICsKICAKICAjIEFkZCBhIGxpbmUgc2VnbWVudCBwb2ludGluZyB0byB0aGUgYW5ub3RhdGlvbgogICAgZ2VvbV9zZWdtZW50KGFlcyh4ID0gY2FwZV9tYXlbMV0gKyAwLjY1LCB5ID0gY2FwZV9tYXlbMl0gICwgCiAgICAgICAgICAgICAgICAgICAgIHhlbmQgPSBjYXBlX21heVsxXSAsIAogICAgICAgICAgICAgICAgICAgICB5ZW5kID0gY2FwZV9tYXlbMl0gKyAwLjEgKSwgCiAgICAgICAgICAgICAgICAgY29sb3IgPSAiIzAwOEI4QiIsIHNpemUgPSAwLjgsIAogICAgICAgICAgICAgICAgIGFycm93ID0gYXJyb3codHlwZSA9ICJjbG9zZWQiLCBsZW5ndGggPSB1bml0KDAuMSwgImluY2hlcyIpKSkgKwogIAogIGxhYnMoCiAgICB0aXRsZSA9ICI8c3BhbiBzdHlsZT0nY29sb3I6I0EyNUY5OTsnPioqSW5jb21lKio8L3NwYW4+IGFuZCA8c3BhbiBzdHlsZT0nY29sb3I6IzAwOEI4QjsnPlBlcmNlbnRhZ2Ugb2YgV2hpdGUgUG9wdWxhdGlvbiA8L3NwYW4+IGluIDIwMjIiLAogICAgc3VidGl0bGUgPSAiQnkgQ291bnR5IGluIE5ldyBKZXJzZXksIEJhc2VkIG9uIENlbnN1cyBUcmFjdCBEYXRhIiwKICAgIGNhcHRpb24gPSAiMzAgZGF5IG1hcCBjaGFsbGVuZ2UgfCBEYXkgMTYgLSBDaG9yb3BsZXRoXG5BdXRob3I6IEppYXRvbmcgU3VcbkRhdGEgU291cmNlOiAgQ2Vuc3VzIHRyYWN0IGRhdGFcbkB3ZWl0em1hbl9tdXNhIgogICkgKwogIGJpX3RoZW1lKCkgKwogICAgdGhlbWUoCiAgcGxvdC50aXRsZSA9IGVsZW1lbnRfbWFya2Rvd24oc2l6ZSA9IDE1LCBjb2xvciA9ICIjNGU0ZDQ3IiwgbWFyZ2luPW1hcmdpbigwLDAsMCwxKSksCiAgcGxvdC5zdWJ0aXRsZSA9IGVsZW1lbnRfdGV4dChzaXplID0gMTAsIG1hcmdpbiA9IG1hcmdpbig1LDAsMCwxKSwgZmFjZT0iYm9sZCIpLAogICAgcGxvdC5jYXB0aW9uID0gZWxlbWVudF90ZXh0KGhqdXN0ID0gMCwgc2l6ZSA9IDUsIGZhY2U9ImJvbGQiKSwKICAgICBheGlzLnRleHQgPSBlbGVtZW50X2JsYW5rKCksCiAgICAgICAgYXhpcy50aWNrcyA9IGVsZW1lbnRfYmxhbmsoKSwKICAgICAgICBheGlzLnRpdGxlID0gZWxlbWVudF9ibGFuaygpKQoKCgpmaW5hbFBsb3QgPC0gZ2dkcmF3KCkgKwogIGRyYXdfcGxvdChtYXAsIDAsIDAsIDEsIDEpICsKICBkcmF3X3Bsb3QobGVnZW5kLCAwLjYyLCAwLCAwLjI1LCAwLjI1KQoKZmluYWxQbG90CmBgYAoKYGBge3J9Cmdnc2F2ZSgiamlhdG9uZ19kYXkxNi5wbmciLCBwbG90ID0gZmluYWxQbG90LCB3aWR0aCA9IDgsIGhlaWdodCA9IDYsIGRwaSA9IDMwMCkKCmBgYAoK