R/funcs_charts-utils.R

In cath-parkinson/mm.reoptimise: Run and Compare Budget Optimisation in Different Scenarios

apply_filter <- function(var, selected){
      if (!is.null(selected)) var %in% selected else TRUE
}

remove_first_break <- function(x) {
      x <- scales::breaks_pretty()(x)
      x[1] <- NA
      x
}

mm_colors <- c("#4F24EE", # "Vibrant Blue"
               "#FF245B", # "Vibrant Red"
               "#FFCB16", # "Vibrant Yellow"
               "#7D26C9", # "Vibrant Purple"
               "#00DC7C", # "Vibrant Green"
               "#FB961F", # "Vibrant Orange"
               "#4DBAC1", # "Vibrant Teal"
               "#A6A6A6", # "Gray"
               # "#000000", # "Black"
               # "#FFFFFF", # "White"
               # "#CBF6FF", # "Pastel Blue"
               "#FFA6BC", # "Pastel Red"
               # "#FFEAA2", # "Pastel Yellow"
               "#CAA2EE", # "Pastel Purple"
               "#8AFFCD" # "Pastel Green"
               # "#FED6A5", # "Pastel Orange"
               # "#B7E3E6", # "Pastel Teal"
               # "#D9D9D9", # "Pastel Gray"
               # "#001D38"  # "Tinted Blue"
)

get_comparison_data <- function(all_scenarios_table, scenario1, scenario2,
                                kpi1, kpi1_unit, group_variable,
                                string_kpi1_s1, string_kpi1_s2, string_kpi1_diff,
                                string_perf_ind_s1, string_perf_ind_s2){

      data_scenario1 <- get_scenario_summary(all_scenarios_table,
                                             scenario1,
                                             kpi1,
                                             kpi1_unit,
                                             group_variable,
                                             "SPEND S1",
                                             string_kpi1_s1)

      data_scenario2 <- get_scenario_summary(all_scenarios_table,
                                             scenario2,
                                             kpi1,
                                             kpi1_unit,
                                             group_variable,
                                             "SPEND S2",
                                             string_kpi1_s2)

      comparison_spend <- data_scenario1$spend %>%
            dplyr::left_join(data_scenario2$spend, by = group_variable) %>%
            dplyr::mutate(`SPEND (S1 - S2)` = `SPEND S1` - `SPEND S2`)

      comparison_response <- data_scenario1$response %>%
            dplyr::left_join(data_scenario2$response, by = group_variable) %>%
            dplyr::mutate(!!string_kpi1_diff := !!rlang::sym(string_kpi1_s1) - !!rlang::sym(string_kpi1_s2))


      comparison_performance_indicator <- comparison_spend %>%
            dplyr::left_join(comparison_response)

      if (kpi1_unit == "percentage"){
            comparison_performance_indicator <- comparison_performance_indicator %>%
                  dplyr::mutate(!!string_perf_ind_s1 := `SPEND S1` / !!rlang::sym(string_kpi1_s1),
                                !!string_perf_ind_s2 := `SPEND S2` / !!rlang::sym(string_kpi1_s2))
      } else if (kpi1_unit == "volume") {
            comparison_performance_indicator <- comparison_performance_indicator %>%
                  dplyr::mutate(!!string_perf_ind_s1 := 1e6 * `SPEND S1` / !!rlang::sym(string_kpi1_s1),
                                !!string_perf_ind_s2 := 1e6 * `SPEND S2` / !!rlang::sym(string_kpi1_s2))
      } else {
            comparison_performance_indicator <- comparison_performance_indicator %>%
                  dplyr::mutate(!!string_perf_ind_s1 := !!rlang::sym(string_kpi1_s1) / `SPEND S1`,
                                !!string_perf_ind_s2 := !!rlang::sym(string_kpi1_s2) / `SPEND S2`)
      }

      comparison_performance_indicator <- comparison_performance_indicator %>%
            dplyr::select(1, !!rlang::sym(string_perf_ind_s1), !!rlang::sym(string_perf_ind_s2)) %>%
            tidyr::pivot_longer(cols = -1,
                                names_to = "metric",
                                values_to = "value") %>%
            dplyr::mutate(metric = factor(metric, levels = c(string_perf_ind_s1,
                                                             string_perf_ind_s2)))

      comparison_spend <- comparison_spend %>%
            tidyr::pivot_longer(cols = -1,
                                names_to = "metric",
                                values_to = "value") %>%
            dplyr::mutate(metric = factor(metric, levels = c("SPEND S1",
                                                             "SPEND S2",
                                                             "SPEND (S1 - S2)")))

      comparison_response <- comparison_response %>%
            tidyr::pivot_longer(cols = -1,
                                names_to = "metric",
                                values_to = "value") %>%
            dplyr::mutate(metric = factor(metric, levels = c(string_kpi1_s1,
                                                             string_kpi1_s2,
                                                             string_kpi1_diff)))

      return(list(spend = comparison_spend,
                  response = comparison_response,
                  performance_indicator = comparison_performance_indicator))

}

