## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## ----setup, message = FALSE, warning=FALSE, echo = FALSE----------------------
library(propop)

## ----data-population----------------------------------------------------------
# Load package data
## Population of 5 subregions
data("ag_population_subregional")
## FSO data containing parameters for the entire canton
data("fso_parameters")

## ----data-parameters----------------------------------------------------------
# Duplicate FSO parameters for five subregions
fso_parameters_sub <- fso_parameters |>
  dplyr::filter(scen == "reference") |>
  # duplicating rows 5 times
  tidyr::uncount(5) |>
  # create 5 subregions
  dplyr::mutate(
    spatial_unit = as.character(
      rep(1:5, length.out = dplyr::n())
    )
  )

## ----shares-pop-size----------------------------------------------------------
# Calculate shares
df_population_shares <- ag_population_subregional |>
  dplyr::mutate(sum_n = sum(n), .by = c(nat, sex, age)) |>
  dplyr::mutate(share = n / sum_n) |>
  # The population and group sum of a few elderly groups is zero, thus the
  # share must also be zero
  dplyr::mutate(share = dplyr::case_when(
    sum_n == 0 & n == 0 ~ 0,
    .default = share
  ))

## ----distribute-pop-size------------------------------------------------------
parameters_sub_size <- fso_parameters_sub |>
  dplyr::left_join(
    df_population_shares |>
      dplyr::select("spatial_unit", "nat", "sex", "age", "share"),
    by = c("spatial_unit", "nat", "sex", "age")
  ) |>
  dplyr::mutate(
    # Calculate number of incoming people per demographic group and spatial unit
    imm_int_n_distr = imm_int_n * share,
    imm_nat_n_distr = imm_nat_n * share
  )

## ----distr-pop-size-group_sum, echo = FALSE-----------------------------------
parameters_sub_size |>
  dplyr::filter(scen == "reference" & year == 2026) |>
  dplyr::select(
    year, nat, sex, age, spatial_unit,
    imm_int_n, share, imm_int_n_distr
  ) |>
  dplyr::mutate(
    group_sum = round(sum(imm_int_n_distr), 0),
    .by = c(year, nat, sex, age)
  ) |>
  dplyr::filter(sex == "m" & nat == "int" & age == "29") |>
  dplyr::mutate(across(
    c(imm_int_n, share, imm_int_n_distr),
    \(x) round(x, 3)
  )) |>
  dplyr::arrange(year, age, sex, nat) |>
  dplyr::slice_head(n = 5) |>
  DT::datatable(
    rownames = FALSE,
    options = list(
      dom = "t",
      paging = FALSE
    )
  ) |>
  DT::formatStyle(
    "imm_int_n",
    backgroundColor = "#ffcc8f"
  ) |>
  DT::formatStyle(
    c("group_sum"),
    backgroundColor = "#96D4FF"
  )

## ----cleaning-----------------------------------------------------------------
parameters_sub_size_clean <- parameters_sub_size |>
  dplyr::mutate(
    # Rename variables
    imm_int_n = imm_int_n_distr,
    imm_nat_n = imm_nat_n_distr
  ) |>
  dplyr::select(-c(share, imm_int_n_distr, imm_nat_n_distr))

## ----project-1----------------------------------------------------------------
propop(
  parameters = parameters_sub_size_clean,
  year_first = 2026,
  year_last = 2027,
  scenarios = "reference",
  age_groups = 101,
  fert_first = 16,
  fert_last = 50,
  share_born_female = 100 / 205,
  population = ag_population_subregional,
  binational = TRUE,
  subregional = FALSE
)

## ----data-historical-immigration, echo = FALSE, message=FALSE-----------------
ag_migration_subregional |>
  dplyr::select(year, spatial_unit, age, nat, sex, hist_imm_nat_n, hist_imm_int_n) |>
  dplyr::filter(sex == "m" & nat == "int" & age == "29") |>
  dplyr::relocate(year, .before = 1) |>
  DT::datatable(
    rownames = FALSE,
    options = list(
      dom = "t",
      paging = FALSE
    )
  )

## ----result-historical-immigration, eval = TRUE-------------------------------
data_distr_hist_int <- ag_migration_subregional |>
  calculate_shares(
    imm_n = "hist_imm_int_n",
    age_group = 5,
    year_range = 2022:2025,
    binational = TRUE,
    two_sex = TRUE
  )

## ----table-historical-immigration, eval = TRUE, echo = FALSE------------------
data_distr_hist_int |>
  # Display rounded numbers to save space
  dplyr::mutate(imm_share = round(imm_share, 3)) |>
  dplyr::filter(sex == "m" & nat == "int" & age == "29") |>
  DT::datatable() |>
  DT::formatStyle(
    "sum_imm_n",
    backgroundColor = "#96D4FF"
  ) |>
  DT::formatStyle(
    "total_imm_n",
    backgroundColor = "#007AB8"
  ) |>
  DT::formatStyle(
    "imm_share",
    backgroundColor = "#005D91"
  )

