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

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

## ----get-benchmark, message = FALSE, eval = FALSE-----------------------------
# data_benchmark <- get_population(
#   number_fso = "px-x-0102010000_101",
#   year = 2024,
#   year_last = 2025,
#   spatial_units = "- Aargau"
# )

## ----get-parameters, message = FALSE, warning=FALSE, results='hide', eval = FALSE----
# data_parameters <- get_parameters(
#   year_first = 2024,
#   year_last = 2030,
#   spatial_units = "Aargau"
# ) |>
#   dplyr::filter(scen == "reference")

## ----project-canton, eval = FALSE---------------------------------------------
# data_projected <- propop(
#   parameters = data_parameters,
#   year_first = 2025,
#   year_last = 2030,
#   scenarios = "reference",
#   # population records from 2024 as starting point
#   population = data_benchmark |>
#     dplyr::filter(year == 2024),
#   subregional = FALSE,
#   binational = TRUE
# )

## ----save-data, message = FALSE, echo=FALSE, eval = FALSE---------------------
# # Save data once
# save(data_benchmark, file = "../vignettes/evaluate_data_benchmark.rda")
# save(data_parameters, file = "../vignettes/evaluate_data_parameters.rda")
# save(data_projected, file = "../vignettes/evaluate_data_projected.rda")

## ----load-data, message = FALSE, echo=FALSE, eval = TRUE----------------------
# Get data when building vignette
load(file = "../vignettes/evaluate_data_benchmark.rda")
load(file = "../vignettes/evaluate_data_parameters.rda")
load(file = "../vignettes/evaluate_data_projected.rda")

## ----combine------------------------------------------------------------------
# Combine and pre-process the data
combined <- prepare_evaluation(
  # only keep years from projected period
  data_benchmark = data_benchmark |> dplyr::filter(year > 2024),
  n_benchmark = "n",
  data_projected = data_projected |> dplyr::filter(year > 2024 & year <= 2025),
  n_projected = "n_dec"
)

# Show combined data
combined

## ----evaluate1----------------------------------------------------------------
evaluation_1 <- compute_measures(combined)

# Create table
evaluation_1 |>
  # select demographic group
  dplyr::filter(sex == "m" & nat == "ch" & age == 27) |>
  # round to two digits
  dplyr::mutate(across(pe:ape, \(x) sprintf(fmt = "%.2f", x))) |>
  DT::datatable(
    filter = "none",
    options = list(dom = "t"),
    caption = htmltools::tags$caption(
      style = "caption-side: top; text-align: left; font-weight: bold",
      "Performance measures for projections with 1-year age classes for the
      canton of Aargau 2019-2022; only one demographic group is displayed."
    )
  )

## ----aggregate1---------------------------------------------------------------
aggregate_measures(evaluation_1) |>
  # round to two digits
  dplyr::mutate(across(mpe:ape_under_5, \(x) sprintf(fmt = "%.2f", x))) |>
  DT::datatable(
    options = list(dom = "t"),
    caption = htmltools::tags$caption(
      style = "caption-side: top; text-align: left; font-weight: bold",
      "Evaluation measures of projection with one-year age classes, aggregated
      across all observations."
    )
  )

## ----combine-grouped----------------------------------------------------------
# Combine and pre-process the data
combined_grouped <- prepare_evaluation(
  # only keep years from projected period
  data_benchmark = data_benchmark |> dplyr::filter(year > 2024),
  n_benchmark = "n",
  data_projected = data_projected |> dplyr::filter(year > 2024 & year <= 2025),
  age_groups = "age_groups_3",
  n_projected = "n_dec"
)

# Show combined data
combined_grouped

# Compute the performance measures
evaluation_2 <- compute_measures(combined_grouped)

evaluation_2 |>
  # select demographic group
  dplyr::filter(sex == "m" & nat == "ch" & age == "age_20_64") |>
  # round to two digits
  dplyr::mutate(across(pe:ape, \(x) sprintf(fmt = "%.2f", x))) |>
  DT::datatable(
    options = list(dom = "t"),
    caption = htmltools::tags$caption(
      style = "caption-side: top; text-align: left; font-weight: bold",
      "Performance measures for projections with three age classes for the
      canton of Aargau 2024-2025; only one demographic group is displayed."
    )
  )

