PensionAge.Rmd

---
title: "Forecasting the old-age dependency ratio to determine a sustainable pension age"
date: "24 February 2022"
author: "Rob J Hyndman"
fontsize: 14pt
classoption: aspectratio=169
toc: true
output:
  binb::monash:
    colortheme: monashwhite
    highlight: pygments
    fig_width: 8
    fig_height: 4
    keep_tex: yes
    includes:
      in_header: preamble.tex
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, messages = FALSE, warning = FALSE, cache = TRUE)

# Set up plan
source("_drake.R")

# Run all code required
drake::r_make()

loadd(oadr_target)

# Additional packages
library(gganimate)
```

# Demographic change and old-age dependency

## Ageing population

\placefig{1.5}{1.5}{width=13cm, trim=0 20 0 0, clip=true}{ageing}

\vspace*{3cm}\pause

  1. advances in medical care leading to longer life
  2. high fertility rates after World War II
  3. large decline in fertility rates over past thirty years.

\pause\vspace*{0.1cm}

\begin{block}{Consequently:}
\begin{itemize}\tightlist
\item older people leaving workforce, fewer workers replacing them
\item increasing old-age dependency ratio (OADR)
\end{itemize}
\end{block}
 
\vspace*{10cm}


## Population data

```{r auspop, fig.show='animate', interval=1/10, message=FALSE, aniopts='controls,buttonsize=0.3cm,width=14.5cm'}
loadd(aus.pop)
bind_rows(
  as_tibble(aus.pop$pop$male / 1000) %>%
    mutate(
      Age = aus.pop$age,
      Sex = "Male"
    ) %>%
    pivot_longer(c(-Age, -Sex), names_to = "Year", values_to = "Population"),
  as_tibble(aus.pop$pop$female / 1000) %>%
    mutate(
      Age = aus.pop$age,
      Sex = "Female"
    ) %>%
    pivot_longer(c(-Age, -Sex), names_to = "Year", values_to = "Population")
  ) %>%
  mutate(Year = as.integer(Year)) %>%
  ggplot(aes(x = Age, y = Population, group = Year, col = Year)) +
  geom_line() +
  facet_grid(. ~ Sex) +
  scale_color_gradientn(colours = rainbow(6)) +
  guides(colour = "none") +
  transition_time(Year) +
  ease_aes("linear") +
  shadow_mark(colour = "grey70") +
  labs(title = "Year: {frame_time}")
```

## Old-age Dependency Ratio (OADR)

\begin{alertblock}{}
\begin{equation*}
  \text{OADR} = \frac{\text{number of people aged over pension age}}{\text{number of people aged 15 to pension age}}
\end{equation*}
\end{alertblock}

\only<2->{\begin{textblock}{9}(0.4,3.1)
\begin{block}{OADR in year $t$}
\begin{equation*}
\text{OADR}_t = \frac{\displaystyle\sum_{x\ge \lfloor a_t\rfloor} P_t(x) - (a_t - \lfloor a_t \rfloor) P_t(\lfloor a_t\rfloor)}{\displaystyle\sum_{x=15}^{\lfloor a_t\rfloor-1} P_t(x) + (a_t - \lfloor a_t \rfloor) P_t(\lfloor a_t\rfloor)}
\end{equation*}
\end{block}
\end{textblock}
\begin{textblock}{5.2}(10.4,3.1)
\begin{block}{}
\begin{align*}
P_t(x)= & \text{~population age $x$} \\[-0.13cm]
        & \text{~in year $t$}\\
   a_t= & \text{~pension age}\\[-0.13cm]
        & \text{~in year $t$}
\end{align*}
\end{block}
\end{textblock}}

\only<3>{\begin{textblock}{12}(1.5,7)\fontsize{13}{13}\sf
Assumptions:\vspace*{-0.3cm}
  \begin{itemize}\tightlist
    \item everyone retires at pension age
    \item pension age can only be adjusted at beginning of year
    \item birthdays are uniformly distributed over year
  \end{itemize}
\end{textblock}}

\vspace*{10cm}

## The age pension in Australia

```{r changespension, echo=FALSE, out.width="100%", message=FALSE, warning=FALSE}
# Policies obtained from https://www.dss.gov.au/seniors/benefits-payments/age-pension
# Law: https://guides.dss.gov.au/guide-social-security-law/3/4/1/10
# History: https://nationalseniors.com.au/news/campaign/a-short-history-of-the-age-pension-section
loadd(pension_age, pension_colors)
pension_age %>%
  filter(Year >= 2014) %>%
  ggplot(aes(x = Year, y = Age, group = Policy, col = Policy)) +
  geom_line(lwd=1) +
  labs(x = latex2exp::TeX("Year $t$"), y = latex2exp::TeX("Minimum pension age $a_t$")) +
  scale_color_manual(
    values = pension_colors[2:4],
    labels = c(
      "Proposed further change",
      "Current policy",
      "Pension age at 65"
    )
  )
