Add peers to trend plot

R/fct_plots.R

@@ -18,12 +18,26 @@ plot_rates_trend <- function(
 ) {
   rates_trend_data |>
     ggplot2::ggplot(
-      ggplot2::aes(as.factor(.data[["fyear"]]), .data[["rate"]], group = 1)
+      ggplot2::aes(
+        x = as.factor(.data[["fyear"]]),
+        y = .data[["rate"]],
+        group = .data[["provider"]]
+      )
+    ) +
+    ggplot2::geom_line(
+      data = \(.x) dplyr::filter(.x, !is.na(.data[["is_peer"]])),
+      ggplot2::aes(
+        colour = .data[["is_peer"]],
+        alpha = .data[["is_peer"]]
+      )
     ) +
-    ggplot2::geom_line() +
-    ggplot2::geom_point(
-      data = \(.x) dplyr::filter(.x, .data[["fyear"]] == selected_year),
-      colour = "red"
+    ggplot2::scale_colour_manual(
+      values = c("TRUE" = "black", "FALSE" = "red"),
+      na.value = "black"
+    ) +
+    ggplot2::scale_alpha_manual(
+      values = c("TRUE" = 0.4, "FALSE" = 1),
+      na.value = 0.1
     ) +
     ggplot2::scale_y_continuous(name = y_axis_title, labels = y_labels) +
     ggplot2::coord_cartesian(ylim = y_axis_limits) +
@@ -57,56 +71,56 @@ plot_rates_funnel <- function(
   cl3_line_type <- "dashed"
   cl3_colour <- "black"
 
-  plot_x_range <- c(0, max(rates_funnel_data$denominator) * 1.05)
+  plot_x_range <- c(0, max(rates_funnel_data[["denominator"]]) * 1.05)
   function_x_range <- plot_x_range * 1.2
 
   rates_funnel_data |>
-    ggplot2::ggplot(ggplot2::aes(.data$denominator, .data$rate)) +
+    ggplot2::ggplot(ggplot2::aes(.data[["denominator"]], .data[["rate"]])) +
     ggplot2::geom_hline(
-      yintercept = funnel_calculations$cl,
+      yintercept = funnel_calculations[["cl"]],
       colour = cl_colour,
       linetype = cl_line_type
     ) +
     ggplot2::geom_function(
-      fun = funnel_calculations$lcl2,
+      fun = funnel_calculations[["lcl2"]],
       colour = cl2_colour,
       linetype = cl2_line_type,
       xlim = function_x_range
     ) +
     ggplot2::geom_function(
-      fun = funnel_calculations$ucl2,
+      fun = funnel_calculations[["ucl2"]],
       colour = cl2_colour,
       linetype = cl2_line_type,
       xlim = function_x_range
     ) +
     ggplot2::geom_function(
-      fun = funnel_calculations$lcl3,
+      fun = funnel_calculations[["lcl3"]],
       colour = cl3_colour,
       linetype = cl3_line_type,
       xlim = function_x_range
     ) +
     ggplot2::geom_function(
-      fun = funnel_calculations$ucl3,
+      fun = funnel_calculations[["ucl3"]],
       colour = cl3_colour,
       linetype = cl3_line_type,
       xlim = function_x_range
     ) +
     ggplot2::geom_point(ggplot2::aes(
-      colour = .data$is_peer,
-      alpha = .data$is_peer
+      colour = .data[["is_peer"]],
+      alpha = .data[["is_peer"]]
     )) +
     ggrepel::geom_text_repel(
-      data = dplyr::filter(rates_funnel_data, !is.na(.data$is_peer)),
-      ggplot2::aes(label = .data$provider, colour = .data$is_peer),
+      data = dplyr::filter(rates_funnel_data, !is.na(.data[["is_peer"]])),
+      ggplot2::aes(label = .data[["provider"]], colour = .data[["is_peer"]]),
       max.overlaps = Inf # include all labels
     ) +
     ggplot2::scale_colour_manual(
       values = c("TRUE" = "black", "FALSE" = "red"),
       na.value = "black"
     ) +
     ggplot2::scale_alpha_manual(
-      values = c("TRUE" = 1, "FALSE" = 1),
-      na.value = 0.2
+      values = c("TRUE" = 0.4, "FALSE" = 1),
+      na.value = 0.1
     ) +
     ggplot2::theme(legend.position = "none") +
     ggplot2::scale_x_continuous(labels = scales::comma_format()) +
@@ -124,23 +138,23 @@ plot_rates_funnel <- function(
 #' @export
 plot_rates_box <- function(rates_box_data, y_axis_limits) {
   rates_box_data |>
-    ggplot2::ggplot(ggplot2::aes(x = "", y = .data$rate)) +
+    ggplot2::ggplot(ggplot2::aes(x = "", y = .data[["rate"]])) +
     ggplot2::geom_boxplot(alpha = 0.2, outlier.shape = NA) +
     ggbeeswarm::geom_quasirandom(
       # just show peers/selected provider
-      data = \(.x) dplyr::filter(.x, !is.na(.data$is_peer)),
+      data = \(.x) dplyr::filter(.x, !is.na(.data[["is_peer"]])),
       ggplot2::aes(
-        colour = .data$is_peer,
-        alpha = .data$is_peer
+        colour = .data[["is_peer"]],
+        alpha = .data[["is_peer"]]
       )
     ) +
     ggplot2::scale_colour_manual(
       values = c("TRUE" = "black", "FALSE" = "red"),
       na.value = "black"
     ) +
     ggplot2::scale_alpha_manual(
-      values = c("TRUE" = 1, "FALSE" = 1),
-      na.value = 0.2
+      values = c("TRUE" = 0.4, "FALSE" = 1),
+      na.value = 0.1
     ) +
     ggplot2::coord_cartesian(ylim = y_axis_limits) +
     ggplot2::labs(x = "") +

R/mod_plot_rates.R

@@ -54,24 +54,17 @@ mod_plot_rates_server <- function(
 
     rates_trend_data <- shiny::reactive({
       df <- shiny::req(rates_data())
+      peers_lookup <- shiny::req(peers_lookup())
       provider <- shiny::req(selected_provider())
+      strategy <- shiny::req(selected_strategy())
 
-      get_rates_trend_data(df, provider)
+      generate_rates_baseline_data(df, provider, peers_lookup)
     })
 
     rates_baseline_data <- shiny::reactive({
-      df <- shiny::req(rates_data())
-      peers_lookup <- shiny::req(peers_lookup())
-      provider <- shiny::req(selected_provider())
-      strategy <- shiny::req(selected_strategy())
-      year <- shiny::req(selected_year())
-
-      generate_rates_baseline_data(
-        df,
-        provider,
-        peers_lookup,
-        year
-      )
+      df <- shiny::req(rates_trend_data())
+      year <- year <- shiny::req(selected_year())
+      df |> dplyr::filter(.data[["fyear"]] == .env[["year"]])
     })
 
     rates_funnel_calculations <- shiny::reactive({

R/utils_plot.R

@@ -15,19 +15,16 @@ isolate_provider_peers <- function(provider, peers) {
 #' @param rates A data.frame. Rates data read from Azure.
 #' @param provider Character. Provider code, e.g. `"RCF"`.
 #' @param peers_lookup Dataframe. A lookup from a provider to its peers.
-#' @param selected_year Integer. Baseline year in the form `202324`.
 #' @return A data.frame.
 #' @export
 generate_rates_baseline_data <- function(
   rates,
   provider,
-  peers_lookup,
-  selected_year
+  peers_lookup
 ) {
   peers <- isolate_provider_peers(provider, peers_lookup)
 
   rates |>
-    dplyr::filter(.data$fyear == .env$selected_year) |>
     dplyr::mutate(
       is_peer = dplyr::case_when(
         .data$provider == .env$provider ~ FALSE,

inst/app/text/viz-tooltip-box.md

@@ -1,4 +1,4 @@
-Distribution of rates for all units, highlighting the selected unit (red) and peers (black).
+Distribution of rates for all units, highlighting the selected unit (red) and peers.
 The box identifies the limits of the central half of the data.
 The line inside is the median value.
 Points outside of the vertical lines are considered outliers.

inst/app/text/viz-tooltip-funnel.md

@@ -1,4 +1,4 @@
-Baseline activity for the selected unit (red) compared to peers (black) and all others (grey).
+Baseline activity for all units, highlighting the selected unit (red) and peers (dark grey).
 The horizontal dashed line is the mean of all units.
 The inner dashed funnel is two standard deviations from the mean, the outer is three.
 Points outside of the outer funnel are considered outliers.

inst/app/text/viz-tooltip-trend.md

@@ -1,3 +1,2 @@
-How activity has changed over time for the selected TPMA.
+How activity for the selected TPMA has changed over time for the chosen unit (red) and peers.
 Years of availability will depend on the selected unit and TPMA.
-The baseline year is highlighted as a red point.