R Notebook
library(mapview)
library(tigris)## To enable caching of data, set `options(tigris_use_cache = TRUE)`
## in your R script or .Rprofile.library(sf)## Linking to GEOS 3.10.2, GDAL 3.4.2, PROJ 8.2.1; sf_use_s2() is TRUEsf_use_s2(FALSE)## Spherical geometry (s2) switched offlibrary(tidycensus)
library(tidyverse)## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2
## ──## ✔ ggplot2 3.4.1 ✔ purrr 1.0.1
## ✔ tibble 3.1.8 ✔ dplyr 1.1.0
## ✔ tidyr 1.3.0 ✔ stringr 1.5.0
## ✔ readr 2.1.4 ✔ forcats 1.0.0
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()library(tmap)
library(leaflet)
library(ggiraph)
library(patchwork)
library(shiny)hinds_race <- get_acs(
geography = "tract",
variables = c(
Hispanic = "DP05_0071P",
White = "DP05_0077P",
Black = "DP05_0078P",
Asian = "DP05_0080P"
),
state = "MS",
county = "Hinds",
geometry = TRUE
)## Getting data from the 2017-2021 5-year ACS## Warning: • You have not set a Census API key. Users without a key are limited to 500
## queries per day and may experience performance limitations.
## ℹ For best results, get a Census API key at
## http://api.census.gov/data/key_signup.html and then supply the key to the
## `census_api_key()` function to use it throughout your tidycensus session.
## This warning is displayed once per session.## Downloading feature geometry from the Census website. To cache shapefiles for use in future sessions, set `options(tigris_use_cache = TRUE)`.## Using the ACS Data Profile##
|
| | 0%
|
|= | 1%
|
|= | 2%
|
|== | 2%
|
|== | 3%
|
|== | 4%
|
|=== | 4%
|
|=== | 5%
|
|==== | 6%
|
|===== | 6%
|
|===== | 7%
|
|====== | 8%
|
|======= | 9%
|
|======= | 10%
|
|========= | 12%
|
|========== | 14%
|
|=========== | 15%
|
|============= | 18%
|
|============= | 19%
|
|============== | 20%
|
|================ | 23%
|
|================== | 25%
|
|=================== | 27%
|
|===================== | 30%
|
|======================== | 34%
|
|=========================== | 38%
|
|=========================== | 39%
|
|================================== | 49%
|
|==================================== | 51%
|
|======================================== | 57%
|
|=========================================== | 61%
|
|============================================== | 65%
|
|================================================== | 71%
|
|======================================================= | 79%
|
|============================================================= | 88%
|
|================================================================= | 92%
|
|================================================================== | 95%
|
|=================================================================== | 95%
|
|=================================================================== | 96%
|
|======================================================================| 100%hinds_race_wide <- get_acs(
geography = "tract",
variables = c(
Hispanic = "DP05_0071P",
White = "DP05_0077P",
Black = "DP05_0078P",
Asian = "DP05_0080P"
),
state = "MS",
county = "Hinds",
geometry = TRUE,
output = "wide" #<<
)## Getting data from the 2017-2021 5-year ACS## Downloading feature geometry from the Census website. To cache shapefiles for use in future sessions, set `options(tigris_use_cache = TRUE)`.## Using the ACS Data Profilehinds_black <- filter(hinds_race, variable == "Black")
ggplot(hinds_black, aes(fill = estimate)) +
geom_sf()
hinds_hispanic <- filter(hinds_race, variable == "Hispanic")
ggplot(hinds_hispanic, aes(fill = estimate)) +
geom_sf()
ggplot(hinds_hispanic, aes(fill = estimate)) +
geom_sf() +
theme_void() +
scale_fill_viridis_c(option = "rocket") +
labs(title = "Percent Hispanic by Census tract",
subtitle = "Hinds County, Missisipi",
fill = "ACS estimate",
caption = "2017-2021 ACS")
ggplot(hinds_hispanic, aes(fill = estimate)) +
geom_sf() +
theme_void() +
scale_fill_viridis_b(option = "rocket", n.breaks = 6) +
labs(title = "Percent Hispanic by Census tract",
subtitle = "Hinds County, Missisipi",
fill = "ACS estimate",
caption = "2017-2021 ACS | tidycensus R package")
ggplot(hinds_race, aes(fill = estimate)) +
geom_sf(color = NA) +
theme_void() +
scale_fill_viridis_c(option = "rocket") +
facet_wrap(~variable) + #<<
labs(title = "Race / ethnicity by Census tract",
subtitle = "Hinds County, Missisipi",
fill = "ACS estimate (%)",
caption = "2017-2021 ACS | tidycensus R package")
hinds_race_counts <- get_acs(
geography = "tract",
variables = c(
Hispanic = "DP05_0071",
White = "DP05_0077",
Black = "DP05_0078",
Asian = "DP05_0080"
),
state = "MS",
county = "Hinds",
geometry = TRUE
)## Getting data from the 2017-2021 5-year ACS## Downloading feature geometry from the Census website. To cache shapefiles for use in future sessions, set `options(tigris_use_cache = TRUE)`.## Using the ACS Data Profilehinds_black <- filter(
hinds_race_counts,
variable == "Black"
)
centroids <- st_centroid(hinds_black)## Warning in st_centroid.sf(hinds_black): st_centroid assumes attributes are
## constant over geometries of x## Warning in st_centroid.sfc(st_geometry(x), of_largest_polygon =
## of_largest_polygon): st_centroid does not give correct centroids for
## longitude/latitude dataggplot() +
geom_sf(data = hinds_black, color = "black", fill = "lightgrey") +
geom_sf(data = centroids, aes(size = estimate),
alpha = 0.7, color = "navy") +
theme_void() +
labs(title = "Black population by Census tract",
subtitle = "2017-2021 ACS, Hinds County, Missisipi",
size = "ACS estimate") +
scale_size_area(max_size = 6) #<<
hinds_race_dots <- as_dot_density(
hinds_race_counts,
value = "estimate",
values_per_dot = 100,
group = "variable"
)## although coordinates are longitude/latitude, st_intersects assumes that they
## are planar
## although coordinates are longitude/latitude, st_intersects assumes that they
## are planarggplot() +
geom_sf(data = hinds_black, color = "lightgrey", fill = "white") +
geom_sf(data = hinds_race_dots, aes(color = variable), size = 0.05) + #<<
scale_color_brewer(palette = "Set1") +
guides(color = guide_legend(override.aes = list(size = 3))) + #<<
theme_void() +
labs(color = "Race / ethnicity",
caption = "2017-2021 ACS | 1 dot = approximately 100 people")library(viridisLite)
colors <- rocket(n = 26)
mapview(hinds_hispanic, zcol = "estimate",
layer.name = "Percent Hispanic 2017-2021 ACS",
col.regions = colors)library(leafsync)
hinds_white <- filter(hinds_race, variable == "White")
m1 <- mapview(hinds_hispanic, zcol = "estimate",
layer.name = "Percent Hispanic 2017-2021 ACS",
col.regions = colors)
m2 <- mapview(hinds_white, zcol = "estimate",
layer.name = "Percent White 2017-2021 ACS",
col.regions = colors)## Warning: Found less unique colors (26) than unique zcol values (62)!
## Interpolating color vector to match number of zcol values.sync(m1, m2)#hinds_race_percent <- hinds_race %>%
#mutate(percent = (estimate/summary_est)*100)hinds_asian <- filter(hinds_race, variable == "Asian")
tm_shape(hinds_asian) + tm_polygons()
# #tm_shape(hinds_asian,
# projection = sf::st_crs(6511)) +
# tm_polygons(col = "percent",
# style = "jenks",
# n = 5,
# palette = "Purples",
# title = "ACS estimate") +
# tm_layout(title = "Percent Asian\nby Census place",
# frame = FALSE,
# legend.outside = TRUE,
# bg.color = "grey80",
# legend.hist.width = 5,
# fontfamily = "Lato")hinds_race1 <- get_acs(
geography = "tract",
variables = c(
hispanic = "DP05_0071P",
white = "DP05_0077P",
black = "DP05_0078P",
native = "DP05_0079P",
asian = "DP05_0080P"),
state = "MS",
county = "Hinds",
year = 2021,
geometry = TRUE) ## Getting data from the 2017-2021 5-year ACS## Downloading feature geometry from the Census website. To cache shapefiles for use in future sessions, set `options(tigris_use_cache = TRUE)`.## Using the ACS Data Profilegroups <- c("Hispanic" = "hispanic",
"White" = "white",
"Black" = "black",
"Native American" = "native",
"Asian" = "asian")
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput(
inputId = "group",
label = "Select a group to map",
choices = groups
)
),
mainPanel(
leafletOutput("map", height = "600")
)
)
)
server <- function(input, output) {
# Reactive function that filters for the selected group in the drop-down menu
group_to_map <- reactive({
filter(hinds_race1, variable == input$group)
})
# Initialize the map object, centered on the Minneapolis-St. Paul area
output$map <- renderLeaflet({
leaflet(options = leafletOptions(zoomControl = FALSE)) %>%
addProviderTiles(providers$Stamen.TonerLite) %>%
setView(lng = -93.21,
lat = 44.98,
zoom = 8.5)
})
observeEvent(input$group, {
pal <- colorNumeric("viridis", group_to_map()$estimate)
leafletProxy("map") %>%
clearShapes() %>%
clearControls() %>%
addPolygons(data = group_to_map(),
color = ~pal(estimate),
weight = 0.5,
fillOpacity = 0.5,
smoothFactor = 0.2,
label = ~estimate) %>%
addLegend(
position = "bottomright",
pal = pal,
values = group_to_map()$estimate,
title = "% of population"
)
})
}
shinyApp(ui = ui, server = server)## PhantomJS not found. You can install it with webshot::install_phantomjs(). If it is installed, please make sure the phantomjs executable can be found via the PATH variable.Shiny applications not supported in static R Markdown documents
library(geojsonio)## Registered S3 method overwritten by 'geojsonsf':
## method from
## print.geojson geojson##
## Attaching package: 'geojsonio'## The following object is masked from 'package:shiny':
##
## validate## The following object is masked from 'package:base':
##
## prettyhindsraces_geojson <- geojson_json(hinds_race_wide, geometry = "polygon")## Warning: 'geojsonlint' not installed, skipping GeoJSON linting# Replace "output.geojson" with the name you want to give to your GeoJSON file
writeLines(hindsraces_geojson, "hindsraces.geojson")vars <- load_variables(2021, "acs5")
hinds_race_tract <- get_acs(
geography = "tract",
state = "MS",
county = "Hinds",
variables = c(White = "B03002_003",
Black = "B03002_004",
Native = "B03002_005",
Asian = "B03002_006",
Hispanic = "B03002_012"),
summary_var = "B03002_001",
year = 2021,
output = "wide"
) #%>% ## Getting data from the 2017-2021 5-year ACS #mutate(percent = (estimate/summary_est)*100)
write_csv(hinds_race_tract, "hinds_tract.csv")#try Jackson
hinds_race_tract <- get_acs(
geography = "tract",
state = "MS",
county = "Hinds",
variables = c(White = "B03002_003",
Black = "B03002_004",
Native = "B03002_005",
Asian = "B03002_006",
Hispanic = "B03002_012"),
summary_var = "B03002_001",
year = 2021,
output = "wide"
)## Getting data from the 2017-2021 5-year ACS#Decennial data
hinds_race_dec <- get_decennial(
geography = "block group",
state = "MS",
county = "Hinds",
variables = c(
White = "P2_005N",
Black = "P2_006N"
),
summary_var = "P2_001N",
year = 2020,
output = "wide"
) %>%
mutate(percent_white = 100 * (White / summary_value)) %>%
mutate(percent_black = 100 * (Black/ summary_value))## Getting data from the 2020 decennial Census## Using the PL 94-171 Redistricting Data summary file## Note: 2020 decennial Census data use differential privacy, a technique that
## introduces errors into data to preserve respondent confidentiality.
## ℹ Small counts should be interpreted with caution.
## ℹ See https://www.census.gov/library/fact-sheets/2021/protecting-the-confidentiality-of-the-2020-census-redistricting-data.html for additional guidance.
## This message is displayed once per session.write_csv(hinds_race_dec, "hinds.csv")madison_race_dec <- get_decennial(
geography = "block group",
state = "MS",
county = "Madison",
variables = c(
White = "P2_005N",
Black = "P2_006N"
),
summary_var = "P2_001N",
year = 2020,
output = "wide"
) %>%
mutate(percent_white = 100 * (White / summary_value)) %>%
mutate(percent_black = 100 * (Black/ summary_value))## Getting data from the 2020 decennial Census## Using the PL 94-171 Redistricting Data summary filewrite_csv(madison_race_dec, "madison.csv")rankin_race_dec <- get_decennial(
geography = "block group",
state = "MS",
county = "Rankin",
variables = c(
White = "P2_005N",
Black = "P2_006N"
),
summary_var = "P2_001N",
year = 2020,
output = "wide"
) %>%
mutate(percent_white = 100 * (White / summary_value)) %>%
mutate(percent_black = 100 * (Black/ summary_value))## Getting data from the 2020 decennial Census## Using the PL 94-171 Redistricting Data summary filewrite_csv(rankin_race_dec, "rankin.csv")