```

## Old Age Dependency Ratio in Australia

```{r oadrhistory}
loadd(OADR_history)
loadd(history_pop)
loadd(pension_age)
OADR_65 <- oadr(history_pop, filter(pension_age, Policy == "Age65"))
OADR_65 %>% 
    ggplot(aes(x = Year, y = OADR*100)) +
    geom_line(lwd=1, col=pension_colors["Age65"]) +
    geom_line(col = "black", size = .75, data = OADR_history) +
    labs(y = "Old Age Dependency Ratio (%)") +
    annotate("text", x=2010, y=24, label="Pension age 65", col=pension_colors["Age65"])
```

# Forecasting population age structure

## Available data

\begin{block}{}\vspace*{-0.2cm}
\begin{align*}
  B_t(x) &= \text{Births in calendar year $t$ to females age $x$}\\
  D_t(x) &= \text{Deaths in calendar year $t$ of persons age $x$}\\
  P_t(x) &= \text{Population age $x$ at 1 January year $t$}\\
  E_t(x) &= \text{Population age $x$ at 30 June year $t$}
\end{align*}
\end{block}

  * Ages: $x=0,1,2,\dots,99, 100+$
  * Year: $t=1,2,\dots,T$
  * $m^F_t(x) = D^F_t(x) / E^F_t(x) =\text{female central death rates, year $t$}$
  * $m^M_t(x) = D^M_t(x) / E^M_t(x) =\text{male central death rates, year $t$}$
  * $f_t(x) = B_t(x) / E^F_t(x)=\text{fertility rates, year $t$}$

## Mortality rates

```{r ausmort, fig.show='animate', interval=1/10, message=FALSE, aniopts='controls,buttonsize=0.3cm,width=14.5cm'}
loadd(aus.mort)
tibble(
    Year = rep(aus.mort$year, rep(length(aus.mort$age), length(aus.mort$year))),
    Age = rep(aus.mort$age, length(aus.mort$year)),
    Female = c(aus.mort$rate$female),
    Male = c(aus.mort$rate$male),
  ) %>%
  mutate(Year = as.integer(round(Year))) %>%
  pivot_longer(Female:Male, names_to = "Sex", values_to = "mxt") %>%
  ggplot(aes(x = Age, y = mxt*1000, group = Year, col = Year)) +
  geom_line() +
  scale_y_log10(breaks = 10^(-1:3), labels=c("0.1","1","10","100","1000")) +
  facet_grid(. ~ Sex) +
  scale_color_gradientn(colours = rainbow(6)) +
  guides(colour = "none") +
  labs(x = latex2exp::TeX("Age $x$"), 
       y = latex2exp::TeX("Death rate per 1000 people: $m_t(x)$")
  ) +
  transition_time(Year) +
  ease_aes("linear") +
  shadow_mark(colour = "grey70") +
  labs(title = "Year: {frame_time}")
```

## Fertility rates

```{r ausfert, fig.show='animate', interval=1/10, message=FALSE, aniopts='controls,buttonsize=0.3cm,width=14cm'}
loadd(aus.fert)
tibble(
    Year = rep(aus.fert$year, rep(length(aus.fert$age), length(aus.fert$year))),
    Age = rep(aus.fert$age, length(aus.fert$year)),
    fxt = c(aus.fert$rate$female)
  ) %>%
  mutate(Year = as.integer(round(Year))) %>%
  ggplot(aes(x = Age, y = fxt, group = Year, col = Year)) +
  geom_line() +
  scale_color_gradientn(colours = rainbow(6)) +
  guides(colour = "none") +
  labs(x = latex2exp::TeX("Age $x$"), 
       y = latex2exp::TeX("Fertility rate per 1000 women: $f_t(x)$")
  ) +
  transition_time(Year) +
  ease_aes("linear") +
  shadow_mark(colour = "grey70") +
  labs(title = "Year: {frame_time}")
