R/funcs_charts.R

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

#' Create the media plan chart for a scenario.
#'
#' This function creates a stacked bar chart where period is on the X axis,
#' optimal spend is on the Y axis and we have a legend entry per allocation
#' unit (without period).
#'
#' The user can supply channel filters.
#'
#' @param all_scenarios_table A data set with information from all scenarios.
#' @param chosen_scenario A scenario name.
#' @param chosen_grouping One of "alloc_unit", "channel",
#'  "channel.group.level1, "channel.group.level2", "channel.group.level3".
#'
#' @return A chart.
#'
#' @export
chart_mediaplan <- function(all_scenarios_table,
                            chosen_scenario,
                            chosen_grouping = NULL){
      # avoid notes when running devtools::check()
      alloc.unit_currency            <- NULL
      alloc.unit_name.without.period <- NULL
      channel_name                   <- NULL
      channel.group.level1_name      <- NULL
      channel.group.level2_name      <- NULL
      channel.group.level3_name      <- NULL
      optim_spend                    <- NULL
      period_level2.name             <- NULL
      scenario_name                  <- NULL
      .                              <- NULL
      .data                          <- NULL

      currency_symbol <- all_scenarios_table %>%
            dplyr::pull(alloc.unit_currency) %>%
            .[[1]] %>%
            currency_string_to_symbol()

      group_variable <- switch(chosen_grouping,
                               "alloc_unit" = "alloc.unit_name.without.period",
                               "channel" = "channel_name",
                               "channel.group.level1" = "channel.group.level1_name",
                               "channel.group.level2" = "channel.group.level2_name",
                               "channel.group.level3" = "channel.group.level3_name"
      )

      plot_data <- all_scenarios_table %>%
            dplyr::filter(scenario_name == chosen_scenario,
                          # remove rows with period_level1 not optimised over
                          !is.na(optim_spend)) %>%
            dplyr::mutate(
                  alloc.unit_name.without.period =
                        stringr::str_replace_all(alloc.unit_name.without.period,
                                                 "_", " - ")
                  ) %>%
            dplyr::group_by(period_level2.name,
                            channel_name,
                            channel.group.level1_name,
                            channel.group.level2_name,
                            channel.group.level3_name,
                            alloc.unit_name.without.period) %>%
            dplyr::summarise(optim_spend = dplyr::first(optim_spend)) %>%
            dplyr::ungroup() %>%
            dplyr::group_by(period_level2.name,
                            .data[[group_variable]]) %>%
            dplyr::summarise(optim_spend = sum(optim_spend))

      plotly::ggplotly(
            ggplot2::ggplot(
                  data = plot_data,
                  ggplot2::aes(
                        x = period_level2.name,
                        y = optim_spend,
                        fill = .data[[group_variable]],
                        text = paste(
                              "Period:", period_level2.name, "\n",
                              "Placed in:", .data[[group_variable]], "\n",
                              "Optimal Spend:", ifelse(
                                    optim_spend < 1e6,
                                    scales::label_number_si()(optim_spend),
                                    scales::label_number_si(accuracy = 0.1)(optim_spend))
                              ))) +
                  ggplot2::geom_bar(stat = "identity") +
                  ggplot2::scale_y_continuous(
                        labels = scales::label_number_si(
                              prefix = currency_symbol,
                        ),
                        breaks = remove_first_break,
                        expand = c(0, 0, 0.1, 0)
                        ) +
                  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_text(angle = 90, hjust = 1),
                        axis.title = ggplot2::element_text(face = "bold"),
                        panel.background = ggplot2::element_blank(),
                        plot.margin = ggplot2::unit(c(0, 0, 0, 0), units = "cm")
                  ) +
                  ggplot2::scale_fill_manual(values = rep(mm_colors, 100) ) +
                  ggplot2::guides(fill = ggplot2::guide_legend(title="Spend Group")),
            tooltip = c("text")
      )
}


