BC demo-graphics

This note investigates the aging of the BC population, focusing on impacts on the labour market and dependency ratios.

• Labour Market: A wave of retirements that is balanced with a wave of new entrants leaves the labour supply unchanged (i.e. employment counts), but may cause excessive churn in labour market: the jobs being vacated by retirees are rarely filled by fresh labour market entrants.

• Dependency ratios: Working age people need to produce enough goods and services to meet their own needs, plus the needs of children and the aged. We can measure this with the total dependency ratio, which if stable, suggests that our aging population is not a huge problem. Nevertheless, the total dependency ratio hides the fact that the goods and services required by the aged differ substantially from the goods and services required by child dependents.

my_dt <- function(tbbl, length=10) {
  DT::datatable(tbbl,
    extensions = "Buttons",
    filter = "top",
    rownames = FALSE,
    options = list(
      columnDefs = list(list(className = "dt-center", targets = "_all")),
      paging = TRUE,
      scrollX = TRUE,
      scrollY = TRUE,
      searching = TRUE,
      ordering = TRUE,
      dom = "Btip",
      buttons = list(
        list(extend = "csv", filename = as.character(substitute(tbbl))),
        list(extend = "excel", filename = as.character(substitute(tbbl)))
      ),
      pageLength = length
    )
  )
}
plotlify <- function(plt){
  fig <- plotly::ggplotly(plt, tooltip = "text")
  plotly::config(fig, toImageButtonOptions = list(format= 'svg', 
                                                  filename= as.character(substitute(plt)),
                                                  height= 500,
                                                  width= 700,
                                                  scale= 1 ))
}

get_prop_old <- function(age_cutoff){
  long|>
    mutate(age_group=if_else(age>age_cutoff, "old","young"))|>
    group_by(Year, age_group)|>
    summarize(count=sum(count))|>
    pivot_wider(names_from = age_group, values_from = count)|>
    mutate(prop_old=old/(old+young))
}

pop <- read_csv(here("data","Population_Projections_all.csv"))|>
  select(-Region, -`Regional District`,-Gender, -Total)
colnames(pop)[ncol(pop)] <- "90"

long <- pop|>
  pivot_longer(cols=-Year, names_to = "age", values_to = "count")|>
  mutate(Year=as.numeric(Year),
         age=as.numeric(age))

The aged are making up a large proportion of the population

Regardless of what age you use as a cutoff between old and young, the proportion of the population that is old is increasing.

prop_old_dat <- tibble(age_cutoff=seq(60,80,1))|>
  mutate(data=map(age_cutoff, get_prop_old))|>
  unnest(data)

prop_old <- ggplot(prop_old_dat, aes(Year, 
                        prop_old, 
                        colour=age_cutoff,
                        group=age_cutoff,
                        text=paste0(
                          "In ",
                          Year,
                          " ",
                          scales::percent(prop_old, accuracy = .1),
                          if_else(Year<2024, 
                                  " of the population was older than ",
                                  " of the population is forecast to be older than "),
                          age_cutoff
                          )))+
  geom_vline(xintercept = 2024)+
  geom_line()+
  theme_minimal()+
  scale_y_continuous(labels = scales::percent)+
  scale_colour_viridis_c()+
  labs(x=NULL, 
       y=NULL,
       colour="Age",
       title="BC's aging population: % of population older than")

plotlify(prop_old)

my_dt(prop_old_dat)

Labour Market impacts:

As mentioned above, if we are interested in the labour supply, we need to consider entrants as well as retirements. Below we look at the ratio of the age cohort that is retirement age (63-67 inclusive) to the age cohort of new entrants to the labour market (18-22 inclusive). If this ratio is close to one then the labour supply (employment count) will be stable, even if the demographic shift causes substantial churn within the labour market. Note that we are making a closed economy assumption here: we are ignoring the impact of net migration of working age individuals.

in_vs_out_dat <- long|>
  filter(age %in% c(18:22, 63:67))|>
  mutate(age_group=if_else(age>45, "old","young"))|>
  group_by(Year, age_group)|>
  summarize(count=sum(count))|>
  pivot_wider(names_from = age_group, values_from = count)|>
  mutate(old_to_young_ratio=old/young)
 
