#' @title Bereitstellung der Bevölkerungsdaten.
#'
#' @description Aufbereitung der Bevölkerungsdaten (Beobachtungen und Szenarien).
#'
#' @param PARAM_GLOBAL a single row data frame
#' 
#' @param BEV_BESTAND tidy data frame containing observed population data, see
#' function \code{\link{mod_input_bev_bestand}}.
#'
#' @param BEV_SCENARIO tidy data frame containing population scenario, see
#' function \code{\link{mod_input_bev_scenario}}.
#'
#' @return a `tidylist` containing the following tidy data frame:
#'   - `BEVOELKERUNG`
#'
#' @author [MAS BSV](mailto:sekretariat.mas@bsv.admin.ch)
#'
#' @export

mod_population <- function(PARAM_GLOBAL,
                           BEV_BESTAND,
                           BEV_SCENARIO) {
    
  print("Run module: mod_population")
    
  # Konsolidierung der Altersgruppen auf 0-99. 
  BEV_SCENARIO <- BEV_SCENARIO %>%
    mutate(alt = pmin(99, alt)) %>% 
    summarize(
      across(all_of(
        c("bevanfangj"  , "bevendejahr" , "geburt", "tod", "einbuergerung", "einwanderung",
          "auswanderung", "geburtmutter", "erwbev", "ept", "erwq"         , "erwqept"     ,
          "frontaliers")), 
        \(x) sum(x, na.rm = TRUE)), .by = c("scenario", "sex", "nat", "alt", "jahr"))
  
  if("jahr_bev" %in% names(PARAM_GLOBAL)) 
    
    BEV_BESTAND <- BEV_BESTAND %>%
      mutate(
        erwbev              = ifelse(jahr > PARAM_GLOBAL$jahr_bev + 1, NA, erwbev),
        ept                 = ifelse(jahr > PARAM_GLOBAL$jahr_bev + 1, NA, ept),
        erwq                = ifelse(jahr > PARAM_GLOBAL$jahr_bev + 1, NA, erwq),
        erwqept             = ifelse(jahr > PARAM_GLOBAL$jahr_bev + 1, NA, erwqept),
        frontaliers         = ifelse(jahr > PARAM_GLOBAL$jahr_bev + 1, NA, frontaliers),
        assures_facultatifs = ifelse(jahr > PARAM_GLOBAL$jahr_bev + 1, NA, assures_facultatifs),
          
        bevanfangj    = ifelse(jahr > PARAM_GLOBAL$jahr_bev, NA, bevanfangj),
        bevendejahr   = ifelse(jahr > PARAM_GLOBAL$jahr_bev, NA, bevendejahr),
        geburt        = ifelse(jahr > PARAM_GLOBAL$jahr_bev, NA, geburt),
        tod           = ifelse(jahr > PARAM_GLOBAL$jahr_bev, NA, tod),
        einbuergerung = ifelse(jahr > PARAM_GLOBAL$jahr_bev, NA, einbuergerung),
        einwanderung  = ifelse(jahr > PARAM_GLOBAL$jahr_bev, NA, einwanderung),
        auswanderung  = ifelse(jahr > PARAM_GLOBAL$jahr_bev, NA, auswanderung),
        bereinigung   = ifelse(jahr > PARAM_GLOBAL$jahr_bev, NA, bereinigung))
  
    
  # Faktoren zur Justierung der Szenarien-Bestände auf die letzten beobachteten Bestände 
  # berechnen.
  fractions_bevoelkerung_scen <- BEV_BESTAND %>% 
    select(- c("bevanfangj", "geburt", "tod", "einbuergerung", "einwanderung", 
               "bereinigung", "saisonniers", "assures_facultatifs")) %>% 
    mutate(quelle = "bestand") %>% 
    bind_rows(BEV_SCENARIO %>% 
                filter(scenario == PARAM_GLOBAL$bev_scenario) %>% 
                select(- scenario) %>% 
                select(- c("bevanfangj", "geburt", "tod", "einbuergerung", 
                           "einwanderung", "geburtmutter")) %>% 
                mutate(quelle = "scenario")) %>% 
    pivot_longer(cols = bevendejahr:frontaliers, names_to = "variable", 
                 values_to = "value") %>% 
    filter(!is.na(value)) %>% 
    group_by(variable) %>% 
    filter(jahr == max(jahr[quelle == "bestand"])) %>% 
    ungroup() %>% 
    arrange(sex, nat, alt, variable, quelle) %>% 
    pivot_wider(names_from = quelle, values_from = value) %>% 
    mutate(fraction = ifelse(scenario == 0 | is.na(scenario), 1, 
                             bestand / scenario)) %>% 
    select(sex, nat, alt, variable, fraction)
  
  # Freiwillig Versicherte.
  fraction_assures_facultatifs <- BEV_BESTAND %>% 
    select(jahr, sex, nat, alt, bevendejahr, assures_facultatifs) %>% 
    mutate(fraction_assures_facultatifs = 
             ifelse( bevendejahr != 0, assures_facultatifs / bevendejahr, 1)) %>% 
    filter(!is.na(assures_facultatifs), !is.na(bevendejahr)) %>% 
    filter(jahr %in% c(min(jahr), max(jahr))) %>%
    summarize(
        fraction_assures_facultatifs_maxjahr = max(
            fraction_assures_facultatifs[jahr == max(jahr)], na.rm = TRUE),
        fraction_assures_facultatifs_minjahr = max(
            fraction_assures_facultatifs[jahr == min(jahr)], na.rm = TRUE),
        .by = c("sex", "nat", "alt"))
  
  # Grenzgänger.
  fraction_frontaliers <- BEV_BESTAND %>% 
    select(jahr, sex, nat, alt, bevendejahr, frontaliers) %>% 
    mutate(fraction_frontaliers = ifelse(bevendejahr != 0, 
                                         frontaliers / bevendejahr, 1)) %>% 
    filter(!is.na(frontaliers)) %>% 
    filter(jahr == min(jahr)) %>% 
    select(sex, nat, alt, fraction_frontaliers)
  
  # Zusammenführung in finalen Bevölkerungsdatensatz.
  BEVOELKERUNG <- BEV_BESTAND %>% 
    select(- c("bevanfangj", "geburt", "tod", "einbuergerung", "einwanderung", 
               "bereinigung", "saisonniers", "assures_facultatifs")) %>% 
    mutate(quelle = "bestand") %>% 
    bind_rows(
        BEV_SCENARIO %>% 
            filter(scenario == PARAM_GLOBAL$bev_scenario) %>% 
            select(- scenario) %>% 
            select(- c("bevanfangj", "geburt", "tod", "einbuergerung", "einwanderung", 
                       "geburtmutter")) %>% 
            mutate(quelle = "scenario")) %>% 
    pivot_longer(cols = bevendejahr:frontaliers, names_to = "variable", 
                 values_to = "value") %>% 
    filter(!is.na(value)) %>% 
    group_by(variable) %>% 
    filter(quelle == "bestand" | jahr > max(jahr[quelle == "bestand"])) %>% 
    ungroup() %>% 
    # Verknüpfung und Anwendung der Justierungs-Faktoren.
    left_join(fractions_bevoelkerung_scen, 
              by = c("sex", "nat", "alt", "variable")) %>%
    mutate(value = ifelse(quelle == "scenario", value * fraction, value)) %>% 
    select(- fraction, - quelle) %>% 
    filter(!is.na(value)) %>% 
    pivot_wider(names_from = "variable", values_from = "value") %>% 
    left_join(BEV_BESTAND %>%  
                select(jahr, sex, nat, alt, saisonniers, assures_facultatifs),
              by = c("sex", "nat", "alt", "jahr")) %>% 
    left_join(fraction_assures_facultatifs,
              by = c("sex", "nat", "alt")) %>% 
    left_join(fraction_frontaliers, 
              by = c("sex", "nat", "alt")) %>% 
    mutate(
        saisonniers = ifelse(jahr >= 2000 & is.na(saisonniers), 0, saisonniers),
        assures_facultatifs = 
          case_when(
            jahr < 2000 & is.na(assures_facultatifs) ~ 
              bevendejahr * fraction_assures_facultatifs_minjahr,
            jahr > 2000 & is.na(assures_facultatifs) ~ 
              bevendejahr * fraction_assures_facultatifs_maxjahr,
            TRUE ~ assures_facultatifs),
        
        frontaliers = ifelse(jahr < 2000 & is.na(frontaliers), 
                             bevendejahr * fraction_frontaliers, frontaliers),
        auswanderung = auswanderung) %>% 
    select(- fraction_assures_facultatifs_maxjahr, 
           - fraction_assures_facultatifs_minjahr, 
           - fraction_frontaliers) %>% 
    arrange(sex, nat, alt, jahr)

  return(BEVOELKERUNG = BEVOELKERUNG)
}
