Skip to content

Commit 6ad0428

Browse files
committed
refactor
1 parent 8b06034 commit 6ad0428

9 files changed

+376
-214
lines changed

R/example_data.R

Lines changed: 48 additions & 48 deletions
Original file line numberDiff line numberDiff line change
@@ -109,17 +109,17 @@ example_transition_risk_sector_ep_product_des_analysis <- function() {
109109
example_transition_risk_ep_product_des_analysis <- function() {
110110
tribble(
111111
# styler: off
112-
~companies_id, ~product, ~grouping_transition_risk, ~transition_risk_category,
113-
"comp_1", "a", "1.5C RPS_2030_all", "high",
114-
"comp_1", "b", "1.5C RPS_2030_all", "high",
115-
"comp_1", "c", "1.5C RPS_2030_all", "high",
116-
"comp_1", "d", NA_character_, NA_character_,
117-
"comp_1", "e", NA_character_, NA_character_,
118-
"comp_2", "a", "1.5C RPS_2030_all", "high",
119-
"comp_2", "b", "1.5C RPS_2030_all", "high",
120-
"comp_2", "c", "1.5C RPS_2030_all", "high",
121-
"comp_3", "d", NA_character_, NA_character_,
122-
"comp_3", "e", NA_character_, NA_character_
112+
~companies_id, ~country, ~product, ~grouping_transition_risk, ~transition_risk_category,
113+
"comp_1", "germany", "a", "1.5C RPS_2030_all", "high",
114+
"comp_1", "germany", "b", "1.5C RPS_2030_all", "high",
115+
"comp_1", "germany", "c", "1.5C RPS_2030_all", "high",
116+
"comp_1", "germany", "d", NA_character_, NA_character_,
117+
"comp_1", "germany", "e", NA_character_, NA_character_,
118+
"comp_2", "germany", "a", "1.5C RPS_2030_all", "high",
119+
"comp_2", "germany", "b", "1.5C RPS_2030_all", "high",
120+
"comp_2", "germany", "c", "1.5C RPS_2030_all", "high",
121+
"comp_3", "germany", "d", NA_character_, NA_character_,
122+
"comp_3", "germany", "e", NA_character_, NA_character_
123123
# styler: on
124124
)
125125
}
@@ -169,15 +169,15 @@ example_transition_risk_product_sector_cov <- function() {
169169
example_transition_risk_product_transition_risk_cov <- function() {
170170
tribble(
171171
# styler: off
172-
~companies_id, ~grouping_transition_risk, ~cov_transition_risk,
173-
"comp_1", "1.5C RPS_2030_tilt_subsector", 10.0,
174-
"comp_1", "1.5C RPS_2050_tilt_subsector", 15.0,
175-
"comp_1", "NZ 2050_2030_tilt_subsector", 20.0,
176-
"comp_1", "NZ 2050_2050_tilt_subsector", 25.0,
177-
"comp_2", "1.5C RPS_2030_tilt_subsector", 45.0,
178-
"comp_2", "1.5C RPS_2050_tilt_subsector", 50.0,
179-
"comp_2", "NZ 2050_2030_tilt_subsector", 55.0,
180-
"comp_2", "NZ 2050_2050_tilt_subsector", 60.0
172+
~companies_id, ~grouping_transition_risk, ~cov_transition_risk,
173+
"comp_1", "1.5C RPS_2030_unit", 10.0,
174+
"comp_1", "1.5C RPS_2050_unit", 15.0,
175+
"comp_1", "NZ 2050_2030_unit", 20.0,
176+
"comp_1", "NZ 2050_2050_unit", 25.0,
177+
"comp_2", "1.5C RPS_2030_unit", 45.0,
178+
"comp_2", "1.5C RPS_2050_unit", 50.0,
179+
"comp_2", "NZ 2050_2030_unit", 55.0,
180+
"comp_2", "NZ 2050_2050_unit", 60.0
181181
# styler: on
182182
)
183183
}
@@ -268,20 +268,20 @@ example_transition_risk_company_emission_avg_best_case_worst_case <- function()
268268
tribble(
269269
# styler: off
270270
~companies_id, ~country, ~grouping_emission, ~emission_rank_avg_equal_weight, ~emission_rank_avg_best_case, ~emission_rank_avg_worst_case,
271-
"comp_1", "france", "all", 0.25, 0.25, 0.25,
272-
"comp_1", "france", "tilt_subsector", 0.85, 0.85, 0.85,
273-
"comp_2", "france", "all", 0.10, 0.10, 0.10,
274-
"comp_2", "france", "tilt_subsector", 0.30, 0.30, 0.30,
275-
"comp_3", "austria", "all", 0.35, 0.35, 0.35,
276-
"comp_3", "austria", "tilt_subsector", 0.55, 0.55, 0.55,
277-
"comp_4", "austria", "all", 0.70, 0.70, 0.70,
278-
"comp_4", "austria", "tilt_subsector", 0.20, 0.20, 0.20,
279-
"comp_5", "germany", "all", 0.70, 0.70, 0.70,
280-
"comp_5", "germany", "tilt_subsector", 0.20, 0.20, 0.20,
281-
"comp_6", "netherlands", "all", 0.70, 0.70, 0.70,
282-
"comp_6", "netherlands", "tilt_subsector", 0.20, 0.20, 0.20,
283-
"comp_7", "spain", "all", 0.70, 0.70, 0.70,
284-
"comp_7", "spain", "tilt_subsector", 0.20, 0.20, 0.20
271+
"comp_1", "france", "unit", 0.25, 0.25, 0.25,
272+
"comp_1", "france", "unit_isic_4digit", 0.85, 0.85, 0.85,
273+
"comp_2", "france", "unit", 0.10, 0.10, 0.10,
274+
"comp_2", "france", "unit_isic_4digit", 0.30, 0.30, 0.30,
275+
"comp_3", "austria", "unit", 0.35, 0.35, 0.35,
276+
"comp_3", "austria", "unit_isic_4digit", 0.55, 0.55, 0.55,
277+
"comp_4", "austria", "unit", 0.70, 0.70, 0.70,
278+
"comp_4", "austria", "unit_isic_4digit", 0.20, 0.20, 0.20,
279+
"comp_5", "germany", "unit", 0.70, 0.70, 0.70,
280+
"comp_5", "germany", "unit_isic_4digit", 0.20, 0.20, 0.20,
281+
"comp_6", "netherlands", "unit", 0.70, 0.70, 0.70,
282+
"comp_6", "netherlands", "unit_isic_4digit", 0.20, 0.20, 0.20,
283+
"comp_7", "spain", "unit", 0.70, 0.70, 0.70,
284+
"comp_7", "spain", "unit_isic_4digit", 0.20, 0.20, 0.20
285285
# styler: on
286286
)
287287
}
@@ -356,20 +356,20 @@ example_transition_risk_company_transition_risk_avg_best_case_worst_case <- func
356356
tribble(
357357
# styler: off
358358
~companies_id, ~country, ~grouping_transition_risk, ~avg_transition_risk_equal_weight, ~avg_transition_risk_best_case, ~avg_transition_risk_worst_case,
359-
"comp_1", "france", "1.5C RPS_2030_all", 0.25, 0.25, 0.25,
360-
"comp_1", "france", "NZ 2050_2030_all", 0.85, 0.85, 0.85,
361-
"comp_2", "france", "1.5C RPS_2030_all", 0.10, 0.10, 0.10,
362-
"comp_2", "france", "NZ 2050_2030_all", 0.30, 0.30, 0.30,
363-
"comp_3", "austria", "1.5C RPS_2030_all", 0.35, 0.35, 0.35,
364-
"comp_3", "austria", "NZ 2050_2030_all", 0.55, 0.55, 0.55,
365-
"comp_4", "austria", "1.5C RPS_2030_all", 0.70, 0.70, 0.70,
366-
"comp_4", "austria", "NZ 2050_2030_all", 0.20, 0.20, 0.20,
367-
"comp_5", "germany", "1.5C RPS_2030_all", 0.70, 0.70, 0.70,
368-
"comp_5", "germany", "NZ 2050_2030_all", 0.20, 0.20, 0.20,
369-
"comp_6", "netherlands", "1.5C RPS_2030_all", 0.70, 0.70, 0.70,
370-
"comp_6", "netherlands", "NZ 2050_2030_all", 0.20, 0.20, 0.20,
371-
"comp_7", "spain", "1.5C RPS_2030_all", 0.70, 0.70, 0.70,
372-
"comp_7", "spain", "NZ 2050_2030_all", 0.20, 0.20, 0.20
359+
"comp_1", "france", "1.5C RPS_2030_unit", 0.25, 0.25, 0.25,
360+
"comp_1", "france", "NZ 2050_2030_unit", 0.85, 0.85, 0.85,
361+
"comp_2", "france", "1.5C RPS_2030_unit", 0.10, 0.10, 0.10,
362+
"comp_2", "france", "NZ 2050_2030_unit", 0.30, 0.30, 0.30,
363+
"comp_3", "austria", "1.5C RPS_2030_unit", 0.35, 0.35, 0.35,
364+
"comp_3", "austria", "NZ 2050_2030_unit", 0.55, 0.55, 0.55,
365+
"comp_4", "austria", "1.5C RPS_2030_unit", 0.70, 0.70, 0.70,
366+
"comp_4", "austria", "NZ 2050_2030_unit", 0.20, 0.20, 0.20,
367+
"comp_5", "germany", "1.5C RPS_2030_unit", 0.70, 0.70, 0.70,
368+
"comp_5", "germany", "NZ 2050_2030_unit", 0.20, 0.20, 0.20,
369+
"comp_6", "netherlands", "1.5C RPS_2030_unit", 0.70, 0.70, 0.70,
370+
"comp_6", "netherlands", "NZ 2050_2030_unit", 0.20, 0.20, 0.20,
371+
"comp_7", "spain", "1.5C RPS_2030_unit", 0.70, 0.70, 0.70,
372+
"comp_7", "spain", "NZ 2050_2030_unit", 0.20, 0.20, 0.20
373373
# styler: on
374374
)
375375
}

