<p><div><div><div><div data-width="100" data-show-faces="false" data-send="true" data-layout="button_count" data-height="21" data-href="https://www.r-bloggers.com/who-is-old-visualizing-the-concept-of-prospective-ageing-with-animated-population-pyramids/"></div></div><div></div></div><div></div></div>
<div>
(This article was first published on <strong><a href="https://ikashnitsky.github.io/2017/who-is-old/"> Ilya Kashnitsky</a></strong>, and kindly contributed to <a rel="nofollow" href="https://www.r-bloggers.com/">R-bloggers)</a> </div>
<p><a target="_blank" rel="nofollow" href="https://i2.wp.com/ikashnitsky.github.io/images/170331/swe-animated.gif?ssl=1"><img alt="fig2" src="https://i2.wp.com/ikashnitsky.github.io/images/170331/swe-animated.gif?w=456&ssl=1" data-recalc-dims="1"></a></p>
<hr>
<p>This post is about illustrating the concept of prospective ageing, a relatively fresh approach in demography to refine our understanding of population ageing. This visualization was created in collaboration with my colleague <a target="_blank" rel="nofollow" href="http://nidi.nl/en/staff/overview/boissonneault">Michael Boissonneault</a>: (mostly) his idea and (mostly) my implementation. The animated visualization builds upon Michael’s viz prepared for the submission to the highly anticipated event at the end June 2017 – <a target="_blank" rel="nofollow" href="http://www.rostock-retreat.org/">Rostock Retreat Visualization</a>. My visualization of the <a target="_blank" rel="nofollow" href="http://www.rostock-retreat.org/files/application2017/SWE.csv">provided Swedish dataset</a> can be found in <a target="_blank" rel="nofollow" href="https://ikashnitsky.github.io/2017/gender-gap-in-swedish-mortality/">the previous post</a>.</p>
<h2>Prospective ageing</h2>
<p>Over the past decades the alarmist views of the upcoming population ageing disaster became widely spread. True, with the growing number of countries approaching the ending of the Demographic Transition, the average/median age of their population increases rapidly, which is something unprecedented in the documented human history. But does that imply an unbearable burden of elderly population in the nearest future? Not necessarily.</p>
<p>The demographic prospects depend a lot on how we define ageing. Quite recently <a target="_blank" rel="nofollow" href="http://www.iiasa.ac.at/web/home/research/researchPrograms/WorldPopulation/Staff/Warren_Sanderson.html">Waren Sanderson</a> and <a target="_blank" rel="nofollow" href="http://www.iiasa.ac.at/web/home/research/researchPrograms/WorldPopulation/Staff/Serguei-Scherbov.en.html">Sergei Scherbov</a> proposed <sup><a target="_blank" rel="nofollow" href="https://ikashnitsky.github.io/2017/who-is-old/#fn:1">1</a></sup> <sup><a target="_blank" rel="nofollow" href="https://ikashnitsky.github.io/2017/who-is-old/#fn:2">2</a></sup> a new way to look at population ageing, they called it Prospective Ageing. The underlying idea is really simple – age is not static: a person aged 65 (the conventional border deliminating elderly population) today is in many aspects not the same as a person ages 65 half a century ago. Health and lifespan improved a lot in the last decades, meaning that today people generally have much more remaining years of life at the moment of being recognized as elderly by the conventional standards. Thus, Sanderson and Scherbov proposed to define elderly population based on the estimation of the expected remaining length of life rather than years lived. Such a refined view of population ageing disqualifies the alarmist claims of the approaching demographic collapse. The would be paradoxical title of one the latest papers of Sanderson and Scherbov <sup><a target="_blank" rel="nofollow" href="https://ikashnitsky.github.io/2017/who-is-old/#fn:3">3</a></sup> summarizes the phenomenon nicely: <em>Faster Increases in Human Life Expectancy Could Lead to Slower Population Aging</em>.</p>
<p>Of course, the choice of the new ageing threshold is a rather arbitrary question <sup><a target="_blank" rel="nofollow" href="https://ikashnitsky.github.io/2017/who-is-old/#fn:4">4</a></sup>. It became usual to define this threshold at the remaining life expectancy of 15 years.</p>
<h2>Population pyramids for Sweden</h2>
<p>Population pyramid is a simple and nice way to represent population composition and to compare changes in the age structure of a given population over time. We show the difference between conventional and prospective approach to the definition of the elderly population using Swedish data for the last half a century. Sweden is a natural choice for demographers aiming to play with rich and reliable data.</p>
<p>The data used for this visualization comes from <a target="_blank" rel="nofollow" href="http://www.mortality.org/">Human Mortality Database</a>. It can be easily accessed from an R session using <a target="_blank" rel="nofollow" href="https://cran.r-project.org/web/packages/HMDHFDplus/index.html"><code>HMDHFDplus</code></a> package by <a target="_blank" rel="nofollow" href="https://sites.google.com/site/timriffepersonal/about-me">Tim Riffe</a> (for examples see my previous posts – <a target="_blank" rel="nofollow" href="https://ikashnitsky.github.io/2017/hmd-all-sex-ratio/">one</a> and <a target="_blank" rel="nofollow" href="https://ikashnitsky.github.io/2017/hmd-male-mortality-rus-jpn/">two</a>). For this exercise, I will use the dataset for Sweden that was provided for an application task for <a target="_blank" rel="nofollow" href="http://www.rostock-retreat.org/">Rostock Retreat Visualization</a> <sup><a target="_blank" rel="nofollow" href="https://ikashnitsky.github.io/2017/who-is-old/#fn:5">5</a></sup>.</p>
<h2>Data preparation</h2>
<div>
<pre><code># load packages
library(tidyverse)
library(extrafont)
myfont &lt;- &quot;Ubuntu Mono&quot;

