Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add article for descriptive analysis on equal_weight, best_case, and worst_case for emission profile #23

Merged
merged 2 commits into from
Aug 13, 2024
Merged

Add article for descriptive analysis on equal_weight, best_case, and worst_case for emission profile #23

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
82e81e0
Add article
kalashsinghal Aug 13, 2024
0997c44
Import 'tiltPlot'
kalashsinghal Aug 13, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 4 additions & 2 deletions DESCRIPTION
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 2 additions & 0 deletions NAMESPACE
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
63 changes: 63 additions & 0 deletions R/example_data.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
)
}
9 changes: 9 additions & 0 deletions man/example_emission_product_co2_des_analysis.Rd
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

254 changes: 254 additions & 0 deletions vignettes/articles/descriptive-analysis-best_case_worst_case_emission_profile.Rmd
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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)
```