Skip to content

Commit

Permalink
Add tiltTransitionRisk code (#24)
Browse files Browse the repository at this point in the history
* Refactor

* refactor

* refactor

* refactor

* refactor

* refactor
  • Loading branch information
kalashsinghal authored Oct 27, 2024
1 parent ee013b8 commit 4d644d6
Show file tree
Hide file tree
Showing 50 changed files with 4,274 additions and 35 deletions.
18 changes: 12 additions & 6 deletions DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -24,16 +24,22 @@ Imports:
rlang,
stats,
tibble,
tidyr,
tidyselect,
tiltIndicator (>= 0.0.0.9223),
tiltIndicatorAfter (>= 0.0.0.9061),
tiltPolish (>= 0.0.0.9006),
tiltToyData (>= 0.0.0.9204),
utils
Suggests:
testthat (>= 3.0.0),
utils,
withr
Remotes:
Suggests:
testthat (>= 3.0.0)
Remotes:
2DegreesInvesting/tiltIndicator,
2degreesinvesting/tiltToyData
2degreesinvesting/tiltToyData,
2degreesinvesting/tiltIndicatorAfter,
2degreesinvesting/tiltPolish
Config/testthat/edition: 3
Encoding: UTF-8
Roxygen: list(markdown = TRUE)
RoxygenNote: 7.3.1
RoxygenNote: 7.3.2
64 changes: 63 additions & 1 deletion NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -2,26 +2,88 @@

export(add_benchmark_tr_score)
export(add_thresholds_transition_risk)
export(add_transition_risk_category)
export(add_transition_risk_category_at_product_level)
export(add_transition_risk_score)
export(best_case_worst_case_transition_risk_profile)
export(example_emissions_profile_at_product_level)
export(example_sector_profile_at_product_level)
export(exclude_cols_then_pivot_wider)
export(pivot_wider_transition_risk_profile)
export(score_transition_risk)
export(score_transition_risk_and_polish)
export(toy_all_activities_scenario_sectors)
export(transition_risk_profile)
importFrom(dplyr,.data)
importFrom(dplyr,across)
importFrom(dplyr,all_of)
importFrom(dplyr,arrange)
importFrom(dplyr,bind_rows)
importFrom(dplyr,case_when)
importFrom(dplyr,coalesce)
importFrom(dplyr,distinct)
importFrom(dplyr,filter)
importFrom(dplyr,full_join)
importFrom(dplyr,left_join)
importFrom(dplyr,mutate)
importFrom(dplyr,n_distinct)
importFrom(dplyr,relocate)
importFrom(dplyr,rename)
importFrom(dplyr,rename_with)
importFrom(dplyr,select)
importFrom(dplyr,summarise)
importFrom(dplyr,where)
importFrom(glue,glue)
importFrom(purrr,walk)
importFrom(readr,read_csv)
importFrom(rlang,":=")
importFrom(rlang,.data)
importFrom(rlang,abort)
importFrom(rlang,as_name)
importFrom(rlang,ensym)
importFrom(stats,quantile)
importFrom(tibble,tibble)
importFrom(tibble,tribble)
importFrom(tidyr,pivot_wider)
importFrom(tidyselect,all_of)
importFrom(tidyselect,any_of)
importFrom(tidyselect,matches)
importFrom(tiltIndicator,categorize_risk)
importFrom(tiltIndicator,epa_at_company_level)
importFrom(tiltIndicator,epa_compute_profile_ranking)
importFrom(tiltIndicator,example_data_factory)
importFrom(tiltIndicator,insert_row_with_na_in_risk_category)
importFrom(tiltIndicator,nest_levels)
importFrom(tiltIndicator,spa_compute_profile_ranking)
importFrom(tiltIndicator,tilt_profile)
importFrom(tiltIndicator,unnest_company)
importFrom(tiltIndicator,unnest_product)
importFrom(tiltIndicatorAfter,best_case_worst_case_emission_profile)
importFrom(tiltIndicatorAfter,best_case_worst_case_impl)
importFrom(tiltIndicatorAfter,best_case_worst_case_sector_profile)
importFrom(tiltIndicatorAfter,polish_best_case_worst_case)
importFrom(tiltIndicatorAfter,profile_emissions)
importFrom(tiltIndicatorAfter,profile_sector)
importFrom(tiltIndicatorAfter,rename_with_prefix)
importFrom(tiltPolish,rename_transition_risk_profile_cols_company)
importFrom(tiltPolish,rename_transition_risk_profile_cols_product)
importFrom(tiltPolish,rename_webtool_cols_at_company_level_wide)
importFrom(tiltPolish,select_webtool_cols_at_company_level_wide)
importFrom(tiltPolish,select_webtool_cols_at_product_level)
importFrom(tiltToyData,toy_ecoinvent_activities)
importFrom(tiltToyData,toy_ecoinvent_europages)
importFrom(tiltToyData,toy_ecoinvent_inputs)
importFrom(tiltToyData,toy_emissions_profile_any_companies)
importFrom(tiltToyData,toy_emissions_profile_products)
importFrom(tiltToyData,toy_emissions_profile_products_ecoinvent)
importFrom(tiltToyData,toy_emissions_profile_upstream_products)
importFrom(tiltToyData,toy_emissions_profile_upstream_products_ecoinvent)
importFrom(tiltToyData,toy_europages_companies)
importFrom(tiltToyData,toy_isic_name)
importFrom(tiltToyData,toy_sector_profile_any_scenarios)
importFrom(tiltToyData,toy_sector_profile_companies)
importFrom(tiltToyData,toy_sector_profile_upstream_companies)
importFrom(tiltToyData,toy_sector_profile_upstream_products)
importFrom(utils,hasName)
importFrom(utils,write.csv)
importFrom(withr,local_options)
importFrom(withr,local_seed)
8 changes: 4 additions & 4 deletions R/add_thresholds_transition_risk.R
Original file line number Diff line number Diff line change
Expand Up @@ -63,8 +63,8 @@ add_thresholds_transition_risk <- function(co2,
#' Calulate `transition_risk_score` column
#'
#' @param data Dataframe.
#' @param profile_ranking Dataframe column.
#' @param reduction_targets Dataframe column.
#' @param col_ranking Dataframe column.
#' @param col_target Dataframe column.
#' @keywords internal
#' @export
add_transition_risk_score <- function(data,
Expand All @@ -83,8 +83,8 @@ add_transition_risk_score <- function(data,
#' Calulate `benchmark_tr_score` column
#'
#' @param data Dataframe.
#' @param profile_ranking Dataframe column.
#' @param reduction_targets Dataframe column.
#' @param col_ranking Dataframe column.
#' @param col_target Dataframe column.
#' @keywords internal
#' @export
add_benchmark_tr_score <- function(data,
Expand Down
98 changes: 98 additions & 0 deletions R/add_transition_risk_NA_share.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,98 @@
add_transition_risk_NA_share <- function(data) {
product <- data |>
unnest_product() |>
add_transition_risk_NA_share_at_product_level()

company <- data |>
unnest_company() |>
select_and_join_transition_risk_NA_share_at_company_level(product)

tilt_profile(nest_levels(product, company))
}

add_transition_risk_NA_share_at_product_level <- function(data) {
data |>
fill_benchmark_tr_score() |>
transition_risk_NA_amount_all() |>
transition_risk_NA_amount_benchmarks() |>
transition_risk_NA_total() |>
transition_risk_NA_share() |>
polish_transition_risk_NA_share()
}

select_and_join_transition_risk_NA_share_at_company_level <- function(data, product) {
join_table <- product |>
select(all_of(c(
"companies_id",
"benchmark_tr_score",
"transition_risk_NA_share"
))) |>
distinct()

data |>
left_join(
join_table,
by = c("companies_id",
"benchmark_tr_score_avg" = "benchmark_tr_score"
)
)
}

fill_benchmark_tr_score <- function(data) {
mutate(data, benchmark_tr_score = ifelse(
is.na(.data[[col_transition_risk_grouped_by()]]),
paste(.data[[col_scenario()]],
.data[[col_year()]],
.data[[col_emission_grouped_by()]],
sep = "_"
),
.data[[col_transition_risk_grouped_by()]]
))
}

transition_risk_NA_amount_all <- function(data) {
mutate(data,
transition_risk_NA_amount_all = n_distinct(
.data[[col_europages_product()]][is.na(.data$matched_activity_name) | is.na(.data$reduction_targets)]
),
.by = col_companies_id()
)
}

transition_risk_NA_amount_benchmarks <- function(data) {
mutate(data,
transition_risk_NA_amount_benchmarks = n_distinct(
.data[[col_europages_product()]][is.na(.data$transition_risk_score)]
),
.by = all_of(c(col_companies_id(), col_transition_risk_grouped_by()))
)
}

transition_risk_NA_total <- function(data) {
mutate(data,
transition_risk_NA_total = ifelse(
is.na(.data$matched_activity_name) | is.na(.data$reduction_targets),
.data$transition_risk_NA_amount_all,
.data$transition_risk_NA_amount_all + .data$transition_risk_NA_amount_benchmarks
),
.by = all_of(c(col_companies_id(), col_transition_risk_grouped_by()))
)
}

transition_risk_NA_share <- function(data) {
mutate(data,
transition_risk_NA_share = ifelse(
.data$amount_of_distinct_products == 0,
NA,
.data$transition_risk_NA_total / .data$amount_of_distinct_products
),
.by = all_of(c(col_companies_id(), col_transition_risk_grouped_by()))
)
}

polish_transition_risk_NA_share <- function(data) {
select(data, -all_of(c(
"transition_risk_NA_amount_all",
"transition_risk_NA_amount_benchmarks"
)))
}
53 changes: 53 additions & 0 deletions R/add_transition_risk_category_at_company_level.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,53 @@
add_transition_risk_category_at_company_level <- function(data) {
product <- data |>
unnest_product()

risk_categories <- product |>
create_risk_categories_at_company_level()

company <- data |>
unnest_company() |>
join_risk_categories_at_company_level(risk_categories)

tilt_profile(nest_levels(product, company))
}

create_risk_categories_at_company_level <- function(data) {
data |>
adapt_tr_product_cols_to_tiltIndicator_cols() |>
epa_at_company_level() |>
insert_row_with_na_in_risk_category() |>
adapt_tiltIndicator_cols_to_tr_company_cols()
}

join_risk_categories_at_company_level <- function(data, risk_categories) {
data |>
create_transition_risk_category_col_at_company_level() |>
left_join(risk_categories, by = c(
"companies_id",
"benchmark_tr_score_avg",
"transition_risk_category"
))
}

adapt_tr_product_cols_to_tiltIndicator_cols <- function(data) {
rename(data,
grouped_by = "benchmark_tr_score",
risk_category = "transition_risk_category"
)
}

adapt_tiltIndicator_cols_to_tr_company_cols <- function(data) {
rename(data,
benchmark_tr_score_avg = "grouped_by",
transition_risk_category = "risk_category",
transition_risk_category_share = "value"
)
}

create_transition_risk_category_col_at_company_level <- function(data) {
mutate(data, transition_risk_category = coalesce(
.data$emission_profile,
.data$sector_profile
))
}
Original file line number Diff line number Diff line change
Expand Up @@ -23,9 +23,9 @@
#' scenarios
#' )
#'
#' output <- add_transition_risk_category(transition_risk_thresholds)
#' output <- add_transition_risk_category_at_product_level(transition_risk_thresholds)
#' output
add_transition_risk_category <- function(data) {
add_transition_risk_category_at_product_level <- function(data) {
check_crucial_cols(data, c(
col_transition_risk_score(), col_tr_low_threshold(),
col_tr_high_threshold()
Expand Down
56 changes: 56 additions & 0 deletions R/best_case_worst_case_avg_profile_ranking.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,56 @@
best_case_worst_case_avg_profile_ranking <- function(data) {
product <- data |>
unnest_product()

avg_best_case_worst_case_at_product_level <- product |>
prepare_for_join_at_company_level_profile_ranking()

avg_best_case <- prepare_avg_best_case_join_table_profile_ranking(
avg_best_case_worst_case_at_product_level
)
avg_worst_case <- prepare_avg_worst_case_join_table_profile_ranking(
avg_best_case_worst_case_at_product_level
)

company <- data |>
unnest_company() |>
left_join(avg_best_case, by = c(
col_companies_id(),
col_emission_grouped_by()
)) |>
left_join(avg_worst_case, by = c(
col_companies_id(),
col_emission_grouped_by()
))

tilt_profile(nest_levels(product, company))
}

prepare_for_join_at_company_level_profile_ranking <- function(data) {
data |>
select(all_of(c(
col_companies_id(),
col_emission_grouped_by(),
"emissions_profile_best_case",
"emissions_profile_worst_case"
))) |>
distinct() |>
rename("avg_profile_ranking_best_case" = "emissions_profile_best_case",
"avg_profile_ranking_worst_case" = "emissions_profile_worst_case")
}

prepare_avg_worst_case_join_table_profile_ranking <- function(data) {
data |>
prepare_avg_best_case_join_table(
"avg_profile_ranking_best_case",
"avg_profile_ranking_worst_case"
)
}

prepare_avg_best_case_join_table_profile_ranking <- function(data) {
data |>
prepare_avg_best_case_join_table(
"avg_profile_ranking_worst_case",
"avg_profile_ranking_best_case"
)
}
Loading

0 comments on commit 4d644d6

Please sign in to comment.