# download data
df_swe &lt;- read_csv(&quot;http://www.rostock-retreat.org/files/application2017/SWE.csv&quot;)
# copy at https://ikashnitsky.github.io/doc/misc/application-rostock-retreat/SWE.csv

# define the selection of years to visualize
years &lt;- c(seq(1965, 2010, 5),2014)

df &lt;- df_swe %>% select(Year, Sex, Age, Exposure, ex) %>% 
        filter(Year %in% years) %>% 
        mutate(old_c = Age >= 65, 
               old_p = ex &lt;= 15) %>% 
        gather(&quot;type&quot;, &quot;old&quot;, contains(&quot;old&quot;)) %>% 
        group_by(Year, Sex, type) %>% 
        mutate(share = Exposure / sum(Exposure)) %>% 
        ungroup() %>% 
        mutate(share = ifelse(Sex == 'f', share, -share))
        
names(df) &lt;- names(df) %>% tolower()


df_old &lt;- df %>% filter(old == T) %>% 
        group_by(year, sex, type, old) %>% 
        summarise(cum_old = sum(share)) %>% 
        ungroup() 
</code></pre>
</div>
<h2>Visualization</h2>
<p>Let’s first have a look at the pyramids in 1965, 1990, and 2014 (the latest available year).</p>
<div>
<pre><code>gg_three &lt;- ggplot(df %>% filter(year %in% c(1965, 1990, 2014))) +
        geom_bar(aes(x = age, y = share, fill = sex, alpha = old), 
                 stat = 'identity', width = 1)+
        geom_vline(xintercept = 64.5, size = .5, color = 'gold')+
        scale_y_continuous(breaks = c(-.01, 0, .01), labels = c(.01, 0, .01),
                           limits = c(-.02, .02), expand = c(0,0))+
        facet_grid(year~type) +
        theme_minimal(base_family = 'Ubuntu Mono') +
        theme(strip.text = element_blank(),
              legend.position = 'none',
              plot.title = element_text(hjust = 0.5, size = 20),
              plot.caption = element_text(hjust = 0, size = 10)) + 
        coord_flip() + 
        
        labs(y = NULL,
             x = 'Age') +
        
        geom_text(data = data_frame(type = c('old_c', 'old_p'),
                                    label = c('CONVENTIONAL', 'PROSPECTIVE')),
                  aes(label = label), 
                  y = 0, x = 50, size = 5, vjust = 1, 
                  family = 'Ubuntu Mono') +
        
        geom_text(data = df_old %>% filter(year %in% c(1965, 1990, 2014), sex == 'f'), 
                  aes(label = year),
                  y = 0, x = 30, vjust = 1, hjust = .5, size = 7, 
                  family = 'Ubuntu Mono') +
        
        geom_text(data = df_old %>% filter(year %in% c(1965, 1990, 2014), sex == 'f'), 
                  aes(label = paste('Elderly\nfemales\n', round(cum_old*100,1), '%')),
                  y = .0125, x = 105, vjust = 1, hjust = .5, size = 4, 
                  family = 'Ubuntu Mono') +
        
        geom_text(data = df_old %>% filter(year %in% c(1965, 1990, 2014), sex == 'm'), 
                  aes(label = paste('Elderly\nmales\n', round(-cum_old*100,1), '%')),
                  y = -.0125, x = 105, vjust = 1, hjust = .5, size = 4, 
                  family = 'Ubuntu Mono')


#ggsave(&quot;figures/three-years.png&quot;, gg_three, width = 6, height = 8)
</code></pre>
</div>
<p><a target="_blank" rel="nofollow" href="https://i1.wp.com/ikashnitsky.github.io/images/170331/three-years.png?ssl=1"><img alt="fig1" src="https://i1.wp.com/ikashnitsky.github.io/images/170331/three-years.png?w=456&ssl=1" data-recalc-dims="1"></a></p>
<h2>Animated pyramid</h2>
<p>To get an animated pyramid I simply saved all the separate plots and then use the very convenient free online tool to make an animated image – <a target="_blank" rel="nofollow" href="http://gifcreator.me/">GIFCreator</a> <sup><a target="_blank" rel="nofollow" href="https://ikashnitsky.github.io/2017/who-is-old/#fn:6">6</a></sup>.</p>
<div>
<pre><code>
note &lt;- 'The population pyramid can be used to compare change in the age structure of a given population over time. In many cases, doing so gives the impression of rapid aging. This is due to the fact that age is represented as a static variable; however, as Sanderson and Scherbov showed repeatedly, age is not static: a person age 65 in 1965 is in many aspects not the same as a person age 65 in 2015. In the right panel, old age is considered to start when the period remaining life expectancy reaches 15 years, thereby providing another look at the change in the age structure of a population. The gold line deliminates the conventional border of old age at 65. Elderly populations are filled with non-transparent colors. Authors: Michael Boissonneault, Ilya Kashnitsky (NIDI)'

# I will store the plots in a list
plots &lt;- list()

for (i in 1:length(years)){
        
        gg &lt;- ggplot(df %>% filter(year == years[[i]])) +
                geom_bar(aes(x = age, y = share, fill = sex, alpha = old), 
                         stat = 'identity', width = 1)+
                geom_vline(xintercept = 64.5, size = .5, color = 'gold')+
                scale_y_continuous(breaks = c(-.01, 0, .01), labels = c(.01, 0, .01),
                                   limits = c(-.02, .02), expand = c(0,0))+
                facet_wrap(~type, ncol = 2) +
                theme_minimal(base_family = 'Ubuntu Mono') +
                theme(strip.text = element_blank(),
                      legend.position = 'none',
                      plot.title = element_text(hjust = 0.5, size = 20),
                      plot.caption = element_text(hjust = 0, size = 10)) + 
                coord_flip() + 
                
                labs(title = paste(&quot;Sweden&quot;, years[i]),
                     caption = paste(strwrap(note, width = 106), collapse = '\n'), 
                     y = NULL,
                     x = 'Age') +
                
                geom_text(data = data_frame(type = c('old_c', 'old_p'),
                                            label = c('CONVENTIONAL', 'PROSPECTIVE')),
                          aes(label = label), 
                          y = 0, x = 115, size = 5, vjust = 1, 
                          family = 'Ubuntu Mono') +
                
                geom_text(data = df_old %>% filter(year == years[[i]], sex == 'f'), 
                          aes(label = paste('Elderly\nfemales\n', round(cum_old*100,1), '%')),
                          y = .0125, x = 105, vjust = 1, hjust = .5, size = 4, 
                          family = 'Ubuntu Mono') +
                
                geom_text(data = df_old %>% filter(year == years[[i]], sex == 'm'), 
                          aes(label = paste('Elderly\nmales\n', round(-cum_old*100,1), '%')),
                          y = -.0125, x = 105, vjust = 1, hjust = .5, size = 4, 
                          family = 'Ubuntu Mono')
        
        plots[[i]] &lt;- gg
}

# # a loop to save the plots
# for (i in 1:length(years)){
#         ggsave(paste0('figures/swe-', years[i], '.png'), plots[[i]], 
#                       width = 8, height = 5.6)
# }
</code></pre>
</div>
<p><a target="_blank" rel="nofollow" href="https://i2.wp.com/ikashnitsky.github.io/images/170331/swe-animated.gif?ssl=1"><img alt="fig2" src="https://i2.wp.com/ikashnitsky.github.io/images/170331/swe-animated.gif?w=456&ssl=1" data-recalc-dims="1"></a></p>
<hr>
<div>
<ol>
<li>
<p>Sanderson, W. C., &amp; Scherbov, S. (2005). Average remaining lifetimes can increase as human populations age. Nature, 435(7043), 811–813. Retrieved from http://www.nature.com/nature/journal/v435/n7043/abs/nature03593.html <a target="_blank" rel="nofollow" href="https://ikashnitsky.github.io/2017/who-is-old/#fnref:1">↩</a></p>
</li>
<li>
<p>Sanderson, W. C., &amp; Scherbov, S. (2010). Remeasuring Aging. Science, 329(5997), 1287–1288. https://doi.org/10.1126/science.1193647 <a target="_blank" rel="nofollow" href="https://ikashnitsky.github.io/2017/who-is-old/#fnref:2">↩</a></p>
</li>
<li>
<p>Sanderson, W. C., &amp; Scherbov, S. (2015). Faster Increases in Human Life Expectancy Could Lead to Slower Population Aging. PLoS ONE, 10(4), e0121922. http://doi.org/10.1371/journal.pone.0121922 <a target="_blank" rel="nofollow" href="https://ikashnitsky.github.io/2017/who-is-old/#fnref:3">↩</a></p>
</li>
<li>
<p>See the <a target="_blank" rel="nofollow" href="http://www.nidi.nl/shared/content/output/papers/nidi-wp-2017-01.pdf">working paper</a> of my colleagues devoted to this question <a target="_blank" rel="nofollow" href="https://ikashnitsky.github.io/2017/who-is-old/#fnref:4">↩</a></p>
</li>
<li>
<p>By using this data, I agree to the <a target="_blank" rel="nofollow" href="http://www.mortality.org/Public/UserAgreement.php">user agreement</a> <a target="_blank" rel="nofollow" href="https://ikashnitsky.github.io/2017/who-is-old/#fnref:5">↩</a></p>
</li>
<li>
<p>I did try to play with the package <code>gganimate</code>, though it produced a strange output. <a target="_blank" rel="nofollow" href="https://ikashnitsky.github.io/2017/who-is-old/#fnref:6">↩</a></p>
</li>
</ol>
</div>
<p>
<div>
<div>To <strong>leave a comment</strong> for the author, please follow the link and comment on their blog: <strong><a href="https://ikashnitsky.github.io/2017/who-is-old/"> Ilya Kashnitsky</a></strong>.</div>
<hr>
<a rel="nofollow" href="https://www.r-bloggers.com/">R-bloggers.com</a> offers <strong><a rel="nofollow" href="https://feedburner.google.com/fb/a/mailverify?uri=RBloggers">daily e-mail updates</a></strong> about <a title="The R Project for Statistical Computing" rel="nofollow" href="https://www.r-project.org/">R</a> news and <a title="R tutorials" rel="nofollow" href="https://www.r-bloggers.com/search/tutorial">tutorials</a> on topics such as: <a title="Data science" rel="nofollow" href="https://www.r-bloggers.com/search/data%20science">Data science</a>, <a title="Big Data" rel="nofollow" href="https://www.r-bloggers.com/search/Big%20Data">Big Data, <a title="R jobs" rel="nofollow" href="https://www.r-users.com/">R jobs</a>, visualization (<a title="ggplot and ggplot2 tutorials" rel="nofollow" href="https://www.r-bloggers.com/search/ggplot2">ggplot2</a>, <a title="Boxplots using lattice and ggplot2 tutorials" rel="nofollow" href="https://www.r-bloggers.com/search/boxplot">Boxplots</a>, <a title="Maps and gis" rel="nofollow" href="https://www.r-bloggers.com/search/map">maps</a>, <a title="Animation in R" rel="nofollow" href="https://www.r-bloggers.com/search/animation">animation</a>), programming (<a title="RStudio IDE for R" rel="nofollow" href="https://www.r-bloggers.com/search/RStudio">RStudio</a>, <a title="Sweave and literate programming" rel="nofollow" href="https://www.r-bloggers.com/search/sweave">Sweave</a>, <a title="LaTeX in R" rel="nofollow" href="https://www.r-bloggers.com/search/LaTeX">LaTeX</a>, <a title="SQL and databases" rel="nofollow" href="https://www.r-bloggers.com/search/SQL">SQL</a>, <a title="Eclipse IDE for R" rel="nofollow" href="https://www.r-bloggers.com/search/eclipse">Eclipse</a>, <a title="git and github, Version Control System" rel="nofollow" href="https://www.r-bloggers.com/search/git">git</a>, <a title="Large data in R using Hadoop" rel="nofollow" href="https://www.r-bloggers.com/search/hadoop">hadoop</a>, <a title="Web Scraping of google, facebook, yahoo, twitter and more using R" rel="nofollow" href="https://www.r-bloggers.com/search/Web+Scraping">Web Scraping</a>) statistics (<a title="Regressions and ANOVA analysis tutorials" rel="nofollow" href="https://www.r-bloggers.com/search/regression">regression</a>, <a title="principal component analysis tutorial" rel="nofollow" href="https://www.r-bloggers.com/search/PCA">PCA</a>, <a title="Time series" rel="nofollow" href="https://www.r-bloggers.com/search/time+series">time series</a>, <a title="finance trading" rel="nofollow" href="https://www.r-bloggers.com/search/trading">trading</a>) and more...
<img height="1" alt="" width="1" src="http://feeds.feedburner.com/~r/RBloggers/~4/3MnPT7Sy0XY"></a></div>