Merge pull request #30 from RMI-PACTA/adjust-to-new-grouping

Adjust to variable result grouping
RMI-PACTA · Apr 24, 2024 · fb9d302 · fb9d302
2 parents 762c32a + 5086d02
commit fb9d302
Show file tree

Hide file tree

Showing 21 changed files with 370 additions and 189 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: pacta.multi.loanbook.plot
 Title: Tools to Visualize Climate Metrics for Multiple Loanbooks
-Version: 0.0.0.9002
+Version: 0.0.0.9003
 Authors@R: 
     c(person(given = "Monika",
              family = "Furdyna",

diff --git a/R/plot_sankey.R b/R/plot_sankey.R
@@ -1,7 +1,10 @@
 #' Make a sankey plot
 #'
 #' @param data data.frame. Should have the same format as output of
-#'   `prep_sankey()`
+#'   `prep_sankey()` and contain columns: `"middle_node"`, optionally
+#'   `"middle_node2"`, `"is_aligned"`, `"loan_size_outstanding"`, and any column
+#'   implied by `group_var`.
+#' @param group_var Character. Vector of length 1. Variable to group by.
 #' @param capitalise_node_labels Logical. Flag indicating if node labels should
 #'   be converted into better looking capitalised form.
 #' @param save_png_to Character. Path where the output in png format should be
@@ -17,16 +20,34 @@
 #' @examples
 #' # TODO
 plot_sankey <- function(data,
+                        group_var,
                         capitalise_node_labels = TRUE,
                         save_png_to = NULL,
                         png_name = "sankey.png",
                         nodes_order_from_data = FALSE) {
-  check_plot_sankey(data, capitalise_node_labels)
+  if (!is.null(group_var)) {
+    if (!inherits(group_var, "character")) {
+      stop("group_var must be of class character")
+    }
+    if (!length(group_var) == 1) {
+      stop("group_var must be of length 1")
+    }
+  } else {
+    data <- data %>%
+      dplyr::mutate(aggregate_loan_book = "Aggregate loan book")
+    group_var <- "aggregate_loan_book"
+  }
+
+  check_plot_sankey(
+    data = data,
+    group_var = group_var,
+    capitalise_node_labels = capitalise_node_labels
+  )
 
   if (capitalise_node_labels) {
     data_links <- data %>%
       dplyr::mutate(
-        group_id = r2dii.plot::to_title(.data$group_id),
+        group_var = r2dii.plot::to_title(!!rlang::sym(group_var)),
         middle_node = r2dii.plot::to_title(.data$middle_node)
       )
     if ("middle_node2" %in% names(data_links)) {
@@ -41,7 +62,7 @@ plot_sankey <- function(data,
 
   links_1 <- data_links %>%
     dplyr::select(
-      source = "group_id",
+      source = .env$group_var,
       target = "middle_node",
       value = "loan_size_outstanding",
       group = "is_aligned"
@@ -50,7 +71,7 @@ plot_sankey <- function(data,
   if ("middle_node2" %in% names(data_links)) {
     links_2 <- data_links %>%
       dplyr::select(
-        "group_id",
+        .env$group_var,
         source = "middle_node",
         target = "middle_node2",
         value = "loan_size_outstanding",
@@ -59,7 +80,7 @@ plot_sankey <- function(data,
 
     links_3 <- data_links %>%
       dplyr::select(
-        "group_id",
+        .env$group_var,
         source = "middle_node2",
         target = "is_aligned",
         value = "loan_size_outstanding",
@@ -70,7 +91,7 @@ plot_sankey <- function(data,
   } else {
     links_2 <- data_links %>%
       dplyr::select(
-        "group_id",
+        .env$group_var,
         source = "middle_node",
         target = "is_aligned",
         value = "loan_size_outstanding",
@@ -145,8 +166,10 @@ plot_sankey <- function(data,
   p
 }
 
-check_plot_sankey <- function(data, capitalise_node_labels) {
-  crucial_names <- c("group_id", "middle_node", "is_aligned", "loan_size_outstanding")
+check_plot_sankey <- function(data,
+                              group_var,
+                              capitalise_node_labels) {
+  crucial_names <- c(group_var, "middle_node", "is_aligned", "loan_size_outstanding")
   abort_if_missing_names(data, crucial_names)
   if (!is.logical(capitalise_node_labels)) {
     rlang::abort(

diff --git a/R/plot_scatter.R b/R/plot_scatter.R
@@ -13,7 +13,7 @@
 #' @param alignment_limit Numeric. Limit to be applied to the x- and y-axis
 #'   scales and to alignment values for colouring. By default the maximum
 #'   absolute alignment value of is used.
-#' @param data_level Character. Level of the plotted data. Can be 'bank' or
+#' @param data_level Character. Level of the plotted data. Can be 'group_var' or
 #'   'company'.
 #' @param cap_outliers Numeric. Cap which should be applied to the alignment
 #'   values in the data. Values bigger than cap are plotted on the border of the
@@ -37,7 +37,7 @@ plot_scatter <- function(data,
                          title = NULL,
                          subtitle = NULL,
                          alignment_limit = NULL,
-                         data_level = c("company", "bank"),
+                         data_level = c("company", "group_var"),
                          cap_outliers = NULL,
                          floor_outliers = NULL) {
   rlang::arg_match(data_level)
@@ -74,9 +74,9 @@ plot_scatter <- function(data,
       subtitle <- "Each dot is a company. The companies in the top right quadrant are both building out\n low-carbon technologies and phasing out high-carbon technologies at rates\ngreater or equal to those required by the scenario."
     }
   } else {
-    title <- paste0(title, " per Bank")
+    title <- paste0(title, " by group")
     if (is.null(subtitle)) {
-      subtitle <- "Each dot is a bank. The banks in the top right quadrant are exposed to companies\nwhich on aggregate level are both building out low-carbon technologies and phasing out\nhigh-carbon technologies at rates greater or equal to those required by the scenario."
+      subtitle <- paste0("Each dot is a group. The groups in the top right quadrant are exposed to companies\nwhich on aggregate level are both building out low-carbon technologies and phasing out\nhigh-carbon technologies at rates greater or equal to those required by the scenario.")
     }
   }
 
@@ -186,7 +186,7 @@ plot_scatter <- function(data,
     ) +
     ggplot2::scale_shape_manual(
       name = "",
-      values = c("bank" = 16, "benchmark" = 21, "company" = 16, "other" = 16),
+      values = c("group" = 16, "benchmark" = 21, "company" = 16, "other" = 16),
       labels = r2dii.plot::to_title
     ) +
     r2dii.plot::theme_2dii() +

diff --git a/R/plot_scatter_alignment_exposure.R b/R/plot_scatter_alignment_exposure.R
@@ -1,17 +1,16 @@
 #' Plot alignment scatterplot
 #'
 #' @param data data.frame. Should have the same format as output of
-#'   `prep_scatter()` and contain columns: 'name', 'buildout', phaseout', 'net'.
+#'   `prep_scatter()` and contain columns: `'name'`, `'buildout'`, `'phaseout'`,
+#'   `'net'`, and any column implied by `group_var`.
 #' @param floor_outliers Numeric. Floor which should be applied to the alignment
 #'   values in the data. Values smaller than floor are plotted on the border of
 #'   the plot.
 #' @param cap_outliers Numeric. Cap which should be applied to the alignment
 #'   values in the data. Values bigger than cap are plotted on the border of the
 #'   plot.
-#' @param category Character. Character specifying the variable that contains
-#'   the groups by which to analyse the loan books. Usually this will be
-#'   `"group_id"` unless there is a clearly specified reason to use another
-#'   category.
+#' @param group_var Character. Character specifying the variable that contains
+#'   the groups by which to analyse the loan books.
 #' @param currency Character. Currency to display in the plot labels.
 #'
 #' @return object of type "ggplot"
@@ -22,8 +21,21 @@
 plot_scatter_alignment_exposure <- function(data,
                                             floor_outliers,
                                             cap_outliers,
-                                            category,
+                                            group_var,
                                             currency) {
+  if (!is.null(group_var)) {
+    if (!inherits(group_var, "character")) {
+      stop("group_var must be of class character")
+    }
+    if (!length(group_var) == 1) {
+      stop("group_var must be of length 1")
+    }
+  } else {
+    data <- data %>%
+      dplyr::mutate(aggregate_loan_book = "Aggregate loan book")
+    group_var <- "aggregate_loan_book"
+  }
+
   if (!is.null(floor_outliers)) {
     data <- data %>%
       dplyr::mutate(
@@ -61,7 +73,7 @@ plot_scatter_alignment_exposure <- function(data,
       ggplot2::aes(
         x = .data$sum_loan_size_outstanding,
         y = .data$exposure_weighted_net_alignment,
-        color = !!rlang::sym(category)
+        color = !!rlang::sym(group_var)
       )
     ) +
     ggplot2::geom_point() +
@@ -74,7 +86,7 @@ plot_scatter_alignment_exposure <- function(data,
     ggplot2::labs(
       title = title,
       subtitle = subtitle,
-      color = r2dii.plot::to_title(category)
+      color = r2dii.plot::to_title(group_var)
     ) +
     ggplot2::xlab(glue::glue("Financial Exposure (in {currency})")) +
     ggplot2::ylab("Net Aggregate Alignment") +

diff --git a/R/plot_scatter_animated.R b/R/plot_scatter_animated.R
@@ -3,7 +3,7 @@
 #' @param data data.frame. Should have the same format as output of
 #'   `prep_scatter_animated()` and contain columns: 'name', 'buildout',
 #'   'phaseout', 'net' and 'year'.
-#' @param data_level Character. Level of the plotted data. Can be 'bank' or
+#' @param data_level Character. Level of the plotted data. Can be 'group_var' or
 #'   'company'.
 #' @param sector Character. Sector name to be used in the plot title.
 #' @param scenario_source Character. Scenario source to be used in the plot
@@ -29,7 +29,7 @@
 #' # TODO
 # nolint start: cyclocomp_linter.
 plot_scatter_animated <- function(data,
-                                  data_level = c("company", "bank"),
+                                  data_level = c("company", "group_var"),
                                   sector = NULL,
                                   scenario_source = NULL,
                                   scenario = NULL,
@@ -70,9 +70,9 @@ plot_scatter_animated <- function(data,
       subtitle <- "Each dot is a company. The companies in the top right quadrant are both building out\n low-carbon technologies and phasing out high-carbon technologies at rates\ngreater or equal to those required by the scenario."
     }
   } else {
-    title <- paste0(title, " per Bank")
+    title <- paste0(title, " per group")
     if (is.null(subtitle)) {
-      subtitle <- "Each dot is a bank. The banks in the top right quadrant are exposed to companies\nwhich on aggregate level are both building out low-carbon technologies and phasing out\nhigh-carbon technologies at rates greater or equal to those required by the scenario."
+      subtitle <- paste0("Each dot is a group. The groups in the top right quadrant are exposed to companies\nwhich on aggregate level are both building out low-carbon technologies and phasing out\nhigh-carbon technologies at rates greater or equal to those required by the scenario.")
     }
   }
 

diff --git a/R/plot_timeline.R b/R/plot_timeline.R
@@ -1,13 +1,14 @@
 #' Plot alignment timeline
 #'
 #' @param data data.frame Should have the same format as output of
-#'   `prep_timeline()` and contain columns: 'direction', 'year',
-#'   'exposure_weighted_net_alignment', 'group_id'.
+#'   `prep_timeline()` and contain columns: `'direction'`, `'year'`,
+#'   `'exposure_weighted_net_alignment'`, and any column implied by `group_var`.
 #' @param sector Character. Sector name to be used in the plot title.
 #' @param scenario_source Character. Scenario source to be used in the plot
 #'   caption.
 #' @param scenario Character. Scenario name to be used in the plot caption.
 #' @param region Character. Region to be used in the plot caption.
+#' @param group_var Character. Vector of length 1. Variable to group by.
 #' @param title Character. Custom title if different than default.
 #' @param subtitle Character. Custom subtitle if different than default.
 #' @param alignment_limits Numeric vector of size 2. Limits to be applied to
@@ -19,11 +20,13 @@
 #'
 #' @examples
 #' # TODO
+# nolint start: cyclocomp_linter.
 plot_timeline <- function(data,
                           sector = NULL,
                           scenario_source = NULL,
                           scenario = NULL,
                           region = NULL,
+                          group_var = NULL,
                           title = NULL,
                           subtitle = NULL,
                           alignment_limits = NULL) {
@@ -63,7 +66,20 @@ plot_timeline <- function(data,
     alignment_limits <- c(-max_value, max_value)
   }
 
-  check_timeline(data, alignment_limits)
+  if (!is.null(group_var)) {
+    if (!inherits(group_var, "character")) {
+      stop("group_var must be of class character")
+    }
+    if (!length(group_var) == 1) {
+      stop("group_var must be of length 1")
+    }
+  } else {
+    data <- data %>%
+      dplyr::mutate(aggregate_loan_book = "Aggregate loan book")
+    group_var <- "aggregate_loan_book"
+  }
+
+  check_timeline(data, alignment_limits, group_var)
 
   p <- ggplot2::ggplot(
     data,
@@ -89,7 +105,11 @@ plot_timeline <- function(data,
       limits = alignment_limits,
       labels = scales::percent
     ) +
-    ggplot2::facet_grid(group_id ~ direction, labeller = ggplot2::as_labeller(format_facet_labels)) +
+    ggplot2::facet_grid(
+      rows = ggplot2::vars(!!rlang::sym(group_var)),
+      cols = ggplot2::vars(.data$direction),
+      labeller = ggplot2::as_labeller(format_facet_labels)
+    ) +
     r2dii.plot::theme_2dii() +
     ggplot2::theme(
       panel.background = ggplot2::element_rect(fill = "#6c6c6c")
@@ -101,12 +121,18 @@ plot_timeline <- function(data,
     )
   p
 }
+# nolint end
 
-check_timeline <- function(data, alignment_limits) {
-  abort_if_missing_names(data, c(
-    "direction", "year",
-    "exposure_weighted_net_alignment", "group_id"
-  ))
+check_timeline <- function(data, alignment_limits, group_var) {
+  abort_if_missing_names(
+    data,
+    c(
+      "direction",
+      "year",
+      "exposure_weighted_net_alignment",
+      group_var
+    )
+  )
   if ((length(alignment_limits) != 2) || (!is.numeric(alignment_limits))) {
     rlang::abort("'alignment_limits' must be a numeric vector of size 2.")
   }