Add plot module for rates-plot submodules

NAMESPACE

@@ -9,5 +9,6 @@ export(plot_rates_box)
 export(plot_rates_funnel)
 export(plot_rates_trend)
 export(run_app)
+export(theme_rates)
 importFrom(rlang,.data)
 importFrom(rlang,.env)

R/app_server.R

@@ -40,21 +40,8 @@ app_server <- function(input, output, session) {
     descriptions_lookup,
     selected_strategy
   )
-  mod_plot_rates_trend_server(
-    "mod_plot_rates_trend",
-    rates_data,
-    selected_provider,
-    selected_strategy
-  )
-  mod_plot_rates_funnel_server(
-    "mod_plot_rates_funnel",
-    rates_data,
-    peers_lookup,
-    selected_provider,
-    selected_strategy
-  )
-  mod_plot_rates_box_server(
-    "mod_plot_rates_box",
+  mod_plot_rates_server(
+    "mod_plot_rates",
     rates_data,
     peers_lookup,
     selected_provider,

R/app_ui.R

@@ -22,27 +22,9 @@ app_ui <- function(request) {
     ),
 
     bslib::layout_columns(
-      bslib::card(
-        bslib::card_header("Description"),
-        bslib::card_body(mod_show_strategy_text_ui(
-          "mod_show_strategy_text"
-        ))
-      ),
-      bslib::card(
-        bslib::card_header("Rates Trend"),
-        bslib::card_body(mod_plot_rates_trend_ui("mod_plot_rates_trend")),
-        full_screen = TRUE
-      ),
-      bslib::card(
-        bslib::card_header("Rates Funnel"),
-        bslib::card_body(mod_plot_rates_funnel_ui("mod_plot_rates_funnel")),
-        full_screen = TRUE
-      ),
-      bslib::card(
-        bslib::card_header("Rates Box"),
-        bslib::card_body(mod_plot_rates_box_ui("mod_plot_rates_box")),
-        full_screen = TRUE
-      )
+      col_widths = c(3, 9),
+      mod_show_strategy_text_ui("mod_show_strategy_text"),
+      mod_plot_rates_ui("mod_plot_rates")
     )
   )
 }

R/fct_plot_rates.R

@@ -2,34 +2,45 @@
 #' @param rates_df A data.frame. Must contain columns given by `fyear_col` and
 #'     `rate_col`. Pre-filtered for a given provider and strategy. One row per
 #'     financial year.
-#' @param fyear_col Character. Name of the column in `rates_df` containing the
-#'     financial year in the form `"2023/24"`.
-#' @param rate_col Character. Name of the column in `rates_df` containing the
-#'     rate value (the type of which is dependent on the strategy).
-#' @return A ggplot2 object.
+#' @param baseline_year Numeric. In the form `202324`.
+#' @param x_axis_title Character.
+#' @param y_axis_title Character.
+#' @param y_axis_limits Numeric vector. Min and max values for the y axis.
+#' @return A 'ggplot2' object.
 #' @export