```

## Migration rates

```{r ausmig, fig.show='animate', interval=1/10, message=FALSE, aniopts='controls,buttonsize=0.3cm,width=14cm'}
loadd(aus.mig)
tibble(
    Year = rep(aus.mig$year, rep(length(aus.mig$age), length(aus.mig$year))),
    Age = rep(aus.mig$age, length(aus.mig$year)),
    Female = c(aus.mig$rate$female),
    Male = c(aus.mig$rate$male),
  ) %>%
  mutate(Year = as.integer(round(Year))) %>%
  pivot_longer(Female:Male, names_to = "Sex", values_to = "mxt") %>%
  ggplot(aes(x = Age, y = mxt, group = Year, col = Year)) +
  geom_line() +
  facet_grid(. ~ Sex) +
  scale_color_gradientn(colours = rainbow(6)) +
  guides(colour = "none") +
  labs(x = latex2exp::TeX("Age $x$"), 
       y = latex2exp::TeX("Net migration: $G_t(x)$")
  ) +
  transition_time(Year) +
  ease_aes("linear") +
  shadow_mark(colour = "grey70") +
  labs(title = "Year: {frame_time}")
```

\begin{textblock}{7}(6,.1)
\begin{block}{}
\centerline{$G_t(x) = P_{t+1}(x+1) - P_t(x) + D_t(x)$}
\end{block}
\end{textblock}

## Functional linear model for fertility

\begin{block}{}
\begin{align*}
  y_t(x) & = s_t(x) + \sigma_t(x)\varepsilon_{t,x}\\
  s_t(x) & = \mu(x) + \sum_{j=1}^{J}\beta_{t,j}\phi_j(x) + e_t(x)
\end{align*}
\end{block}

  * $y_t(x)=\log(f_t(x))$, year $t$, age $x$
  * $s_t(x)=$ smoothed version of $y_t(x)$
  * $\varepsilon_{t,x} \sim$ iid N(0,1)
  * $\mu(x)=$ mean $s_t(x)$ across years. 
  * $\phi_j(x)$ and $\beta_{t,j}$ are principal components & scores of $s_t(x)-\mu(x)$. 
  * $e_t(x)$ serially uncorrelated with mean zero
  
\vspace*{10cm}

## Functional linear model for fertility

\begin{block}{}
\begin{align*}
  y_t(x) & = s_t(x) + \sigma_t(x)\varepsilon_{t,x}\\
  s_t(x) & = \mu(x) + \sum_{j=1}^{J}\beta_{t,j}\phi_j(x) + e_t(x)
\end{align*}
\end{block}

  * $\{\beta_{1,j},\dots,\beta_{T,j}\}$ is automatically modelled with ARIMA process
  * $\widehat{\beta}_{T+h\mid T,j}$ is an $h$-step forecast from the ARIMA model

\begin{alertblock}{}
\centerline{$\displaystyle\widehat{y}_{T+h\mid T}(x)= \widehat{\mu}(x)+\sum_{j=1}^{J}\phi_j(x)\widehat{\beta}_{T+h\mid T,j}$}
\end{alertblock}

## Fertility forecasts

```{r loadfertfit}
loadd(fertf)
loadd(fert.fit)
history <- tibble(
    Year = rep(aus.fert$year, rep(length(aus.fert$age), length(aus.fert$year))),
    Age = rep(aus.fert$age, length(aus.fert$year)),
    fxt = c(aus.fert$rate$female)
  ) 
forecasts <- tibble(
  Year = rep(fertf$year, rep(length(fertf$age), length(fertf$year))),
  Age = rep(fertf$age, length(fertf$year)),
  fxt = c(fertf$rate$female),
  lower = c(fertf$rate$lower),
  upper = c(fertf$rate$upper)
)
fert_df <- bind_rows(
    history %>% mutate(type="History"), 
    forecasts %>% mutate(type = "Forecast")
  ) %>%
  mutate(Year = as.integer(round(Year)))
