R/scenario_benchmarking.R

In caldwellst/billionaiRe: Calculate the WHO Triple Billions

#' Benchmarking scenarios
#'
#' @description
#'
#' UHC benchmarking scenarios are generated by running 3 versions of
#' `scenario_top_n_iso3()`:
#'
#' - Top 20% AROC globally
#' - Top 20% AROC in WHO regions
#' - Top 20% AROC in World Bank (WB) Income Groups (IC)
#'
#' Some functions (see below) set additional parameters to guarantee comparability
#' with other scenarios
#'
#' @inheritParams transform_hpop_data
#' @inheritParams calculate_hpop_contributions
#' @inheritParams calculate_uhc_billion
#' @inheritParams accelerate_alcohol
#' @param ... additional parameters to be passed to scenario function
#'
#' @return data frame with acceleration scenario binded to `df`. `scenario` is
#' set to `acceleration`
#'
#' @family benchmarking
#'
#' @rdname uhc-benchmarking
#'
benchmarking_anc4 <- function(df,
                              ...) {

  params <- get_dots_and_call_parameters(...)

  df <- df %>%
    dplyr::mutate(region = whoville::iso3_to_regions(.data[["iso3"]]),
                  wb_ig = whoville::iso3_to_regions(.data[["iso3"]], "wb_ig"))

  params_benchmarking <- list(
    prop = c(rep(.2, 3)),
    use_prop = c(rep(TRUE, 3)),
    group_col = list(NULL, "region", "wb_ig"),
    is_aroc_last_n_years = TRUE,
    aroc_last_n_years = 5,
    scenario_name = list("top_20_percent_aroc",
                         "top_20_percent_region_aroc",
                         "top_20_percent_wb_ig_aroc")
  )

  params_expanded <- purrr::pmap(params_benchmarking, set_parameters, parameters = params)

  purrr::map_dfr(params_expanded,
                 exec_scenario,
                 df = df,
                 fn = scenario_top_n_iso3)
}

#' @rdname uhc-benchmarking
benchmarking_art <- function(df,
                             ...) {

  params <- get_dots_and_call_parameters(...)
  exec_scenario(df,
                benchmarking_anc4,
                params)
}

#' @describeIn uhc-benchmarking Set a `upper_limit` of 10000
benchmarking_beds <- function(df,
                              ...) {
  params <- get_dots_and_call_parameters(...) %>%
    set_parameters(upper_limit = 10000)

  exec_scenario(df,
                benchmarking_anc4,
                params)

}

#' @rdname uhc-benchmarking
benchmarking_bp <- function(df,
                            ...) {
  params <- get_dots_and_call_parameters(...)

  exec_scenario(df,
                benchmarking_anc4,
                params)
}

#' @describeIn uhc-benchmarking Set a `upper_limit` of 10000
benchmarking_doctors <- function(df,
                                 ...) {
  params <- get_dots_and_call_parameters(...)

  params <- get_dots_and_call_parameters(...) %>%
    set_parameters(upper_limit = 10000)

  exec_scenario(df,
                benchmarking_anc4,
                params)
}

#' @rdname uhc-benchmarking
benchmarking_nurses <- function(df,
                                ...) {

  params <- get_dots_and_call_parameters(...)

  exec_scenario(df,
                benchmarking_doctors,
                params
  )
}

#' @describeIn uhc-benchmarking Set `baseline_year` to 2012 and `aroc_end_year` to 2017
benchmarking_hwf <- function(df,
                             ...) {

  params <- get_dots_and_call_parameters(...) %>%
    set_parameters(baseline_year = 2012,
                   aroc_end_year = 2017)

  exec_scenario(df,
                benchmarking_doctors,
                params
  )
}

#' @rdname uhc-benchmarking
benchmarking_dtp3 <- function(df,
                              ...) {

  params <- get_dots_and_call_parameters(...)

  exec_scenario(df,
                benchmarking_anc4,
                params)
}


#' @rdname uhc-benchmarking
benchmarking_fh <- function(df,
                            ...) {

  params <- get_dots_and_call_parameters(...)

  exec_scenario(df,
                benchmarking_anc4,
                params)
}

#' @rdname uhc-benchmarking
benchmarking_fp <- function(df,
                            ...) {
  params <- get_dots_and_call_parameters(...)

  exec_scenario(df,
                benchmarking_anc4,
                params)
}

#' @describeIn uhc-benchmarking Force `start_year` to 2018
benchmarking_fpg <- function(df,
                             start_year = 2018,
                             ...) {

  params <- get_dots_and_call_parameters(...)

  exec_scenario(df,
                benchmarking_anc4,
                params)

}

#' @rdname uhc-benchmarking
benchmarking_itn <- function(df,
                             ...) {

  params <- get_dots_and_call_parameters(...)

  exec_scenario(df,
                benchmarking_anc4,
                params)
}


#' @rdname uhc-benchmarking
benchmarking_pneumo <- function(df,
                                ...) {
  params <- get_dots_and_call_parameters(...)

  exec_scenario(df,
                benchmarking_anc4,
                params)
}

#' @rdname uhc-benchmarking
benchmarking_tb <- function(df,
                            ...) {
  params <- get_dots_and_call_parameters(...)

  exec_scenario(df,
                benchmarking_anc4,
                params)
}

#' @rdname uhc-benchmarking
benchmarking_uhc_sanitation <- function(df,
                                        ...) {

  params <- get_dots_and_call_parameters(...)

  exec_scenario(df,
                benchmarking_anc4,
                params)
}

#' @rdname uhc-benchmarking
benchmarking_uhc_tobacco <- function(df,
                                     ...) {

  params <- get_dots_and_call_parameters(...)

  exec_scenario(df,
                benchmarking_anc4,
                params)
}

#' @rdname uhc-benchmarking
benchmarking_espar <- function(df,
                               ...) {

  params <- get_dots_and_call_parameters(...)

  exec_scenario(df,
                benchmarking_anc4,
                params)
}