## ----share-check, eval = TRUE, message = FALSE, echo = FALSE, results='hide'----
# Useful check for development, not shown in final vignette
data_distr_hist_int |>
  dplyr::select(spatial_unit, age_group, nat, sex, imm_share) |>
  dplyr::distinct() |>
  dplyr::summarise(sum_share = round(
    sum(imm_share, na.rm = TRUE),
    digits = 2
  ), .by = c(nat, sex, age_group)) |>
  DT::datatable()

## ----parameters-distributed, eval = TRUE--------------------------------------
# Calculate the historical shares for immigration from other cantons
data_distr_hist_nat <- ag_migration_subregional |>
  calculate_shares(
    imm_n = "hist_imm_nat_n",
    age_group = 5,
    year_range = 2022:2025,
    binational = TRUE,
    two_sex = TRUE
  )

# Add both shares to the data frame that holds the parameters for the whole canton
# Start from the original duplicated parameters
fso_parameters_sub_distr_hist <- fso_parameters_sub |>
  dplyr::left_join(
    data_distr_hist_int |>
      dplyr::select(spatial_unit, nat, sex, age,
        share_imm_int = imm_share
      ),
    by = dplyr::join_by(spatial_unit, nat, sex, age)
  ) |>
  dplyr::left_join(
    data_distr_hist_nat |>
      dplyr::select(spatial_unit, nat, sex, age,
        share_imm_nat = imm_share
      ),
    by = dplyr::join_by(spatial_unit, nat, sex, age)
  ) |>
  # Compute immigration-`n` for subregions
  dplyr::mutate(
    imm_int_n_distr = imm_int_n * share_imm_int,
    imm_nat_n_distr = imm_nat_n * share_imm_nat
  )

## ----distr-pop-size-group_sum2, echo = FALSE----------------------------------
fso_parameters_sub_distr_hist |>
  dplyr::select(
    year, nat, sex, age, spatial_unit,
    imm_int_n,
    share_imm_int,
    imm_int_n_distr
  ) |>
  dplyr::mutate(
    group_sum_int = round(sum(imm_int_n_distr), 0),
    .by = c(year, nat, sex, age)
  ) |>
  dplyr::filter(sex == "m" & nat == "int" & age == "29" & year == 2026) |>
  dplyr::mutate(across(c(
    imm_int_n, share_imm_int, imm_int_n_distr
  ), \(x) round(x, 3))) |>
  dplyr::arrange(year, age, sex, nat) |>
  dplyr::filter(sex == "m" & nat == "int" & age == "29") |>
  dplyr::slice_head(n = 5) |>
  DT::datatable(
    rownames = FALSE,
    options = list(
      dom = "t",
      paging = FALSE
    )
  ) |>
  DT::formatStyle(
    "imm_int_n",
    backgroundColor = "#ffcc8f"
  ) |>
  DT::formatStyle(
    c("group_sum_int"),
    backgroundColor = "#96D4FF"
  )

## ----cleaning-2---------------------------------------------------------------
fso_parameters_sub_distr_hist <- fso_parameters_sub_distr_hist |>
  dplyr::mutate(
    # Rename variables
    imm_int_n = imm_int_n_distr,
    imm_nat_n = imm_nat_n_distr
  ) |>
  dplyr::select(-c(imm_int_n_distr, imm_nat_n_distr))

## ----project-2, eval = TRUE---------------------------------------------------
propop(
  parameters = fso_parameters_sub_distr_hist,
  year_first = 2026,
  year_last = 2027,
  scenarios = "reference",
  age_groups = 101,
  fert_first = 16,
  fert_last = 50,
  share_born_female = 100 / 205,
  population = ag_population_subregional,
  binational = TRUE,
  subregional = FALSE
)

## ----emi-rate-----------------------------------------------------------------
data("ag_migration_subregional")

# Compute mean for each demographic group
emi_rate <- calculate_rates(
  past_migration = ag_migration_subregional,
  year_range = 2024:2025,
  n_jan = n_jan,
  births = births,
  emi_n = hist_emi_sub_n,
  spatial_unit = spatial_unit,
  age_group = 2,
  method = "mean"
)

## ----emi-rate-table, echo=FALSE-----------------------------------------------
spatial_units <- unique(emi_rate$spatial_unit)
colors <- colorspace::lighten(
  c("#007AB8", "#ffa81f", "#A05388", "#ffe562", "#96D4FF"),
  amount = 0.8
)


emi_rate |>
  # Select sample group
  dplyr::filter(age >= 28 & age <= 29 & nat == "int" & sex == "m") |>
  # Remove columns to fit on screen
  dplyr::select(-births, -n_jan, -sex, -nat, -method) |>
  dplyr::mutate(
    emi_rate_year = round(emi_rate_year, 3),
    emi_rate = round(emi_rate, 3)
  ) |>
  dplyr::arrange(spatial_unit) |>
  DT::datatable(
    rownames = FALSE,
    options = list(
      dom = "t",
      paging = FALSE
    )
  ) |>
  DT::formatStyle(
    columns         = "spatial_unit",
    target          = "row",
    backgroundColor = DT::styleEqual(spatial_units, colors)
  ) |>
  DT::formatStyle(
    columns = "emi_rate_year",
    fontStyle = "italic"
  ) |>
  DT::formatStyle(
    columns    = "emi_rate",
    fontWeight = "bold"
  )

