library(tidycensus)
library(dplyr)
library(tidyverse)Segregation
race_table10 <- get_acs(geography = "tract", year=2020, geometry = F, output="wide", table = "B03002", cache_table = T, state = "TX")trdat<-race_table10%>%
mutate(nhwhite=B03002_003E,
nhblack=B03002_004E,
nhother= B03002_005E+B03002_006E+B03002_007E+B03002_008E+B03002_009E+B03002_010E,
hisp=B03002_012E,
total=B03002_001E,
year=2020,
cofips=substr(GEOID, 1,5))%>%
select(GEOID,nhwhite, nhblack , nhother, hisp, total, year, cofips )%>%
arrange(cofips, GEOID)
#look at the first few cases
head(trdat)# A tibble: 6 × 8
GEOID nhwhite nhblack nhother hisp total year cofips
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <chr>
1 48001950100 3811 267 735 409 4958 2020 48001
2 48001950401 1497 1842 142 1386 4867 2020 48001
3 48001950402 2300 2871 122 2057 7335 2020 48001
4 48001950500 1752 707 78 1860 4397 2020 48001
5 48001950600 2963 1268 69 404 4704 2020 48001
6 48001950700 518 1056 101 822 2497 2020 48001 #We need the county-level totals for the total population and each race group
codat<-trdat%>%
group_by(cofips)%>%
summarise(co_total=sum(total), co_wht=sum(nhwhite), co_blk=sum(nhblack), co_oth=sum(nhother), cohisp=sum(hisp))
#we merge the county data back to the tract data by the county FIPS code
merged<-left_join(x=trdat,y=codat, by="cofips")
#have a look and make sure it looks ok
head(merged)# A tibble: 6 × 13
GEOID nhwhite nhblack nhother hisp total year cofips co_total co_wht co_blk
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <chr> <dbl> <dbl> <dbl>
1 48001… 3811 267 735 409 4958 2020 48001 57917 33642 11919
2 48001… 1497 1842 142 1386 4867 2020 48001 57917 33642 11919
3 48001… 2300 2871 122 2057 7335 2020 48001 57917 33642 11919
4 48001… 1752 707 78 1860 4397 2020 48001 57917 33642 11919
5 48001… 2963 1268 69 404 4704 2020 48001 57917 33642 11919
6 48001… 518 1056 101 822 2497 2020 48001 57917 33642 11919
# ℹ 2 more variables: co_oth <dbl>, cohisp <dbl>library(writexl)
# knitr::kable(merged, format = "html")
library(DT)
datatable(merged)Dissimilarity Index for Black-white
co.dis<-merged%>%
mutate(d.wb=abs(nhwhite/co_wht - nhblack/co_blk))%>%
group_by(cofips)%>%
summarise(dissim= .5*sum(d.wb, na.rm=T))Dissimilarity for Hispanic-white
co.dis_hisp<-merged%>%
mutate(d.wb=abs(nhwhite/co_wht - hisp/cohisp))%>%
group_by(cofips)%>%
summarise(dissim= .5*sum(d.wb, na.rm=T))Interaction Index for Black-white
co.int<-merged%>%
mutate(int.bw=(nhblack/co_blk * nhwhite/total))%>%
group_by(cofips)%>%
summarise(inter_bw= sum(int.bw, na.rm=T))Interaction Index for Hispanic-white
his.co.int<-merged%>%
mutate(int.bw=(hisp/cohisp * nhwhite/total))%>%
group_by(cofips)%>%
summarise(inter_bw= sum(int.bw, na.rm=T))Isolation Index for Black-white
co.isob<-merged%>%
mutate(isob=(nhblack/co_blk * nhblack/total))%>%
group_by(cofips)%>%
summarise(iso_b= sum(isob, na.rm=T))Isolation Index for Hispanic-white
hisp.co.isob<-merged%>%
mutate(isob=(hisp/cohisp * hisp/total))%>%
group_by(cofips)%>%
summarise(iso_b= sum(isob, na.rm=T))Join for Black-white
tx_seg<-list(co.dis, co.int, co.isob)%>% reduce (left_join, by="cofips")library(tigris)
options(tigris_class = "sf")
tx_counties<- counties(state="TX", cb=T, year=2021)
|
| | 0%
|
| | 1%
|
|= | 1%
|
|= | 2%
|
|== | 2%
|
|== | 3%
|
|=== | 4%
|
|=== | 5%
|
|==== | 5%
|
|==== | 6%
|
|===== | 7%
|
|===== | 8%
|
|====== | 8%
|
|====== | 9%
|
|======= | 9%
|
|======= | 10%
|
|======= | 11%
|
|======== | 11%
|
|======== | 12%
|
|========= | 12%
|
|========= | 13%
|
|========= | 14%
|
|========== | 14%
|
|========== | 15%
|
|=========== | 15%
|
|=========== | 16%
|
|============ | 17%
|
|============ | 18%
|
|============= | 18%
|
|============= | 19%
|
|============== | 19%
|
|============== | 20%
|
|=============== | 21%
|
|=============== | 22%
|
|================ | 22%
|
|================ | 23%
|
|================ | 24%
|
|================= | 24%
|
|================= | 25%
|
|================== | 25%
|
|================== | 26%
|
|=================== | 26%
|
|=================== | 27%
|
|=================== | 28%
|
|==================== | 28%
|
|==================== | 29%
|
|===================== | 30%
|
|===================== | 31%
|
|====================== | 31%
|
|====================== | 32%
|
|======================= | 32%
|
|======================= | 33%
|
|======================== | 34%
|
|======================== | 35%
|
|========================= | 35%
|
|========================= | 36%
|
|========================== | 36%
|
|========================== | 37%
|
|========================== | 38%
|
|=========================== | 38%
|
|=========================== | 39%
|
|============================ | 40%
|
|============================ | 41%
|
|============================= | 41%
|
|============================= | 42%
|
|============================== | 42%
|
|============================== | 43%
|
|=============================== | 44%
|
|=============================== | 45%
|
|================================ | 45%
|
|================================ | 46%
|
|================================= | 47%
|
|================================= | 48%
|
|================================== | 48%
|
|================================== | 49%
|
|=================================== | 49%
|
|=================================== | 50%
|
|=================================== | 51%
|
|==================================== | 51%
|
|==================================== | 52%
|
|===================================== | 52%
|
|===================================== | 53%
|
|===================================== | 54%
|
|====================================== | 54%
|
|====================================== | 55%
|
|======================================= | 55%
|
|======================================= | 56%
|
|======================================== | 56%
|
|======================================== | 57%
|
|======================================== | 58%
|
|========================================= | 58%
|
|========================================= | 59%
|
|========================================== | 59%
|
|========================================== | 60%
|
|========================================== | 61%
|
|=========================================== | 61%
|
|=========================================== | 62%
|
|============================================ | 62%
|
|============================================ | 63%
|
|============================================= | 64%
|
|============================================= | 65%
|
|============================================== | 65%
|
|============================================== | 66%
|
|=============================================== | 67%
|
|=============================================== | 68%
|
|================================================ | 68%
|
|================================================ | 69%
|
|================================================= | 69%
|
|================================================= | 70%
|
|================================================= | 71%
|
|================================================== | 71%
|
|================================================== | 72%
|
|=================================================== | 72%
|
|=================================================== | 73%
|
|==================================================== | 74%
|
|==================================================== | 75%
|
|===================================================== | 75%
|
|===================================================== | 76%
|
|====================================================== | 77%
|
|====================================================== | 78%
|
|======================================================= | 78%
|
|======================================================= | 79%
|
|======================================================== | 79%
|
|======================================================== | 80%
|
|======================================================== | 81%
|
|========================================================= | 81%
|
|========================================================= | 82%
|
|========================================================== | 82%
|
|========================================================== | 83%
|
|========================================================== | 84%
|
|=========================================================== | 84%
|
|=========================================================== | 85%
|
|============================================================ | 85%
|
|============================================================ | 86%
|
|============================================================= | 86%
|
|============================================================= | 87%
|
|============================================================= | 88%
|
|============================================================== | 88%
|
|============================================================== | 89%
|
|=============================================================== | 89%
|
|=============================================================== | 90%
|
|=============================================================== | 91%
|
|================================================================ | 91%
|
|================================================================ | 92%
|
|================================================================= | 92%
|
|================================================================= | 93%
|
|================================================================== | 94%
|
|================================================================== | 95%
|
|=================================================================== | 95%
|
|=================================================================== | 96%
|
|==================================================================== | 97%
|
|==================================================================== | 98%
|
|===================================================================== | 98%
|
|===================================================================== | 99%
|
|======================================================================| 99%
|
|======================================================================| 100%tx_counties$cofips<-substr(tx_counties$AFFGEOID, 10,15)
tx_seg_dat<- geo_join(tx_counties, tx_seg, by_sp="cofips", by_df="cofips")Join for Hispanic-white
hisp_seg <- list(co.dis_hisp, his.co.int, hisp.co.isob)%>% reduce (left_join, by="cofips")
library(tigris)
options(tigris_class = "sf")
tx_counties<- counties(state="TX", cb=T, year=2021)
tx_counties$cofips<-substr(tx_counties$AFFGEOID, 10,15)
hisp_tx_seg_dat<- geo_join(tx_counties, hisp_seg, by_sp="cofips", by_df="cofips")Mapping Black-white Isolation Index
library(ggplot2)
tx_seg_dat%>%
ggplot()+geom_sf(aes(fill=iso_b))+
scale_fill_viridis_c()+
scale_color_viridis_c()+
ggtitle("Non-Hispanic Black isolation index", subtitle = "2021 ACS")
Mapping Black-white Dissimilarity Index
The index ranges between 0 and 1, with 0 being pure integration, and 1 being perfect segregation. Typically values over .5 are considered to be very high levels of segregation
library(ggplot2)
map_dis <- tx_seg_dat%>%
ggplot()+geom_sf(aes(fill=dissim))+
scale_fill_viridis_c()+
scale_color_viridis_c()+
ggtitle("Black White Dissimilarity index", subtitle = "2021 ACS")
map_dis
Mapping Hispanic-white Dissimilarity
library(ggplot2)
hisp_map_dis <- hisp_tx_seg_dat%>%
ggplot()+geom_sf(aes(fill=dissim))+
scale_fill_viridis_c()+
scale_color_viridis_c()+
ggtitle("Hispanic-White Dissimilarity index", subtitle = "2021 ACS, 5 Year Data")
hisp_map_dis
Made interactive maps
Hispanic-White Dissimilarity
library(plotly)
plotly::ggplotly(hisp_map_dis)Black-White Dissimilarity
#| warning: false
#| error: false
#| message: false
library(plotly)
plotly::ggplotly(map_dis)