Cities boomed and doomed

GL Li, 2018/12/15

Population in the United States grew by 3.76% from 313.91 million in 2012 to 325.72 million in 2017. The growth, however, is not uniform geographically. One of the geographical areas of particular interest is the city. Some cities are shrinking in population while some others exploding. The purpose of this post is to find cities that decrease and increase most in population. In addition, we will show the population and its change of all cities in an interactive map.

We will use population data of cities published in the American Community Survey 5-year estimates. The numbers are 5-year rolling average, for example, the data published in 2017 are averaged over the 5 year period of 2013 - 2017. ACS 1-year estimates provide data of one particular year but unfortunately they only cover cities with population greater than 65000.

Read data from summary files

In ACS data, city is presented by summary level “place”. The summary level “place” also includes census designated places (CDPs), which strictly speaking are not cities. So we will select only those places that have “city” in their names. We will also keep cities with population greater than 5000 in the 2008-2012 or 2013-2017 ACS 5-year estimates. Let’s get the population data of cities using totalcensus package. The codes below read 2012 and 2017 ACS 5-year population data of all places, join the data, and calculate the percentage change in population from 2012 to 2017.

library(totalcensus)
library(data.table)
library(magrittr)
library(leaflet)

# read population data of 2007-2012 and 2013-2017 ACS 5-year 
p2012 <- read_acs5year(year = 2012, 
                     states = states_DC,
                     summary_level = "place", 
                     show_progress = FALSE) %>%
    .[, .(GEOID, p1 = population)]

p2017 <- read_acs5year(year = 2017, 
                     states = states_DC,
                     summary_level = "place", 
                     show_progress = FALSE) %>%
    .[, .(GEOID, NAME, lon, lat, p2 = population)]

# joint data, calculate change of pupulation for cities with population over 5000
popul <- p2012[p2017, on = .(GEOID)]  %>%
    # keep only those population greater than 1000, too many microcities
    .[p1 > 5000 | p2 > 5000] %>%
    # keep 48 states for better plotting
    .[lon > -130 & lon < -68] %>%
    # keep places that have "city" in their names
    .[NAME %like% "city"] %>%
    # calculate percentage change 
    .[, change := round(100 * (p2 - p1) / p1, 2)] %>%
    .[order(change)]

Top 10 doomed and boomed cities

Illinois has 3 cities in the top 10 list of doomed cities and Texas has 4 in the top 10 list of boomed cities. Surprisingly, Texas also has 2 cities in the list of top 10 doomed cities. The tables below give city names, population in 2012 and 2017, and the population change.

The doomed: top 10 cities with the most population loss

kable(popul[1:10, .(NAME, p2012 = p1,  p2017 = p2, "change(%)" = change)])
NAME p2012 p2017 change(%)
Sumner city, Illinois 5073 3285 -35.25
San Elizario city, Texas 14207 9213 -35.15
Gatesville city, Texas 15779 12426 -21.25
Rio Communities city, New Mexico 5625 4593 -18.35
Sullivan city, Missouri 7830 6587 -15.87
Genoa city, Illinois 5693 4808 -15.55
Avenal city, California 15341 13119 -14.48
Susanville city, California 17384 15286 -12.07
Shelbyville city, Illinois 5267 4650 -11.71
Trinidad city, Colorado 9032 8054 -10.83

The boomed: top 10 cities with the most population gain

kable(popul[(.N-9):.N, .(NAME, p2012 = p1,  p2017 = p2, "change(%)" = change)])
NAME p2012 p2017 change(%)
Selma city, Texas 5637 9217 63.51
Wilmore city, Kentucky 3736 6226 66.65
Clarkston city, Georgia 7612 12702 66.87
Buda city, Texas 7835 13253 69.15
Cibolo city, Texas 15541 26602 71.17
Kirkland city, Washington 49090 86772 76.76
Sanford city, Maine 10084 20920 107.46
Chamblee city, Georgia 13297 28433 113.83
Watford City city, North Dakota 2088 5441 160.58
Fulshear city, Texas 1365 6203 354.43

Interactive mapping

We divide the population change into 5 groups: obvious decline (< -2%), marginally change (-2% - 2%), average gain (2% - 6%), significant increase (6% - 10%), and extraordinary gain (> 10%).

popul <- popul[!is.na(change), group := "< -2%"] %>%
    .[change > -2, group := "-2% - 2%"] %>%
    .[change > 2, group := "2% - 6%"] %>%
    .[change > 6, group := "6% - 10%"] %>%
    .[change > 10, group := "> 10%"] %>%
    .[, group := factor(group, levels = c(
        "< -2%", "-2% - 2%", "2% - 6%", "6% - 10%", "> 10%"
    ))] %>%
    .[order(-p2)]

And here is the code to make interactive mapping using leaflet. Zoom in and click to view the details of each city.

pal <- colorFactor(
    palette = c("blue", "green", "cyan", "orange", "magenta"),
    domain = popul$group
)
leaflet(popul) %>% addTiles() %>%
    addCircles(lng = ~lon, lat = ~lat, weight = 1,
               radius = ~p2^0.5 * 30, 
               popup = paste0(popul$NAME, "<br>", 
                              "2017 population: ", popul$p2, "<br>",
                              "5-year population change: ", 
                              popul$change, "%"), 
               color = ~pal(group), fillOpacity = 0.5) %>%
    addLegend("bottomleft", pal = pal, values = ~group,
              title = "population change",
              opacity = 1)
 
comments powered by Disqus