## ----imm_share----------------------------------------------------------------
imm_share <- calculate_shares(
  past_migration = ag_migration_subregional,
  year_range = 2024:2025,
  imm_n = "hist_imm_sub_n",
  age_group = 2
)

## ----imm_share-table, echo=FALSE----------------------------------------------
imm_share |>
  # Select sample group
  dplyr::filter(age >= 28 & age <= 29 & nat == "int" & sex == "m") |>
  dplyr::distinct(age_group, spatial_unit, .keep_all = TRUE) |>
  # Remove columns to fit on screen
  dplyr::select(-age, -sex, -nat) |>
  dplyr::mutate(imm_share = round(imm_share, 3)) |>
  dplyr::arrange(spatial_unit) |>
  DT::datatable(
    rownames = FALSE,
    options = list(
      dom = "t",
      paging = FALSE
    )
  ) |>
  DT::formatStyle(
    columns         = "spatial_unit",
    target          = "row",
    backgroundColor = DT::styleEqual(spatial_units, colors)
  ) |>
  DT::formatStyle(
    columns    = "imm_share",
    fontWeight = "bold"
  )

## ----prep-project-rate, eval = TRUE-------------------------------------------
parameters_rate <- fso_parameters_sub_distr_hist |>
  dplyr::left_join(
    emi_rate |>
      dplyr::select(spatial_unit, age, nat, sex, emi_rate) |>
      dplyr::distinct(),
    by = dplyr::join_by(nat, sex, age, spatial_unit),
    relationship = "many-to-many"
  ) |>
  dplyr::left_join(
    imm_share |>
      dplyr::select(spatial_unit, age, nat, sex, imm_share) |>
      dplyr::distinct(),
    by = dplyr::join_by(nat, sex, age, spatial_unit),
    relationship = "many-to-many"
  ) |>
  # Use names expected in propop()
  dplyr::rename(emi_sub = emi_rate, imm_sub = imm_share)

## ----project-rate, eval = TRUE------------------------------------------------
propop(
  parameters = parameters_rate,
  year_first = 2026,
  year_last = 2055,
  age_groups = 101,
  fert_first = 16,
  fert_last = 50,
  share_born_female = 100 / 205,
  population = ag_population_subregional,
  binational = TRUE,
  subregional = "rate"
)

## ----eval = TRUE--------------------------------------------------------------
# Historical subregional immigration
subregional_imm_share <- ag_migration_subregional |>
  dplyr::select(year, spatial_unit, age, nat, sex, hist_imm_sub_n) |>
  calculate_shares(
    imm_n = "hist_imm_sub_n",
    age_group = 5,
    year_range = 2022:2025,
    binational = TRUE,
    two_sex = TRUE
  )

# Historical subregional emigration
subregional_emi_share <- ag_migration_subregional |>
  dplyr::select(year, spatial_unit, age, nat, sex, hist_emi_sub_n) |>
  calculate_shares(
    imm_n = "hist_emi_sub_n",
    age_group = 5,
    year_range = 2022:2025,
    binational = TRUE,
    two_sex = TRUE
  )

## ----eval = TRUE--------------------------------------------------------------
subregional_net_migration <- dplyr::full_join(
  subregional_imm_share |>
    dplyr::select(
      spatial_unit, age, age_group, nat, sex,
      sum_imm_sub_n = sum_imm_n,
      total_imm_sub_n = total_imm_n, imm_sub_share = imm_share
    ),
  subregional_emi_share |>
    dplyr::select(
      spatial_unit, age, age_group, nat, sex,
      sum_emi_sub_n = sum_imm_n,
      total_emi_sub_n = total_imm_n, emi_sub_share = imm_share
    ),
  by = dplyr::join_by(spatial_unit, age, age_group, nat, sex)
) |>
  # calculate net migration
  dplyr::mutate(sum_mig_sub_n = sum_imm_sub_n - sum_emi_sub_n)

## ----eval = TRUE--------------------------------------------------------------
parameters_net <- fso_parameters_sub_distr_hist |>
  dplyr::left_join(
    subregional_net_migration |>
      dplyr::mutate(mig_sub = sum_mig_sub_n) |>
      dplyr::select(spatial_unit, age, nat, sex, mig_sub),
    by = dplyr::join_by(spatial_unit, age, nat, sex)
  )

## ----project-3, eval = TRUE---------------------------------------------------
propop(
  parameters = parameters_net,
  year_first = 2026,
  year_last = 2055,
  age_groups = 101,
  fert_first = 16,
  fert_last = 50,
  share_born_female = 100 / 205,
  population = ag_population_subregional,
  binational = TRUE,
  subregional = "net"
)