in_vs_out <- ggplot(in_vs_out_dat, aes(Year, 
             old_to_young_ratio,
             group=1,
             text=paste0(
               "In ",
               Year,
               if_else(Year<2024," there were ", " there will be "),
               scales::comma(old),
               " people ages 63-67, and \n",
               scales::comma(young),
               " people ages 18-22, yielding a ratio of ",
               round(old_to_young_ratio, 3)
             )))+
  geom_vline(xintercept = 2024, lty=2)+
  geom_line()+
  theme_minimal()+
  labs(x=NULL,
       title="Retirement age population / entrant age population",
       y="63-67 year olds / 18-22 year olds"
       )

plotlify(in_vs_out)

my_dt(in_vs_out_dat)

Dependency ratios:

Prima facie, if the total dependency ratio is stable the aging population should not be a huge concern. Nevertheless, the goods and services required by the aged differ from those of children, so the stability of total dependency ratio does not give an indication of the required shift in what we produce.

dep_ratio_dat <- long|>
  mutate(age_group=case_when(age<15~"young",
                             age>64~"old",
                             TRUE~"working"
                             )
         )|>
  group_by(Year, age_group)|>
  summarise(count=sum(count))|>
  pivot_wider(names_from = age_group, values_from = count)|>
  mutate(`Child dependency ratio`=young/working,
         `Aged dependency ratio`=old/working,
         `Total dependency ratio`=(young+old)/working)|>
  pivot_longer(cols=contains("ratio"), names_to = "dependency", values_to = "ratio")

  dep_ratio <- ggplot(dep_ratio_dat, aes(Year, 
                                         ratio, 
                                         group=dependency,
                                         colour=dependency,
                                         text=paste0(
                                           "In ",
                                           Year,
                                           " the ",
                                           dependency,
                                           " was ",
                                           scales::percent(ratio, accuracy = .1))))+
    geom_vline(xintercept = 2024, lty=2)+
    geom_line()+
    scale_y_continuous(labels = scales::percent)+
    labs(x=NULL,
         y=NULL,
         colour=NULL,
         title="Dependency Ratios: ratio of non-working age to working age (15-64)")+
    theme_minimal()

plotlify(dep_ratio)

my_dt(dep_ratio_dat)

Boomers to be replaced by Gen Z migrants:

generations_dat <- long |>
  mutate(
    birth_year = Year - age,
    generation = case_when(#generation is a character variable, which R sorts alphabetically :(
      birth_year %in% 1900:1927 ~ "Greatest", 
      birth_year %in% 1928:1945 ~ "Interwar",
      birth_year %in% 1946:1965 ~ "Baby Boomers",
      birth_year %in% 1966:1980 ~ "Gen X",
      birth_year %in% 1981:1996 ~ "Millenials",
      birth_year %in% 1997:2012 ~ "Gen Z",
      birth_year %in% 2013:2023 ~ "Gen Alpha",
      birth_year %in% 2024:2034 ~ "Gen Beta",
      birth_year %in% 2035:2045 ~ "Gen Gamma",
      birth_year %in% 2046:2056 ~ "Gen Delta",
      TRUE ~ NA_character_
    ),# convert generation to factor, ordered chronologically :)
    generation=ordered(generation, levels=c("Greatest",
                                            "Interwar",
                                            "Baby Boomers",
                                            "Gen X",
                                            "Millenials",
                                            "Gen Z",
                                            "Gen Alpha",
                                            "Gen Beta",
                                            "Gen Gamma",
                                            "Gen Delta"
                                            ))
  )|>
  group_by(Year, generation)|>
  summarise(count=sum(count))|>
  filter(Year>1989)

Below you can see the demographic composition of BC over time. Of particular interest is the increase over time of Gen Z. Note that in 2024, there were 1,192,791 members of this generation, but by 2046 this generation is expected to swell to 2,069,648, reflecting a large net in migration of this age cohort. In contrast, in 2024 there were 1,274,317 baby boomers, but by 2046 this generation is expected to shrink to 591,858 due to deaths.

generations <- generations_dat |>
  ggplot(aes(Year, 
             count, 
             fill = generation,
             text=paste0(
               "In ",
               Year,
               if_else(Year<2024, " there were ", " there are forecast to be "),
               scales::comma(count),
               " members of the ",
               generation,
               " Generation.")
             )
         )+
  geom_vline(xintercept = 2023.5, lty=2)+
  geom_col()+
  scale_y_continuous(labels = scales::comma)+
  labs(x=NULL,
       y=NULL,
       fill=NULL,
       title="Population counts by generation")+
  theme_minimal()

plotlify(generations)

my_dt(generations_dat)