```

```{r componentsfertility, message=FALSE}
autoplot.fmforecast(fertf)
```

## Fertility forecasts

```{r ausfertf, fig.show='animate', interval=1/10, message=FALSE, aniopts='controls,buttonsize=0.3cm,width=14cm', dependson="loadfertfit"}
fert_df %>%
  ggplot(aes(x = Age, y = fxt, group = Year, col = Year, lty=type)) +
  geom_line() +
  scale_color_gradientn(colours = rainbow(6)) +
  guides(colour = "none") +
  labs(x = latex2exp::TeX("Age $x$"), 
       y = latex2exp::TeX("Fertility rate per 1000 women: $f_t(x)$")
  ) +
  transition_time(Year) +
  ease_aes("linear") +
  shadow_mark(colour = "grey70") +
  labs(title = "Year: {frame_time}") +
  guides(lty="none") +
  ylim(0,282)
```


## Fertility forecasts

```{r ausfertf2, dependson="loadfertfit"}
# Save as pdf so we can match the size to the animated graphs that precede it
p <- fert_df %>%
  mutate(Year = as.integer(round(Year))) %>%
  ggplot(aes(x = Age, y = fxt, group = Year, lty=type)) +
  geom_line(col="grey70") +
  scale_color_gradientn(colours = rainbow(6)) +
  guides(colour = "none") +
  labs(x = latex2exp::TeX("Age $x$"), 
       y = latex2exp::TeX("Fertility rate per 1000 women: $f_t(x)$")
  ) +
  labs(title = "Year: 2019") +
  guides(lty="none") +
  geom_ribbon(aes(ymin=lower, ymax=upper), fill=rainbow(6)[6], alpha=0.2,
              data = fert_df %>% filter(Year==2019))+
  geom_line(col=rainbow(6)[6], data = fert_df %>% filter(Year==2019)) +
  ylim(0,282)
pdf("figs/ausfertf2.pdf", width=8, height=4)
print(p)
crop::dev.off.crop("figs/ausfertf2.pdf")
```

\placefig{1}{1.55}{width=14cm, height=20cm}{figs/ausfertf2.pdf}

## Fertility forecasts

```{r ausfertf3, dependson="loadfertfit"}
p <- fert_df %>%
  mutate(Year = as.integer(round(Year))) %>%
  ggplot(aes(x = Age, y = fxt, group = Year, lty=type)) +
  geom_line(col="grey70") +
  scale_color_gradientn(colours = rainbow(6)) +
  guides(colour = "none") +
  labs(x = latex2exp::TeX("Age $x$"), 
       y = latex2exp::TeX("Fertility rate per 1000 women: $f_t(x)$")
  ) +
  labs(title = "Year: 2051") +
  guides(lty="none") +
  geom_ribbon(aes(ymin=lower, ymax=upper), fill=rainbow(6)[6], alpha=0.2,
              data = fert_df %>% filter(Year==2051))+
  geom_line(col=rainbow(6)[6], data = fert_df %>% filter(Year==2051)) +
  ylim(0,282)
