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..cefa63d 100644 --- a/R/mod_plot_rates.R +++ b/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({ diff --git a/R/utils_plot.R b/R/utils_plot.R index cf4b441..14ad9e7 100644 --- a/R/utils_plot.R +++ b/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, 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..b75dbf2 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 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.