US census and CPS maps
Steven Li
2023-01-24
#ACS Graphs
National level
hh_has_computer %>% filter(CIHHCOMP==2) %>%
ggplot()+geom_line(aes(YEAR,pct/100))+
labs(title="% of Households with computer",caption = "Source: CPS",x="Year",y="")+
scale_y_continuous(labels = label_percent())+
scale_x_continuous(breaks= pretty_breaks())
internet_nation %>% mutate(pct=has_computer.one_or_more_devicesE/has_computer.universeE) %>%
select(year,pct) %>%
ggplot()+geom_line(aes(year,pct))+
labs(title="% of Households with one or more device",caption = "Source: American Community Survey 1-Year Data")+
scale_y_continuous(labels = label_percent())+
scale_x_continuous(breaks= pretty_breaks())
hh_has_internet %>% filter(CINETHH==2) %>%
ggplot()+geom_line(aes(YEAR,pct/100))+
labs(title="% of Households with internet",caption = "Source: CPS",x="Year",y="")+
scale_y_continuous(labels = label_percent())+
scale_x_continuous(breaks= pretty_breaks())
internet_nation %>% mutate(pct=internet.subscriptionE/internet.universeE) %>%
select(year,pct) %>%
ggplot()+geom_line(aes(year,pct))+
labs(title="% of Households with internet subscription",caption = "Source: American Community Survey 1-Year Data",x="Year",y="")+
scale_y_continuous(labels = label_percent())+
scale_x_continuous(breaks= pretty_breaks())
internet_nation %>% select(year,
computer_and_type_of_internet.has_computer.dialup_aloneE,
computer_and_type_of_internet.has_computer.broadband.fixedE,
computer_and_type_of_internet.has_computer.broadband.mobile_aloneE,
computer_and_type_of_internet.has_computer.without_internetE,
computer_and_type_of_internet.no_computerE) %>%
rename_with(~str_remove(.,"computer_and_type_of_internet.")) %>%
rename_with(~str_remove(.,"has_computer.")) %>%
gather("variable","value",-year) %>%
ggplot() + geom_area(aes(x=year, y=value, fill=variable))+
labs(title="Type of internet subscription over time",caption = "Source: American Community Survey 1-Year Data",x="Year",y="")+
scale_y_continuous(labels = label_comma())+
scale_x_continuous(breaks= pretty_breaks())+
theme(legend.position="bottom")
internet_nation %>% select(year,
has_computer.universeE,
has_computer.one_or_more_devices.desktop_or_laptopE,
has_one_or_more_types_of_computing_devices.handheld_computer13E,
has_one_or_more_types_of_computing_devices.smartphone16E,
has_one_or_more_types_of_computing_devices.tablet_or_other_portable_computer16E,
has_computer.one_or_more_devices.other_computerE,
has_computer.one_or_more_devices.no_computerE) %>%
rename_with(~str_remove(.,"has_computer.")) %>%
rename_with(~str_remove(.,"has_one_or_more_types_of_computing_devices.")) %>%
rename_with(~str_remove(.,"one_or_more_devices.")) %>%
gather("variable","value",-year) %>%
ggplot() + geom_line(aes(x=year, y=value, color=variable))+
labs(title="Type of internet device over time",caption = "Source: American Community Survey 1-Year Data",x="Year",y="")+
scale_y_continuous(labels = label_comma())+
scale_x_continuous(breaks= pretty_breaks())+
theme(legend.position="bottom")## Warning: Removed 11 row(s) containing missing values (geom_path).
internet_nation %>% transmute(year,
income.less_than_10000= income.less_than_10000.without_subscriptionE/income.less_than_10000E,
income.10000_19999=income.10000_19999.without_subscriptionE/income.10000_19999E,
income.20000_34999=income.20000_34999.without_subscriptionE/income.20000_34999E,
income.35000_49999=income.35000_49999.without_subscriptionE/income.35000_49999E,
income.50000_74999=income.50000_74999.without_subscriptionE/income.50000_74999E,
income.75000_or_more=income.75000_or_more.without_subscriptionE/income.75000_or_moreE) %>%
gather("variable","value",-year) %>%
ggplot() + geom_line(aes(x=year, y=value, color=variable))+
labs(title="% without internet subscription by income",caption = "Source: American Community Survey 1-Year Data",x="Year",y="")+
scale_y_continuous(labels = label_percent())+
scale_x_continuous(breaks= pretty_breaks())+
theme(legend.position="bottom")
internet_nation %>% transmute(year,
under_18= age.under_18.no_computerE/age.under_18E,
between_18_64=age.between_18_64.no_computerE/age.between_18_64E,
age.65_or_moreE=age.65_or_more.no_computerE/age.65_or_moreE) %>%
gather("variable","value",-year) %>%
ggplot() + geom_line(aes(x=year, y=value, color=variable))+
labs(title="% without computer by age group",caption = "Source: American Community Survey 1-Year Data")+
scale_y_continuous(labels = label_percent())+
scale_x_continuous(breaks= pretty_breaks())+
theme(legend.position="bottom")
internet_nation %>% transmute(year,
below_HS= education.less_than_hs_e.no_computerE/education.less_than_hs_eE,
hs_some_college=education.hs_some_college_associates.no_computerE/education.hs_some_college_associatesE,
bac_or_higher=education.bachelors_or_higher.no_computerE/education.bachelors_or_higherE) %>%
gather("variable","value",-year) %>%
ggplot() + geom_line(aes(x=year, y=value, color=variable))+
labs(title="% without computer by educational attainment",caption = "Source: American Community Survey 1-Year Data",x="Year",y="")+
scale_y_continuous(labels = label_percent())+
scale_x_continuous(breaks= pretty_breaks())+
theme(legend.position="bottom")
internet_nation %>% transmute(year,
white = race.white_alone_not_hispanic.no_computerE/race.white_alone_not_hispanicE,
black= race.black_alone.no_computerE/race.black_aloneE,
asian=race.asian_alone.no_computerE/race.asian_aloneE,
hispanic=race.hispanic.no_computerE/race.hispanicE) %>%
gather("variable","value",-year) %>%
ggplot() + geom_line(aes(x=year, y=value, color=variable))+
labs(title="% without computer by race",caption = "Source: American Community Survey 1-Year Data",x="Year",y="")+
scale_y_continuous(labels = label_percent())+
scale_x_continuous(breaks= pretty_breaks())+
theme(legend.position="bottom")
internet_nation %>% transmute(year,
income.less_than_10000= income.less_than_10000.with_broadbandE/income.less_than_10000E,
income.10000_19999=income.10000_19999.with_broadbandE/income.10000_19999E,
income.20000_34999=income.20000_34999.with_broadbandE/income.20000_34999E,
income.35000_49999=income.35000_49999.with_broadbandE/income.35000_49999E,
income.50000_74999=income.50000_74999.with_broadbandE/income.50000_74999E,
income.75000_or_more=income.75000_or_more.with_broadbandE/income.75000_or_moreE) %>%
gather("variable","value",-year) %>%
ggplot() + geom_line(aes(x=year, y=value, color=variable))+
labs(title="% with broadband",caption = "Source: American Community Survey 1-Year Data",x="Year",y="")+
scale_y_continuous(labels = label_percent())+
scale_x_continuous(breaks= pretty_breaks())+
theme(legend.position="bottom")
internet_nation %>% transmute(year,
under_18= age.under_18.has_computer.with_broadbandE/age.under_18E,
between_18_64=age.between_18_64.has_computer.with_broadbandE/age.between_18_64E,
age.65_or_moreE=age.65_or_more.has_computer.with_broadbandE/age.65_or_moreE) %>%
gather("variable","value",-year) %>%
ggplot() + geom_line(aes(x=year, y=value, color=variable))+
labs(title="% with broadband by age group",caption = "Source: American Community Survey 1-Year Data",x="Year",y="")+
scale_y_continuous(labels = label_percent())+
scale_x_continuous(breaks= pretty_breaks())+
theme(legend.position="bottom")
internet_nation %>% transmute(year,
below_HS= education.less_than_hs_e.has_computer.with_broadbandE/education.less_than_hs_eE,
hs_some_college=education.hs_some_college_associates.has_computer.with_broadbandE/education.hs_some_college_associatesE,
bac_or_higher=education.bachelors_or_higher.has_computer.with_broadbandE/education.bachelors_or_higherE) %>%
gather("variable","value",-year) %>%
ggplot() + geom_line(aes(x=year, y=value, color=variable))+
labs(title="% with broadband by educational attainment",caption = "Source: American Community Survey 1-Year Data",x="Year",y="")+
scale_y_continuous(labels = label_percent())+
scale_x_continuous(breaks= pretty_breaks())+
theme(legend.position="bottom")
internet_nation %>% transmute(year,
white = race.white_alone_not_hispanic.has_computer.with_broadbandE/race.white_alone_not_hispanicE,
black= race.black_alone.has_computer.with_broadbandE/race.black_aloneE,
asian=race.asian_alone.has_computer.with_broadbandE/race.asian_aloneE,
hispanic=race.hispanic.has_computer.with_broadbandE/race.hispanicE) %>%
gather("variable","value",-year) %>%
ggplot() + geom_line(aes(x=year, y=value, color=variable))+
labs(title="% with broadband by race",caption = "Source: American Community Survey 1-Year Data",x="Year",y="")+
scale_y_continuous(labels = label_percent())+
scale_x_continuous(breaks= pretty_breaks())+
theme(legend.position="bottom")
State level
cw <- get(data(stcrosswalk))
internet_state_cw <- internet_state %>% left_join(cw,by=c("NAME"="stname")) %>% filter(NAME!="Puerto Rico")
device_state <- internet_state_cw %>% mutate(pct=has_computer.one_or_more_devicesE/has_computer.universeE) %>%
select(year,pct,NAME,cenregnm) %>%
ggplot()+geom_line(aes(year,pct,color=NAME))+
labs(title="% of Households with one or more device",caption = "Source: American Community Survey 1-Year Data",x="Year",y="")+
scale_y_continuous(labels = label_percent())+
scale_x_continuous(breaks= pretty_breaks())+
facet_wrap(~cenregnm)
ggplotly(device_state)access_state <- internet_state_cw %>% mutate(pct=internet.subscriptionE/internet.universeE) %>%
select(year,pct,NAME,cenregnm) %>%
ggplot()+geom_line(aes(year,pct,color=NAME))+
labs(title="% of Households with internet subscription",caption = "Source: American Community Survey 1-Year Data",x="Year",y="")+
scale_y_continuous(labels = label_percent())+
scale_x_continuous(breaks= pretty_breaks())+
facet_wrap(~cenregnm)
ggplotly(access_state)internet_state %>% select(year,
NAME,
computer_and_type_of_internet.universeE,
computer_and_type_of_internet.has_computer.dialup_aloneE,
computer_and_type_of_internet.has_computer.broadband.fixedE,
computer_and_type_of_internet.has_computer.broadband.mobile_aloneE,
computer_and_type_of_internet.has_computer.without_internetE,
computer_and_type_of_internet.no_computerE) %>%
mutate(across("computer_and_type_of_internet.has_computer.dialup_aloneE":"computer_and_type_of_internet.no_computerE", ~./ computer_and_type_of_internet.universeE)) %>%
select(-computer_and_type_of_internet.universeE) %>%
rename_with(~str_remove(.,"computer_and_type_of_internet.")) %>%
rename_with(~str_remove(.,"has_computer.")) %>%
gather("variable","value",-year,-NAME) %>%
ggplot() + geom_area(aes(x=year, y=value, fill=variable))+
facet_geo(~ NAME)+
labs(title="Type of internet subscription over time",caption = "Source: ACS 1 yr",x="Year",y="")+
scale_y_continuous(labels = label_percent())+
scale_x_continuous(breaks= pretty_breaks())+
theme(legend.position="bottom")
internet_state %>% select(year,
NAME,
has_computer.universeE,
has_computer.one_or_more_devices.desktop_or_laptopE,
has_one_or_more_types_of_computing_devices.handheld_computer13E,
has_one_or_more_types_of_computing_devices.smartphone16E,
has_one_or_more_types_of_computing_devices.tablet_or_other_portable_computer16E,
has_computer.one_or_more_devices.other_computerE,
has_computer.one_or_more_devices.no_computerE) %>%
mutate(across(has_computer.one_or_more_devices.desktop_or_laptopE:has_computer.one_or_more_devices.no_computerE, ~./ has_computer.universeE)) %>%
select(-has_computer.universeE) %>%
rename_with(~str_remove(.,"has_computer.")) %>%
rename_with(~str_remove(.,"has_one_or_more_types_of_computing_devices.")) %>%
rename_with(~str_remove(.,"one_or_more_devices.")) %>%
gather("variable","value",-year,-NAME) %>%
ggplot() + geom_line(aes(x=year, y=value, color=variable))+
facet_geo(~ NAME)+
labs(title="Type of internet device over time",caption = "Source: American Community Survey 1-Year Data",x="Year",y="")+
scale_y_continuous(labels = label_comma())+
scale_x_continuous(breaks= pretty_breaks())+
theme(legend.position="bottom")## Warning: Removed 11 row(s) containing missing values (geom_path).
MSA level
top25 <- internet_cbsa %>% filter(year==2021) %>% top_n(25,total_popE)
getmode <- function(v) {
uniqv <- unique(v)
uniqv[which.max(tabulate(match(v, uniqv)))]
}
internet_cbsa_25 <- internet_cbsa %>% filter(GEOID %in% top25$GEOID) %>% group_by(GEOID) %>% mutate(NAME=getmode(NAME)) %>% ungroup() %>%
mutate(NAME=str_remove(NAME," Metro Area"))
device_cbsa <- internet_cbsa_25 %>% mutate(pct=has_computer.one_or_more_devicesE/has_computer.universeE) %>%
select(year,pct,NAME) %>%
ggplot()+geom_line(aes(year,pct,color=NAME))+
labs(title="% of Households with one or more device",caption = "Source ACS 1 yr",x="Year",y="")+
scale_y_continuous(labels = label_percent())+
scale_x_continuous(breaks= pretty_breaks())
ggplotly(device_cbsa)access_cbsa <- internet_cbsa_25 %>% mutate(pct=internet.subscriptionE/internet.universeE) %>%
select(year,pct,NAME) %>%
ggplot()+geom_line(aes(year,pct,color=NAME))+
labs(title="% of Households with internet subscription",caption = "Source ACS 1 yr",x="Year",y="")+
scale_y_continuous(labels = label_percent())+
scale_x_continuous(breaks= pretty_breaks())
ggplotly(access_cbsa)internet_cbsa_25 %>% select(year,
NAME,
computer_and_type_of_internet.universeE,
computer_and_type_of_internet.has_computer.dialup_aloneE,
computer_and_type_of_internet.has_computer.broadband.fixedE,
computer_and_type_of_internet.has_computer.broadband.mobile_aloneE,
computer_and_type_of_internet.has_computer.without_internetE,
computer_and_type_of_internet.no_computerE) %>%
mutate(across("computer_and_type_of_internet.has_computer.dialup_aloneE":"computer_and_type_of_internet.no_computerE", ~./ computer_and_type_of_internet.universeE)) %>%
arrange(-computer_and_type_of_internet.no_computerE) %>%
select(-computer_and_type_of_internet.universeE) %>%
rename_with(~str_remove(.,"computer_and_type_of_internet.")) %>%
rename_with(~str_remove(.,"has_computer.")) %>%
gather("variable","value",-year,-NAME) %>%
ggplot() + geom_area(aes(x=year, y=value, fill=variable))+
facet_wrap(~ NAME)+
labs(title="Type of internet subscription over time",caption = "Source: ACS 1 yr",x="Year",y="")+
scale_y_continuous(labels = label_percent())+
scale_x_continuous(breaks= pretty_breaks())+
theme(legend.position="bottom")
internet_cbsa_25 %>% select(year,
NAME,
has_computer.universeE,
has_computer.one_or_more_devices.desktop_or_laptopE,
has_one_or_more_types_of_computing_devices.handheld_computer13E,
has_one_or_more_types_of_computing_devices.smartphone16E,
has_one_or_more_types_of_computing_devices.tablet_or_other_portable_computer16E,
has_computer.one_or_more_devices.other_computerE,
has_computer.one_or_more_devices.no_computerE) %>%
mutate(across(has_computer.one_or_more_devices.desktop_or_laptopE:has_computer.one_or_more_devices.no_computerE, ~./ has_computer.universeE)) %>%
arrange(-has_computer.one_or_more_devices.no_computerE) %>%
select(-has_computer.universeE) %>%
rename_with(~str_remove(.,"has_computer.")) %>%
rename_with(~str_remove(.,"has_one_or_more_types_of_computing_devices.")) %>%
rename_with(~str_remove(.,"one_or_more_devices.")) %>%
gather("variable","value",-year,-NAME) %>%
ggplot() + geom_line(aes(x=year, y=value, color=variable))+
facet_wrap(~ NAME)+
labs(title="Type of internet device over time",caption = "Source ACS 1 yr",x="Year",y="")+
scale_y_continuous(labels = label_comma())+
scale_x_continuous(breaks= pretty_breaks())+
theme(legend.position="bottom")## Warning: Removed 11 row(s) containing missing values (geom_path).