Add modes for the emission profile bar plot without financial data (#134

) * added modes arg for bar plot * refactored function + built readme file * tidy style change vignette * added FIXME * figure update * error in vignette * added tiltIndicatorAfter * adapted Rmd file to work with tiltIndicatorAfter * styled * udpated readme * change DESCRIPTION * added NEWS.md * news.md modified * Update DESCRIPTION Co-authored-by: Mauro Lepore <[email protected]> * Update DESCRIPTION Co-authored-by: Mauro Lepore <[email protected]> * Update R/bar_plot_emission_profile.R Co-authored-by: Mauro Lepore <[email protected]> * added modes() * changed to Imports --------- Co-authored-by: Mauro Lepore <[email protected]>
2DegreesInvesting · Jun 10, 2024 · a931511 · a931511
1 parent 9bd0208
commit a931511
Show file tree

Hide file tree

Showing 11 changed files with 149 additions and 51 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -32,14 +32,16 @@ Imports:
     tidyr,
     tidyselect,
     tiltIndicator,
+    tiltIndicatorAfter (>= 0.0.0.9042),
     tools,
     vroom
 Suggests: 
     testthat (>= 3.0.0),
     tiltToyData (>= 0.0.0.9002)
 Remotes: 
     2DegreesInvesting/tiltIndicator,
-    2degreesinvesting/tiltToyData
+    2degreesinvesting/tiltToyData,
+    2DegreesInvesting/tiltIndicatorAfter
 Config/Needs/website: rmarkdown
 Config/testthat/edition: 3
 Encoding: UTF-8

diff --git a/NAMESPACE b/NAMESPACE
@@ -83,6 +83,7 @@ importFrom(tidyr,drop_na)
 importFrom(tidyr,pivot_wider)
 importFrom(tidyselect,matches)
 importFrom(tiltIndicator,example_data_factory)
+importFrom(tiltIndicatorAfter,profile_emissions)
 importFrom(tools,toTitleCase)
 importFrom(vroom,col_character)
 importFrom(vroom,col_integer)

diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,9 @@
 <!-- NEWS.md is maintained by https://cynkra.github.io/fledge, do not edit -->
 
+# tiltPlot 0.0.0.9002 (2024-06-04)
+
+* `bar_plot_emission_profile()` has now modes that the user can choose from (#134).
+
 # tiltPlot 0.0.0.9001 (2023-06-27)
 
 * New `plot_sankey()` and `toy_data`.
diff --git a/R/bar_plot_emission_profile.R b/R/bar_plot_emission_profile.R
@@ -7,6 +7,7 @@
 #' @param benchmarks 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())`.
 #'
 #' @return A [ggplot] object.
 #'
@@ -16,44 +17,68 @@
 #' benchmarks <- c("all", "unit", "isic_4digit")
 #' bar_plot_emission_profile(without_financial, benchmarks)
 bar_plot_emission_profile <- function(data,
-                                      benchmarks = benchmarks()) {
+                                      benchmarks = benchmarks(),
+                                      mode = modes()) {
   benchmarks <- arg_match(benchmarks, multiple = TRUE)
+  mode <- mode |>
+    arg_match()
 
+  data |>
+    check_bar_plot_emission_profile() |>
+    prepare_bar_plot_emission_profile(benchmarks, mode) |>
+    plot_bar_plot_emission_profile_impl()
+}
+
+#' Check bar plot plot without financial data
+#'
+#' @param data A data frame.
+#'
+#' @return A data frame
+#' @noRd
+check_bar_plot_emission_profile <- function(data) {
   crucial <- c(
     "benchmark",
+    modes(),
     aka("risk_category")
   )
   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]]))
-
-  data <- calc_benchmark_emission_profile(data, risk_var, benchmarks)
-
-  ggplot(data, aes(x = .data$proportion, y = .data$benchmark, fill = .data$risk_category_var)) +
-    geom_col(position = position_stack(reverse = TRUE), width = width_bar()) +
-    fill_score_colors() +
-    theme_tiltplot() +
-    xlim(0, 1)
 }
 
-#' Calculate emission profile proportions for specific benchmarks
+#' Prepare emission profile proportions for specific benchmarks
 #'
 #' @param data A data frame.
-#' @param risk_var A character vector.
 #' @param benchmarks A character vector.
+#' @param mode A character vector.
 #'
 #' @return A data frame.
 #'
 #' @noRd
-calc_benchmark_emission_profile <- function(data, risk_var, benchmarks) {
+prepare_bar_plot_emission_profile <- function(data, benchmarks, mode) {
+  risk_var <- names_matching(data, aka("risk_category"))
+
+  data <- data |>
+    mutate(risk_category_var = as_risk_category(.data[[risk_var]]))
+
   data <- data |>
     filter(.data$benchmark %in% benchmarks) |>
     group_by(.data$risk_category_var, .data$benchmark) |>
-    summarise(count = n()) |>
+    summarise(total_mode = sum(.data[[mode]])) |>
     group_by(.data$benchmark) |>
-    mutate(proportion = .data$count / sum(.data$count))
-  return(data)
+    mutate(proportion = total_mode / sum(total_mode))
+
+  data
+}
+
+#' Implementation of the emission profile bar plot
+#'
+#' @param data A data frame.
+#'
+#' @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)) +
+    geom_col(position = position_stack(reverse = TRUE), width = width_bar()) +
+    fill_score_colors() +
+    theme_tiltplot() +
+    xlim(0, 1)
 }
