diff --git a/DESCRIPTION b/DESCRIPTION index af67522..026e72d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -27,15 +27,17 @@ Imports: tidyselect, tiltIndicator (>= 0.0.0.9228), tiltIndicatorAfter (>= 0.0.0.9057), + tiltPlot (>= 0.0.0.9001), tiltPolish (>= 0.0.0.9006), tiltToyData (>= 0.0.0.9204), tiltTransitionRisk (>= 0.0.0.9003), utils -Remotes: +Remotes: 2degreesinvesting/tiltIndicatorAfter, 2degreesinvesting/tiltToyData, 2degreesinvesting/tiltTransitionRisk, - 2degreesinvesting/tiltPolish + 2degreesinvesting/tiltPolish, + 2degreesinvesting/tiltPlot Depends: R (>= 2.10) LazyData: true diff --git a/NAMESPACE b/NAMESPACE index 685d2bf..da48e7d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -3,8 +3,10 @@ export(calculate_co2_descriptive_analysis_per_benchmark) export(calculate_trs_descriptive_analysis_per_tr_benchmark) export(example_emission_ep_product_des_analysis) +export(example_emission_product_best_case_worst_case) export(example_emission_product_co2_des_analysis) export(example_sector_ep_product_des_analysis) +export(example_transition_risk_product_emission_avg_best_case_worst_case) export(example_transition_risk_product_emission_cov) export(example_transition_risk_product_sector_cov) export(example_transition_risk_product_transition_risk_cov) diff --git a/R/example_data.R b/R/example_data.R index 0feded0..affba8f 100644 --- a/R/example_data.R +++ b/R/example_data.R @@ -15,6 +15,8 @@ #' example_transition_risk_product_emission_cov() #' example_transition_risk_product_sector_cov() #' example_transition_risk_product_transition_risk_cov() +#' example_emission_product_best_case_worst_case() +#' example_transition_risk_product_emission_avg_best_case_worst_case() example_emission_product_co2_des_analysis <- function() { tribble( # styler: off @@ -150,3 +152,64 @@ example_transition_risk_product_transition_risk_cov <- function() { # styler: on ) } + +#' @export +#' @rdname example_emission_product_co2_des_analysis +example_emission_product_best_case_worst_case <- function() { + tribble( + # styler: off + ~benchmark, ~country, ~emission_profile, ~emissions_profile_equal_weight, ~emissions_profile_best_case, ~emissions_profile_worst_case, + "all", "france", "high", 0.25, 0.25, 0.25, + "all", "france", "high", 0.75, 0.75, 0.75, + "all", "france", "medium", 0.10, 0.10, 0.10, + "all", "france", "low", 0.15, 0.15, 0.15, + "all", "france", "low", 0.55, 0.55, 0.55, + "all", "france", NA_character_, 0.30, 0.30, 0.30, + "unit", "france", "high", 0.45, 0.45, 0.45, + "unit", "france", "medium", 0.60, 0.60, 0.60, + "unit", "france", "medium", 0.40, 0.40, 0.40, + "unit", "france", "low", 0.35, 0.35, 0.35, + "unit", "france", "low", 0.75, 0.75, 0.75, + "unit", "austria", "high", 0.35, 0.35, 0.35, + "all", "austria", "high", 0.25, 0.25, 0.25, + "all", "austria", "medium", 0.10, 0.10, 0.10, + "all", "austria", "medium", 0.60, 0.60, 0.60, + "all", "austria", "low", 0.15, 0.15, 0.15, + "all", "austria", NA_character_, 0.30, 0.30, 0.30, + "unit", "austria", "high", 0.45, 0.45, 0.45, + "unit", "austria", "medium", 0.60, 0.60, 0.60, + "unit", "austria", "medium", 0.80, 0.80, 0.80, + "unit", "austria", "low", 0.35, 0.35, 0.35, + "unit", "austria", "low", 0.85, 0.85, 0.85, + "unit", "austria", NA_character_, 0.75, 0.75, 0.75 + + # styler: on + ) +} + +#' @export +#' @rdname example_emission_product_co2_des_analysis +example_transition_risk_product_emission_avg_best_case_worst_case <- function() { + tribble( + # styler: off + ~companies_id, ~country, ~grouping_emission, ~emission_rank_avg_equal_weight, ~emission_rank_avg_best_case, ~emission_rank_avg_worst_case, + "comp_1", "france", "all", 0.25, 0.25, 0.25, + "comp_1", "france", "isic_4digit", 0.85, 0.85, 0.85, + "comp_1", "france", "all", 0.20, 0.20, 0.20, + "comp_1", "france", "isic_4digit", 0.15, 0.15, 0.15, + "comp_2", "france", "all", 0.10, 0.10, 0.10, + "comp_2", "france", "isic_4digit", 0.30, 0.30, 0.30, + "comp_2", "france", "all", 0.40, 0.40, 0.40, + "comp_2", "france", "isic_4digit", 0.70, 0.70, 0.70, + "comp_1", "austria", "all", 0.35, 0.35, 0.35, + "comp_1", "austria", "isic_4digit", 0.55, 0.55, 0.55, + "comp_1", "austria", "all", 0.60, 0.60, 0.60, + "comp_1", "austria", "isic_4digit", 0.15, 0.15, 0.15, + "comp_2", "austria", "all", 0.70, 0.70, 0.70, + "comp_2", "austria", "isic_4digit", 0.20, 0.20, 0.20, + "comp_2", "austria", "all", 0.80, 0.80, 0.80, + "comp_2", "austria", "isic_4digit", 0.90, 0.90, 0.90 + + # styler: on + ) +} diff --git a/man/example_emission_product_co2_des_analysis.Rd b/man/example_emission_product_co2_des_analysis.Rd index 2ce580b..8966a92 100644 --- a/man/example_emission_product_co2_des_analysis.Rd +++ b/man/example_emission_product_co2_des_analysis.Rd @@ -8,6 +8,8 @@ \alias{example_transition_risk_product_emission_cov} \alias{example_transition_risk_product_sector_cov} \alias{example_transition_risk_product_transition_risk_cov} +\alias{example_emission_product_best_case_worst_case} +\alias{example_transition_risk_product_emission_avg_best_case_worst_case} \title{Example raw datasets} \usage{ example_emission_product_co2_des_analysis() @@ -23,6 +25,10 @@ example_transition_risk_product_emission_cov() example_transition_risk_product_sector_cov() example_transition_risk_product_transition_risk_cov() + +example_emission_product_best_case_worst_case() + +example_transition_risk_product_emission_avg_best_case_worst_case() } \value{ A dataframe. @@ -38,5 +44,8 @@ example_emission_ep_product_des_analysis() example_sector_ep_product_des_analysis() example_transition_risk_product_emission_cov() example_transition_risk_product_sector_cov() +example_transition_risk_product_transition_risk_cov() +example_emission_product_best_case_worst_case() +example_transition_risk_product_emission_avg_best_case_worst_case() } \keyword{internal} diff --git a/vignettes/articles/descriptive-analysis-best_case_worst_case_emission_profile.Rmd b/vignettes/articles/descriptive-analysis-best_case_worst_case_emission_profile.Rmd new file mode 100644 index 0000000..9c10e5d --- /dev/null +++ b/vignettes/articles/descriptive-analysis-best_case_worst_case_emission_profile.Rmd @@ -0,0 +1,254 @@ +--- +title: "Descriptive analysis of best case and worst case for emission profile" +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +This article shows how to calculate the descriptive analysis of equal weight, +best case, and worst case for emission profile. + +```{r setup, echo = FALSE, message=FALSE} +library(tiltDataAnalysis) +library(dplyr) +library(knitr) +library(ggplot2) +options(readr.show_col_types = FALSE) +``` + +### Example product-level output of emission profile for best case and worst case + +```{r, warning=FALSE} +emission_product_example <- example_emission_product_best_case_worst_case() +kable(emission_product_example) +``` + +### Average `emissions_profile_equal_weight` per benchmark and emission_profile + +```{r, warning=FALSE} +avg_per_benchmark_risk_category <- function(data, col) { + data |> + select(all_of(c("benchmark", "emission_profile", col))) |> + distinct() |> + mutate(total_mode = sum(.data[[col]], na.rm = TRUE), .by = c("benchmark", "emission_profile")) |> + mutate(proportion = total_mode / sum(total_mode), .by = c("benchmark")) |> + select(-all_of(c("total_mode", col))) |> + distinct() +} +avg_equal_weight_per_benchmark_risk_category <- avg_per_benchmark_risk_category(emission_product_example, "emissions_profile_equal_weight") |> + rename(avg_equal_weight = "proportion") + +kable(avg_equal_weight_per_benchmark_risk_category) +``` + +#### Bar plot + +```{r, echo = FALSE, warning=FALSE} +score_colors <- function(...) c("low" = "#F6CB4E", "medium" = "#B3D15D", "high" = "#E3693B") +fill_score_colors <- function() scale_fill_manual(values = score_colors(), na.value = "#0476D0") + +plot_bar_plot_profile <- function(data, col) { + ggplot(data, aes(x = .data[[col]], y = .data$benchmark, fill = .data$emission_profile)) + + geom_col(position = position_stack(reverse = TRUE), width = 0.5) + + fill_score_colors() + + tiltPlot::theme_tiltplot() + + xlim(0, NA) +} + +plot_bar_plot_profile(avg_equal_weight_per_benchmark_risk_category, "avg_equal_weight") +``` + +### Average `emissions_profile_best_case` per benchmark and emission_profile + +```{r, warning=FALSE} +avg_best_case_per_benchmark_risk_category <- avg_per_benchmark_risk_category(emission_product_example, "emissions_profile_best_case") |> + rename(avg_best_case = "proportion") + +kable(avg_best_case_per_benchmark_risk_category) +``` + +#### Bar plot + +```{r, echo = FALSE, warning=FALSE} +plot_bar_plot_profile(avg_best_case_per_benchmark_risk_category, "avg_best_case") +``` + +### Average `emissions_profile_worst_case` per benchmark and emission_profile + +```{r, warning=FALSE} +avg_worst_case_per_benchmark_risk_category <- avg_per_benchmark_risk_category(emission_product_example, "emissions_profile_worst_case") |> + rename(avg_worst_case = "proportion") + +kable(avg_worst_case_per_benchmark_risk_category) +``` + +#### Bar plot + +```{r, echo = FALSE, warning=FALSE} +plot_bar_plot_profile(avg_worst_case_per_benchmark_risk_category, "avg_worst_case") +``` + +### Average `emissions_profile_equal_weight` per benchmark and emission_profile for a country + +```{r, warning=FALSE} +avg_per_benchmark_country_risk_category <- function(data, col, country_value) { + data |> + select(all_of(c("benchmark", "country", "emission_profile", col))) |> + distinct() |> + filter(country == country_value) |> + mutate(total_mode = sum(.data[[col]], na.rm = TRUE), .by = c("benchmark", "emission_profile")) |> + mutate(proportion = total_mode / sum(total_mode), .by = c("benchmark")) |> + select(-all_of(c("total_mode", col))) |> + distinct() +} +avg_equal_weight_per_benchmark_country_risk_category <- avg_per_benchmark_country_risk_category(emission_product_example, "emissions_profile_equal_weight", "france") |> + rename(avg_equal_weight = "proportion") + +kable(avg_equal_weight_per_benchmark_country_risk_category) +``` + +#### Bar plot + +```{r, echo = FALSE, warning=FALSE} +plot_bar_plot_profile(avg_equal_weight_per_benchmark_country_risk_category, "avg_equal_weight") +``` + +### Average `emissions_profile_base_case` per benchmark and emission_profile for a country + +```{r, warning=FALSE} +avg_best_case_per_benchmark_country_risk_category <- avg_per_benchmark_country_risk_category(emission_product_example, "emissions_profile_best_case", "france") |> + rename(avg_best_case = "proportion") + +kable(avg_best_case_per_benchmark_country_risk_category) +``` + +#### Bar plot + +```{r, echo = FALSE, warning=FALSE} +plot_bar_plot_profile(avg_best_case_per_benchmark_country_risk_category, "avg_best_case") +``` + +### Average `emissions_profile_worst_case` per benchmark and emission_profile for a country + +```{r, warning=FALSE} +avg_worst_case_per_benchmark_country_risk_category <- avg_per_benchmark_country_risk_category(emission_product_example, "emissions_profile_worst_case", "france") |> + rename(avg_worst_case = "proportion") + +kable(avg_worst_case_per_benchmark_country_risk_category) +``` + +#### Bar plot + +```{r, echo = FALSE, warning=FALSE} +plot_bar_plot_profile(avg_worst_case_per_benchmark_country_risk_category, "avg_worst_case") +``` + +### Example company-level output of transition risk profile for best case and worst case + +```{r, warning=FALSE} +transition_risk_product_example <- example_transition_risk_product_emission_avg_best_case_worst_case() +kable(transition_risk_product_example) +``` + +### Descriptive analysis of `emission_rank_avg_equal_weight` per benchmark + +```{r, warning=FALSE} +emission_rank_avg_per_benchmark <- function(data, col) { + data |> + select(all_of(c("companies_id", "grouping_emission", col))) |> + distinct() |> + mutate(sum_mode = sum(.data[[col]], na.rm = TRUE), .by = "grouping_emission") |> + mutate(distinct_comp = n_distinct(companies_id, na.rm = TRUE), .by = "grouping_emission") |> + mutate(average = sum_mode / distinct_comp, .by = "grouping_emission") |> + mutate(rank_median = median(.data[[col]], na.rm = TRUE), .by = "grouping_emission") |> + mutate(rank_25th = quantile(.data[[col]], 0.25, na.rm = TRUE), .by = "grouping_emission") |> + mutate(rank_75th = quantile(.data[[col]], 0.75, na.rm = TRUE), .by = "grouping_emission") |> + select(-all_of(c("sum_mode", col, "companies_id", "distinct_comp"))) |> + distinct() +} +emission_rank_avg_equal_weight_per_benchmark <- emission_rank_avg_per_benchmark(transition_risk_product_example, "emission_rank_avg_equal_weight") |> + rename("average_emission_rank_avg_equal_weight" = "average", + "median_emission_rank_avg_equal_weight" = "rank_median", + "25th_quantile_emission_rank_avg_equal_weight" = "rank_25th", + "75th_quantile_emission_rank_avg_equal_weight" = "rank_75th") + +kable(emission_rank_avg_equal_weight_per_benchmark) +``` + +### Descriptive analysis of `emission_rank_avg_best_case` per benchmark + +```{r, warning=FALSE} +emission_rank_avg_best_case_per_benchmark <- emission_rank_avg_per_benchmark(transition_risk_product_example, "emission_rank_avg_best_case") |> + rename("average_emission_rank_avg_best_case" = "average", + "median_emission_rank_avg_best_case" = "rank_median", + "25th_quantile_emission_rank_avg_best_case" = "rank_25th", + "75th_quantile_emission_rank_avg_best_case" = "rank_75th") + +kable(emission_rank_avg_best_case_per_benchmark) +``` + +### Descriptive analysis of `emission_rank_avg_worst_case` per benchmark + +```{r, warning=FALSE} +emission_rank_avg_worst_case_per_benchmark <- emission_rank_avg_per_benchmark(transition_risk_product_example, "emission_rank_avg_worst_case") |> + rename("average_emission_rank_avg_worst_case" = "average", + "median_emission_rank_avg_worst_case" = "rank_median", + "25th_quantile_emission_rank_avg_worst_case" = "rank_25th", + "75th_quantile_emission_rank_avg_worst_case" = "rank_75th") + +kable(emission_rank_avg_worst_case_per_benchmark) +``` + +### Descriptive analysis of `emission_rank_avg_equal_weight` per benchmark for a country + +```{r, warning=FALSE} +emission_rank_avg_per_benchmark_country <- function(data, col, country_value) { + data |> + select(all_of(c("companies_id", "grouping_emission", "country", col))) |> + distinct() |> + filter(country == country_value) |> + mutate(sum_mode = sum(.data[[col]], na.rm = TRUE), .by = "grouping_emission") |> + mutate(distinct_comp = n_distinct(companies_id, na.rm = TRUE), .by = "grouping_emission") |> + mutate(average = sum_mode / distinct_comp, .by = "grouping_emission") |> + mutate(rank_median = median(.data[[col]], na.rm = TRUE), .by = "grouping_emission") |> + mutate(rank_25th = quantile(.data[[col]], 0.25, na.rm = TRUE), .by = "grouping_emission") |> + mutate(rank_75th = quantile(.data[[col]], 0.75, na.rm = TRUE), .by = "grouping_emission") |> + select(-all_of(c("sum_mode", col, "companies_id", "distinct_comp"))) |> + distinct() +} +emission_rank_avg_equal_weight_per_benchmark_country <- emission_rank_avg_per_benchmark_country(transition_risk_product_example, "emission_rank_avg_equal_weight", "france") |> + rename("average_emission_rank_avg_equal_weight" = "average", + "median_emission_rank_avg_equal_weight" = "rank_median", + "25th_quantile_emission_rank_avg_equal_weight" = "rank_25th", + "75th_quantile_emission_rank_avg_equal_weight" = "rank_75th") + +kable(emission_rank_avg_equal_weight_per_benchmark_country) +``` + +### Descriptive analysis of `emission_rank_avg_best_case` per benchmark for a country + +```{r, warning=FALSE} +emission_rank_avg_best_case_per_benchmark_country <- emission_rank_avg_per_benchmark_country(transition_risk_product_example, "emission_rank_avg_best_case", "france") |> + rename("average_emission_rank_avg_best_case" = "average", + "median_emission_rank_avg_best_case" = "rank_median", + "25th_quantile_emission_rank_avg_best_case" = "rank_25th", + "75th_quantile_emission_rank_avg_best_case" = "rank_75th") + +kable(emission_rank_avg_best_case_per_benchmark_country) +``` + +### Descriptive analysis of `emission_rank_avg_best_case` per benchmark for a country + +```{r, warning=FALSE} +emission_rank_avg_worst_case_per_benchmark_country <- emission_rank_avg_per_benchmark_country(transition_risk_product_example, "emission_rank_avg_worst_case", "france") |> + rename("average_emission_rank_avg_worst_case" = "average", + "median_emission_rank_avg_worst_case" = "rank_median", + "25th_quantile_emission_rank_avg_worst_case" = "rank_25th", + "75th_quantile_emission_rank_avg_worst_case" = "rank_75th") + +kable(emission_rank_avg_worst_case_per_benchmark_country) +```