Adapt German map function to latest version of tiltIndicatorAfter (#140)

* Refactor

* refactor

* refactor

* refactor

* refactor

* Add tests

Author: kalashsinghal

DESCRIPTION

@@ -47,5 +47,5 @@ Config/testthat/edition: 3
 Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 BugReports: https://github.com/2DegreesInvesting/tiltPlot/issues

NAMESPACE

@@ -5,9 +5,11 @@ export(bar_plot_emission_profile_financial)
 export(benchmarks)
 export(example_financial)
 export(example_without_financial)
+export(grouping_emission)
 export(map_region_risk)
 export(modes)
 export(plot_sankey)
+export(risk_category)
 export(scatter_plot_financial)
 export(scenarios)
 export(scenarios_financial)

R/bar_plot_emission_profile.R

@@ -4,26 +4,28 @@
 #' the emission risk profiles risks for one or several benchmarks.
 #'
 #' @param data A data frame like [without_financial].
-#' @param benchmarks A character vector specifying the benchmarks for which the
+#' @param grouping_emission A character vector specifying the benchmarks for which the
 #' emission profiles will be plotted. The user can choose from one to several
 #' benchmark(s) to be plotted.
 #' @param mode A character vector: `r toString(modes())`.
 #' @param scenario A character vector: `r toString(scenarios())`.
 #' @param year A character vector: `r toString(years())`.
+#' @param risk_category A character vector.
 #'
 #' @return A [ggplot] object.
 #'
 #' @export
 #'
 #' @examples
-#' benchmarks <- c("all", "unit", "isic_4digit")
-#' bar_plot_emission_profile(without_financial, benchmarks)
+#' grouping_emission <- c("unit")
+#' bar_plot_emission_profile(without_financial, grouping_emission, risk_category = "emission_category")
 bar_plot_emission_profile <- function(data,
-                                      benchmarks = benchmarks(),
+                                      grouping_emission = grouping_emission(),
                                       mode = modes(),
                                       scenario = scenarios(),
-                                      year = years()) {
-  benchmarks <- arg_match(benchmarks, multiple = TRUE)
+                                      year = years(),
+                                      risk_category = risk_category()) {
+  grouping_emission <- arg_match(grouping_emission, multiple = TRUE)
   mode <- mode |>
     arg_match() |>
     switch_mode_emission_profile()
@@ -32,8 +34,9 @@ bar_plot_emission_profile <- function(data,
 
   data |>
     check_bar_plot_emission_profile(mode) |>
-    prepare_bar_plot_emission_profile(benchmarks = benchmarks, mode = mode, scenario = scenario, year = year) |>
-    plot_bar_plot_emission_profile_impl()
+    prepare_bar_plot_emission_profile(grouping_emission = grouping_emission, mode = mode,
+                                      scenario = scenario, year = year, risk_category = risk_category) |>
+    plot_bar_plot_emission_profile_impl(risk_category = risk_category)
 }
 
 #' Check bar plot plot without financial data
@@ -44,35 +47,31 @@ bar_plot_emission_profile <- function(data,
 #' @noRd
 check_bar_plot_emission_profile <- function(data, mode) {
   crucial <- c(
-    "benchmark",
+    "grouping_emission",
     mode,
     aka("risk_category")
   )
   data |> check_crucial_names(names_matching(data, crucial))
 }
 
-#' Prepare emission profile proportions for specific benchmarks
+#' Prepare emission profile proportions for specific grouping_emission
 #'
 #' @param data A data frame.
-#' @param benchmarks A character vector.
+#' @param grouping_emission A character vector.
 #' @param mode A character vector.
+#' @param risk_category A character vector.
 #'
 #' @return A data frame.
 #'
 #' @noRd
-prepare_bar_plot_emission_profile <- function(data, benchmarks, mode, scenario, year) {
-  risk_var <- get_colname(data, aka("risk_category"))
-
-  data <- data |>
-    mutate(risk_category_var = as_risk_category(.data[[risk_var]]))
-
+prepare_bar_plot_emission_profile <- function(data, grouping_emission, mode, scenario, year, risk_category) {
   data <- data |>
-    filter((.data$benchmark %in% .env$benchmarks &
+    filter((.data$grouping_emission %in% .env$grouping_emission &
       .data$scenario == .env$scenario &
       .data$year == .env$year)) |>
-    group_by(.data$risk_category_var, .data$benchmark) |>
+    group_by(.data[[risk_category]], .data$grouping_emission) |>
     summarise(total_mode = sum(.data[[mode]])) |>
-    group_by(.data$benchmark) |>
+    group_by(.data$grouping_emission) |>
     mutate(proportion = total_mode / sum(total_mode))
 
   data
@@ -81,11 +80,12 @@ prepare_bar_plot_emission_profile <- function(data, benchmarks, mode, scenario,
 #' Implementation of the emission profile bar plot
 #'
 #' @param data A data frame.
+#' @param risk_category A character vector.
 #'
 #' @return A [ggplot] object.
 #' @noRd
-plot_bar_plot_emission_profile_impl <- function(data) {
-  ggplot(data, aes(x = .data$proportion, y = .data$benchmark, fill = .data$risk_category_var)) +
+plot_bar_plot_emission_profile_impl <- function(data, risk_category) {
+  ggplot(data, aes(x = .data$proportion, y = .data$grouping_emission, fill = .data[[risk_category]])) +
     geom_col(position = position_stack(reverse = TRUE), width = width_bar()) +
     fill_score_colors() +
     theme_tiltplot() +

R/bar_plot_emission_profile_financial.R

@@ -4,56 +4,53 @@
 #' the emission risk profiles risks for one or several benchmarks.
 #'
 #' @param data A data frame like [financial].
-#' @param benchmarks A character vector specifying the benchmarks for which the
+#' @param grouping_emission A character vector specifying the benchmarks for which the
 #' emission profiles will be plotted. The user can choose from one to several
 #' benchmark(s) to be plotted.
 #' @param mode The mode of financial data to plot.
 #' It can be one of "equal_weight", "worst_case" or "best_case".
 #' If nothing is chosen, "equal_weight" is the default case.
+#' @param risk_category A character vector.
 #'
 #' @return A [ggplot] object.
 #' @export
 #'
 #' @examples
-#' benchmarks <- c("all", "unit", "isic_4digit")
-#' bar_plot_emission_profile_financial(financial, benchmarks, "equal_weight")
+#' grouping_emission <- c("all", "unit", "isic_4digit")
+#' bar_plot_emission_profile_financial(financial, grouping_emission, "equal_weight", risk_category = "emission_category")
 bar_plot_emission_profile_financial <- function(data,
-                                                benchmarks = benchmarks(),
+                                                grouping_emission = grouping_emission(),
                                                 mode = c(
                                                   "equal_weight",
                                                   "worst_case",
                                                   "best_case"
-                                                )) {
-  benchmarks <- arg_match(benchmarks, multiple = TRUE)
+                                                ),
+                                                risk_category = risk_category()) {
+  grouping_emission <- arg_match(grouping_emission, multiple = TRUE)
   mode <- arg_match(mode)
 
   crucial <- c(
     "amount_total",
     "bank_id",
     "company_name",
     aka("risk_category"),
-    "benchmark",
+    "grouping_emission",
     "equal_weight_finance",
     "worst_case_finance",
     "best_case_finance"
   )
   data |> check_crucial_names(names_matching(data, crucial))
 
-  risk_var <- names_matching(data, aka("risk_category"))
-
-  data <- data |>
-    mutate(risk_category_var = as_risk_category(data[[risk_var]]))
-
   mode_var <- switch_mode(mode)
 
   data <- data |>
     calc_benchmark_emission_profile_financial(
-      risk_var,
-      benchmarks,
+      risk_category,
+      grouping_emission,
       mode_var
     )
 
-  ggplot(data, aes(x = .data$percentage_total, y = .data$benchmark, fill = .data$risk_category_var)) +
+  ggplot(data, aes(x = .data$percentage_total, y = .data$grouping_emission, fill = .data[[risk_category]])) +
     geom_col(position = position_stack(reverse = TRUE), width = width_bar()) +
     fill_score_colors() +
     theme_tiltplot() +
@@ -64,28 +61,28 @@ bar_plot_emission_profile_financial <- function(data,
 #' data
 #'
 #' @param data A data frame.
-#' @param risk_var A character vector.
+#' @param risk_category A character vector.
 #' @param benchmarks A character vector.
 #' @param mode_var A character vector.
 #'
 #' @return A data frame.
 #'
 #' @noRd
 calc_benchmark_emission_profile_financial <- function(data,
-                                                      risk_var,
+                                                      risk_category,
                                                       benchmarks,
                                                       mode_var) {
   total_amount_portfolio <- data |>
-    filter(.data$benchmark %in% benchmarks) |>
+    filter(.data$grouping_emission %in% benchmarks) |>
     distinct(.data$bank_id, .data$company_name, .keep_all = TRUE) |>
     summarise(total_amount_portfolio = sum(.data$amount_total, na.rm = TRUE)) |>
     pull()
 
   data <- data |>
-    filter(.data$benchmark %in% benchmarks) |>
-    distinct(.data$bank_id, .data$company_name, .data$ep_product, .data$benchmark, .keep_all = TRUE) |>
+    filter(.data$grouping_emission %in% benchmarks) |>
+    distinct(.data$bank_id, .data$company_name, .data$ep_product, .data$grouping_emission, .keep_all = TRUE) |>
     mutate(proportion = .data[[mode_var]] / total_amount_portfolio) |>
-    group_by(.data$risk_category_var, .data$company_name, .data$benchmark) |>
+    group_by(.data[[risk_category]], .data$company_name, .data$grouping_emission) |>
     summarise(percentage = sum(.data$proportion, na.rm = TRUE), .groups = "keep") |>
     summarise(percentage_total = sum(.data$percentage, na.rm = TRUE))
 

R/example_data.R

@@ -1,8 +1,8 @@
 default_financial <- function(bank_id = "a",
                               amount_total = 10,
                               company_name = "b",
-                              emission_profile = "medium",
-                              benchmark = "all",
+                              emission_category = "medium",
+                              grouping_emission = "all",
                               profile_ranking = 0.1,
                               transition_risk_score = 0.1,
                               equal_weight_finance = 10,
@@ -12,8 +12,8 @@ default_financial <- function(bank_id = "a",
     bank_id = bank_id,
     amount_total = amount_total,
     company_name = company_name,
-    emission_profile = emission_profile,
-    benchmark = benchmark,
+    emission_category = emission_category,
+    grouping_emission = grouping_emission,
     profile_ranking = profile_ranking,
     transition_risk_score = transition_risk_score,
     equal_weight_finance = equal_weight_finance,
@@ -23,22 +23,22 @@ default_financial <- function(bank_id = "a",
 }
 
 default_without_financial <- function(company_name = "a",
-                                      emission_profile = "medium",
-                                      benchmark = "all",
+                                      emission_category = c("low", "medium", "high"),
+                                      grouping_emission = "all",
                                       scenario = "1.5C RPS",
                                       year = 2030,
-                                      equal_weight_emission_profile = 0.1,
-                                      worst_case_emission_profile = 0.1,
-                                      best_case_emission_profile = 0.1) {
+                                      emissions_profile_equal_weight = 0.1,
+                                      emissions_profile_worst_case = 0.1,
+                                      emissions_profile_best_case = 0.1) {
   tibble(
     company_name = company_name,
-    emission_profile = emission_profile,
-    benchmark = benchmark,
+    emission_category = emission_category,
+    grouping_emission = grouping_emission,
     scenario = scenario,
     year = year,
-    equal_weight_emission_profile = equal_weight_emission_profile,
-    worst_case_emission_profile = worst_case_emission_profile,
-    best_case_emission_profile = best_case_emission_profile
+    emissions_profile_equal_weight = emissions_profile_equal_weight,
+    emissions_profile_worst_case = emissions_profile_worst_case,
+    emissions_profile_best_case = emissions_profile_best_case
   )
 }
 

R/map_region_risk.R

@@ -4,14 +4,15 @@
 #' @param data A data frame like [without_financial]
 #' @param country_code Country code (ISO 3166 alpha-2) for which the map will be
 #' plotted.
-#' @param benchmark The mode of benchmark to plot.
+#' @param grouping_emission The mode of benchmark to plot.
 #' It can be one of "all", "unit" or "tilt_sector", "unit_tilt_sector",
 #' "isic_4digit" or "unit_isic_4digit". If nothing is chosen, "all" is the
 #' default mode.
 #' @param mode The mode to plot. It can be one of "equal_weight", "worst_case"
 #' or "best_case". If nothing is chosen, "equal_weight" is the default mode.
 #' @param scenario A character vector: `r toString(scenarios())`.
 #' @param year A character vector: `r toString(years())`.
+#' @param risk_category A character vector.
 #'
 #' @return A ggplot2 object representing the country data plot.
 #' @export
@@ -24,17 +25,19 @@
 map_region_risk <- function(data,
                             # TODO: plot for other countries
                             country_code = c("DE"),
-                            benchmark = benchmarks(),
+                            grouping_emission = grouping_emission(),
                             mode = modes(),
                             scenario = scenarios(),
-                            year = years()) {
+                            year = years(),
+                            risk_category = risk_category()) {
   prepared_data <- prepare_geo_data(
     data,
     country_code,
-    benchmark,
+    grouping_emission,
     mode,
     scenario,
-    year
+    year,
+    risk_category
   )
   shp_1 <- prepared_data[[1]]
   aggregated_data <- prepared_data[[2]]

R/plot_sankey.R

@@ -9,16 +9,16 @@
 #'
 #' @examples
 #' # Plot with equal weight and with company name
-#' plot_sankey(financial)
+#' plot_sankey(financial, grouping_emission = "all")
 #'
-#' # Plot with best_case weight and benchmark "all".
-#' plot_sankey(financial, benchmark = "all", mode = "best_case")
+#' # Plot with best_case weight and grouping_emission "all".
+#' plot_sankey(financial, grouping_emission = "all", mode = "best_case")
 plot_sankey <- function(data,
                         with_company = TRUE,
-                        benchmark = benchmarks(),
+                        grouping_emission = grouping_emission(),
                         mode = c("equal_weight", "worst_case", "best_case")) {
   mode <- arg_match(mode)
-  benchmark <- arg_match(benchmark)
+  grouping_emission <- arg_match(grouping_emission)
 
   crucial <- c(
     aka("risk_category"),
@@ -30,7 +30,7 @@ plot_sankey <- function(data,
   risk_var <- names_matching(data, aka("risk_category"))
 
   data <- data |>
-    filter(.data$benchmark == .env$benchmark) |>
+    filter(.data$grouping_emission == .env$grouping_emission) |>
     distinct(.data$bank_id,
       .data$company_name,
       .data$ep_product,