diff --git a/R/tiltPlot-package.R b/R/tiltPlot-package.R
@@ -75,6 +75,7 @@
 #' @importFrom tidyr pivot_wider
 #' @importFrom tidyselect matches
 #' @importFrom tiltIndicator example_data_factory
+#' @importFrom tiltIndicatorAfter profile_emissions
 #' @importFrom tools toTitleCase
 #' @importFrom vroom col_character
 #' @importFrom vroom col_integer

diff --git a/README.Rmd b/README.Rmd
@@ -114,14 +114,14 @@ benchmarks <- c("all", "isic_4digit", "unit")
 
 no_fin |>
   filter(company_name == "peter") |>
-  bar_plot_emission_profile(benchmarks) +
+  bar_plot_emission_profile(benchmarks, mode = "equal_weight") +
   labs(title = "Emission profile of all products on a company level")
 ```
 
 Plot on a portfolio level. 
 
 ```{r}
-bar_plot_emission_profile(no_fin, benchmarks) +
+bar_plot_emission_profile(no_fin, benchmarks, mode = "equal_weight") +
   labs(title = "Emission profile of all products on a portfolio level")
 ```
 

diff --git a/README.md b/README.md
@@ -172,7 +172,7 @@ benchmarks <- c("all", "isic_4digit", "unit")
 
 no_fin |>
   filter(company_name == "peter") |>
-  bar_plot_emission_profile(benchmarks) +
+  bar_plot_emission_profile(benchmarks, mode = "equal_weight") +
   labs(title = "Emission profile of all products on a company level")
 ```
 
@@ -181,7 +181,7 @@ no_fin |>
 Plot on a portfolio level.
 
 ``` r
-bar_plot_emission_profile(no_fin, benchmarks) +
+bar_plot_emission_profile(no_fin, benchmarks, mode = "equal_weight") +
   labs(title = "Emission profile of all products on a portfolio level")
 ```
 
@@ -219,6 +219,7 @@ map_region_risk(no_fin, "DE", benchmark = "tilt_sector", mode = "best_case") +
   that are found in one region.
   © EuroGeographics for the administrative boundaries ")
 #> Extracting data using giscoR package, please report issues on https://github.com/rOpenGov/giscoR/issues