vignettes/articles/descriptive-analysis-best_case_worst_case_emission_profile.Rmd

Lines changed: 12 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -34,7 +34,7 @@ options(readr.show_col_types = FALSE)
3434
### Example company-level output of emission profile for best case and worst case
3535

3636
```{r, warning=FALSE, echo=FALSE}
37-
# read_csv("transition_risk_profile_at_company_level_23_10_24.csv")
37+
# read_csv("transition_risk_profile_at_company_level_29_01_25.csv")
3838
emission_company_example <- example_transition_risk_company_emission_avg_best_case_worst_case()
3939
kable(emission_company_example |> head(20))
4040
```
@@ -47,11 +47,12 @@ avg_per_benchmark_risk_category <- function(data, col) {
4747
select(all_of(c("companies_id", "grouping_emission", col))) |>
4848
distinct() |>
4949
mutate(risk_category = categorize_risk(.data[[col]], 1/3, 2/3)) |>
50+
filter(!is.na(.data[[col]])) |>
5051
summarise(total_mode = n(), .by = c("grouping_emission", "risk_category")) |>
5152
mutate(proportion = total_mode / sum(total_mode), .by = c("grouping_emission")) |>
5253
select(-all_of(c("total_mode"))) |>
5354
distinct() |>
54-
filter(grouping_emission %in% c("all", "tilt_subsector"))
55+
filter(grouping_emission %in% c("unit", "unit_tilt_subsector", "unit_isic_4digit"))
5556
}
5657
avg_emission_profile_equal_weight_per_benchmark_risk_category <- avg_per_benchmark_risk_category(emission_company_example, "emission_rank_avg_equal_weight") |>
5758
rename("Average `emission_rank_avg_equal_weight`" = "proportion")
@@ -60,10 +61,13 @@ avg_emission_profile_equal_weight_per_benchmark_risk_category <- avg_per_benchma
6061
#### Bar plot
6162