#' Create overview chart for a scenario
#'
#' @param all_scenarios_table A data set with information from all scenarios.
#' @param chosen_scenario A scenario name.
#' @param selected_kpi_level1_id Expects an integer or integer vector.
#' @param selected_kpi_level2_id Expects an integer or integer vector.
#' @param selected_kpi_level3_id Expects an integer or integer vector.
#'
#' @return A chart.
#' @export
chart_overview <- function(all_scenarios_table,
                           chosen_scenario,
                           selected_kpi_level1_id = NULL,
                           selected_kpi_level2_id = NULL,
                           selected_kpi_level3_id = NULL) {
      # avoid notes when running devtools::check()
      alloc.unit_id     <- NULL
      everything        <- NULL
      kpi.level1_id     <- NULL
      kpi.level2_id     <- NULL
      kpi.level3_id     <- NULL
      optim_spend       <- NULL
      response          <- NULL
      response_at_optim <- NULL
      scenario_name     <- NULL
      spend             <- NULL
      value             <- NULL
      var               <- NULL


      scenario_curves <- all_scenarios_table %>%
            dplyr::filter(scenario_name == chosen_scenario)

      scenario_spend <- scenario_curves %>%
            dplyr::distinct(alloc.unit_id, optim_spend) %>%
            dplyr::pull(optim_spend) %>%
            sum()

      selected_kpi_response <- scenario_curves %>%
            dplyr::filter(
                  apply_filter(kpi.level1_id, selected_kpi_level1_id),
                  apply_filter(kpi.level2_id, selected_kpi_level2_id),
                  apply_filter(kpi.level3_id, selected_kpi_level3_id)
            ) %>%
            dplyr::summarise(response = sum(response_at_optim)) %>%
            dplyr::pull(response)

      overview <- tibble::tibble(spend = scenario_spend,
                                 response = selected_kpi_response,
                                 roi = response / spend) %>%
            tidyr::pivot_longer(cols = everything(),
                                names_to = "var",
                                values_to = "value") %>%
            dplyr::mutate(
                  value = dplyr::case_when(
                        var %in% c("spend",
                                   "response") ~ scales::number(
                                         value,
                                         accuracy = 1,
                                         scale = 1e-6,
                                         prefix = "$",
                                         suffix = "M"
                                   ),
                        var %in% c("roi") ~ scales::number(
                              value,
                              accuracy = 0.01,
                              scale = 1,
                              prefix = "$"
                        )
                  ),
                  var = factor(var, levels = c("spend", "response", "roi"))
            )

      overview %>%
            ggplot2::ggplot() +
            ggplot2::geom_point(ggplot2::aes(x = var, y = 1, color = var),
                                show.legend = FALSE,
                                size = 40) +
            ggplot2::scale_color_manual(values = c(
                  "spend" = "#FF245B",
                  "response" = "#00DC7C",
                  "roi" = "#4F24EE"
            )) +
            ggplot2::geom_text(ggplot2::aes(
                  x = var,
                  y = 1,
                  label = paste0(var, ":\n", value)
            ),
            color = "white") +
            ggplot2::theme_void()

}



#' Create overview summary table
#'
#' @param all_scenarios_table A data set with information from all scenarios.
#' @param selected_scenarios A scenario name.
#'
#' @return A tibble with overview summary numbers for selected scenario
#' @export
chart_overview_summary <- function(all_scenarios_table,
                              selected_scenarios){

   # get the right scenario
   df <- all_scenarios_table %>% dplyr::filter(scenario_name == selected_scenarios)

   # kpi1 - need to add kpi2 and 3
   total_kpi1 <- df %>%
      dplyr::group_by(kpi.level1_name) %>%
      dplyr::summarise(value = sum(response_at_optim)) %>%
      dplyr::rename(metric = kpi.level1_name)

   # total spend across all allocation units
   total_spend <- df %>% dplyr::group_by(channel_name,
                                         channel.group.level1_name,
                                         channel.group.level2_name,
                                         channel.group.level3_name,
                                         period_level2.name) %>%
      dplyr::slice_head() %>%
      dplyr::summarise(optim_spend= sum(optim_spend),
                       .groups = "drop") %>%
      dplyr::summarise(Spend = sum(optim_spend)) %>%
      tidyr::pivot_longer(cols = everything(),
                          names_to = "metric",
                          values_to = "value")

   # TO DO :if calculating an ROI
   # for now assuming this is profit divided by spend

   profit <- total_kpi1 %>% dplyr::filter(metric == "Revenue") %>% dplyr::pull(value)
   spend <- total_spend %>% dplyr::filter(metric == "Spend") %>% dplyr::pull(value)

   total_perf_indicator <- tibble::tibble(metric = "ROI",
                                          value = profit/spend)

   # TO DO: Append units to this
   df <- dplyr::bind_rows(total_kpi1,
                          total_spend,
                          total_perf_indicator)

   return(df)
}





