refactor

Author: kalashsinghal

NAMESPACE

@@ -5,12 +5,11 @@ export(add_thresholds_transition_risk)
 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(example_emissions_profile_trs)
+export(example_sector_profile_trs)
 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)
@@ -23,14 +22,17 @@ importFrom(dplyr,coalesce)
 importFrom(dplyr,distinct)
 importFrom(dplyr,filter)
 importFrom(dplyr,full_join)
+importFrom(dplyr,group_by)
 importFrom(dplyr,left_join)
 importFrom(dplyr,mutate)
+importFrom(dplyr,n)
 importFrom(dplyr,n_distinct)
 importFrom(dplyr,relocate)
 importFrom(dplyr,rename)
 importFrom(dplyr,rename_with)
 importFrom(dplyr,select)
 importFrom(dplyr,summarise)
+importFrom(dplyr,ungroup)
 importFrom(dplyr,where)
 importFrom(glue,glue)
 importFrom(purrr,walk)

R/example_data.R

@@ -5,10 +5,12 @@
 #' @keywords internal
 #'
 #' @examples
-#' example_emissions_profile_at_product_level()
-#' example_sector_profile_at_product_level()
-example_emissions_profile_at_product_level <- function() {
+#' example_emissions_profile_trs()
+#' example_sector_profile_trs()
+example_emissions_profile_trs <- function() {
   local_options(readr.show_col_types = FALSE)
+  withr::local_options(list(tiltIndicatorAfter.output_co2_footprint = TRUE))
+
   toy_emissions_profile_products_ecoinvent <-
     read_csv(toy_emissions_profile_products_ecoinvent())
   toy_emissions_profile_any_companies <-
@@ -19,21 +21,20 @@ example_emissions_profile_at_product_level <- function() {
   toy_ecoinvent_inputs <- read_csv(toy_ecoinvent_inputs())
   toy_isic_name <- read_csv(toy_isic_name())
 
-  emissions_profile_at_product_level <- profile_emissions(
+  emissions_profile_trs <- profile_emissions(
     companies = toy_emissions_profile_any_companies,
     co2 = toy_emissions_profile_products_ecoinvent,
     europages_companies = toy_europages_companies,
     ecoinvent_activities = toy_ecoinvent_activities,
     ecoinvent_europages = toy_ecoinvent_europages,
     isic = toy_isic_name
-  ) |>
-    unnest_product()
-  emissions_profile_at_product_level
+  )
+  emissions_profile_trs
 }
 
 #' @export
-#' @rdname example_emissions_profile_at_product_level
-example_sector_profile_at_product_level <- function() {
+#' @rdname example_emissions_profile_trs
+example_sector_profile_trs <- function() {
   local_options(readr.show_col_types = FALSE)
   toy_sector_profile_any_scenarios <-
     read_csv(toy_sector_profile_any_scenarios())
@@ -45,16 +46,15 @@ example_sector_profile_at_product_level <- function() {
   toy_ecoinvent_inputs <- read_csv(toy_ecoinvent_inputs())
   toy_isic_name <- read_csv(toy_isic_name())
 
-  sector_profile_at_product_level <- profile_sector(
+  sector_profile_trs <- profile_sector(
     companies = toy_sector_profile_companies,
     scenarios = toy_sector_profile_any_scenarios,
     europages_companies = toy_europages_companies,
     ecoinvent_activities = toy_ecoinvent_activities,
     ecoinvent_europages = toy_ecoinvent_europages,
     isic = toy_isic_name
-  ) |>
-    unnest_product()
-  sector_profile_at_product_level
+  )
+  sector_profile_trs
 }
 
 

R/score_transition_risk.R

@@ -83,7 +83,11 @@ score_transition_risk <- function(emissions_profile,
     get_rows_union_for_common_cols(
       emissions_profile_at_product_level,
       sector_profile_at_product_level
-    )
+    ) |>
+    group_by(across(-c("tilt_sector", "tilt_subsector", "isic_4digit"))) |>
+    filter(!(is.na(.data$tilt_sector) & is.na(.data$tilt_subsector) & is.na(.data$isic_4digit) & n() > 1)) |>
+    ungroup()
+
   trs_emissions <-
     prepare_trs_emissions(emissions_profile_at_product_level, include_co2)
   trs_sector <-
@@ -102,37 +106,34 @@ score_transition_risk <- function(emissions_profile,
       by = c("companies_id", "ep_product", "activity_uuid_product_uuid"),
       relationship = "many-to-many"
     ) |>
-    relocate(
-      relocate_trs_columns(product_level_trs_column()),
-      "profile_ranking",
-      "reduction_targets"
-    ) |>
+    relocate(relocate_trs_columns_product(include_co2)) |>
     distinct()
 
   emissions_profile_at_company_level <- unnest_company(emissions_profile) |>
-    select(
-      c("companies_id",
-        "benchmark",
-        "emission_profile",
-        "emission_profile_share",
-        "profile_ranking_avg",
-        if (include_co2) "co2_avg"
-      )
-    )
+    select(c(
+      "companies_id",
+      "benchmark",
+      "emission_profile",
+      "emission_profile_share",
+      "profile_ranking_avg",
+      if (include_co2) "co2_avg"
+    ))
 
   sector_profile_at_company_level <- unnest_company(sector_profile) |>
-    select(c("companies_id",
-             "sector_profile",
-             "sector_profile_share",
-             "scenario",
-             "year",
-             "reduction_targets_avg"))
+    select(c(
+      "companies_id",
+      "sector_profile",
+      "sector_profile_share",
+      "scenario",
+      "year",
+      "reduction_targets_avg"
+    ))
 
   trs_company <- trs_product |>
     select(common_columns_emissions_sector_at_company_level(), "benchmark_tr_score", product_level_trs_column()) |>
     distinct() |>
     create_trs_average() |>
-    select(-product_level_trs_column()) |>
+    select(-product_level_trs_column(), -c("benchmark_tr_score")) |>
     left_join(
       emissions_profile_at_company_level,
       relationship = "many-to-many",
@@ -143,8 +144,8 @@ score_transition_risk <- function(emissions_profile,
       relationship = "many-to-many",
       by = c("companies_id")
     ) |>
-    relocate(relocate_trs_columns(company_level_trs_avg_column())) |>
-    rename(benchmark_tr_score_avg = "benchmark_tr_score") |>
+    add_benchmark_tr_score_avg() |>
+    relocate(relocate_trs_columns_company(include_co2)) |>
     distinct()
 
   nest_levels(trs_product, trs_company)
@@ -155,7 +156,7 @@ create_benchmarks_tr_score <- function(data) {
     data,
     benchmark_tr_score = ifelse(
       is.na(.data$profile_ranking) | is.na(.data$reduction_targets),
-      NA,
+      NA_character_,
       paste(.data$scenario, .data$year, .data$benchmark, sep = "_")
     )
   )
@@ -172,3 +173,14 @@ create_trs_average <- function(data) {
 limit_transition_risk_score_between_0_and_1 <- function(data) {
   mutate(data, transition_risk_score = pmin(pmax(data$transition_risk_score, 0), 1))
 }
+
+add_benchmark_tr_score_avg <- function(data) {
+  mutate(
+    data,
+    benchmark_tr_score_avg = ifelse(
+      is.na(.data$profile_ranking_avg) | is.na(.data$reduction_targets_avg),
+      NA_character_,
+      paste(.data$scenario, .data$year, .data$benchmark, sep = "_")
+    )
+  )
+}