exploring_tidycensus
Jules Gonzalez
2023-05-02
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.2 ✔ readr 2.1.4
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ ggplot2 3.4.2 ✔ tibble 3.2.1
## ✔ lubridate 1.9.2 ✔ tidyr 1.3.0
## ✔ purrr 1.0.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(dplyr)
library(purrr)
library(tidycensus)
library(geofacet)
library(ggridges)
census_api_key("a4d96ac7ff4ba560c03cd295dd6a404071c1a488", overwrite = TRUE)## To install your API key for use in future sessions, run this function with `install = TRUE`.library(tidycensus)
library(sf)## Linking to GEOS 3.11.0, GDAL 3.5.3, PROJ 9.1.0; sf_use_s2() is TRUElibrary(mapview)
#Decennial Census
total_pop_10 <- get_decennial(
geography = "state",
variables = "P001001",
year = 2010
) ## Getting data from the 2010 decennial Census## Using Census Summary File 1library(tidycensus)
library(sf)
library(mapview)
get_acs(geography = "state",
variables = c("Total Population" = "B01001_001"),
year = 2018,
survey = "acs1")## Getting data from the 2018 1-year ACS## The 1-year ACS provides data for geographies with populations of 65,000 and greater.## # A tibble: 52 × 5
## GEOID NAME variable estimate moe
## <chr> <chr> <chr> <dbl> <dbl>
## 1 01 Alabama Total Population 4887871 NA
## 2 02 Alaska Total Population 737438 NA
## 3 04 Arizona Total Population 7171646 NA
## 4 05 Arkansas Total Population 3013825 NA
## 5 06 California Total Population 39557045 NA
## 6 08 Colorado Total Population 5695564 NA
## 7 09 Connecticut Total Population 3572665 NA
## 8 10 Delaware Total Population 967171 NA
## 9 11 District of Columbia Total Population 702455 NA
## 10 12 Florida Total Population 21299325 NA
## # ℹ 42 more rows#Median Household income, Texas.
tx_income <- get_acs(
geography = "county",
variables = "B19013_001",
state = "TX",
year = 2020
)## Getting data from the 2016-2020 5-year ACSprint(tx_income)## # A tibble: 254 × 5
## GEOID NAME variable estimate moe
## <chr> <chr> <chr> <dbl> <dbl>
## 1 48001 Anderson County, Texas B19013_001 45847 2728
## 2 48003 Andrews County, Texas B19013_001 75147 9031
## 3 48005 Angelina County, Texas B19013_001 49684 2450
## 4 48007 Aransas County, Texas B19013_001 47924 8481
## 5 48009 Archer County, Texas B19013_001 63958 5369
## 6 48011 Armstrong County, Texas B19013_001 69386 5604
## 7 48013 Atascosa County, Texas B19013_001 59251 2620
## 8 48015 Austin County, Texas B19013_001 64468 4347
## 9 48017 Bailey County, Texas B19013_001 55038 35559
## 10 48019 Bandera County, Texas B19013_001 60361 4410
## # ℹ 244 more rows#mapping tx MHHI
# Load required libraries
library(tidyverse)
library(tidycensus)
library(sf)
# Set the census API key
census_api_key("a4d96ac7ff4ba560c03cd295dd6a404071c1a488")## To install your API key for use in future sessions, run this function with `install = TRUE`.# Retrieve median household income data for Texas counties
tx_income <- get_acs(
geography = "county",
variables = "B19013_001",
state = "TX",
year = 2020,
geometry = TRUE
) %>%
rename(median_household_income = estimate)## Getting data from the 2016-2020 5-year ACS## Downloading feature geometry from the Census website. To cache shapefiles for use in future sessions, set `options(tigris_use_cache = TRUE)`.##
|
| | 0%
|
| | 1%
|
|= | 1%
|
|= | 2%
|
|== | 2%
|
|== | 3%
|
|== | 4%
|
|=== | 4%
|
|==== | 5%
|
|==== | 6%
|
|===== | 6%
|
|===== | 7%
|
|===== | 8%
|
|====== | 8%
|
|======= | 10%
|
|======== | 11%
|
|======== | 12%
|
|========= | 12%
|
|========= | 13%
|
|========== | 14%
|
|========== | 15%
|
|=========== | 15%
|
|=========== | 16%
|
|============ | 17%
|
|============ | 18%
|
|============= | 18%
|
|============= | 19%
|
|============== | 20%
|
|=============== | 21%
|
|=============== | 22%
|
|================ | 23%
|
|================ | 24%
|
|================= | 24%
|
|================= | 25%
|
|================== | 25%
|
|================== | 26%
|
|=================== | 27%
|
|==================== | 28%
|
|==================== | 29%
|
|===================== | 30%
|
|===================== | 31%
|
|====================== | 31%
|
|======================= | 33%
|
|========================= | 36%
|
|========================== | 37%
|
|========================== | 38%
|
|=========================== | 38%
|
|============================ | 39%
|
|============================ | 40%
|
|============================ | 41%
|
|============================= | 41%
|
|============================= | 42%
|
|============================== | 42%
|
|============================== | 43%
|
|=============================== | 44%
|
|=============================== | 45%
|
|================================ | 45%
|
|================================ | 46%
|
|================================= | 46%
|
|================================= | 47%
|
|================================= | 48%
|
|================================== | 48%
|
|================================== | 49%
|
|==================================== | 51%
|
|==================================== | 52%
|
|===================================== | 53%
|
|====================================== | 54%
|
|======================================= | 55%
|
|======================================= | 56%
|
|======================================== | 57%
|
|======================================== | 58%
|
|========================================= | 58%
|
|========================================= | 59%
|
|========================================== | 59%
|
|========================================== | 60%
|
|========================================== | 61%
|
|============================================ | 63%
|
|============================================= | 64%
|
|============================================= | 65%
|
|============================================== | 65%
|
|============================================== | 66%
|
|=============================================== | 67%
|
|=============================================== | 68%
|
|================================================ | 69%
|
|================================================= | 70%
|
|================================================= | 71%
|
|================================================== | 71%
|
|================================================== | 72%
|
|=================================================== | 73%
|
|==================================================== | 74%
|
|==================================================== | 75%
|
|===================================================== | 75%
|
|===================================================== | 76%
|
|====================================================== | 77%
|
|====================================================== | 78%
|
|======================================================= | 78%
|
|======================================================= | 79%
|
|========================================================== | 82%
|
|=========================================================== | 84%
|
|=========================================================== | 85%
|
|============================================================ | 85%
|
|============================================================== | 88%
|
|============================================================== | 89%
|
|=============================================================== | 89%
|
|=============================================================== | 90%
|
|================================================================= | 92%
|
|================================================================== | 94%
|
|================================================================== | 95%
|
|=================================================================== | 95%
|
|=================================================================== | 96%
|
|==================================================================== | 97%
|
|===================================================================== | 98%
|
|===================================================================== | 99%
|
|======================================================================| 99%
|
|======================================================================| 100%# Visualize the data using ggplot2
ggplot(data = tx_income) +
geom_sf(aes(fill = median_household_income)) +
scale_fill_viridis_c(option = "magma", direction = 1, trans = "log",
name = "Median Household\nIncome") +
theme_void() +
labs(title = "Median Household Income by County in Texas",
subtitle = "ACS 5-Year Estimates (2020)") +
theme(plot.title = element_text(size = 18, face = "bold", hjust = 0.5),
plot.subtitle = element_text(size = 14, hjust = 0.5))
# Load required libraries
library(tidyverse)
library(tidycensus)
library(sf)
library(scales)##
## Attaching package: 'scales'## The following object is masked from 'package:purrr':
##
## discard## The following object is masked from 'package:readr':
##
## col_factor# Set the census API key
census_api_key("a4d96ac7ff4ba560c03cd295dd6a404071c1a488")## To install your API key for use in future sessions, run this function with `install = TRUE`.# Retrieve median household income data for Texas counties
tx_income <- get_acs(
geography = "county",
variables = "B19013_001",
state = "TX",
year = 2020,
geometry = TRUE
) %>%
st_as_sf() %>%
rename(median_household_income = estimate)## Getting data from the 2016-2020 5-year ACS## Downloading feature geometry from the Census website. To cache shapefiles for use in future sessions, set `options(tigris_use_cache = TRUE)`.# Define pretty breaks and labels
breaks <- pretty_breaks(n = 5)(range(tx_income$median_household_income))
labels <- dollar_format()(breaks)
# Visualize the data using ggplot2
ggplot(data = tx_income) +
geom_sf(aes(fill = median_household_income)) +
scale_fill_viridis_c(option = "pretty breaks", direction = 1,
breaks = breaks,
labels = labels,
name = "Median Household\nIncome") +
theme_minimal() +
theme(legend.position = "bottom",
plot.title = element_text(size = 18, face = "bold", hjust = 0.5),
plot.subtitle = element_text(size = 14, hjust = 0.5)) +
labs(title = "Median Household Income by County in Texas",
subtitle = "ACS 5-Year Estimates (2020)")## Warning in viridisLite::viridis(n, alpha, begin, end, direction, option):
## Option 'pretty breaks' does not exist. Defaulting to 'viridis'.
#searching for variables in tidycensus
#1990 - not available. removed by census bureau
#var<- load_variables(1990, "acs5", cache = TRUE)
v10<- load_variables(2010, "acs5", cache = TRUE)
print(v10)## # A tibble: 20,927 × 3
## name label concept
## <chr> <chr> <chr>
## 1 B00001_001 Estimate!!Total UNWEIGHTED SAMPLE COUNT O…
## 2 B00002_001 Estimate!!Total UNWEIGHTED SAMPLE HOUSING…
## 3 B01001A_001 Estimate!!Total SEX BY AGE (WHITE ALONE)
## 4 B01001A_002 Estimate!!Total!!Male SEX BY AGE (WHITE ALONE)
## 5 B01001A_003 Estimate!!Total!!Male!!Under 5 years SEX BY AGE (WHITE ALONE)
## 6 B01001A_004 Estimate!!Total!!Male!!5 to 9 years SEX BY AGE (WHITE ALONE)
## 7 B01001A_005 Estimate!!Total!!Male!!10 to 14 years SEX BY AGE (WHITE ALONE)
## 8 B01001A_006 Estimate!!Total!!Male!!15 to 17 years SEX BY AGE (WHITE ALONE)
## 9 B01001A_007 Estimate!!Total!!Male!!18 and 19 years SEX BY AGE (WHITE ALONE)
## 10 B01001A_008 Estimate!!Total!!Male!!20 to 24 years SEX BY AGE (WHITE ALONE)
## # ℹ 20,917 more rowstxsexhisp<- get_estimates(
geography = "state",
product = "characteristics",
breakdown = c("SEX", "HISP"),
breakdown_labels = TRUE,
state = "TX",
year = 2019
)
print(txsexhisp)## # A tibble: 9 × 5
## GEOID NAME value SEX HISP
## <chr> <chr> <dbl> <chr> <chr>
## 1 48 Texas 28995881 Both sexes Both Hispanic Origins
## 2 48 Texas 17470303 Both sexes Non-Hispanic
## 3 48 Texas 11525578 Both sexes Hispanic
## 4 48 Texas 14402702 Male Both Hispanic Origins
## 5 48 Texas 8601893 Male Non-Hispanic
## 6 48 Texas 5800809 Male Hispanic
## 7 48 Texas 14593179 Female Both Hispanic Origins
## 8 48 Texas 8868410 Female Non-Hispanic
## 9 48 Texas 5724769 Female Hispanicbexar_migration <- get_flows(
geography = "county",
state = "TX",
county = "Bexar",
year = 2019
)
print(bexar_migration)## # A tibble: 4,122 × 7
## GEOID1 GEOID2 FULL1_NAME FULL2_NAME variable estimate moe
## <chr> <chr> <chr> <chr> <chr> <dbl> <dbl>
## 1 48029 <NA> Bexar County, Texas Africa MOVEDIN 341 143
## 2 48029 <NA> Bexar County, Texas Africa MOVEDOUT NA NA
## 3 48029 <NA> Bexar County, Texas Africa MOVEDNET NA NA
## 4 48029 <NA> Bexar County, Texas Asia MOVEDIN 5412 1007
## 5 48029 <NA> Bexar County, Texas Asia MOVEDOUT NA NA
## 6 48029 <NA> Bexar County, Texas Asia MOVEDNET NA NA
## 7 48029 <NA> Bexar County, Texas Central America MOVEDIN 3641 1030
## 8 48029 <NA> Bexar County, Texas Central America MOVEDOUT NA NA
## 9 48029 <NA> Bexar County, Texas Central America MOVEDNET NA NA
## 10 48029 <NA> Bexar County, Texas Caribbean MOVEDIN 261 139
## # ℹ 4,112 more rowslibrary(tidycensus)
options(tigris_use_cache = TRUE)
tx_income <- get_acs(
geography = "county",
variables = "B19013_001",
state = "TX",
year = 2020,
geometry = TRUE
)## Getting data from the 2016-2020 5-year ACStx_income## Simple feature collection with 254 features and 5 fields
## Geometry type: MULTIPOLYGON
## Dimension: XY
## Bounding box: xmin: -106.6456 ymin: 25.83738 xmax: -93.50829 ymax: 36.5007
## Geodetic CRS: NAD83
## First 10 features:
## GEOID NAME variable estimate moe
## 1 48355 Nueces County, Texas B19013_001 56784 1681
## 2 48215 Hidalgo County, Texas B19013_001 41846 974
## 3 48167 Galveston County, Texas B19013_001 74633 1798
## 4 48195 Hansford County, Texas B19013_001 46507 12855
## 5 48057 Calhoun County, Texas B19013_001 57170 6165
## 6 48389 Reeves County, Texas B19013_001 61543 14665
## 7 48423 Smith County, Texas B19013_001 59450 2471
## 8 48053 Burnet County, Texas B19013_001 59919 2935
## 9 48051 Burleson County, Texas B19013_001 60058 8744
## 10 48347 Nacogdoches County, Texas B19013_001 44507 2782
## geometry
## 1 MULTIPOLYGON (((-97.11172 2...
## 2 MULTIPOLYGON (((-98.5853 26...
## 3 MULTIPOLYGON (((-94.78337 2...
## 4 MULTIPOLYGON (((-101.6239 3...
## 5 MULTIPOLYGON (((-96.80935 2...
## 6 MULTIPOLYGON (((-104.101 31...
## 7 MULTIPOLYGON (((-95.59454 3...
## 8 MULTIPOLYGON (((-98.45924 3...
## 9 MULTIPOLYGON (((-96.96363 3...
## 10 MULTIPOLYGON (((-94.97813 3...plot(tx_income["estimate"])
library(tidycensus)
library(tidyverse)
library(tigris)## To enable caching of data, set `options(tigris_use_cache = TRUE)`
## in your R script or .Rprofile.us_median_age <- get_acs(
geography = "state",
variables = "B01002_001",
year = 2019,
survey = "acs5",
geometry = TRUE,
resolution = "20m"
) %>%
shift_geometry()## Getting data from the 2015-2019 5-year ACSplot(us_median_age$geometry)
ggplot(data = us_median_age, aes(fill = estimate)) +
geom_sf()
ggplot(data = us_median_age, aes(fill = estimate)) +
geom_sf() +
scale_fill_distiller(palette = "RdPu",
direction = 1) +
labs(title = " Median Age by State, 2019",
caption = "Data source: 2019 5-year ACS, US Census Bureau",
fill = "ACS estimate") +
theme_void()
bexar_race <- get_decennial(
geography = "tract",
state = "TX",
county = "Bexar",
variables = c(
Hispanic = "P2_002N",
White = "P2_005N",
Black = "P2_006N",
Native = "P2_007N",
Asian = "P2_008N"
),
summary_var = "P2_001N",
year = 2020,
geometry = TRUE
) %>%
mutate(percent = 100 * (value / 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.bexar_race## Simple feature collection with 1875 features and 6 fields
## Geometry type: MULTIPOLYGON
## Dimension: XY
## Bounding box: xmin: -98.80655 ymin: 29.11444 xmax: -98.1169 ymax: 29.76071
## Geodetic CRS: NAD83
## # A tibble: 1,875 × 7
## GEOID NAME variable value summary_value geometry percent
## * <chr> <chr> <chr> <dbl> <dbl> <MULTIPOLYGON [°]> <dbl>
## 1 4802917… Cens… Hispanic 3862 4284 (((-98.62398 29.41355, -… 90.1
## 2 4802917… Cens… White 183 4284 (((-98.62398 29.41355, -… 4.27
## 3 4802917… Cens… Black 150 4284 (((-98.62398 29.41355, -… 3.50
## 4 4802917… Cens… Native 17 4284 (((-98.62398 29.41355, -… 0.397
## 5 4802917… Cens… Asian 17 4284 (((-98.62398 29.41355, -… 0.397
## 6 4802917… Cens… Hispanic 4373 4914 (((-98.58759 29.42769, -… 89.0
## 7 4802917… Cens… White 150 4914 (((-98.58759 29.42769, -… 3.05
## 8 4802917… Cens… Black 315 4914 (((-98.58759 29.42769, -… 6.41
## 9 4802917… Cens… Native 1 4914 (((-98.58759 29.42769, -… 0.0204
## 10 4802917… Cens… Asian 45 4914 (((-98.58759 29.42769, -… 0.916
## # ℹ 1,865 more rowslibrary(tmap)
bexar_black <- filter(bexar_race,
variable == "Black")
tm_shape(bexar_black) +
tm_polygons()
tm_shape(bexar_black) +
tm_polygons(col = "percent")
hist(bexar_black$percent)
library(tmap)
bexar_hisp <- filter(bexar_race,
variable == "Hispanic")
tm_shape(bexar_hisp) +
tm_polygons()
tm_shape(bexar_hisp) +
tm_polygons(col = "percent")
hist(bexar_hisp$percent)
library(tmap)
bexar_white <- filter(bexar_race,
variable == "White")
tm_shape(bexar_white) +
tm_polygons()
tm_shape(bexar_white) +
tm_polygons(col = "percent")
hist(bexar_white$percent)
#question: is there way to do this for the rio grande valley?
hidalgo_race <- get_decennial(
geography = "tract",
state = "TX",
county = "Hidalgo",
variables = c(
Hispanic = "P2_002N",
White = "P2_005N",
Black = "P2_006N",
Native = "P2_007N",
Asian = "P2_008N"
),
summary_var = "P2_001N",
year = 2020,
geometry = TRUE
) %>%
mutate(percent = 100 * (value / summary_value))## Getting data from the 2020 decennial Census## Using the PL 94-171 Redistricting Data summary filehidalgo_race## Simple feature collection with 1060 features and 6 fields
## Geometry type: MULTIPOLYGON
## Dimension: XY
## Bounding box: xmin: -98.5867 ymin: 26.03642 xmax: -97.86169 ymax: 26.78308
## Geodetic CRS: NAD83
## # A tibble: 1,060 × 7
## GEOID NAME variable value summary_value geometry percent
## * <chr> <chr> <chr> <dbl> <dbl> <MULTIPOLYGON [°]> <dbl>
## 1 4821502… Cens… Hispanic 5030 5282 (((-98.20481 26.19426, -… 95.2
## 2 4821502… Cens… White 203 5282 (((-98.20481 26.19426, -… 3.84
## 3 4821502… Cens… Black 19 5282 (((-98.20481 26.19426, -… 0.360
## 4 4821502… Cens… Native 1 5282 (((-98.20481 26.19426, -… 0.0189
## 5 4821502… Cens… Asian 8 5282 (((-98.20481 26.19426, -… 0.151
## 6 4821502… Cens… Hispanic 2618 3055 (((-98.23158 26.19433, -… 85.7
## 7 4821502… Cens… White 347 3055 (((-98.23158 26.19433, -… 11.4
## 8 4821502… Cens… Black 6 3055 (((-98.23158 26.19433, -… 0.196
## 9 4821502… Cens… Native 2 3055 (((-98.23158 26.19433, -… 0.0655
## 10 4821502… Cens… Asian 62 3055 (((-98.23158 26.19433, -… 2.03
## # ℹ 1,050 more rowslibrary(tmap)
hidalgo_white <- filter(hidalgo_race,
variable == "White")
tm_shape(hidalgo_white) +
tm_polygons()
tm_shape(hidalgo_white) +
tm_polygons(col = "percent")
hist(hidalgo_white$percent)
library(tmap)
hidalgo_hisp <- filter(hidalgo_race,
variable == "Hispanic")
tm_shape(hidalgo_hisp) +
tm_polygons()
tm_shape(hidalgo_hisp) +
tm_polygons(col = "percent")
hist(hidalgo_hisp$percent)
library(tmap)
hidalgo_black <- filter(hidalgo_race,
variable == "Black")
tm_shape(hidalgo_black) +
tm_polygons()
tm_shape(hidalgo_black) +
tm_polygons(col = "percent")
hist(hidalgo_black$percent)
tm_shape(bexar_black) +
tm_polygons(col = "percent",
style = "quantile",
n = 5,
palette = "Purples",
title = "2020 US Census") +
tm_layout(title = "Percent Black\nby Census tract",
frame = FALSE,
legend.outside = TRUE)
tm_shape(bexar_hisp) +
tm_polygons(col = "percent",
style = "quantile",
n = 5,
palette = "Purples",
title = "2020 US Census") +
tm_layout(title = "Percent Hispanic\nby Census tract",
frame = FALSE,
legend.outside = TRUE)
tm_shape(bexar_white) +
tm_polygons(col = "percent",
style = "quantile",
n = 5,
palette = "Purples",
title = "2020 US Census") +
tm_layout(title = "Percent Whites\nby Census tract",
frame = FALSE,
legend.outside = TRUE)
tm_shape(hidalgo_black) +
tm_polygons(col = "percent",
style = "quantile",
n = 5,
palette = "Purples",
title = "2020 US Census") +
tm_layout(title = "Percent Black\nby Census tract",
frame = FALSE,
legend.outside = TRUE)
tm_shape(hidalgo_hisp) +
tm_polygons(col = "percent",
style = "quantile",
n = 5,
palette = "Purples",
title = "2020 US Census") +
tm_layout(title = "Percent Hispanic\nby Census tract",
frame = FALSE,
legend.outside = TRUE)
tm_shape(hidalgo_white) +
tm_polygons(col = "percent",
style = "quantile",
n = 5,
palette = "Purples",
title = "2020 US Census") +
tm_layout(title = "Percent White\nby Census tract",
frame = FALSE,
legend.outside = TRUE)
tm_shape(bexar_black) +
tm_polygons(col = "percent",
style = "jenks",
n = 5,
palette = "Purples",
title = "2020 US Census",
legend.hist = TRUE) +
tm_layout(title = "Percent Black\nby Census tract",
frame = FALSE,
legend.outside = TRUE,
bg.color = "grey70",
legend.hist.width = 5,
fontfamily = "Verdana")
tm_shape(bexar_hisp) +
tm_polygons(col = "percent",
style = "jenks",
n = 5,
palette = "Purples",
title = "2020 US Census",
legend.hist = TRUE) +
tm_layout(title = "Percent Hispanic\nby Census tract",
frame = FALSE,
legend.outside = TRUE,
bg.color = "grey70",
legend.hist.width = 5,
fontfamily = "Verdana")
tm_shape(bexar_white) +
tm_polygons(col = "percent",
style = "jenks",
n = 5,
palette = "Purples",
title = "2020 US Census",
legend.hist = TRUE) +
tm_layout(title = "Percent White\nby Census tract",
frame = FALSE,
legend.outside = TRUE,
bg.color = "grey70",
legend.hist.width = 5,
fontfamily = "Verdana")
tm_shape(hidalgo_hisp) +
tm_polygons(col = "percent",
style = "jenks",
n = 5,
palette = "Purples",
title = "2020 US Census",
legend.hist = TRUE) +
tm_layout(title = "Percent Hispanic\nby Census tract",
frame = FALSE,
legend.outside = TRUE,
bg.color = "grey70",
legend.hist.width = 5,
fontfamily = "Verdana")
tm_shape(hidalgo_black) +
tm_polygons(col = "percent",
style = "jenks",
n = 5,
palette = "Purples",
title = "2020 US Census",
legend.hist = TRUE) +
tm_layout(title = "Percent Black\nby Census tract",
frame = FALSE,
legend.outside = TRUE,
bg.color = "grey70",
legend.hist.width = 5,
fontfamily = "Verdana")
tm_shape(hidalgo_white) +
tm_polygons(col = "percent",
style = "jenks",
n = 5,
palette = "Purples",
title = "2020 US Census",
legend.hist = TRUE) +
tm_layout(title = "Percent White\nby Census tract",
frame = FALSE,
legend.outside = TRUE,
bg.color = "grey70",
legend.hist.width = 5,
fontfamily = "Verdana")
tm_shape(bexar_hisp) +
tm_polygons() +
tm_bubbles(size = "value", alpha = 0.5,
col = "navy",
title.size = "Hispanic - 2020 US Census") +
tm_layout(legend.outside = TRUE,
legend.outside.position = "bottom")
tm_shape(hidalgo_black) +
tm_polygons() +
tm_bubbles(size = "value", alpha = 0.5,
col = "red",
title.size = "Non-Hispanic Black - 2020 US Census") +
tm_layout(legend.outside = TRUE,
legend.outside.position = "bottom")
tm_shape(hidalgo_hisp) +
tm_polygons() +
tm_bubbles(size = "value", alpha = 0.5,
col = "yellow",
title.size = "Hispanic - 2020 US Census") +
tm_layout(legend.outside = TRUE,
legend.outside.position = "bottom")
tm_shape(bexar_race) +
tm_facets(by = "variable", scale.factor = 4) +
tm_fill(col = "percent",
style = "quantile",
n = 6,
palette = "Blues",
title = "Percent (2020 US Census)",) +
tm_layout(bg.color = "grey",
legend.position = c(-0.7, 0.15),
panel.label.bg.color = "white")
tm_shape(hidalgo_race) +
tm_facets(by = "variable", scale.factor = 4) +
tm_fill(col = "percent",
style = "quantile",
n = 6,
palette = "Purples",
title = "Percent (2020 US Census)",) +
tm_layout(bg.color = "grey",
legend.position = c(-0.7, 0.15),
panel.label.bg.color = "white")
bexar_dots <- bexar_race %>%
as_dot_density(
value = "value",
values_per_dot = 100,
group = "variable"
)
background_tracts <- filter(bexar_race, variable == "White")
tm_shape(background_tracts) +
tm_polygons(col = "white",
border.col = "grey") +
tm_shape(bexar_dots) +
tm_dots(col = "variable",
palette = "Set1",
size = 0.005,
title = "1 dot = 100 people") +
tm_layout(legend.outside = TRUE,
title = "Race/ethnicity,\n2020 US Census")hidalgo_bachelors <- get_acs(
geography = "tract",
variables = "DP02_0068P",
year = 2020,
state = "TX",
county = "Hidalgo",
geometry = TRUE
)## Getting data from the 2016-2020 5-year ACS## Using the ACS Data Profilelibrary(mapview)
mapview(hidalgo_bachelors, zcol = "estimate")#Poverty B05010_001
hidalgo_pov <- get_acs(
geography = "tract",
variables = "B05010_001",
year = 2020,
state = "TX",
county = "Hidalgo",
geometry = TRUE
)## Getting data from the 2016-2020 5-year ACSlibrary(mapview)
mapview(hidalgo_pov, zcol = "estimate")bexar_bachelors <- get_acs(
geography = "tract",
variables = "DP02_0068P",
year = 2020,
state = "TX",
county = "Bexar",
geometry = TRUE
)## Getting data from the 2016-2020 5-year ACS## Using the ACS Data Profilelibrary(mapview)
mapview(bexar_bachelors, zcol = "estimate")travis_bachelors <- get_acs(
geography = "tract",
variables = "DP02_0068P",
year = 2020,
state = "TX",
county = "Travis",
geometry = TRUE
)## Getting data from the 2016-2020 5-year ACS## Using the ACS Data Profilelibrary(mapview)
mapview(travis_bachelors, zcol = "estimate")harris_bachelors <- get_acs(
geography = "tract",
variables = "DP02_0068P",
year = 2020,
state = "TX",
county = "Harris County",
geometry = TRUE
)## Getting data from the 2016-2020 5-year ACS## Using the ACS Data Profilelibrary(mapview)
mapview(harris_bachelors, zcol = "estimate")library(tmap)
tmap_mode("view")## tmap mode set to interactive viewingtm_shape(hidalgo_bachelors) +
tm_fill(col = "estimate", palette = "magma",
alpha = 0.5)library(leaflet)
pal <- colorNumeric(
palette = "magma",
domain = hidalgo_bachelors$estimate
)
pal(c(10, 20, 30, 40, 50))## [1] "#2B115E" "#6E1E81" "#B2357B" "#ED5A5F" "#FEA772"leaflet() %>%
addProviderTiles(providers$Stamen.TonerLite) %>%
addPolygons(data = hidalgo_bachelors,
color = ~pal(estimate),
weight = 0.5,
smoothFactor = 0.2,
fillOpacity = 0.5,
label = ~estimate) %>%
addLegend(
position = "bottomright",
pal = pal,
values = hidalgo_bachelors$estimate,
title = "% with bachelor's<br/>degree"
)## Warning: sf layer has inconsistent datum (+proj=longlat +datum=NAD83 +no_defs).
## Need '+proj=longlat +datum=WGS84'library(tmap)
tmap_mode("view")## tmap mode set to interactive viewingtm_shape(bexar_bachelors) +
tm_fill(col = "estimate", palette = "magma",
alpha = 0.5)library(leaflet)
pal <- colorNumeric(
palette = "magma",
domain = bexar_bachelors$estimate
)
pal(c(10, 20, 30, 40, 50))## [1] "#180F3E" "#491078" "#7A2282" "#AC337C" "#DD4968"leaflet() %>%
addProviderTiles(providers$Stamen.TonerLite) %>%
addPolygons(data = bexar_bachelors,
color = ~pal(estimate),
weight = 0.5,
smoothFactor = 0.2,
fillOpacity = 0.5,
label = ~estimate) %>%
addLegend(
position = "bottomright",
pal = pal,
values = bexar_bachelors$estimate,
title = "% with bachelor's<br/>degree"
)## Warning: sf layer has inconsistent datum (+proj=longlat +datum=NAD83 +no_defs).
## Need '+proj=longlat +datum=WGS84'#mapping migration flows
travis_inflow <- get_flows(
geography = "county",
state = "TX",
county = "Travis",
geometry = TRUE
) %>%
filter(variable == "MOVEDIN") %>%
na.omit() %>%
arrange(desc(estimate))
library(mapdeck)##
## Attaching package: 'mapdeck'## The following object is masked from 'package:tibble':
##
## add_columntoken <- "pk.eyJ1IjoieHBpMzUyIiwiYSI6ImNsaDVyZW56aTIyd3YzZG94ZzBmYWs0bjgifQ.pw1OdwEytUiDW6DbybnhxA"
travis_inflow %>%
slice_max(estimate, n = 30) %>%
mutate(weight = estimate / 500) %>%
mapdeck(token = token) %>%
add_arc(origin = "centroid2",
destination = "centroid1",
stroke_width = "weight",
update_view = FALSE) ## Registered S3 method overwritten by 'jsonify':
## method from
## print.json jsonlite#mapping migration flows
hidalgo_inflow <- get_flows(
geography = "county",
state = "TX",
county = "Hidalgo",
geometry = TRUE
) %>%
filter(variable == "MOVEDIN") %>%
na.omit() %>%
arrange(desc(estimate))
library(mapdeck)
token <- "pk.eyJ1IjoieHBpMzUyIiwiYSI6ImNsaDVyZW56aTIyd3YzZG94ZzBmYWs0bjgifQ.pw1OdwEytUiDW6DbybnhxA"
hidalgo_inflow %>%
slice_max(estimate, n = 30) %>%
mutate(weight = estimate / 500) %>%
mapdeck(token = token) %>%
add_arc(origin = "centroid2",
destination = "centroid1",
stroke_width = "weight",
update_view = FALSE) #mapping migration flows
bexar_inflow <- get_flows(
geography = "county",
state = "TX",
county = "Bexar",
geometry = TRUE
) %>%
filter(variable == "MOVEDIN") %>%
na.omit() %>%
arrange(desc(estimate))
library(mapdeck)
token <- "pk.eyJ1IjoieHBpMzUyIiwiYSI6ImNsaDVyZW56aTIyd3YzZG94ZzBmYWs0bjgifQ.pw1OdwEytUiDW6DbybnhxA"
bexar_inflow %>%
slice_max(estimate, n = 30) %>%
mutate(weight = estimate / 500) %>%
mapdeck(token = token) %>%
add_arc(origin = "centroid2",
destination = "centroid1",
stroke_width = "weight",
update_view = FALSE) library(tidycensus)
library(ggiraph)
library(tidyverse)
library(patchwork)
library(scales)
tx_income <- get_acs(
geography = "county",
variables = "B19013_001",
state = "TX",
year = 2020,
geometry = TRUE
) %>%
mutate(NAME = str_remove(NAME, " County, Texas"))## Getting data from the 2016-2020 5-year ACStx_map <- ggplot(tx_income, aes(fill = estimate)) +
geom_sf_interactive(aes(data_id = GEOID)) +
scale_fill_distiller(palette = "Greens",
direction = 1,
guide = "none") +
theme_void()
tx_plot <- ggplot(tx_income, aes(x = estimate, y = reorder(NAME, estimate),
fill = estimate)) +
geom_errorbar(aes(xmin = estimate - moe, xmax = estimate + moe)) +
geom_point_interactive(color = "black", size = 4, shape = 21,
aes(data_id = GEOID)) +
scale_fill_distiller(palette = "Greens", direction = 1,
labels = label_dollar()) +
scale_x_continuous(labels = label_dollar()) +
labs(title = "Household income by county in Texas",
subtitle = "2016-2020 American Community Survey",
y = "",
x = "ACS estimate (bars represent margin of error)",
fill = "ACS estimate") +
theme_minimal(base_size = 14)
girafe(ggobj = tx_map + tx_plot, width_svg = 10, height_svg = 5) %>%
girafe_options(opts_hover(css = "fill:cyan;"))## Warning: Removed 1 rows containing missing values (`geom_interactive_point()`).#got this to work for the twin cities but not texas
library(tidycensus)
library(shiny)
library(leaflet)
library(tidyverse)
census_api_key("a4d96ac7ff4ba560c03cd295dd6a404071c1a488")## To install your API key for use in future sessions, run this function with `install = TRUE`.twin_cities_race <- get_acs(
geography = "tract",
variables = c(
hispanic = "DP05_0071P",
white = "DP05_0077P",
black = "DP05_0078P",
native = "DP05_0079P",
asian = "DP05_0080P",
year = 2019
),
state = "MN",
county = c("Hennepin", "Ramsey", "Anoka", "Washington",
"Dakota", "Carver", "Scott"),
geometry = TRUE
) ## Getting data from the 2017-2021 5-year ACS## Fetching data by table type ("B/C", "S", "DP") and combining the result.groups <- 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(twin_cities_race, 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