library(tidycensus)
library(sf)
library(tmap)
library(tidyverse)
library(magrittr)
library(here)
library(tigris)
ttm()
census_api_key("7329fd3a4a1a2962c47ae4cd2152cdb4037be674") # Sys.getenv('census_api')
# var <- load_variables('acs5', year = 2022)
# var %>% filter(str_detect(label, '65')) %>% view()
census_2023 <- suppressMessages(
get_acs('tract',
variables = c(income = 'B19013_001',
housing_cost = 'B25105_001',
pop = 'B01003_001',
white_nh = 'B03002_003',
black_nh = 'B03002_004',
asian_nh = 'B03002_006',
hispanic = 'B03002_012',
korean = 'B02015_005',
edu.degree.bachelor = 'B15003_022',
edu.degree.master = 'B15003_023',
edu.degree.professional = 'B15003_024',
edu.degree.doctorate = 'B15003_025',
age_65_66 = "B01001_020",
age_65_66_f = "B01001_044",
age_67_69 = "B01001_021",
age_67_69_f = "B01001_045",
age_70_74 = "B01001_022",
age_70_74_f = "B01001_046",
age_75_79 = "B01001_023",
age_75_79_f = "B01001_047",
age_80_84 = "B01001_024",
age_80_84_f = "B01001_048",
age_85_up = "B01001_025",
age_85_up_f = "B01001_049",
owner_occ = "B25003_002", # Owner-occupied units
total_hh = "B25003_001", # Total occupied units
total_movedin = "B25038_001", # Total
movedin_1990s = "B25038_007", # Moved in 90s
movedin_pre_1990 = "B25038_008" # Moved in before 1990
),
year = 2023,
county = c("Fulton", "Dekalb","Gwinnett", "Cobb"),
geometry = TRUE,
state = "GA",
output = "wide")
)
census_2023 %<>%
mutate(
higher_edu = edu.degree.bachelorE + edu.degree.masterE +
edu.degree.professionalE + edu.degree.doctorateE,
pct_65_plus = (age_65_66E + age_65_66_fE +
age_67_69E + age_67_69_fE +
age_70_74E + age_70_74_fE +
age_75_79E + age_75_79_fE +
age_80_84E + age_80_84_fE +
age_85_upE + age_85_up_fE) / popE,
pct_owner = owner_occE / total_hhE,
pct_movedin_pre2000 = (movedin_1990sE + movedin_pre_1990E) / total_movedinE
) %>%
select(
geoid = GEOID, pop = popE, income = incomeE, higher_edu, housing_cost = housing_costE,
white = white_nhE, black = black_nhE, asian = asian_nhE, hispanic = hispanicE, korean = koreanE,
pct_65_plus, pct_owner, pct_movedin_pre2000
) %>%
mutate(
higher_edu_r = round(higher_edu/pop, 3),
white_r = round(white/pop, 3),
black_r = round(black/pop, 3),
hispanic_r = round(hispanic/pop, 3),
asian_r = round(asian/pop, 3),
korean_r = round(korean/pop, 3),
argmin_black_asian = case_when(
black_r < asian_r ~ black_r,
TRUE ~ asian_r),
argmin_black_korean = case_when(
black_r < korean_r ~ black_r,
TRUE ~ korean_r),
korean_among_asian = round(korean/asian, 3))
cities <- places('GA', year = 2023) %>% filter(LSAD == 25) %>%
.[census_2023, ]
scaled <- census_2023 %>%
st_set_geometry(NULL) %>%
select(argmin_black_korean, income, higher_edu_r) %>%
scale(.) %>%
as.data.frame() %>%
mutate(demo_income_edu = rowSums(.))
census_2023$demo_income_edu <- scaled$demo_income_edu
aesthetics <- tm_basemap("OpenStreetMap") +
tm_shape(cities) + tm_borders(col = 'green', lwd = 1.5) +
tm_view(set.view = c(-84.37032, 33.85764, 10),
view.legend.position = c('right','bottom'))
cor.test(census_2023$pct_65_plus, census_2023$pct_movedin_pre2000)
##
## Pearson's product-moment correlation
##
## data: census_2023$pct_65_plus and census_2023$pct_movedin_pre2000
## t = 16.461, df = 930, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.4237037 0.5232511
## sample estimates:
## cor
## 0.4749956
Income
tm_shape(census_2023) +
tm_fill(col = 'income',
alpha = 0.5,
palette = "inferno") + aesthetics
Higher education (%)
tm_shape(census_2023) +
tm_fill(col = 'higher_edu_r',
breaks = c(0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 1),
alpha = 0.5,
palette = "inferno") + aesthetics
Black & Korean (%, argmin)
tm_shape(census_2023) +
tm_fill(col = 'argmin_black_korean',
breaks = c(0, 0.01, 0.02, 0.04, 0.06, 0.08, 0.1, 0.15, 0.2, 1),
alpha = 0.5,
palette = "inferno") + aesthetics