pdf("figs/ausfertf3.pdf", width=8, height=4)
print(p)
crop::dev.off.crop("figs/ausfertf3.pdf")
```

\placefig{1}{1.55}{width=14cm, height=20cm}{figs/ausfertf3.pdf}

## Functional linear model for fertility

\begin{block}{}
\begin{align*}
  y_t(x) & = s_t(x) + \sigma_t(x)\varepsilon_{t,x}\\
  s_t(x) & = \mu(x) + \sum_{j=1}^{J}\beta_{t,j}\phi_j(x) + e_t(x)
\end{align*}
\end{block}

  * $y_t(x)= \log(f_t(x))$ 
  * $s_t(x)=$ smoothed version of $y_t(x)$
  * $\varepsilon_{t,x} \sim$ iid N(0,1). $e_t(x)$ serially uncorrelated with mean zero
  * $\mu(x)=$ mean $s_t(x)$ across years. 
  * $\phi_j(x)$ and $\beta_{t,j}$ are principal components & scores of $s_t(x)-\mu(x)$. 
  * $\{\beta_{1,j},\dots,\beta_{T,j}\}$ is modelled with ARIMA \rlap{processes}

## Functional linear models for mortality

\begin{block}{}
\begin{align*}
  y_t(x) & = s_t(x) + \sigma_t(x)\varepsilon_{t,x}\\
  s_t(x) & = \mu(x) + \sum_{j=1}^{J}\beta_{t,j}\phi_j(x) + e_t(x)
\end{align*}
\end{block}

  * $y_t(x)= \log(m_t^M(x)m_t^F(x))$ and $\log(m_t^M(x)/m_t^F(x))$ 
  * $s_t(x)=$ smoothed version of $y_t(x)$
  * $\varepsilon_{t,x} \sim$ iid N(0,1). $e_t(x)$ serially uncorrelated with mean zero
  * $\mu(x)=$ mean $s_t(x)$ across years. 
  * $\phi_j(x)$ and $\beta_{t,j}$ are principal components & scores of $s_t(x)-\mu(x)$. 
  * $\{\beta_{1,j},\dots,\beta_{T,j}\}$ is modelled with ARIMA or ARFIMA \rlap{processes}


## Functional linear models for migration

\begin{block}{}
\begin{align*}
  y_t(x) & = s_t(x) + \sigma_t(x)\varepsilon_{t,x}\\
  s_t(x) & = \mu(x) + \sum_{j=1}^{J}\beta_{t,j}\phi_j(x) + e_t(x)
\end{align*}
\end{block}

  * $y_t(x)= (G_t^M(x) + G_t^F(x))$ and $(G_t^M(x) - G_t^F(x))$
  * $s_t(x)=$ smoothed version of $y_t(x)$
  * $\varepsilon_{t,x} \sim$ iid N(0,1). $e_t(x)$ serially uncorrelated with mean zero
  * $\mu(x)=$ mean $s_t(x)$ across years. 
  * $\phi_j(x)$ and $\beta_{t,j}$ are principal components & scores of $s_t(x)-\mu(x)$. 
  * $\{\beta_{1,j},\dots,\beta_{T,j}\}$ is modelled with ARIMA or ARFIMA \rlap{processes}


## Population forecasts

  * Fit similar models to fertility rates, mortality rates, migration numbers
  * Constrained so sex differences do not diverge
  * Assume mortality, fertility and migration are independent processes
  * Simulate births, deaths and migrants for future years
  * Assume births and deaths are Poisson, migrant distribution is bootstrapped
  * Compute populations by age and sex for future years

\vspace*{10cm}

## Population forecasts

\begin{block}{For each year of each simulated population}
\begin{itemize}\tightlist
  \item Draw from forecast distribution of fertility rates: $f_t(x)$
  \item Generate number of births from Poisson population: $B_t$
  \item Draw from forecast distribution of mortality rates: $m_t^F(x)$, $m_t^M(x)$
  \item Generate number of deaths by age and sex: $D_t(x) \sim \text{Poisson}(P_t(x)m_t(x))$
  \item Draw from forecast distribution of migration: $G_t^F(x)$, $G_t^M(x)$
  \item Compute population for next year from
    $$P_{t+1}(x) = P_t(x) + B_t1(x=0) - D_t(x) + G_t(x)$$
\end{itemize}
\end{block}

Repeat for all future years. Repeat for multiple simulated \rlap{populations.}

\begin{textblock}{5}(11,0.5)
\fontsize{12}{13}\sf\textcolor{white}{Slightly over-simplified}
\end{textblock}

## Population forecasts

```{r aussim, fig.show='animate', interval=1, message=FALSE, aniopts='controls=none,autoplay,loop,width=14.5cm'}
loadd(aussim_df)
aussim_df %>%
  filter(Rep %in% seq(1,2000,by=100)) %>%
  ggplot(aes(x=Age, y=Population, group=Year, col=Year)) +
  geom_line() +
  facet_grid(. ~ Sex) +
  scale_color_gradientn(colours = rainbow(6)) +
  transition_states(Rep, transition_length=0, state_length=1)
```


## Population forecasts

```{r totalpopulationin2038, warnings=FALSE}
loadd(pyramid_plot)
pyramid_plot +
  plot_annotation(title = "Forecast population for 2038 compared to 2019")