get_scenario_summary <- function(all_scenarios_table,
                                 scenario,
                                 kpi1,
                                 kpi1_unit,
                                 group_variable,
                                 colname_spend,
                                 colname_response){

      scenario_data <- all_scenarios_table %>%
            dplyr::filter(scenario_name == scenario,
                          kpi.level1_name == kpi1,
                          !is.na(optim_spend)) # remove rows with period_level1 not optimised over

      scenario_spend <- scenario_data %>%
            dplyr::group_by(.data[[group_variable]]) %>%
            dplyr::summarise(!!colname_spend := sum(optim_spend))

      if (kpi1_unit == "percentage"){
            if (group_variable == "period_level2.name"){
                  scenario_response <- scenario_data %>%
                        dplyr::group_by(.data[[group_variable]]) %>%
                        dplyr::summarise(!!colname_response := sum(response_at_optim))
            } else {
                  scenario_response <- scenario_data %>%
                        dplyr::group_by(.data[[group_variable]]) %>%
                        dplyr::summarise(!!colname_response := mean(response_at_optim))
            }
      } else {
            scenario_response <- scenario_data %>%
                  dplyr::group_by(.data[[group_variable]]) %>%
                  dplyr::summarise(!!colname_response := sum(response_at_optim))
      }

      return(list(data = scenario_data,
                  spend = scenario_spend,
                  response = scenario_response))
}