6263
```{r, echo = FALSE, warning=FALSE}
63-
score_colors <- function(...) c("low" = "#F6CB4E", "medium" = "#B3D15D", "high" = "#E3693B")
64-
fill_score_colors <- function() scale_fill_manual(values = score_colors(), na.value = "#0476D0")
64+
score_colors <- function(...) c("low" = "#B3D15D", "medium" = "#F6CB4E", "high" = "#E3693B")
65+
fill_score_colors <- function() scale_fill_manual(values = score_colors())
6566
6667
plot_bar_plot_profile <- function(data, col) {
68+
data <- data %>%
69+
mutate(risk_category = factor(risk_category, levels = c("high", "medium", "low")))
70+
6771
ggplot(data, aes(x = .data[[col]], y = .data$grouping_emission, fill = .data$risk_category)) +
6872
geom_col(position = position_stack(reverse = TRUE), width = 0.5) +
6973
fill_score_colors() +
@@ -112,11 +116,12 @@ avg_per_benchmark_country_risk_category <- function(data, col, country_value) {
112116
filter(country == country_value) |>
113117
distinct() |>
114118
mutate(risk_category = categorize_risk(.data[[col]], 1/3, 2/3)) |>
119+
filter(!is.na(.data[[col]])) |>
115120
summarise(total_mode = n(), .by = c("grouping_emission", "risk_category")) |>
116121
mutate(proportion = total_mode / sum(total_mode), .by = c("grouping_emission")) |>
117122
select(-all_of(c("total_mode"))) |>
118123
distinct() |>
119-
filter(grouping_emission %in% c("all", "tilt_subsector"))
124+
filter(grouping_emission %in% c("unit", "unit_tilt_subsector", "unit_isic_4digit"))
120125
}
121126
avg_emission_profile_equal_weight_per_benchmark_risk_category_france <- avg_per_benchmark_country_risk_category(emission_company_example, "emission_rank_avg_equal_weight", "france") |>
122127
rename("Average `emission_rank_avg_equal_weight`" = "proportion")
@@ -228,7 +233,7 @@ emission_rank_avg_per_benchmark <- function(data, col) {
228233
mutate("75th_quantile" = quantile(.data[[col]], 0.75, na.rm = TRUE), .by = "grouping_emission") |>
229234
select(-all_of(c("sum_mode", col, "companies_id", "distinct_comp"))) |>
230235
distinct() |>
231-
filter(grouping_emission %in% c("all", "tilt_subsector"))
236+
filter(grouping_emission %in% c("unit", "unit_tilt_subsector", "unit_isic_4digit"))
232237
}
233238
emission_rank_avg_equal_weight_per_benchmark <- emission_rank_avg_per_benchmark(transition_risk_company_example, "emission_rank_avg_equal_weight")
234239
@@ -276,7 +281,7 @@ emission_rank_avg_per_benchmark_country <- function(data, col, country_value) {
276281
mutate("75th_quantile" = quantile(.data[[col]], 0.75, na.rm = TRUE), .by = "grouping_emission") |>
277282
select(-all_of(c("sum_mode", col, "companies_id", "distinct_comp"))) |>
278283
distinct() |>
279-
filter(grouping_emission %in% c("all", "tilt_subsector"))
284+
filter(grouping_emission %in% c("unit", "unit_tilt_subsector", "unit_isic_4digit"))
280285
}
281286
emission_rank_avg_equal_weight_per_benchmark_france <- emission_rank_avg_per_benchmark_country(transition_risk_company_example, "emission_rank_avg_equal_weight", "france")
282287
emission_rank_avg_equal_weight_per_benchmark_austria <- emission_rank_avg_per_benchmark_country(transition_risk_company_example, "emission_rank_avg_equal_weight", "austria")

0 commit comments

Comments
 (0)