```

\vspace*{10cm}

## Population forecasts

```{r totalpopulationbyyears, fig.height=4}
loadd(population_plot)
population_plot
```

\begin{textblock}{15}(3,8.3)
Fifty-year forecasts with 80\% prediction intervals.
\end{textblock}

\vspace*{10cm}

## OADR forecasts

```{r OADRcurrent}
loadd(oadr_plots)
oadr_plots
```

# Sustainable pension age schemes

## Sustainable pension age schemes

\begin{block}{}
\begin{align*}
a_t&= \text{pension age in year $t$}\\
O_t&= \text{OADR in year $t$}\\
O^*&= \text{target OADR}
\end{align*}
\end{block}

\begin{alertblock}{Find $a_{T+1},\dots,a_{T+H}$ where}
\begin{itemize}\tightlist
\item $a_t$ is minimum pension age such that $O_t \le O^*$.
\item $a_{t-1} \le a_t < a_{t-1} + 1$ to prevent (a) years where no-one is able to retire; and (b) years where retired people become ineligible for the pension. 
\item $a_t$ must be in increments of one month.
\end{itemize}
\end{alertblock}

## Sustainable pension age schemes

\fontsize{14}{15}\sf

###

Starting with $h=1$:

  1. Set $a_{T+h}=a_{T+h-1}$.
  2. Increment $a_{T+h}$ by one-month intervals until either $\widehat{O}_{T+h|T} \le O^*$ or $a_{T+h} - a_{T+h-1}=11$ months, where $\widehat{O}_{T+h|T}$ denotes the mean of the simulated $O_{T+h|T}$ values.

Repeat for $h=2,\dots,H$. 

\pause

### Confidence intervals

  * Range of pension age schemes for which $O^*$ is contained within 80% prediction intervals of simulated $O_{T+H|T}$ values. 
  * Same algorithm but $\widehat{O}_{T+H|T}$ replaced by 10% and 90% quantiles.

## Target OADR

```{r OADRtarget}
loadd(oadr_plots)
oadr_plots +
  geom_hline(aes(yintercept=oadr_target*100), color="#0072B2") +
  annotate("text", x=1999, y=oadr_target*100+1, label="Target OADR", color="#0072B2")
```

## Target pension age scheme

```{r comparisonofpensionages}
loadd(proposed_pension_scheme_plot)
proposed_pension_scheme_plot +
  ggtitle("Pension scheme that meets OADR target")
```

## Target pension age scheme

```{r OADRwithoptimal}
## plots of OADR with plausible pension age schemes
loadd(proposed_oadr_plot)
proposed_oadr_plot
```

## Target pension age scheme

```{r OADRboundaries}
loadd(oadr_upper_lower_plot)
oadr_upper_lower_plot
```

OADR when pension age set at prediction interval boundaries.

## Target pension age scheme

This analysis does not allow for:

  * superannuation and other sources of income.
  * changing GDP per capita
  * COVID-19

\vspace*{10cm}

\placefig{4}{3.2}{width=11cm, height=10cm}{lifestages}


## Relevant papers
\fontsize{13}{15}\sf

* Rob J Hyndman & Shahid Ullah (2007) Robust forecasting of mortality and fertility rates: a functional data approach. *Computational Statistics & Data Analysis* **51**, 4942--4956.
* Rob J Hyndman & Heather Booth (2008) Stochastic population forecasts using functional data models for mortality, fertility and migration. *International Journal of Forecasting* **24**(3), 323--342.
* Rob J Hyndman, Heather Booth & Farah Yasmeen (2013) Coherent mortality forecasting: the product-ratio method with functional time series models. *Demography* **50**(1), 261--283.
* Rob J Hyndman, Yijun Zeng & Han Lin Shang (2021) Forecasting the old-age dependency ratio to determine a sustainable pension age. *Australian & New Zealand Journal of Statistics*, **63**(2), 241--256.


## More information
\fontsize{18}{20}\sf

\vspace*{0.2cm}

\begin{block}{}
\centerline{\url{robjhyndman.com/seminars/oadr/}}
\end{block}

\begin{textblock}{8}(7.55,4.6)
\fontsize{18}{20}\sf
\begin{alertblock}{Find me at ...}
\href{https://robjhyndman.com}{\faicon{home} robjhyndman.com}

\href{https://twitter.com/robjhyndman}{\faicon{twitter} @robjhyndman}

\href{https://github.com/robjhyndman}{\faicon{github}  @robjhyndman}

\href{mailto:rob.hyndman@monash.edu}{\faicon{envelope}  rob.hyndman@monash.edu}
\end{alertblock}
\end{textblock}
\vspace*{10cm}

\placefig{0.5}{2.8}{width=3cm}{forecast.png}
\placefig{2}{5.4}{width=3cm}{demography.png}