diff --git a/DESCRIPTION b/DESCRIPTION
index a88dbc22..ed7f0bfd 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -24,6 +24,7 @@ Imports:
cachem,
config (>= 0.3.1),
dplyr,
+ DT,
forcats,
future,
ggbeeswarm,
diff --git a/R/app_server.R b/R/app_server.R
index 4b2c915c..d68b4aef 100644
--- a/R/app_server.R
+++ b/R/app_server.R
@@ -148,6 +148,20 @@ app_server <- function(input, output, session) {
mod_health_status_adjustment_server("health_status_adjustment", params)
+ observe({
+ can_set_inequalities <- any(
+ c("nhp_devs", "nhp_power_users", "nhp_test_inequalities") %in%
+ session$groups
+ )
+
+ shinyjs::toggle(
+ "inequalities_tab",
+ condition = (is_local() || can_set_inequalities)
+ )
+ })
+
+ mod_inequalities_server("inequalities", params)
+
mod_waiting_list_imbalances_server(
"waiting_list_imbalances",
wli_data(),
diff --git a/R/app_ui.R b/R/app_ui.R
index bfdab6af..c68d1860 100644
--- a/R/app_ui.R
+++ b/R/app_ui.R
@@ -63,7 +63,17 @@ app_ui <- function(request) {
"Health Status Adjustment",
tabName = "tab_health_status_adjustment"
),
- #
+ shiny::tags$hr(),
+ shinyjs::hidden(
+ shiny::div(
+ id = "inequalities_tab",
+ bs4Dash::sidebarHeader("Inequalities"),
+ bs4Dash::menuItem(
+ "Inequalities",
+ tabName = "tab_inequalities"
+ )
+ )
+ ),
shiny::tags$hr(),
bs4Dash::sidebarHeader("Demand-supply Imbalances"),
bs4Dash::menuItem(
@@ -183,6 +193,10 @@ app_ui <- function(request) {
tabName = "tab_health_status_adjustment",
mod_health_status_adjustment_ui("health_status_adjustment")
),
+ bs4Dash::tabItem(
+ tabName = "tab_inequalities",
+ mod_inequalities_ui("inequalities")
+ ),
bs4Dash::tabItem(
tabName = "tab_nda",
mod_non_demographic_adjustment_ui("non_demographic_adjustment")
diff --git a/R/fct_azure_storage.R b/R/fct_azure_storage.R
index 385c424d..f93bc2ba 100644
--- a/R/fct_azure_storage.R
+++ b/R/fct_azure_storage.R
@@ -1,6 +1,21 @@
+#' Get inequalities data
+#'
+#' Read the parquet file for inequalities
+#' @return A tibble.
+load_inequalities_data <- function() {
+ fs <- get_adls_fs()
+ fs |>
+ AzureStor::download_adls_file(
+ glue::glue("dev/inequalities.parquet"),
+ dest = NULL
+ ) |>
+ arrow::read_parquet() |>
+ tibble::as_tibble()
+}
+
#' Get Provider Data
#'
-#' Read the parquet file containing a selected tupe of provider data.
+#' Read the parquet file containing a selected type of provider data.
#'
#' @param file The name of the file to read.
#' @param inputs_data_version The version of the inputs data to use.
diff --git a/R/mod_inequalities_server.R b/R/mod_inequalities_server.R
new file mode 100644
index 00000000..c6afa736
--- /dev/null
+++ b/R/mod_inequalities_server.R
@@ -0,0 +1,136 @@
+#' inequalities Server Functions
+#'
+#' @noRd
+mod_inequalities_server <- function(id, params) {
+ shiny::moduleServer(id, function(input, output, session) {
+ ns <- session$ns
+
+ mod_reasons_server(shiny::NS(id, "reasons"), params, "inequalities")
+
+ # This is the data for each HRG split by IMD for the selector provider
+ # load_inequalities_data() is pulling from Azure so might take some time
+ provider_inequalities <- shiny::reactive({
+ dataset <- shiny::req(params$dataset) # nolint: object_usage_linter
+
+ load_inequalities_data() |>
+ dplyr::filter(
+ .data[["provider"]] == .env[["dataset"]]
+ )
+ })
+
+ # hrg is used to track the current choice selections in table form
+ hrg <- shiny::reactiveValues(
+ selections = NULL
+ )
+
+ # Initialisation
+ init <- shiny::observe(
+ {
+ # Wait for data to be available
+ shiny::req(provider_inequalities())
+
+ hrg$selections <- initialise_hrg_table(provider_inequalities(), params)
+
+ # Destroy the observer so it only runs once
+ init$destroy()
+ },
+ priority = -1 # Low priority to ensure other reactives are ready
+ )
+
+ # "Set all to zero sum" button
+ shiny::observeEvent(input$set_all_zero_sum, {
+ shiny::req(hrg$selections)
+ hrg$selections$choice <- "Zero-sum"
+ })
+
+ # "Clear all" button
+ shiny::observeEvent(input$clear_all, {
+ shiny::req(hrg$selections)
+ hrg$selections$choice <- "No change"
+ })
+
+ output$hrg_table <- DT::renderDataTable({
+ shiny::req(hrg$selections)
+
+ choice_options <- unname(get_inequality_choice_mappings())
+
+ # Create the dropdown HTML for each row
+ dropdown_html <- purrr::map_chr(
+ seq_len(nrow(hrg$selections)),
+ function(i) {
+ current_choice <- hrg$selections$choice[i]
+ options_html <- glue::glue_collapse(
+ purrr::map_chr(choice_options, function(option) {
+ selected <- if (option == current_choice) "selected" else ""
+ glue::glue(
+ ""
+ )
+ })
+ )
+ glue::glue(
+ ""
+ )
+ }
+ )
+
+ display_data <- hrg$selections
+ display_data$choice <- dropdown_html
+
+ DT::datatable(
+ display_data,
+ escape = FALSE,
+ rownames = FALSE,
+ selection = "none",
+ filter = "top",
+ options = list(
+ pageLength = 25,
+ searching = FALSE,
+ ordering = TRUE,
+ info = TRUE
+ ),
+ callback = DT::JS(glue::glue(
+ "
+ table.on('change', '.choice-select', function() {{
+ var row = $(this).data('row');
+ var value = $(this).val();
+ Shiny.setInputValue('{ns('choice_changed')}', {{row: row, value: value}}, {{priority: 'event'}});
+ }});
+"
+ ))
+ )
+ })
+
+ # Handle dropdown changes
+ shiny::observeEvent(input$choice_changed, {
+ shiny::req(hrg$selections)
+
+ row_index <- input$choice_changed$row
+
+ # Update the data
+ hrg$selections$choice[row_index] <- input$choice_changed$value
+ })
+
+ # Download inequalities data
+ output$download_inequalities <- shiny::downloadHandler(
+ filename = \() glue::glue("{params[['dataset']]}_inequalities.csv"),
+ content = \(file) {
+ readr::write_csv(provider_inequalities(), file)
+ }
+ )
+
+ shiny::observe({
+ shiny::req(hrg$selections)
+
+ params$inequalities <-
+ hrg$selections |>
+ dplyr::filter(.data$choice != "No change") |>
+ dplyr::mutate(
+ choice = inequality_choices_to_snake(.data$choice)
+ ) |>
+ dplyr::group_by(.data$choice) |>
+ dplyr::summarise(hrg_codes = list(.data$hrg_code)) |>
+ tibble::deframe() |>
+ purrr::map(I) # Forces any single values to stay in a list (asis)
+ })
+ })
+}
diff --git a/R/mod_inequalities_ui.R b/R/mod_inequalities_ui.R
new file mode 100644
index 00000000..1561c384
--- /dev/null
+++ b/R/mod_inequalities_ui.R
@@ -0,0 +1,49 @@
+#' inequalities UI Function
+#'
+#' @description A shiny Module.
+#'
+#' @param id,input,output,session Internal parameters for {shiny}.
+#'
+#' @noRd
+#'
+#' @importFrom shiny NS tagList
+mod_inequalities_ui <- function(id) {
+ ns <- shiny::NS(id)
+ shiny::tagList(
+ shiny::tags$h1("Inequalities"),
+ shiny::fluidRow(
+ col_4(
+ bs4Dash::box(
+ collapsible = FALSE,
+ headerBorder = FALSE,
+ width = 12,
+ md_file_to_html("app", "text", "inequalities.md")
+ ),
+ mod_reasons_ui(ns("reasons"))
+ ),
+ col_8(
+ bs4Dash::box(
+ collapsible = FALSE,
+ headerBorder = FALSE,
+ width = 12,
+ shiny::div(
+ shiny::downloadButton(
+ ns("download_inequalities"),
+ "Download inequalities"
+ ),
+ shiny::actionButton(ns("set_all_zero_sum"), "Set all to zero sum"),
+ shiny::actionButton(
+ ns("clear_all"),
+ "Clear all",
+ class = "btn-secondary"
+ )
+ ),
+ shiny::br(),
+ shiny::div(
+ DT::dataTableOutput(ns("hrg_table"), height = "calc(100vh - 200px)")
+ )
+ )
+ )
+ )
+ )
+}
diff --git a/R/mod_inequalities_utils.R b/R/mod_inequalities_utils.R
new file mode 100644
index 00000000..30e0f8ad
--- /dev/null
+++ b/R/mod_inequalities_utils.R
@@ -0,0 +1,86 @@
+#' Initialise inequality choice table
+#'
+#' Creates a tibble containing unique HRG codes for selected provider and
+#' a "choice" column indicating the type of adjustment to apply.
+#' Set to "No change" by default
+#'
+#' If editing an existing scenario, previous parameters will be loaded.
+#'
+#' @param provider_inequalities A data frame containing provider inequality data.
+#' @param params The standard params object
+#'
+#' @return A tibble with two columns:
+#' \item{hrg_code}{Character vector of unique HRG codes from the input data}
+#' \item{choice}{Character vector indicating the inequality adjustment choice
+#' for each HRG code.}
+#' Possible values are defined in get_inequality_choice_mappings()
+#'
+
+initialise_hrg_table <- function(provider_inequalities, params) {
+ # Get unique HRG codes from the data
+ unique_hrg_codes <- unique(provider_inequalities$sushrg_trimmed)
+
+ hrg_table <- tibble::tibble(
+ hrg_code = unique_hrg_codes,
+ choice = "No change"
+ )
+
+ # Check if params$inequalities has existing data
+ if (!is.null(params$inequalities) && length(params$inequalities) > 0) {
+ # Update choices based on existing params$inequalities
+ for (choice_type in names(params$inequalities)) {
+ display_choice <- inequality_choices_to_display(choice_type)
+
+ # Get the HRG codes for this choice type
+ hrg_codes_for_choice <- params$inequalities[[choice_type]]
+
+ # Update the selections for matching HRG codes
+ hrg_table$choice[
+ hrg_table$hrg_code %in% hrg_codes_for_choice
+ ] <- display_choice
+ }
+ }
+
+ hrg_table
+}
+
+#' Get Inequality Choice Mappings
+#
+#' Returns the mapping between programmatic snake_case and display
+#' names for inequality adjustment choices.
+#'
+#' @return Named character vector where names are snake_case identifiers and
+#' values are display names.
+get_inequality_choice_mappings <- function() {
+ c(
+ no_change = "No change",
+ zero_sum = "Zero-sum",
+ level_up = "Level up",
+ level_down = "Level down"
+ )
+}
+
+#' Convert inequality choices to snake case
+#'
+#' @param display_choice Character vector of display names e.g., Zero-sum"
+#'
+#' @return Character vector of snake_case names. Returns \code{NA} for
+#' unrecognized values.
+
+inequality_choices_to_snake <- function(display_choice) {
+ mappings <- get_inequality_choice_mappings()
+ names(mappings)[match(display_choice, mappings)]
+}
+
+#' Convert inequality choices to display case
+#'
+#' @param snake_choice Character vector of snake_case names e.g., 'zero_sum'
+#'
+#' @return Character vector of display names. Returns \code{NA} for
+#' unrecognized values.
+#'
+#'
+inequality_choices_to_display <- function(snake_choice) {
+ mappings <- get_inequality_choice_mappings()
+ unname(mappings[snake_choice])
+}
diff --git a/man/get_inequality_choice_mappings.Rd b/man/get_inequality_choice_mappings.Rd
new file mode 100644
index 00000000..1586e135
--- /dev/null
+++ b/man/get_inequality_choice_mappings.Rd
@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/mod_inequalities_utils.R
+\name{get_inequality_choice_mappings}
+\alias{get_inequality_choice_mappings}
+\title{Get Inequality Choice Mappings
+Returns the mapping between programmatic snake_case and display
+names for inequality adjustment choices.}
+\usage{
+get_inequality_choice_mappings()
+}
+\value{
+Named character vector where names are snake_case identifiers and
+ values are display names.
+}
+\description{
+Get Inequality Choice Mappings
+Returns the mapping between programmatic snake_case and display
+names for inequality adjustment choices.
+}
diff --git a/man/inequality_choices_to_display.Rd b/man/inequality_choices_to_display.Rd
new file mode 100644
index 00000000..1f3bb68a
--- /dev/null
+++ b/man/inequality_choices_to_display.Rd
@@ -0,0 +1,18 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/mod_inequalities_utils.R
+\name{inequality_choices_to_display}
+\alias{inequality_choices_to_display}
+\title{Convert inequality choices to display case}
+\usage{
+inequality_choices_to_display(snake_choice)
+}
+\arguments{
+\item{snake_choice}{Character vector of snake_case names e.g., 'zero_sum'}
+}
+\value{
+Character vector of display names. Returns \code{NA} for
+ unrecognized values.
+}
+\description{
+Convert inequality choices to display case
+}
diff --git a/man/inequality_choices_to_snake.Rd b/man/inequality_choices_to_snake.Rd
new file mode 100644
index 00000000..d8c0e088
--- /dev/null
+++ b/man/inequality_choices_to_snake.Rd
@@ -0,0 +1,18 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/mod_inequalities_utils.R
+\name{inequality_choices_to_snake}
+\alias{inequality_choices_to_snake}
+\title{Convert inequality choices to snake case}
+\usage{
+inequality_choices_to_snake(display_choice)
+}
+\arguments{
+\item{display_choice}{Character vector of display names e.g., Zero-sum"}
+}
+\value{
+Character vector of snake_case names. Returns \code{NA} for
+ unrecognized values.
+}
+\description{
+Convert inequality choices to snake case
+}
diff --git a/man/initialise_hrg_table.Rd b/man/initialise_hrg_table.Rd
new file mode 100644
index 00000000..4e1e2ff6
--- /dev/null
+++ b/man/initialise_hrg_table.Rd
@@ -0,0 +1,28 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/mod_inequalities_utils.R
+\name{initialise_hrg_table}
+\alias{initialise_hrg_table}
+\title{Initialise inequality choice table}
+\usage{
+initialise_hrg_table(provider_inequalities, params)
+}
+\arguments{
+\item{provider_inequalities}{A data frame containing provider inequality data.}
+
+\item{params}{The standard params object}
+}
+\value{
+A tibble with two columns:
+ \item{hrg_code}{Character vector of unique HRG codes from the input data}
+ \item{choice}{Character vector indicating the inequality adjustment choice
+ for each HRG code.}
+ Possible values are defined in get_inequality_choice_mappings()
+}
+\description{
+Creates a tibble containing unique HRG codes for selected provider and
+a "choice" column indicating the type of adjustment to apply.
+Set to "No change" by default
+}
+\details{
+If editing an existing scenario, previous parameters will be loaded.
+}
diff --git a/man/load_inequalities_data.Rd b/man/load_inequalities_data.Rd
new file mode 100644
index 00000000..48b41151
--- /dev/null
+++ b/man/load_inequalities_data.Rd
@@ -0,0 +1,14 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/fct_azure_storage.R
+\name{load_inequalities_data}
+\alias{load_inequalities_data}
+\title{Get inequalities data}
+\usage{
+load_inequalities_data()
+}
+\value{
+A tibble.
+}
+\description{
+Read the parquet file for inequalities
+}
diff --git a/man/load_provider_data.Rd b/man/load_provider_data.Rd
index 3b2fc684..6f071993 100644
--- a/man/load_provider_data.Rd
+++ b/man/load_provider_data.Rd
@@ -18,5 +18,5 @@ load_provider_data(
A tibble.
}
\description{
-Read the parquet file containing a selected tupe of provider data.
+Read the parquet file containing a selected type of provider data.
}