Skip to content

Commit 4d644d6

Browse files
kalashsinghalkalashsinghal
authored
Add tiltTransitionRisk code (#24)
* Refactor * refactor * refactor * refactor * refactor * refactor
1 parent ee013b8 commit 4d644d6

File tree

50 files changed

+4274
-35
lines changed

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

50 files changed

+4274
-35
lines changed

‎DESCRIPTION‎

Lines changed: 12 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -24,16 +24,22 @@ Imports:
2424
rlang,
2525
stats,
2626
tibble,
27+
tidyr,
28+
tidyselect,
2729
tiltIndicator (>= 0.0.0.9223),
30+
tiltIndicatorAfter (>= 0.0.0.9061),
31+
tiltPolish (>= 0.0.0.9006),
2832
tiltToyData (>= 0.0.0.9204),
29-
utils
30-
Suggests:
31-
testthat (>= 3.0.0),
33+
utils,
3234
withr
33-
Remotes:
35+
Suggests:
36+
testthat (>= 3.0.0)
37+
Remotes:
3438
2DegreesInvesting/tiltIndicator,
35-
2degreesinvesting/tiltToyData
39+
2degreesinvesting/tiltToyData,
40+
2degreesinvesting/tiltIndicatorAfter,
41+
2degreesinvesting/tiltPolish
3642
Config/testthat/edition: 3
3743
Encoding: UTF-8
3844
Roxygen: list(markdown = TRUE)
39-
RoxygenNote: 7.3.1
45+
RoxygenNote: 7.3.2

‎NAMESPACE‎

Lines changed: 63 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,26 +2,88 @@
22

33
export(add_benchmark_tr_score)
44
export(add_thresholds_transition_risk)
5-
export(add_transition_risk_category)
5+
export(add_transition_risk_category_at_product_level)
66
export(add_transition_risk_score)
7+
export(best_case_worst_case_transition_risk_profile)
8+
export(example_emissions_profile_at_product_level)
9+
export(example_sector_profile_at_product_level)
10+
export(exclude_cols_then_pivot_wider)
11+
export(pivot_wider_transition_risk_profile)
12+
export(score_transition_risk)
13+
export(score_transition_risk_and_polish)
714
export(toy_all_activities_scenario_sectors)
15+
export(transition_risk_profile)
816
importFrom(dplyr,.data)
17+
importFrom(dplyr,across)
918
importFrom(dplyr,all_of)
19+
importFrom(dplyr,arrange)
20+
importFrom(dplyr,bind_rows)
21+
importFrom(dplyr,case_when)
22+
importFrom(dplyr,coalesce)
1023
importFrom(dplyr,distinct)
1124
importFrom(dplyr,filter)
1225
importFrom(dplyr,full_join)
26+
importFrom(dplyr,left_join)
1327
importFrom(dplyr,mutate)
28+
importFrom(dplyr,n_distinct)
29+
importFrom(dplyr,relocate)
30+
importFrom(dplyr,rename)
31+
importFrom(dplyr,rename_with)
1432
importFrom(dplyr,select)
33+
importFrom(dplyr,summarise)
34+
importFrom(dplyr,where)
1535
importFrom(glue,glue)
1636
importFrom(purrr,walk)
1737
importFrom(readr,read_csv)
38+
importFrom(rlang,":=")
39+
importFrom(rlang,.data)
1840
importFrom(rlang,abort)
41+
importFrom(rlang,as_name)
42+
importFrom(rlang,ensym)
1943
importFrom(stats,quantile)
44+
importFrom(tibble,tibble)
2045
importFrom(tibble,tribble)
46+
importFrom(tidyr,pivot_wider)
47+
importFrom(tidyselect,all_of)
48+
importFrom(tidyselect,any_of)
49+
importFrom(tidyselect,matches)
2150
importFrom(tiltIndicator,categorize_risk)
51+
importFrom(tiltIndicator,epa_at_company_level)
2252
importFrom(tiltIndicator,epa_compute_profile_ranking)
53+
importFrom(tiltIndicator,example_data_factory)
54+
importFrom(tiltIndicator,insert_row_with_na_in_risk_category)
55+
importFrom(tiltIndicator,nest_levels)
2356
importFrom(tiltIndicator,spa_compute_profile_ranking)
57+
importFrom(tiltIndicator,tilt_profile)
58+
importFrom(tiltIndicator,unnest_company)
59+
importFrom(tiltIndicator,unnest_product)
60+
importFrom(tiltIndicatorAfter,best_case_worst_case_emission_profile)
61+
importFrom(tiltIndicatorAfter,best_case_worst_case_impl)
62+
importFrom(tiltIndicatorAfter,best_case_worst_case_sector_profile)
63+
importFrom(tiltIndicatorAfter,polish_best_case_worst_case)
64+
importFrom(tiltIndicatorAfter,profile_emissions)
65+
importFrom(tiltIndicatorAfter,profile_sector)
66+
importFrom(tiltIndicatorAfter,rename_with_prefix)
67+
importFrom(tiltPolish,rename_transition_risk_profile_cols_company)
68+
importFrom(tiltPolish,rename_transition_risk_profile_cols_product)
69+
importFrom(tiltPolish,rename_webtool_cols_at_company_level_wide)
70+
importFrom(tiltPolish,select_webtool_cols_at_company_level_wide)
71+
importFrom(tiltPolish,select_webtool_cols_at_product_level)
72+
importFrom(tiltToyData,toy_ecoinvent_activities)
73+
importFrom(tiltToyData,toy_ecoinvent_europages)
74+
importFrom(tiltToyData,toy_ecoinvent_inputs)
75+
importFrom(tiltToyData,toy_emissions_profile_any_companies)
76+
importFrom(tiltToyData,toy_emissions_profile_products)
2477
importFrom(tiltToyData,toy_emissions_profile_products_ecoinvent)
78+
importFrom(tiltToyData,toy_emissions_profile_upstream_products)
79+
importFrom(tiltToyData,toy_emissions_profile_upstream_products_ecoinvent)
80+
importFrom(tiltToyData,toy_europages_companies)
81+
importFrom(tiltToyData,toy_isic_name)
2582
importFrom(tiltToyData,toy_sector_profile_any_scenarios)
2683
importFrom(tiltToyData,toy_sector_profile_companies)
84+
importFrom(tiltToyData,toy_sector_profile_upstream_companies)
85+
importFrom(tiltToyData,toy_sector_profile_upstream_products)
86+
importFrom(utils,hasName)
2787
importFrom(utils,write.csv)
88+
importFrom(withr,local_options)
89+
importFrom(withr,local_seed)

‎R/add_thresholds_transition_risk.R‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -63,8 +63,8 @@ add_thresholds_transition_risk <- function(co2,
6363
#' Calulate `transition_risk_score` column
6464
#'
6565
#' @param data Dataframe.
66-
#' @param profile_ranking Dataframe column.
67-
#' @param reduction_targets Dataframe column.
66+
#' @param col_ranking Dataframe column.
67+
#' @param col_target Dataframe column.
6868
#' @keywords internal
6969
#' @export
7070
add_transition_risk_score <- function(data,
@@ -83,8 +83,8 @@ add_transition_risk_score <- function(data,
8383
#' Calulate `benchmark_tr_score` column
8484
#'
8585
#' @param data Dataframe.
86-
#' @param profile_ranking Dataframe column.
87-
#' @param reduction_targets Dataframe column.
86+
#' @param col_ranking Dataframe column.
87+
#' @param col_target Dataframe column.
8888
#' @keywords internal
8989
#' @export
9090
add_benchmark_tr_score <- function(data,

‎R/add_transition_risk_NA_share.R‎

Lines changed: 98 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,98 @@
1+
add_transition_risk_NA_share <- function(data) {
2+
product <- data |>
3+
unnest_product() |>
4+
add_transition_risk_NA_share_at_product_level()
5+
6+
company <- data |>
7+
unnest_company() |>
8+
select_and_join_transition_risk_NA_share_at_company_level(product)
9+
10+
tilt_profile(nest_levels(product, company))
11+
}
12+
13+
add_transition_risk_NA_share_at_product_level <- function(data) {
14+
data |>
15+
fill_benchmark_tr_score() |>
16+
transition_risk_NA_amount_all() |>
17+
transition_risk_NA_amount_benchmarks() |>
18+
transition_risk_NA_total() |>
19+
transition_risk_NA_share() |>
20+
polish_transition_risk_NA_share()
21+
}
22+
23+
select_and_join_transition_risk_NA_share_at_company_level <- function(data, product) {
24+
join_table <- product |>
25+
select(all_of(c(
26+
"companies_id",
27+
"benchmark_tr_score",
28+
"transition_risk_NA_share"
29+
))) |>
30+
distinct()
31+
32+
data |>
33+
left_join(
34+
join_table,
35+
by = c("companies_id",
36+
"benchmark_tr_score_avg" = "benchmark_tr_score"
37+
)
38+
)
39+
}
40+
41+
fill_benchmark_tr_score <- function(data) {
42+
mutate(data, benchmark_tr_score = ifelse(
43+
is.na(.data[[col_transition_risk_grouped_by()]]),
44+
paste(.data[[col_scenario()]],
45+
.data[[col_year()]],
46+
.data[[col_emission_grouped_by()]],
47+
sep = "_"
48+
),
49+
.data[[col_transition_risk_grouped_by()]]
50+
))
51+
}
52+
53+
transition_risk_NA_amount_all <- function(data) {
54+
mutate(data,
55+
transition_risk_NA_amount_all = n_distinct(
56+
.data[[col_europages_product()]][is.na(.data$matched_activity_name) | is.na(.data$reduction_targets)]
57+
),
58+
.by = col_companies_id()
59+
)
60+
}
61+
62+
transition_risk_NA_amount_benchmarks <- function(data) {
63+
mutate(data,
64+
transition_risk_NA_amount_benchmarks = n_distinct(
65+
.data[[col_europages_product()]][is.na(.data$transition_risk_score)]
66+
),
67+
.by = all_of(c(col_companies_id(), col_transition_risk_grouped_by()))
68+
)
69+
}
70+
71+
transition_risk_NA_total <- function(data) {
72+
mutate(data,
73+
transition_risk_NA_total = ifelse(
74+
is.na(.data$matched_activity_name) | is.na(.data$reduction_targets),
75+
.data$transition_risk_NA_amount_all,
76+
.data$transition_risk_NA_amount_all + .data$transition_risk_NA_amount_benchmarks
77+
),
78+
.by = all_of(c(col_companies_id(), col_transition_risk_grouped_by()))
79+
)
80+
}
81+
82+
transition_risk_NA_share <- function(data) {
83+
mutate(data,
84+
transition_risk_NA_share = ifelse(
85+
.data$amount_of_distinct_products == 0,
86+
NA,
87+
.data$transition_risk_NA_total / .data$amount_of_distinct_products
88+
),
89+
.by = all_of(c(col_companies_id(), col_transition_risk_grouped_by()))
90+
)
91+
}
92+
93+
polish_transition_risk_NA_share <- function(data) {
94+
select(data, -all_of(c(
95+
"transition_risk_NA_amount_all",
96+
"transition_risk_NA_amount_benchmarks"
97+
)))
98+
}

‎R/add_transition_risk_category_at_company_level.R‎

Lines changed: 53 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,53 @@
1+
add_transition_risk_category_at_company_level <- function(data) {
2+
product <- data |>
3+
unnest_product()
4+
5+
risk_categories <- product |>
6+
create_risk_categories_at_company_level()
7+
8+
company <- data |>
9+
unnest_company() |>
10+
join_risk_categories_at_company_level(risk_categories)
11+
12+
tilt_profile(nest_levels(product, company))
13+
}
14+
15+
create_risk_categories_at_company_level <- function(data) {
16+
data |>
17+
adapt_tr_product_cols_to_tiltIndicator_cols() |>
18+
epa_at_company_level() |>
19+
insert_row_with_na_in_risk_category() |>
20+
adapt_tiltIndicator_cols_to_tr_company_cols()
21+
}
22+
23+
join_risk_categories_at_company_level <- function(data, risk_categories) {
24+
data |>
25+
create_transition_risk_category_col_at_company_level() |>
26+
left_join(risk_categories, by = c(
27+
"companies_id",
28+
"benchmark_tr_score_avg",
29+
"transition_risk_category"
30+
))
31+
}
32+
33+
adapt_tr_product_cols_to_tiltIndicator_cols <- function(data) {
34+
rename(data,
35+
grouped_by = "benchmark_tr_score",
36+
risk_category = "transition_risk_category"
37+
)
38+
}
39+
40+
adapt_tiltIndicator_cols_to_tr_company_cols <- function(data) {
41+
rename(data,
42+
benchmark_tr_score_avg = "grouped_by",
43+
transition_risk_category = "risk_category",
44+
transition_risk_category_share = "value"
45+
)
46+
}
47+
48+
create_transition_risk_category_col_at_company_level <- function(data) {
49+
mutate(data, transition_risk_category = coalesce(
50+
.data$emission_profile,
51+
.data$sector_profile
52+
))
53+
}

‎R/add_transition_risk_category.R‎ renamed to ‎R/add_transition_risk_category_at_product_level.R‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -23,9 +23,9 @@
2323
#' scenarios
2424
#' )
2525
#'
26-
#' output <- add_transition_risk_category(transition_risk_thresholds)
26+
#' output <- add_transition_risk_category_at_product_level(transition_risk_thresholds)
2727
#' output
28-
add_transition_risk_category <- function(data) {
28+
add_transition_risk_category_at_product_level <- function(data) {
2929
check_crucial_cols(data, c(
3030
col_transition_risk_score(), col_tr_low_threshold(),
3131
col_tr_high_threshold()

‎R/best_case_worst_case_avg_profile_ranking.R‎

Lines changed: 56 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,56 @@
1+
best_case_worst_case_avg_profile_ranking <- function(data) {
2+
product <- data |>
3+
unnest_product()
4+
5+
avg_best_case_worst_case_at_product_level <- product |>
6+
prepare_for_join_at_company_level_profile_ranking()
7+
8+
avg_best_case <- prepare_avg_best_case_join_table_profile_ranking(
9+
avg_best_case_worst_case_at_product_level
10+
)
11+
avg_worst_case <- prepare_avg_worst_case_join_table_profile_ranking(
12+
avg_best_case_worst_case_at_product_level
13+
)
14+
15+
company <- data |>
16+
unnest_company() |>
17+
left_join(avg_best_case, by = c(
18+
col_companies_id(),
19+
col_emission_grouped_by()
20+
)) |>
21+
left_join(avg_worst_case, by = c(
22+
col_companies_id(),
23+
col_emission_grouped_by()
24+
))
25+
26+
tilt_profile(nest_levels(product, company))
27+
}
28+
29+
prepare_for_join_at_company_level_profile_ranking <- function(data) {
30+
data |>
31+
select(all_of(c(
32+
col_companies_id(),
33+
col_emission_grouped_by(),
34+
"emissions_profile_best_case",
35+
"emissions_profile_worst_case"
36+
))) |>
37+
distinct() |>
38+
rename("avg_profile_ranking_best_case" = "emissions_profile_best_case",
39+
"avg_profile_ranking_worst_case" = "emissions_profile_worst_case")
40+
}
41+
42+
prepare_avg_worst_case_join_table_profile_ranking <- function(data) {
43+
data |>
44+
prepare_avg_best_case_join_table(
45+
"avg_profile_ranking_best_case",
46+
"avg_profile_ranking_worst_case"
47+
)
48+
}
49+
50+
prepare_avg_best_case_join_table_profile_ranking <- function(data) {
51+
data |>
52+
prepare_avg_best_case_join_table(
53+
"avg_profile_ranking_worst_case",
54+
"avg_profile_ranking_best_case"
55+
)
56+
}

0 commit comments

Comments
 (0)