subchart_comparison_overview <- function(all_data, a_metric, group_variable,
                                         string_kpi1_s1,
                                         string_kpi1_s2,
                                         string_kpi1_diff,
                                         string_perf_ind_s1,
                                         string_perf_ind_s2,
                                         currency_symbol,
                                         kpi1_unit){

      ymax <- max(all_data[[a_metric]][["value"]], na.rm = TRUE)

      ggplot2::ggplot(
            data = all_data[[a_metric]],
            ggplot2::aes(

                  x = if(group_variable != "period_level2.name"){
                        if (a_metric != "performance_indicator"){
                              forcats::fct_reorder(
                                    .f = .data[[group_variable]],
                                    .x = all_data$spend$value,
                                    .fun = dplyr::first
                                    )
                        } else {
                              forcats::fct_reorder(
                                    .f = .data[[group_variable]],
                                    .x = all_data$spend %>%
                                          dplyr::filter(metric %in% c("SPEND S1", "SPEND S2")) %>%
                                          dplyr::pull(value),
                                    .fun = dplyr::first
                                    )
                        }
                  } else {
                        x = forcats::fct_rev(f = .data[[group_variable]])
                  },
                  y = value,
                  fill = metric,
                  text = if (a_metric == "spend"){
                        paste0(
                              .data[[group_variable]], "\n",
                              metric, ": ",
                              scales::number(value,
                                             accuracy = 1,
                                             prefix = currency_symbol,
                                             big.mark = ",")
                              )
                  } else if (a_metric == "performance_indicator"){
                        paste0(
                              .data[[group_variable]], "\n",
                              metric, ": ",
                              ifelse(value < 100,
                                     scales::number(value,
                                                    accuracy = 0.01,
                                                    prefix = currency_symbol,
                                                    big.mark = ","),
                                     scales::number(value,
                                                    accuracy = 1,
                                                    prefix = currency_symbol,
                                                    big.mark = ",")
                              )
                        )
                  } else if (a_metric == "response"){
                        if (kpi1_unit == "percentage"){
                              paste0(
                                    .data[[group_variable]], "\n",
                                    metric, ": ",
                                    scales::percent(value,
                                                    accuracy = 0.1)
                              )
                        } else {
                              paste0(
                                    .data[[group_variable]], "\n",
                                    metric, ": ",
                                    ifelse(value < 100,
                                           scales::number(value,
                                                          accuracy = 0.01,
                                                          prefix = currency_symbol,
                                                          big.mark = ","),
                                           scales::number(value,
                                                          accuracy = 1,
                                                          prefix = currency_symbol,
                                                          big.mark = ",")
                                    )
                              )
                        }
                  }
            )
      ) +
            ggplot2::geom_bar(stat = "identity") +
            ggplot2::geom_abline(intercept = 0, slope = 0, lty = 2, color = "grey") +
            ggplot2::geom_text(
                  ggplot2::aes(
                        y = 0.75 * ymax,
                        label = if (a_metric == "spend"){
                              ifelse(value < 1e6,
                                     scales::label_number_si(prefix = currency_symbol)(value),
                                     scales::label_number_si(prefix = currency_symbol, accuracy = 0.1)(value)
                              )
                        } else if (a_metric == "response"){
                              if (kpi1_unit == "percentage"){
                                    scales::percent(value,
                                                    accuracy = 0.1)
                              } else if (kpi1_unit == "volume"){
                                    ifelse(value < 1e6,
                                           scales::label_number_si()(value),
                                           scales::label_number_si(accuracy = 0.1)(value)
                                    )
                              } else {
                                    ifelse(value < 1e6,
                                           scales::label_number_si(prefix = currency_symbol)(value),
                                           scales::label_number_si(prefix = currency_symbol, accuracy = 0.1)(value)
                                    )
                              }
                        } else if (a_metric == "performance_indicator"){
                              if (kpi1_unit == "percentage"){
                                    ifelse(value < 100,
                                           scales::label_number_si(prefix = currency_symbol)(value),
                                           scales::label_number_si(prefix = currency_symbol, accuracy = 0.1)(value)
                                    )
                              } else if (kpi1_unit == "volume"){
                                    ifelse(value < 100,
                                           scales::label_number_si(prefix = currency_symbol)(value),
                                           scales::label_number_si(prefix = currency_symbol, accuracy = 0.1)(value)
                                    )
                              } else {
                                    ifelse(value < 100,
                                           scales::label_number_si(prefix = currency_symbol, accuracy = 0.1)(value),
                                           scales::label_number_si(prefix = currency_symbol)(value)
                                    )
                              }

                        }
                  )
            ) +
            ggplot2::scale_fill_manual(values = stats::setNames(
                  c("#FF245B", "#FF245B", "#00DC7C", "#00DC7C",
                    "#4DBAC1", "#4DBAC1", "#C2C5CC", "#C2C5CC"),
                  c("SPEND S1", "SPEND S2", string_kpi1_s1, string_kpi1_s2,
                    string_perf_ind_s1, string_perf_ind_s2, "SPEND (S1 - S2)", string_kpi1_diff)
            )) +
            ggplot2::facet_grid(cols = ggplot2::vars(metric), scales = "fixed") +
            ggplot2::coord_flip() +
            ggplot2::theme(
                  text = ggplot2::element_text(size = 14,
                                               color = "#0D0D0D",
                                               family = "Calibri"),
                  axis.title.x = ggplot2::element_blank(),
                  axis.title.y = ggplot2::element_blank(),
                  axis.text = ggplot2::element_text(color = "#0D0D0D"),
                  axis.text.x = ggplot2::element_blank(),
                  axis.text.y = if (a_metric != "spend") ggplot2::element_blank(),
                  axis.ticks = ggplot2::element_blank(),
                  axis.title = ggplot2::element_text(face = "bold"),
                  panel.background = ggplot2::element_blank(),
                  plot.margin = ggplot2::unit(c(0, 0, 0, 0), units = "cm"),
                  legend.position = "none"
            )

}