#' popForecast Creates a Chart showing population and estmates
#'
#'
#' @param listID the list containing place id and Place names
#' @param byr is the first year of the series to be extracted by county_sya (min 2000)
#' @param eyr is the last year of the series to be extracted by county_sya (max 2050)
#' @param base is the base text size for the ggplot2 object and codemog_theme()
#' @return ggplot2 graphic and data file
#' @export
popForecast <- function(listID, byr=2000,eyr=2050, base=10) {
# Collecting place ids from idList, setting default values
ctyfips <- listID$ctyNum
ctyname <- listID$ctyName
placefips <- listID$plNum
placename <- listID$plName
if(listID$PlFilter == "T") {
placefips <- ""
placename <- ""
}
fips=as.numeric(ctyfips)
yrs <- seq(byr,eyr,2)
d <- county_sya(fips, yrs) %>%
group_by(county, datatype, year) %>%
summarize(Tot_pop = sum(as.numeric(totalpopulation)))
yaxs <- setAxis(d$Tot_pop)
xaxs <- setAxis(d$year)
#Creating Plot
p=d%>%
ggplot(aes(x=year, y=round(Tot_pop, digits=0), group=datatype))+
geom_line(aes(linetype=datatype), color="#00953A", size=1.5) +
labs(x="Year", y="Population", title=paste("Population Forecast,", byr, "to", eyr, sep=" "),
subtitle = ctyname,
caption = captionSrc("SDO",""))+
scale_y_continuous(limits=c(yaxs$minBrk,yaxs$maxBrk), breaks=yaxs$yBrk, label=comma)+
scale_x_continuous(limits=c(xaxs$minBrk,xaxs$maxBrk),breaks= xaxs$yBrk) +
theme_codemog(base_size=base)+
theme(plot.title = element_text(hjust = 0.5, size=18),
axis.text.x=element_text(angle=90,size=12),
axis.text.y = element_text(size=12),
legend.title=element_blank())
# Creating Output data file
d[4] <- round(d[4],digits=0)
d$county <- ctyname
#Output text
d10 <- d[which(d$year%% 10 == 0),]
d10$grNum <- (((d10$Tot_pop/lag(d10$Tot_pop))^(1/(d10$year-lag(d10$year)))) -1)*100
pop2020 <- as.numeric(d10[which(d10$year == 2020),4])
pop2040 <- as.numeric(d10[which(d10$year == 2040),4])
gr20102020 <- as.numeric(d10[which(d10$year == 2020),5])
gr20202030 <- as.numeric(d10[which(d10$year == 2030),5])
gr20302040 <- as.numeric(d10[which(d10$year == 2040),5])
grDir <- ifelse(gr20102020 > gr20302040,"decrease",
ifelse(gr20102020 < gr20302040,"increase", "remain stable"))
gr20102020 <- gsub("%"," percent",percent(gr20102020,digits=1))
gr20202030 <- gsub("%"," percent",percent(gr20202030,digits=1))
gr20302040 <- gsub("%"," percent",percent(gr20302040,digits=1))
grText1 <- paste0(" Overall, the growth rate for ",ctyname," is expected to ",grDir," between 2020 and 2040.")
grText2 <-paste0(" Between 2010 and 2020 the forecast growth rate was ",gr20102020,", between 2020 and 2030 the forecast growth rate is ",gr20202030,", ")
grText3 <-paste0(" while the forecast growth rate between 2030 and 2040 is ",gr20302040,".")
OutText <- paste0("The population of ",ctyname," is forecast to reach ",format(pop2020,big.mark=",")," by 2020 and ",format(pop2040,big.mark=",")," by 2040.")
OutText <- paste0(OutText,grText1, grText2,grText3)
OutText <- paste0(OutText," The change is due in part to population aging and changes in the proportion of the population in childbearing ages.")
OutText <- paste0(OutText," Note: Population forecasts are only provided for Colorado counties.")
outList <- list("plot" = p,"data" = d,"text" = OutText)
return(outList)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.