library(httr)
library(jsonlite)
library(tidyverse)
library(zeallot)
library(glue)
gender <- c(rep("M", 23), rep("F", 23))
ages <- rep(c("0-5", "5-10", "10-15", "15-20", "15-20", "20-25","20-25", "20-25", "25-30", "30-35",
"35-40", "40-45", "45-50", "50-55", "55-60", "60-65", "60-65", "65-70", "65-70", "70-75",
"75-80", "80-85", "85-90"), 2)
base_vars <- glue("0{03:49}E") %>%
map_chr(function(x) {
if (nchar(x) == 3) x <- glue("0{x}")
x
}) %>%
map_chr(function(x) glue("B01001_{x}")) %>%
discard(~.=="B01001_026E")
urls <- glue("https://api.census.gov/data/2015/acs/acs5?get={base_vars}&for=us")
get_pop_estimate <- function(url) {
Sys.sleep(2)
est <- GET(url) %>%
content("text") %>%
fromJSON() %>%
.[2,1] %>%
as.numeric()
cat(glue("Received population estimate for {url}..."), "\n")
return(est)
}
pop_estimates <- map(urls, get_pop_estimate)
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_003E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_004E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_005E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_006E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_007E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_008E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_009E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_010E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_011E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_012E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_013E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_014E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_015E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_016E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_017E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_018E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_019E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_020E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_021E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_022E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_023E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_024E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_025E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_027E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_028E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_029E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_030E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_031E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_032E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_033E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_034E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_035E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_036E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_037E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_038E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_039E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_040E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_041E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_042E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_043E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_044E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_045E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_046E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_047E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_048E&for=us...
## Received population estimate for https://api.census.gov/data/2015/acs/acs5?get=B01001_049E&for=us...
pop_estimates <- flatten_dbl(pop_estimates)
df_1 <- tibble(
gender = gender,
age = ages,
estimate = pop_estimates
) %>%
group_by(gender, age) %>%
summarize(estimate = sum(estimate)) %>%
ungroup() %>%
spread(gender, estimate) %>%
mutate(larger = if_else(`F` > `M`, "Larger female pop", "Larger male pop")) %>%
gather(gender, estimate, `F`:`M`, -age, -larger)
c(fdf, mdf) %<-% split(df_1, f = df_1$gender)
mdf_lower <- anti_join(mdf, filter(df_1, larger == "Larger male pop"))
mdf_higher <- anti_join(mdf, filter(df_1, larger == "Larger female pop"))
fdf_lower <- anti_join(fdf, filter(df_1, larger == "Larger female pop"))
fdf_higher <- anti_join(fdf, filter(df_1, larger == "Larger male pop"))
names(mdf) <- glue("m_{names(mdf)}")
names(fdf) <- glue("f_{names(fdf)}")
df_2 <- bind_cols(mdf, fdf) %>%
rowwise() %>%
mutate(larger = if_else(m_estimate > f_estimate, "Male", "Female"),
total_est = m_estimate + f_estimate,
min_pop_est = min(m_estimate, f_estimate)) %>%
mutate(remainder_est = max(m_estimate, f_estimate) - min_pop_est)
df_3 <- df_2 %>%
select(age = f_age, larger, min_pop_est, remainder_est) %>%
gather(fill_col, value, min_pop_est:remainder_est, -age, -larger) %>%
unite("fill_col", c("larger", "fill_col"), sep = "_") %>%
mutate(fill_col = recode(
fill_col,
"Female_min_pop_est" = "min_pop_est",
"Male_min_pop_est" = "min_pop_est")) %>%
mutate(age = forcats::fct_relevel(age, "5-10", after = 1))
pretty_num <- partial(prettyNum, big.mark = ",", preserve.width = "none")
library(ggplot2)
ggplot(df_3, aes(age, value)) +
geom_bar(stat = "identity", aes(fill = fill_col), width = 0.95) +
geom_text(data = mdf_lower,
aes(age, estimate, label = pretty_num(estimate)),
size = 3.5, color = "#4d74b7", hjust = 1.2) +
geom_text(data = mdf_higher,
aes(age, estimate, label = pretty_num(estimate)),
size = 3.5, color = "#4d74b7", hjust = -0.2) +
geom_text(data = fdf_lower,
aes(age, estimate, label = pretty_num(estimate)),
size = 3.5, color = "#e60000", hjust = 1.2) +
geom_text(data = fdf_higher,
aes(age, estimate, label = pretty_num(estimate)),
size = 3.5, color = "#e60000", hjust = -0.2) +
labs(y = "",
x = "Age",
title = "US Population by Age and Sex",
subtitle = "This chart compares the estimated female and male populations by age in the United States as of 2015. \nFor each age bracket, red represents a larger female population, blue represents a larger male population, \nand gray represents the smaller of the two. The total estimated population is 316,515,021.",
caption = "Source: American Community Survey") +
coord_flip() +
scale_y_continuous(
breaks = seq(1e6, 12e6, by = 1e6),
labels = paste0(1:12, "M"),
expand = expand_scale(mult = c(0,0.2))
) +
scale_fill_manual(values = c("#e60000", "#4d74b7", "#dddddd")) +
theme_classic() +
theme(legend.position = "none") +
theme(axis.line.x = element_blank()) +
theme(axis.title.y = element_text(vjust = 1, angle = 0)) +
theme(axis.text = element_text(color = "black")) +
theme(plot.margin = unit(c(1, 2, 1.5, 1.2), "cm"))
Original work by Mike Bostock