/ Visualization

# Population Distribution of Hispanics by Age in the US

I was recently reading on the increasing role being played by Hispanics in the US Real Estate market. The report titled Housing Demand: Demographics And The Numbers Behind The Coming Multi-million Increase In Households has some interesting charts and the influence the Hispanics population will have on the Housing industry.

I tried reproducing a stacked bar chart and it seems to have turned out quite well. Here is the code followed by the output.

``````# [2014 National Population Projections: Downloadable Files - People and Households - U.S. Census Bureau](http://www.census.gov/population/projections/data/national/2014/downloadablefiles.html)
# In this post, we will try to replicate the population chart in this paper [https://www.mba.org/Documents/Research/15292_Research_Growth_White_Paper.pdf](https://www.mba.org/Documents/Research/15292_Research_Growth_White_Paper.pdf)

require("data.table")

age_brackets <- c("pop_0:pop_17","pop_18:pop_24","pop_25:pop_29","pop_30:pop_34","pop_35:pop_39","pop_40:pop_44","pop_45:pop_49","pop_50:pop_54","pop_55:pop_59","pop_60:pop_64","pop_65:pop_70","pop_71:pop_75","pop_76:pop_80","pop_81:pop_100")

for (i in age_brackets) {
cmdText <- paste('dt[, paste("",i,sep=""):= rowSums(.SD, na.rm=TRUE), by=list(origin, race, sex,year, total_pop), .SDcols=',i,']', sep="")
eval(parse(text=cmdText))
}

require("gdata")

dt_race_map[,race:=trim(race)]
dt_race_map[,code:=trim(code)]

dt_origin_map[,origin:=trim(origin)]
dt_origin_map[,code:=trim(code)]

dt_sex_map[,sex:=trim(sex)]
dt_sex_map[,code:=trim(code)]

dt <- merge(dt, dt_race_map, by.x="race", by.y="race")
dt <- merge(dt, dt_origin_map, by.x="origin", by.y="origin")
dt <- merge(dt, dt_sex_map, by.x="sex", by.y="sex")

dt_year <- dt[year==2024]

which(colnames(dt)=="pop_0:pop_17") #107
which(colnames(dt)=="code") #123

dt_year <- dt_year[,.SD,.SDcols=107:123]

which(colnames(dt_year)=="pop_0:pop_17") #1
which(colnames(dt_year)=="pop_81:pop_100") #14

dt_year[,lapply(.SD, sum),by=code.y,.SDcols=1:14]

# Aggregated population by races
dt_year_pop_agg <- dt_year[,lapply(.SD, sum),by=code.x,.SDcols=1:14]

dt_debug <- dt_year_pop_agg[1:7][,list(code.x, `pop_0:pop_17`)]
sum(dt_debug[2:7][,list(`pop_0:pop_17`)]) #This should match with the total population

dt_year_pop_agg <- dt_year_pop_agg[2:7] #only needed data
dt_year_pop_agg.m <- melt.data.table(dt_year_pop_agg)

require("ggplot2")

# library("devtools")

library("ggthemes")

# Create the bar chart
b <- ggplot(dt_year_pop_agg.m, aes(x=variable, y=value, fill=code.x))
b <- b + geom_bar(stat="identity", width=0.7, position = position_dodge(width=0.4))
b <- b + theme(axis.line.x = element_blank(), axis.title.y = element_text(face="bold",angle=90), axis.text.x = element_text(angle=45, vjust = 1, hjust=1))
b <- b + labs(x = "\nAge Bracket", y = "Population")
b

age_categories <- unique(dt_year_pop_agg.m\$variable)
age_categories <- as.character(age_categories)
gsub("pop_", "", age_categories)

dt_year_pop_agg.m[,age_bucket :=gsub("pop_", "", variable)]

# Create the stacked bar chart
b <- ggplot(dt_year_pop_agg.m, aes(x=age_bucket, y=value/1e6, fill=code.x))
b <- b +   theme_solarized() + scale_colour_solarized("blue")
b <- b + geom_bar(stat="identity", width=0.7)
b <- b + theme(axis.line.x = element_blank(), axis.title.y = element_text(face="bold",angle=90), axis.text.x = element_text(angle=45, vjust = 1, hjust=1))
b <- b + labs(x = "\nAge Bracket", y = "Population (Mn)")
b <- b + theme(legend.position = "bottom")
b <- b + theme(legend.title=element_blank()) #Reference: [Beautiful plotting in R: A ggplot2 cheatsheet | Technical Tidbits From Spatial Analysis & Data Science](http://zevross.com/blog/2014/08/04/beautiful-plotting-in-r-a-ggplot2-cheatsheet-3/#add-x-and-y-axis-labels-labs-xlab)
b
``````
{"ft_lang_label":"__label__en","ft_lang_prob":0.5647774,"math_prob":0.8868001,"size":4022,"snap":"2020-45-2020-50","text_gpt3_token_len":1226,"char_repetition_ratio":0.117222495,"word_repetition_ratio":0.14092141,"special_character_ratio":0.3386375,"punctuation_ratio":0.24418604,"nsfw_num_words":0,"has_unicode_error":false,"math_prob_llama3":0.9918941,"pos_list":[0,1,2],"im_url_duplicate_count":[null,5,null],"WARC_HEADER":"{\"WARC-Type\":\"response\",\"WARC-Date\":\"2020-10-21T18:34:28Z\",\"WARC-Record-ID\":\"<urn:uuid:f3e801b9-6a71-4aa1-8f45-28211cb36ba2>\",\"Content-Length\":\"23291\",\"Content-Type\":\"application/http; msgtype=response\",\"WARC-Warcinfo-ID\":\"<urn:uuid:fe290049-5068-469b-8738-f5f1dfa0debf>\",\"WARC-Concurrent-To\":\"<urn:uuid:b7d2cde5-d941-4f4c-b9bd-0de7f9feb93d>\",\"WARC-IP-Address\":\"157.230.145.153\",\"WARC-Target-URI\":\"https://www.santoshsrinivas.com/us-population-distribution-by-age/\",\"WARC-Payload-Digest\":\"sha1:EAAJWDNUWZN6J7KCABFZ4NFTVN6FF3FW\",\"WARC-Block-Digest\":\"sha1:THOXB3H4TEULIP4YRBGT6IV7W4J36X54\",\"WARC-Identified-Payload-Type\":\"text/html\",\"warc_filename\":\"/cc_download/warc_2020/CC-MAIN-2020-45/CC-MAIN-2020-45_segments_1603107877420.17_warc_CC-MAIN-20201021180646-20201021210646-00462.warc.gz\"}"}