#' Create chart for comparison multiple scenarios
#'
#' @param all_scenarios_table A data set with information from all scenarios.
#' @param scenario1 A scenario name.
#' @param scenario2 Expects an integer or integer vector.
#' @param kpi1 Expects an integer or integer vector.
#' @param chosen_grouping Variable to group by the summaries.
#' One of "channel", "channel.group.level1", "channel.group.level2",
#' "channel.group.level3", "period_level2".
#'
#' @return A chart.
#' @export
chart_comparison_overview <- function(all_scenarios_table,
                                      scenario1,
                                      scenario2,
                                      kpi1,
                                      chosen_grouping = NULL){

      # kpi1 title
      string_kpi1_s1   <- paste(stringr::str_to_upper(kpi1), "S1")
      string_kpi1_s2   <- paste(stringr::str_to_upper(kpi1), "S2")
      string_kpi1_diff <- paste(stringr::str_to_upper(kpi1), "(S1 - S2)")

      # alloc unit currency name
      currency_name <- all_scenarios_table %>%
            dplyr::pull(alloc.unit_currency) %>%
            .[[1]]

      # alloc unit currency symbol to use in plots
      currency_symbol <- currency_name %>%
            currency_string_to_symbol()

      # kpi1 unit (a particular currency, percentage, volume)
      kpi1_unit <- all_scenarios_table %>%
            dplyr::filter(kpi.level1_name == kpi1) %>%
            dplyr::pull(kpi_unit) %>%
            dplyr::first()

      # performance indicator (metric) title
      # if kpi unit is currency, and assuming it is the same as alloc unit
      # the performance metric should be an ROI
      if (kpi1_unit == currency_name){
            string_perf_ind_s1 <- "ROI S1"
            string_perf_ind_s2 <- "ROI S2"
      } else if (kpi1_unit == "percentage") {
            string_perf_ind_s1 <- "COST PER 1% S1"
            string_perf_ind_s2 <- "COST PER 1% S2"
      } else if (kpi1_unit == "volume") {
            string_perf_ind_s1 <- "COST PER 1M S1"
            string_perf_ind_s2 <- "COST PER 1M S2"
      }

      group_variable <- switch(chosen_grouping,
                               "channel" = "channel_name",
                               "channel.group.level1" = "channel.group.level1_name",
                               "channel.group.level2" = "channel.group.level2_name",
                               "channel.group.level3" = "channel.group.level3_name",
                               "period_level2" = "period_level2.name"
      )

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

            comparison_spend <- data_scenario1$spend

            comparison_response <- data_scenario1$response

            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))
            } 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))
            } else {
                  comparison_performance_indicator <- comparison_performance_indicator %>%
                        dplyr::mutate(!!string_perf_ind_s1 := !!rlang::sym(string_kpi1_s1) / `SPEND S1`)
            }

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

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

            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)))

            comparison_data <- list(
                  spend = comparison_spend,
                  response = comparison_response,
                  performance_indicator = comparison_performance_indicator
            )

            plot_spend <- subchart_comparison_overview(comparison_data,
                                                       "spend",
                                                       group_variable,
                                                       string_kpi1_s1,
                                                       string_kpi1_s2,
                                                       string_kpi1_diff,
                                                       string_perf_ind_s1,
                                                       string_perf_ind_s2,
                                                       currency_symbol,
                                                       kpi1_unit)

            plot_response <- subchart_comparison_overview(comparison_data,
                                                          "response",
                                                          group_variable,
                                                          string_kpi1_s1,
                                                          string_kpi1_s2,
                                                          string_kpi1_diff,
                                                          string_perf_ind_s1,
                                                          string_perf_ind_s2,
                                                          currency_symbol,
                                                          kpi1_unit)

            plot_performance_indicator <- subchart_comparison_overview(comparison_data,
                                                                       "performance_indicator",
                                                                       group_variable,
                                                                       string_kpi1_s1,
                                                                       string_kpi1_s2,
                                                                       string_kpi1_diff,
                                                                       string_perf_ind_s1,
                                                                       string_perf_ind_s2,
                                                                       currency_symbol,
                                                                       kpi1_unit)

            if (kpi1_unit == "percentage"){
                  return(plotly::subplot(plotly::ggplotly(plot_spend,
                                                          tooltip = c("text")),
                                         plotly::ggplotly(plot_response,
                                                          tooltip = c("text")),
                                         nrows=1,
                                         widths = c(0.5,0.5)))
            } else {
                  return(plotly::subplot(plotly::ggplotly(plot_spend,
                                                          tooltip = c("text")),
                                         plotly::ggplotly(plot_response,
                                                          tooltip = c("text")),
                                         plotly::ggplotly(plot_performance_indicator,
                                                          tooltip = c("text")),
                                         nrows=1,
                                         widths = c(0.4,0.4,0.2)))
            }

      }


      comparison_data <- get_comparison_data(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)


      plot_spend <- subchart_comparison_overview(comparison_data,
                                                 "spend",
                                                 group_variable,
                                                 string_kpi1_s1,
                                                 string_kpi1_s2,
                                                 string_kpi1_diff,
                                                 string_perf_ind_s1,
                                                 string_perf_ind_s2,
                                                 currency_symbol,
                                                 kpi1_unit)

      plot_response <- subchart_comparison_overview(comparison_data,
                                                     "response",
                                                    group_variable,
                                                    string_kpi1_s1,
                                                    string_kpi1_s2,
                                                    string_kpi1_diff,
                                                    string_perf_ind_s1,
                                                    string_perf_ind_s2,
                                                    currency_symbol,
                                                    kpi1_unit)

      plot_performance_indicator <- subchart_comparison_overview(comparison_data,
                                                                 "performance_indicator",
                                                                 group_variable,
                                                                 string_kpi1_s1,
                                                                 string_kpi1_s2,
                                                                 string_kpi1_diff,
                                                                 string_perf_ind_s1,
                                                                 string_perf_ind_s2,
                                                                 currency_symbol,
                                                                 kpi1_unit)

      if (kpi1_unit == "percentage"){
            plotly::subplot(plotly::ggplotly(plot_spend,
                                             tooltip = c("text")),
                            plotly::ggplotly(plot_response,
                                             tooltip = c("text")),
                            nrows=1,
                            widths = c(0.5,0.5))
      } else {
            plotly::subplot(plotly::ggplotly(plot_spend,
                                             tooltip = c("text")),
                            plotly::ggplotly(plot_response,
                                             tooltip = c("text")),
                            plotly::ggplotly(plot_performance_indicator,
                                             tooltip = c("text")),
                            nrows=1,
                            widths = c(0.4,0.4,0.2))
      }

}