+#> Cache management as per giscoR. see 'giscoR::gisco_get_nuts()'
 ```
 
 <img src="man/figures/README-unnamed-chunk-14-1.png" width="100%" />
diff --git a/man/bar_plot_emission_profile.Rd b/man/bar_plot_emission_profile.Rd
diff --git a/man/figures/README-unnamed-chunk-12-1.png b/man/figures/README-unnamed-chunk-12-1.png
diff --git a/tests/testthat/test-bar_plot_emission_profile.R b/tests/testthat/test-bar_plot_emission_profile.R
@@ -1,30 +1,86 @@
 test_that("returns an object of the expected class", {
   data <- example_without_financial()
-  plot <- bar_plot_emission_profile(data, benchmarks())
+  plot <- bar_plot_emission_profile(data, benchmarks(), mode = "equal_weight")
   expect_s3_class(plot, "ggplot")
 })
 
-test_that("returns correct risk category values", {
+test_that("returns correct risk category values for equal weight mode", {
   data <- example_without_financial(!!aka("risk_category") := risk_category_levels())
-  plot <- bar_plot_emission_profile(data, benchmarks())
-  risk_categories <- levels(plot |> plot_data("risk_category_var"))
+  data <- prepare_bar_plot_emission_profile(data, benchmarks(), "equal_weight")
+  risk_categories <- levels(data$risk_category_var)
   expected_risk_categories <- risk_category_levels()
   expect_true(setequal(risk_categories, expected_risk_categories))
 })
 
-test_that("returns correct benchmarks values", {
+test_that("returns correct risk category values for best case mode", {
+  data <- example_without_financial(!!aka("risk_category") := risk_category_levels())
+  data <- prepare_bar_plot_emission_profile(data, benchmarks(), "best_case")
+  risk_categories <- levels(data$risk_category_var)
+  expected_risk_categories <- risk_category_levels()
+  expect_true(setequal(risk_categories, expected_risk_categories))
+})
+
+test_that("returns correct risk category values for worst_case mode", {
+  data <- example_without_financial(!!aka("risk_category") := risk_category_levels())
+  data <- prepare_bar_plot_emission_profile(data, benchmarks(), "worst_case")
+  risk_categories <- levels(data$risk_category_var)
+  expected_risk_categories <- risk_category_levels()
+  expect_true(setequal(risk_categories, expected_risk_categories))
+})
+
+test_that("returns correct benchmarks values for equal weight mode", {
+  data <- example_without_financial()
+  data <- prepare_bar_plot_emission_profile(data, benchmarks(), "equal_weight")
+  benchmarks <- unique(data$benchmark)
+  expected_benchmarks <- example_without_financial() |>
+    pull(benchmark) |>
+    unique()
+  expect_true(all(benchmarks %in% expected_benchmarks))
+})
+
+test_that("returns correct benchmarks values for best case mode", {
   data <- example_without_financial()
-  plot <- bar_plot_emission_profile(data, benchmarks())
-  benchmarks <- unique(plot |> plot_data("benchmark"))
-  expected_benchmarks <- data |>
+  data <- prepare_bar_plot_emission_profile(data, benchmarks(), "best_case")
+  benchmarks <- unique(data$benchmark)
+  expected_benchmarks <- example_without_financial() |>
     pull(benchmark) |>
     unique()
   expect_true(all(benchmarks %in% expected_benchmarks))
 })
 
-test_that("calculated proportions are less or equal to 1", {
+test_that("returns correct benchmarks values for worst case mode", {
   data <- example_without_financial()
-  plot <- bar_plot_emission_profile(data, benchmarks())
-  proportions <- plot |> plot_data("proportion")
-  expect_true(proportions >= 0 & proportions <= 1)
+  data <- prepare_bar_plot_emission_profile(data, benchmarks(), "worst_case")
+  benchmarks <- unique(data$benchmark)
+  expected_benchmarks <- example_without_financial() |>
+    pull(benchmark) |>
+    unique()
+  expect_true(all(benchmarks %in% expected_benchmarks))
+})
+
+test_that("proportions are less or equal to 1 for equal weight mode", {
+  data <- example_without_financial()
+  data <- data |>
+    prepare_bar_plot_emission_profile(benchmarks(), mode = "equal_weight")
+
+  proportions <- data$proportion
+  expect_true(all(proportions >= 0 & proportions <= 1))
+})
+
+test_that("proportions are less or equal to 1 for best case mode", {
+  data <- example_without_financial()
+  data <- data |>
+    prepare_bar_plot_emission_profile(benchmarks(), mode = "best_case")
+
+  proportions <- data$proportion
+  expect_true(all(proportions >= 0 & proportions <= 1))
+})
+
+test_that("proportions are less or equal to 1 for worst case mode", {
+  data <- example_without_financial()
+  data <- data |>
+    prepare_bar_plot_emission_profile(benchmarks(), mode = "worst_case")
+
+  proportions <- data$proportion
+  expect_true(all(proportions >= 0 & proportions <= 1))
 })
diff --git a/vignettes/articles/integration-with-tiltIndicator.Rmd b/vignettes/articles/integration-with-tiltIndicator.Rmd
@@ -13,44 +13,50 @@ Setup.
 
 ```{r setup}
 library(tiltToyData)
-library(tiltIndicator)
+library(tiltIndicatorAfter)
 library(tiltPlot)
 library(dplyr, warn.conflicts = FALSE)
 library(readr, warn.conflicts = FALSE)
 
 options(readr.show_col_types = FALSE)
 ```
 
+
 Data.
 
 ```{r}
 companies <- read_csv(toy_emissions_profile_any_companies())
 products <- read_csv(toy_emissions_profile_products_ecoinvent())
+co2 <- read_csv(toy_emissions_profile_products_ecoinvent())
+europages_companies <- read_csv(toy_europages_companies())
+ecoinvent_activities <- read_csv(toy_ecoinvent_activities())
+ecoinvent_europages <- read_csv(toy_ecoinvent_europages())
+isic_name <- read_csv(toy_isic_name())
 ```
 
 Apply tilt methodology.
 
 ```{r}
-emissions_profile <- emissions_profile(companies, products)
-at_product_level <- unnest_product(emissions_profile)
-```
-
-Adapt the ouput of tiltIindicator to the input of tiltPlot.
-
-```{r}
-at_product_level <- at_product_level |>
-  rename(emission_profile = risk_category, benchmark = grouped_by)
+result <- profile_emissions(
+  companies,
+  products,
+  europages_companies = europages_companies,
+  ecoinvent_activities = ecoinvent_activities,
+  ecoinvent_europages = ecoinvent_europages,
+  isic = isic_name
+  ) |> 
+  unnest_product()
 ```
 
 Visualize all companies.
 
 ```{r}
-bar_plot_emission_profile(at_product_level, benchmarks = c("all", "unit"))
+bar_plot_emission_profile(result, benchmarks = c("all", "unit"), mode = "equal_weight")
 ```
 
 Visualize one specific company.
 
 ```{r}
-first_company <- filter(at_product_level, companies_id %in% first(companies_id))
-bar_plot_emission_profile(first_company, benchmarks = c("all", "unit"))
+first_company <- filter(result, companies_id %in% first(companies_id))
+bar_plot_emission_profile(first_company, benchmarks = c("all", "unit"), mode = "equal_weight")
 ```