-plot_rates_trend <- function(rates_df, fyear_col = "fyear", rate_col = "rate") {
+plot_rates_trend <- function(
+  rates_df,
+  baseline_year = 202324,
+  x_axis_title = "Financial year",
+  y_axis_title = "Rate",
+  y_axis_limits
+) {
   rates_df |>
     ggplot2::ggplot(
-      ggplot2::aes(
-        x = .data[[fyear_col]],
-        y = .data[[rate_col]]
-      )
+      ggplot2::aes(as.factor(.data[["fyear"]]), .data[["rate"]], group = 1)
     ) +
     ggplot2::geom_line() +
-    ggplot2::labs(
-      x = "Financial year",
-      y = "Rate"
-    )
+    ggplot2::geom_point(
+      data = \(.x) dplyr::filter(.x, .data[["fyear"]] == baseline_year),
+      colour = "red"
+    ) +
+    # TODO: add labels = number_format to scale_y_continuous
+    ggplot2::scale_y_continuous(name = y_axis_title) +
+    ggplot2::coord_cartesian(ylim = y_axis_limits) +
+    ggplot2::scale_x_discrete(
+      labels = \(.x) stringr::str_replace(.x, "^(\\d{4})(\\d{2})$", "\\1/\\2")
+    ) +
+    ggplot2::labs(x = x_axis_title) +
+    theme_rates()
 }
 
 #' Plot Rates Funnel with Peers
 #' @param rates_funnel_data A data.frame.
-#' @param plot_range Character. A vector of length two giving the y-axis limits.
+#' @param y_axis_limits Numeric vector. Min and max values for the y axis.
 #' @param x_axis_title Character.
-#' @return A ggplot2 object.
+#' @return A 'ggplot2' object.
 #' @export
-plot_rates_funnel <- function(rates_funnel_data, plot_range, x_axis_title) {
+plot_rates_funnel <- function(rates_funnel_data, y_axis_limits, x_axis_title) {
   lines_data <- rates_funnel_data |>
     dplyr::select(
       "denominator",
@@ -58,24 +69,17 @@ plot_rates_funnel <- function(rates_funnel_data, plot_range, x_axis_title) {
     ) +
     ggplot2::theme(legend.position = "none") +
     ggplot2::scale_x_continuous(labels = scales::comma_format()) +
-    ggplot2::coord_cartesian(ylim = plot_range) +
+    ggplot2::coord_cartesian(ylim = y_axis_limits) +
     ggplot2::labs(x = x_axis_title) +
-    ggplot2::theme(
-      axis.ticks.y = ggplot2::element_blank(),
-      axis.text.y = ggplot2::element_blank(),
-      axis.title.y = ggplot2::element_blank(),
-      legend.position = "none",
-      panel.background = ggplot2::element_blank(),
-      panel.grid.major.y = ggplot2::element_line("#9d928a", linetype = "dotted")
-    )
+    theme_rates(has_y_axis = FALSE)
 }
 
 #' Plot Rates Boxplot with Peers
 #' @param trend_data A data.frame.
-#' @param plot_range Character. A vector of length two giving the y-axis limits.
-#' @return A ggplot2 object.
+#' @param y_axis_limits Numeric vector. Min and max values for the y axis.
+#' @return A 'ggplot2' object.
 #' @export
-plot_rates_box <- function(trend_data, plot_range) {
+plot_rates_box <- function(trend_data, y_axis_limits) {
   trend_data |>
     ggplot2::ggplot(ggplot2::aes(x = "", y = .data$rate)) +
     ggplot2::geom_boxplot(alpha = 0.2, outlier.shape = NA) +
@@ -84,15 +88,35 @@ plot_rates_box <- function(trend_data, plot_range) {
       values = c("TRUE" = "black", "FALSE" = "red"),
       na.value = "lightgrey"
     ) +
-    ggplot2::coord_cartesian(ylim = plot_range) +
+    ggplot2::coord_cartesian(ylim = y_axis_limits) +
     ggplot2::labs(x = "") +
-    ggplot2::theme(
-      axis.ticks.y = ggplot2::element_blank(),
-      axis.text.y = ggplot2::element_blank(),
-      axis.title.y = ggplot2::element_blank(),
-      legend.position = "none",
-      panel.background = ggplot2::element_blank(),
-      axis.ticks.x = ggplot2::element_blank(),
-      panel.grid.major.y = ggplot2::element_line("#9d928a", linetype = "dotted")
+    theme_rates(has_y_axis = FALSE)
+}
+
+#' A 'ggplot2' Theme for Rates Plots
+#' @param has_y_axis Logical. Should the y-axis, ticks and labels be shown?
+#'     Default `TRUE`.
+#' @return A 'ggplot2' theme.
+#' @export
+theme_rates <- function(has_y_axis = TRUE) {
+  theme <- ggplot2::theme(
+    legend.position = "none",
+    panel.background = ggplot2::element_blank(),
+    panel.grid.major.y = ggplot2::element_line(
+      "#9d928a",
+      linetype = "dotted"
     )
+  )
+
+  if (!has_y_axis) {
+    theme <- theme +
+      ggplot2::theme(
+        axis.ticks.x = ggplot2::element_blank(),
+        axis.ticks.y = ggplot2::element_blank(),
+        axis.text.y = ggplot2::element_blank(),
+        axis.title.y = ggplot2::element_blank()
+      )
+  }
+
+  theme
 }

R/mod_plot_rates.R

@@ -0,0 +1,104 @@
+#' Plot Rates UI
+#' @param id,input,output,session Internal parameters for `shiny`.
+#' @noRd
+mod_plot_rates_ui <- function(id) {
+  ns <- shiny::NS(id)
+  bslib::layout_columns(
+    col_widths = 4,
+    mod_plot_rates_trend_ui(ns("mod_plot_rates_trend")),
+    mod_plot_rates_funnel_ui(ns("mod_plot_rates_funnel")),
+    mod_plot_rates_box_ui(ns("mod_plot_rates_box"))
+  )
+}
+
+#' Plot Rates Server
+#' @param id Internal parameter for `shiny`.
+#' @param rates A data.frame. Annual rate values for combinations of provider
+#'     and TPMA.
+#' @param peers_lookup A data.frame. A row per provider-peer pair.
+#' @param selected_provider Character. Provider code, e.g. `"RCX"`.
+#' @param selected_strategy Character. TPMA variable name, e.g.
+#'     `"alcohol_partially_attributable_acute"`.
+#' @noRd
+mod_plot_rates_server <- function(
+  id,
+  rates,
+  peers_lookup,
+  selected_provider,
+  selected_strategy
+) {
+  shiny::moduleServer(id, function(input, output, session) {
+    rates_trend_data <- shiny::reactive({
+      shiny::req(rates)
+      shiny::req(selected_provider())
+      shiny::req(selected_strategy())
+
+      rates |>
+        dplyr::filter(
+          .data$provider == selected_provider(),
+          .data$strategy == selected_strategy()
+        ) |>
+        dplyr::arrange(.data$fyear)
+    })
+
+    rates_baseline_data <- shiny::reactive({
+      shiny::req(rates)
+      shiny::req(peers_lookup)
+      shiny::req(selected_provider())
+      shiny::req(selected_strategy())
+
+      provider_peers <- isolate_provider_peers(
+        selected_provider(),
+        peers_lookup
+      )
+      rates |>
+        generate_rates_baseline_data(
+          selected_provider(),
+          provider_peers,
+          selected_strategy(),
+          start_year = "202324"
+        )
+    })
+
+    rates_funnel_data <- shiny::reactive({
+      shiny::req(rates_baseline_data())
+      rates_baseline_data() |> generate_rates_funnel_data()
+    })
+
+    y_axis_limits <- shiny::reactive({
+      shiny::req(rates_trend_data())
+      shiny::req(rates_funnel_data())
+      range(c(
+        rates_trend_data()[["rate"]],
+        rates_funnel_data()[["rate"]],
+        rates_funnel_data()[["lower3"]],
+        rates_funnel_data()[["upper3"]]
+      )) |>
+        pmax(0)
+    })
+
+    mod_plot_rates_trend_server(
+      "mod_plot_rates_trend",
+      rates_trend_data,
+      selected_provider,
+      selected_strategy,
+      y_axis_limits
+    )
+    mod_plot_rates_funnel_server(
+      "mod_plot_rates_funnel",
+      rates_funnel_data,
+      peers_lookup,
+      selected_provider,
+      selected_strategy,
+      y_axis_limits
+    )
+    mod_plot_rates_box_server(
+      "mod_plot_rates_box",
+      rates_baseline_data,
+      peers_lookup,
+      selected_provider,
+      selected_strategy,
+      y_axis_limits
+    )
+  })
+}

R/mod_plot_rates_box.R

@@ -3,7 +3,11 @@
 #' @noRd
 mod_plot_rates_box_ui <- function(id) {
   ns <- shiny::NS(id)
-  shiny::plotOutput(ns("rates_box_plot"))
+  bslib::card(
+    bslib::card_header("Rates Box"),
+    bslib::card_body(shiny::plotOutput(ns("rates_box_plot"))),
+    full_screen = TRUE
+  )
 }
 
 #' Plot Rates Box Server
@@ -14,42 +18,24 @@ mod_plot_rates_box_ui <- function(id) {
 #' @param selected_provider Character. Provider code, e.g. `"RCX"`.
 #' @param selected_strategy Character. TPMA variable name, e.g.
 #'     `"alcohol_partially_attributable_acute"`.
-#' @noRd
+#' @param y_axis_limits Numeric vector. Min and max values for the y axis.
 #' @noRd
 mod_plot_rates_box_server <- function(
   id,
   rates,
   peers_lookup,
   selected_provider,
-  selected_strategy
+  selected_strategy,
+  y_axis_limits
 ) {
   shiny::moduleServer(id, function(input, output, session) {
-    rates_prepared <- shiny::reactive({
-      shiny::req(rates)
-      shiny::req(peers_lookup)
-      shiny::req(selected_provider())
-      shiny::req(selected_strategy())
-
-      provider_peers <- isolate_provider_peers(
-        selected_provider(),
-        peers_lookup
-      )
-      rates |>
-        generate_rates_baseline_data(
-          selected_provider(),
-          provider_peers,
-          selected_strategy(),
-          start_year = "202324"
-        )
-    })
-
     output$rates_box_plot <- shiny::renderPlot({
-      rates <- rates_prepared()
+      rates <- rates()
       shiny::validate(shiny::need(
         nrow(rates) > 0,
         "No data available for these selections."
       ))
-      plot_rates_box(rates, plot_range = c(0, max(rates$rate)))
+      plot_rates_box(rates, y_axis_limits())
     })
   })
 }