From 82eb7ca35e9d52ccccd071ae151f6fdfea60618c Mon Sep 17 00:00:00 2001 From: Matt Dray <18232097+matt-dray@users.noreply.github.com> Date: Mon, 9 Feb 2026 16:52:21 +0000 Subject: [PATCH 1/4] Added peers to trend, tweaked colours/tooltips across plots --- R/fct_plots.R | 62 ++++++++++++++++++----------- R/mod_plot_rates.R | 19 +++++---- R/utils_plot.R | 6 +-- inst/app/text/viz-tooltip-box.md | 2 +- inst/app/text/viz-tooltip-funnel.md | 2 +- inst/app/text/viz-tooltip-trend.md | 3 +- 6 files changed, 52 insertions(+), 42 deletions(-) diff --git a/R/fct_plots.R b/R/fct_plots.R index 3b0ebcb..2ca8fa1 100644 --- a/R/fct_plots.R +++ b/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,47 +71,47 @@ 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( @@ -105,8 +119,8 @@ plot_rates_funnel <- function( 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,14 +138,14 @@ 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( @@ -139,8 +153,8 @@ plot_rates_box <- function(rates_box_data, y_axis_limits) { 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 = "") + diff --git a/R/mod_plot_rates.R b/R/mod_plot_rates.R index c3d9f7b..28b7f7c 100644 --- a/R/mod_plot_rates.R +++ b/R/mod_plot_rates.R @@ -53,27 +53,26 @@ mod_plot_rates_server <- function( }) rates_trend_data <- shiny::reactive({ - df <- shiny::req(rates_data()) - provider <- shiny::req(selected_provider()) - - get_rates_trend_data(df, provider) - }) - - 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()) + # year <- shiny::req(selected_year()) generate_rates_baseline_data( df, provider, - peers_lookup, - year + peers_lookup #, + # year ) }) + rates_baseline_data <- shiny::reactive({ + df <- shiny::req(rates_trend_data()) + year <- year <- shiny::req(selected_year()) + df |> dplyr::filter(.data[["fyear"]] == .env[["year"]]) + }) + rates_funnel_calculations <- shiny::reactive({ df <- shiny::req(rates_baseline_data()) diff --git a/R/utils_plot.R b/R/utils_plot.R index cf4b441..564dbfb 100644 --- a/R/utils_plot.R +++ b/R/utils_plot.R @@ -15,19 +15,17 @@ 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::filter(.data$fyear == .env$selected_year) |> dplyr::mutate( is_peer = dplyr::case_when( .data$provider == .env$provider ~ FALSE, diff --git a/inst/app/text/viz-tooltip-box.md b/inst/app/text/viz-tooltip-box.md index 8044a34..9349fe5 100644 --- a/inst/app/text/viz-tooltip-box.md +++ b/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. diff --git a/inst/app/text/viz-tooltip-funnel.md b/inst/app/text/viz-tooltip-funnel.md index 125410c..eb04837 100644 --- a/inst/app/text/viz-tooltip-funnel.md +++ b/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. diff --git a/inst/app/text/viz-tooltip-trend.md b/inst/app/text/viz-tooltip-trend.md index a5b4129..0548b48 100644 --- a/inst/app/text/viz-tooltip-trend.md +++ b/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 chosen unit (red) and peers have changed over time for the selected TPMA. Years of availability will depend on the selected unit and TPMA. -The baseline year is highlighted as a red point. From 79d0e97b91f7013670ecaa0f5ba921d4ebc2835f Mon Sep 17 00:00:00 2001 From: Matt Dray <18232097+matt-dray@users.noreply.github.com> Date: Mon, 9 Feb 2026 16:54:25 +0000 Subject: [PATCH 2/4] Tweak tooltip text for clarity --- inst/app/text/viz-tooltip-trend.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/inst/app/text/viz-tooltip-trend.md b/inst/app/text/viz-tooltip-trend.md index 0548b48..0163e75 100644 --- a/inst/app/text/viz-tooltip-trend.md +++ b/inst/app/text/viz-tooltip-trend.md @@ -1,2 +1,2 @@ -How activity for the chosen unit (red) and peers have changed over time for the selected TPMA. +How activity for the selected TPMA has changed pver tiem for the chosen unit (red) and peers. Years of availability will depend on the selected unit and TPMA. From 357d0852195f48478abec171a8e692a4e85f3c65 Mon Sep 17 00:00:00 2001 From: Matt Dray <18232097+matt-dray@users.noreply.github.com> Date: Mon, 9 Feb 2026 17:06:41 +0000 Subject: [PATCH 3/4] Remove vestigial commented sections --- R/mod_plot_rates.R | 8 +------- R/utils_plot.R | 1 - 2 files changed, 1 insertion(+), 8 deletions(-) diff --git a/R/mod_plot_rates.R b/R/mod_plot_rates.R index 28b7f7c..cefa63d 100644 --- a/R/mod_plot_rates.R +++ b/R/mod_plot_rates.R @@ -57,14 +57,8 @@ mod_plot_rates_server <- function( 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 - ) + generate_rates_baseline_data(df, provider, peers_lookup) }) rates_baseline_data <- shiny::reactive({ diff --git a/R/utils_plot.R b/R/utils_plot.R index 564dbfb..14ad9e7 100644 --- a/R/utils_plot.R +++ b/R/utils_plot.R @@ -25,7 +25,6 @@ generate_rates_baseline_data <- function( 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, From 692f26a6e9cd89ce98abeb6c7e985379d8be32e0 Mon Sep 17 00:00:00 2001 From: Matt Dray <18232097+matt-dray@users.noreply.github.com> Date: Tue, 10 Feb 2026 09:04:03 +0000 Subject: [PATCH 4/4] Correct typo --- inst/app/text/viz-tooltip-trend.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/inst/app/text/viz-tooltip-trend.md b/inst/app/text/viz-tooltip-trend.md index 0163e75..b75dbf2 100644 --- a/inst/app/text/viz-tooltip-trend.md +++ b/inst/app/text/viz-tooltip-trend.md @@ -1,2 +1,2 @@ -How activity for the selected TPMA has changed pver tiem for the chosen unit (red) and peers. +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.