Skip to content

Commit dfe81bb

Browse files
kalashsinghalkalashsinghal
authored
Resolve left join issue to cover all the products in final output (#25)
* refactor * refactor
1 parent a962ab2 commit dfe81bb

14 files changed

+537
-663
lines changed

‎NAMESPACE‎

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -5,12 +5,11 @@ export(add_thresholds_transition_risk)
55
export(add_transition_risk_category_at_product_level)
66
export(add_transition_risk_score)
77
export(best_case_worst_case_transition_risk_profile)
8-
export(example_emissions_profile_at_product_level)
9-
export(example_sector_profile_at_product_level)
8+
export(example_emissions_profile_trs)
9+
export(example_sector_profile_trs)
1010
export(exclude_cols_then_pivot_wider)
1111
export(pivot_wider_transition_risk_profile)
1212
export(score_transition_risk)
13-
export(score_transition_risk_and_polish)
1413
export(toy_all_activities_scenario_sectors)
1514
export(transition_risk_profile)
1615
importFrom(dplyr,.data)
@@ -23,14 +22,17 @@ importFrom(dplyr,coalesce)
2322
importFrom(dplyr,distinct)
2423
importFrom(dplyr,filter)
2524
importFrom(dplyr,full_join)
25+
importFrom(dplyr,group_by)
2626
importFrom(dplyr,left_join)
2727
importFrom(dplyr,mutate)
28+
importFrom(dplyr,n)
2829
importFrom(dplyr,n_distinct)
2930
importFrom(dplyr,relocate)
3031
importFrom(dplyr,rename)
3132
importFrom(dplyr,rename_with)
3233
importFrom(dplyr,select)
3334
importFrom(dplyr,summarise)
35+
importFrom(dplyr,ungroup)
3436
importFrom(dplyr,where)
3537
importFrom(glue,glue)
3638
importFrom(purrr,walk)

‎R/example_data.R‎

Lines changed: 13 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -5,10 +5,12 @@
55
#' @keywords internal
66
#'
77
#' @examples
8-
#' example_emissions_profile_at_product_level()
9-
#' example_sector_profile_at_product_level()
10-
example_emissions_profile_at_product_level <- function() {
8+
#' example_emissions_profile_trs()
9+
#' example_sector_profile_trs()
10+
example_emissions_profile_trs <- function() {
1111
local_options(readr.show_col_types = FALSE)
12+
withr::local_options(list(tiltIndicatorAfter.output_co2_footprint = TRUE))
13+
1214
toy_emissions_profile_products_ecoinvent <-
1315
read_csv(toy_emissions_profile_products_ecoinvent())
1416
toy_emissions_profile_any_companies <-
@@ -19,21 +21,20 @@ example_emissions_profile_at_product_level <- function() {
1921
toy_ecoinvent_inputs <- read_csv(toy_ecoinvent_inputs())
2022
toy_isic_name <- read_csv(toy_isic_name())
2123

22-
emissions_profile_at_product_level <- profile_emissions(
24+
emissions_profile_trs <- profile_emissions(
2325
companies = toy_emissions_profile_any_companies,
2426
co2 = toy_emissions_profile_products_ecoinvent,
2527
europages_companies = toy_europages_companies,
2628
ecoinvent_activities = toy_ecoinvent_activities,
2729
ecoinvent_europages = toy_ecoinvent_europages,
2830
isic = toy_isic_name
29-
) |>
30-
unnest_product()
31-
emissions_profile_at_product_level
31+
)
32+
emissions_profile_trs
3233
}
3334

3435
#' @export
35-
#' @rdname example_emissions_profile_at_product_level
36-
example_sector_profile_at_product_level <- function() {
36+
#' @rdname example_emissions_profile_trs
37+
example_sector_profile_trs <- function() {
3738
local_options(readr.show_col_types = FALSE)
3839
toy_sector_profile_any_scenarios <-
3940
read_csv(toy_sector_profile_any_scenarios())
@@ -45,16 +46,15 @@ example_sector_profile_at_product_level <- function() {
4546
toy_ecoinvent_inputs <- read_csv(toy_ecoinvent_inputs())
4647
toy_isic_name <- read_csv(toy_isic_name())
4748

48-
sector_profile_at_product_level <- profile_sector(
49+
sector_profile_trs <- profile_sector(
4950
companies = toy_sector_profile_companies,
5051
scenarios = toy_sector_profile_any_scenarios,
5152
europages_companies = toy_europages_companies,
5253
ecoinvent_activities = toy_ecoinvent_activities,
5354
ecoinvent_europages = toy_ecoinvent_europages,
5455
isic = toy_isic_name
55-
) |>
56-
unnest_product()
57-
sector_profile_at_product_level
56+
)
57+
sector_profile_trs
5858
}
5959

6060

‎R/score_transition_risk.R‎

Lines changed: 136 additions & 74 deletions
Original file line numberDiff line numberDiff line change
@@ -2,111 +2,162 @@
22
#'
33
#' Calulate Transition Risk Score at product level and company level
44
#'
5-
#' @param emissions_profile_at_product_level Dataframe. Emissions profile product level output
6-
#' @param sector_profile_at_product_level Dataframe. Sector profile product level output
5+
#' @param emissions_profile Nested data frame. The output of
6+
#' `profile_emissions()`.
7+
#' @param sector_profile Nested data frame. The output of `profile_sector()`.
8+
#' @param include_co2 Logical. Include `co2_*` columns ?
9+
#'
10+
#' @return A data frame with the column `companies_id`, and the nested
11+
#' columns`product` and `company` holding the outputs at product and company
12+
#' level.
713
#'
814
#' @family top-level functions
915
#'
1016
#' @return A dataframe
1117
#' @export
1218
#'
1319
#' @examples
14-
#' library(dplyr)
1520
#' library(readr, warn.conflicts = FALSE)
16-
#' library(tiltToyData)
21+
#' library(dplyr, warn.conflicts = FALSE)
22+
#' library(tiltToyData, warn.conflicts = FALSE)
1723
#' library(tiltIndicator)
1824
#' library(tiltIndicatorAfter)
1925
#'
20-
#' restore <- options(readr.show_col_types = FALSE)
21-
#'
22-
#' emissions_companies <- read_csv(toy_emissions_profile_any_companies())
23-
#' products <- read_csv(toy_emissions_profile_products_ecoinvent())
24-
#' europages_companies <- read_csv(toy_europages_companies())
25-
#' ecoinvent_activities <- read_csv(toy_ecoinvent_activities())
26-
#' ecoinvent_europages <- read_csv(toy_ecoinvent_europages())
27-
#' isic_name <- read_csv(toy_isic_name())
26+
#' set.seed(123)
27+
#' restore <- options(list(
28+
#' readr.show_col_types = FALSE,
29+
#' tiltIndicatorAfter.output_co2_footprint = TRUE
30+
#' ))
2831
#'
29-
#' emissions_profile_at_product_level <- profile_emissions(
30-
#' companies = emissions_companies,
31-
#' co2 = products,
32-
#' europages_companies = europages_companies,
33-
#' ecoinvent_activities = ecoinvent_activities,
34-
#' ecoinvent_europages = ecoinvent_europages,
35-
#' isic = isic_name
36-
#' ) |> unnest_product()
32+
#' toy_emissions_profile_products_ecoinvent <- read_csv(toy_emissions_profile_products_ecoinvent())
33+
#' toy_emissions_profile_any_companies <- read_csv(toy_emissions_profile_any_companies())
34+
#' toy_sector_profile_any_scenarios <- read_csv(toy_sector_profile_any_scenarios())
35+
#' toy_sector_profile_companies <- read_csv(toy_sector_profile_companies())
36+
#' toy_europages_companies <- read_csv(toy_europages_companies())
37+
#' toy_ecoinvent_activities <- read_csv(toy_ecoinvent_activities())
38+
#' toy_ecoinvent_europages <- read_csv(toy_ecoinvent_europages())
39+
#' toy_ecoinvent_inputs <- read_csv(toy_ecoinvent_inputs())
40+
#' toy_isic_name <- read_csv(toy_isic_name())
3741
#'
38-
#' sector_companies <- read_csv(toy_sector_profile_companies())
39-
#' scenarios <- read_csv(toy_sector_profile_any_scenarios())
42+
#' emissions_profile <- profile_emissions(
43+
#' companies = toy_emissions_profile_any_companies,
44+
#' co2 = toy_emissions_profile_products_ecoinvent,
45+
#' europages_companies = toy_europages_companies,
46+
#' ecoinvent_activities = toy_ecoinvent_activities,
47+
#' ecoinvent_europages = toy_ecoinvent_europages,
48+
#' isic = toy_isic_name
49+
#' )
4050
#'
41-
#' sector_profile_at_product_level <- profile_sector(
42-
#' companies = sector_companies,
43-
#' scenarios = scenarios,
44-
#' europages_companies = europages_companies,
45-
#' ecoinvent_activities = ecoinvent_activities,
46-
#' ecoinvent_europages = ecoinvent_europages,
47-
#' isic = isic_name
48-
#' ) |> unnest_product()
51+
#' sector_profile <- profile_sector(
52+
#' companies = toy_sector_profile_companies,
53+
#' scenarios = toy_sector_profile_any_scenarios,
54+
#' europages_companies = toy_europages_companies,
55+
#' ecoinvent_activities = toy_ecoinvent_activities,
56+
#' ecoinvent_europages = toy_ecoinvent_europages,
57+
#' isic = toy_isic_name
58+
#' )
4959
#'
50-
#' result <- score_transition_risk(emissions_profile_at_product_level, sector_profile_at_product_level)
60+
#' result <- score_transition_risk(emissions_profile,
61+
#' sector_profile,
62+
#' include_co2 = TRUE
63+
#' )
5164
#'
5265
#' result |> unnest_product()
5366
#'
5467
#' result |> unnest_company()
5568
#'
5669
#' # Cleanup
5770
#' options(restore)
58-
score_transition_risk <-
59-
function(emissions_profile_at_product_level,
60-
sector_profile_at_product_level) {
61-
union_emissions_sector_rows <-
62-
get_rows_union_for_common_cols(
63-
emissions_profile_at_product_level,
64-
sector_profile_at_product_level
65-
)
66-
trs_emissions <-
67-
prepare_trs_emissions(emissions_profile_at_product_level)
68-
trs_sector <-
69-
prepare_trs_sector(sector_profile_at_product_level)
71+
score_transition_risk <- function(emissions_profile,
72+
sector_profile,
73+
include_co2 = FALSE) {
74+
if (include_co2) {
75+
hint <- "Do you need `options(tiltIndicatorAfter.output_co2_footprint = TRUE)`?"
76+
unnest_product(emissions_profile) |> check_col("co2_footprint", hint)
77+
}
7078

71-
trs_product <-
72-
full_join_emmissions_sector(trs_emissions, trs_sector) |>
73-
add_transition_risk_score(
74-
col_ranking = col_ranking(),
75-
col_target = "reduction_targets"
76-
) |>
77-
create_benchmarks_tr_score() |>
78-
limit_transition_risk_score_between_0_and_1() |>
79-
select(-all_of(c("scenario_year", "benchmark"))) |>
80-
left_join(
81-
union_emissions_sector_rows,
82-
by = c("companies_id", "ep_product", "activity_uuid_product_uuid"),
83-
relationship = "many-to-many"
84-
) |>
85-
relocate(
86-
relocate_trs_columns(product_level_trs_column()),
87-
"profile_ranking",
88-
"reduction_targets"
89-
) |>
90-
distinct()
79+
emissions_profile_at_product_level <- unnest_product(emissions_profile)
80+
sector_profile_at_product_level <- unnest_product(sector_profile)
9181

92-
trs_company <- trs_product |>
93-
select(common_columns_emissions_sector_at_company_level(), "benchmark_tr_score", product_level_trs_column()) |>
94-
create_trs_average() |>
95-
select(-product_level_trs_column()) |>
96-
relocate(relocate_trs_columns(company_level_trs_avg_column())) |>
97-
rename(benchmark_tr_score_avg = "benchmark_tr_score") |>
98-
distinct()
82+
union_emissions_sector_rows <-
83+
get_rows_union_for_common_cols(
84+
emissions_profile_at_product_level,
85+
sector_profile_at_product_level
86+
) |>
87+
group_by(across(-c("tilt_sector", "tilt_subsector", "isic_4digit"))) |>
88+
filter(!(is.na(.data$tilt_sector) & is.na(.data$tilt_subsector) & is.na(.data$isic_4digit) & n() > 1)) |>
89+
ungroup()
9990

100-
nest_levels(trs_product, trs_company)
101-
}
91+
trs_emissions <-
92+
prepare_trs_emissions(emissions_profile_at_product_level, include_co2)
93+
trs_sector <-
94+
prepare_trs_sector(sector_profile_at_product_level)
95+
96+
trs_product <-
97+
full_join_emmissions_sector(trs_emissions, trs_sector) |>
98+
add_transition_risk_score(
99+
col_ranking = col_ranking(),
100+
col_target = "reduction_targets"
101+
) |>
102+
create_benchmarks_tr_score() |>
103+
limit_transition_risk_score_between_0_and_1() |>
104+
left_join(
105+
union_emissions_sector_rows,
106+
by = c("companies_id", "ep_product", "activity_uuid_product_uuid"),
107+
relationship = "many-to-many"
108+
) |>
109+
relocate(relocate_trs_columns_product(include_co2)) |>
110+
distinct()
111+
112+
emissions_profile_at_company_level <- unnest_company(emissions_profile) |>
113+
select(c(
114+
"companies_id",
115+
"benchmark",
116+
"emission_profile",
117+
"emission_profile_share",
118+
"profile_ranking_avg",
119+
if (include_co2) "co2_avg"
120+
))
121+
122+
sector_profile_at_company_level <- unnest_company(sector_profile) |>
123+
select(c(
124+
"companies_id",
125+
"sector_profile",
126+
"sector_profile_share",
127+
"scenario",
128+
"year",
129+
"reduction_targets_avg"
130+
))
131+
132+
trs_company <- trs_product |>
133+
select(common_columns_emissions_sector_at_company_level(), "benchmark_tr_score", product_level_trs_column()) |>
134+
distinct() |>
135+
create_trs_average() |>
136+
select(-product_level_trs_column(), -c("benchmark_tr_score")) |>
137+
left_join(
138+
emissions_profile_at_company_level,
139+
relationship = "many-to-many",
140+
by = c("companies_id")
141+
) |>
142+
left_join(
143+
sector_profile_at_company_level,
144+
relationship = "many-to-many",
145+
by = c("companies_id")
146+
) |>
147+
add_benchmark_tr_score_avg() |>
148+
relocate(relocate_trs_columns_company(include_co2)) |>
149+
distinct()
150+
151+
nest_levels(trs_product, trs_company)
152+
}
102153

103154
create_benchmarks_tr_score <- function(data) {
104155
mutate(
105156
data,
106157
benchmark_tr_score = ifelse(
107158
is.na(.data$profile_ranking) | is.na(.data$reduction_targets),
108-
NA,
109-
paste(.data$scenario_year, .data$benchmark, sep = "_")
159+
NA_character_,
160+
paste(.data$scenario, .data$year, .data$benchmark, sep = "_")
110161
)
111162
)
112163
}
@@ -122,3 +173,14 @@ create_trs_average <- function(data) {
122173
limit_transition_risk_score_between_0_and_1 <- function(data) {
123174
mutate(data, transition_risk_score = pmin(pmax(data$transition_risk_score, 0), 1))
124175
}
176+
177+
add_benchmark_tr_score_avg <- function(data) {
178+
mutate(
179+
data,
180+
benchmark_tr_score_avg = ifelse(
181+
is.na(.data$profile_ranking_avg) | is.na(.data$reduction_targets_avg),
182+
NA_character_,
183+
paste(.data$scenario, .data$year, .data$benchmark, sep = "_")
184+
)
185+
)
186+
}

0 commit comments

Comments
 (0)