#' Create curves chart
#'
#' @param curves_filtered Curves dataset filtered by KPI Level 1 and Period.
#'
#' @return A chart.
#' @export
chart_curves <- function(curves_filtered){
      plot_data <- curves_filtered %>%
            dplyr::rowwise() %>%
            dplyr::mutate(ref_spend = get_ref_spend(equation, param1, param2, param3, param4)) %>%
            dplyr::ungroup() %>%
            dplyr::group_by(kpi.level1_name, channel_name) %>%
            dplyr::mutate(ref_spend = max(ref_spend)) %>%
            dplyr::ungroup() %>%
            dplyr::rowwise() %>%
            dplyr::mutate(plot_spends = list(seq(0, ref_spend * 1.25, by = ref_spend * 1.25/100))) %>%
            dplyr::ungroup() %>%
            tidyr::unnest(plot_spends) %>%
            dplyr::mutate(response_at_spend = dplyr::case_when(
                  equation == "dim_rets" ~ dimrets_function(plot_spends,
                                                            param1,
                                                            param2) %>% round(2),
                  equation == "s_curve" ~ s_curve_function(plot_spends,
                                                           param1,
                                                           param2,
                                                           param3,
                                                           param4) %>% round(2)
            )) %>%
            dplyr::group_by(kpi.level1_name, channel_name, plot_spends) %>%
            dplyr::summarise(response_at_spend = sum(response_at_spend)) %>%
            dplyr::ungroup()

      plotly::ggplotly({
            plot_data %>%
                  ggplot2::ggplot(
                        ggplot2::aes(
                              x = plot_spends,
                              y = response_at_spend,
                              color = channel_name,
                              text = paste(
                                    channel_name,
                                    sep = "\n")
                        )
                  ) +
                  ggplot2::geom_line() +
                  ggplot2::scale_y_continuous(
                        labels = scales::label_number_si()
                  ) +
                  ggplot2::scale_x_continuous(
                        labels = scales::label_number_si()
                  ) +
                  ggplot2::labs(
                        x = "Spend",
                        y = "KPI",
                        color = "Channel"
                  )

      }, tooltip = c("text"))

}

get_ref_spend <- function(equation, param1, param2, param3, param4){
      .eval_f = switch(equation,
            "dim_rets" = function(x, a, b){
                  -b * ( 1 - exp( -x / a ) )
            }
      )

      .eval_grad_f = switch(equation,
            "dim_rets" = function(x, a, b){
                  -( ( ( b / a ) * exp( -(x/a) ) ) )
            }
      )

      .x0 = switch(equation,
            "dim_rets" = 0
      )


      optim <- nloptr::nloptr(
            x0 = .x0,
            eval_f = .eval_f,
            eval_grad_f = .eval_grad_f,
            a = param1,
            b = param2,
            # c = param3,
            # d = param4,
            opts = list(
                     "algorithm"   = "NLOPT_LD_SLSQP",
                     "xtol_rel"    = 1e-2,
                     "ftol_rel"    = 1e-2,
                     "maxeval"     = 2000,
                     "maxtime"     = 100,
                     "print_level" = 0, # stop nlopt from printing
                     "randseed"    = 1
                     )
      )

      optim$solution
}