## ----aggregate2---------------------------------------------------------------
aggregate_measures(evaluation_2) |>
  # round to two digits
  dplyr::mutate(across(mpe:ape_under_5, \(x) sprintf(fmt = "%.2f", x))) |>
  DT::datatable(
    options = list(dom = "t"),
    caption = htmltools::tags$caption(
      style = "caption-side: top; text-align: left; font-weight: bold",
      "Evaluation measures for projection with three age classes, aggregated
      across all observations."
    )
  )

## ----weighted-----------------------------------------------------------------
evaluation_3 <- compute_measures(combined_grouped, weight_groups = c("age"))

evaluation_3 |>
  dplyr::filter(year == 2025 & ape > 0.34 & ape < 0.39) |>
  dplyr::mutate(across(pe:w_ape, \(x) sprintf(fmt = "%.2f", x))) |>
  DT::datatable(
    options = list(dom = "t"),
    caption = htmltools::tags$caption(
      style = "caption-side: top; text-align: left; font-weight: bold",
      "Selected results showing the effect of using weights
      (ape versus w_ape)."
    ),
  ) |>
  DT::formatStyle(
    columns = c("ape", "w_ape"),
    backgroundColor = "#96D4FF"
  )

## ----aggregate3---------------------------------------------------------------
aggregate_measures(evaluation_3, weight_groups = c("age")) |>
  # round to two digits
  dplyr::mutate(across(mpe:ape_under_5, \(x) sprintf(fmt = "%.2f", x))) |>
  DT::datatable(options = list(dom = "t"))

## ----fso-population-2024, eval = FALSE, echo = TRUE---------------------------
# fso_population_2024 <- get_population(
#   number_fso = "px-x-0102010000_101",
#   year = 2024,
#   spatial_units = "- Aargau"
# )

## ----save-data2, message = FALSE, echo=FALSE, eval = FALSE--------------------
# # Save data once
# save(fso_population_2024, file = "../vignettes/fso_population_2024.rda")

## ----load-data2, message = FALSE, echo=FALSE, eval = TRUE---------------------
# Get data when building vignette
load(file = "../vignettes/fso_population_2024.rda")

## ----project-canton-2025------------------------------------------------------
projection_2025 <- propop(
  parameters = fso_parameters |>
    dplyr::filter(scen == "reference"),
  year_first = 2025,
  year_last = 2055,
  # population records from 2024 as starting point
  population = fso_population_2024,
  subregional = FALSE,
  binational = TRUE
)

## ----fso-comparison-----------------------------------------------------------
fso_propop <- prepare_evaluation(
  data_benchmark = fso_parameters |>
    dplyr::filter(scen == "reference" & year >= 2025) |>
    dplyr::mutate(n = fso_projection_n),
  n_benchmark = "n",
  data_projected = projection_2025 |>
    dplyr::filter(scen == "reference" & year >= 2025),
  age_groups = "age_groups_3",
  n_projected = "n_dec"
) |>
  compute_measures()

fso_propop |>
  dplyr::mutate(across(pe:ape, \(x) sprintf(fmt = "%.3f", x))) |>
  DT::datatable(
    filter = "top",
    caption = htmltools::tags$caption(
      style = "caption-side: top; text-align: left; font-weight: bold",
      "Comparison of projetions from FSO versus 'propop'."
    )
  )

## ----fig.width = 9, fig.height = 7, echo = FALSE------------------------------
library(ggplot2)

add_percent <- function(x) {
  paste0(x, "%")
}

ggplot(fso_propop) +
  geom_jitter(aes(x = year, y = pe, color = age), size = 0.8) +
  scale_color_manual(values = c(
    "age_00_19" = "#ffa81f", "age_20_64" = "#96D4FF", "age_65_plus" = "#A05388"
  )) +
  labs(
    title = paste0(
      "Differences between FSO and propop projections for each demographic ",
      "group (2025-2055)"
    ),
    x = "Year",
    y = "Difference in percent"
  ) +
  scale_y_continuous(labels = add_percent) +
  theme_minimal()