expected_retirements/01_load_data.R at main · bcgov/expected_retirements · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
library(tidyverse)
library(fpp3)
bc_pop <- cansim::get_cansim("17-10-0005-01") %>%
  janitor::clean_names() %>%
  filter(
    geo == "British Columbia",
    !str_detect(age_group, "to"),
    !str_detect(age_group, "and over"),
    !str_detect(age_group, "Median"),
    !str_detect(age_group, "Average"),
    !str_detect(age_group, "All"),
    sex != "Both sexes"
  ) %>%
  mutate(
    age_group = as.numeric(gsub(".*?([0-9]+).*", "\\1", age_group)),
    ref_date = as.numeric(ref_date)
  ) %>%
  select(ref_date, value, age_group, sex)
# population projections need to be manually downloaded :( from https://bcstats.shinyapps.io/popApp/ ---------
projections <- read_csv(here::here("raw_data", "Population_Projections.csv")) %>%
  select(-Region, -`Regional District`, -Total) %>%
  pivot_longer(cols = c(-"Year", -"Gender"), names_to = "age_group", values_to = "value") %>%
  rename(
    sex = Gender,
    ref_date = Year
  ) %>%
  filter(
    !str_detect(age_group, "\\+"),
    sex != "T"
  ) %>%
  mutate(
    sex = if_else(sex == "M", "Males", "Females"),
    age_group = as.numeric(age_group)
  )

past_and_future <- bind_rows(bc_pop, projections)

write_rds(past_and_future, here::here("processed_data", "bc_pop.rds"))

retirements <- cansim::get_cansim("14-10-0126-01") %>%
  janitor::clean_names() %>%
  filter(
    geo == "British Columbia",
    reason == "Retired",
    characteristics == "Total, unemployed and not in the labour force",
    sex %in% c("Males", "Females"),
    age_group == "15 years and over"
  ) %>%
  select(ref_date, val_norm, reason, sex, age_group)

write_rds(retirements, here::here("processed_data", "retirements.rds"))

participation <- cansim::get_cansim("14-10-0017-01") %>%
  janitor::clean_names() %>%
  filter(
    geo == "British Columbia",
    labour_force_characteristics == "Participation rate",
    sex != "Both sexes",
    age_group == "50 to 54 years"
  ) %>%
  select(Date = ref_date, `Participation Rate` = val_norm, Sex = sex)%>%
  mutate(Year=lubridate::year(lubridate::ym(Date)))%>%
  group_by(Year, Sex)%>%
  summarize(`Participation Rate`=mean(`Participation Rate`))%>%
  ungroup()%>%
  tsibble::as_tsibble(key=Sex, index=Year)

part_past_future <- participation %>%
  model(ets_model = ETS(`Participation Rate`))%>%
  forecast(h = "19 years")%>%
  as_tibble()%>%
  select(Year, Sex, `Participation Rate`=.mean)%>%
  bind_rows(participation)

write_rds(part_past_future, here::here("processed_data", "participation.rds"))