diff --git a/R/polish_sector_profile_product.R b/R/polish_sector_profile_product.R index 59834e7f..e4bc80dc 100644 --- a/R/polish_sector_profile_product.R +++ b/R/polish_sector_profile_product.R @@ -11,7 +11,8 @@ polish_sector_profile_product <- function(sp_prod, europages_companies, ecoinven prepare_inter_sector_profile(sp_prod, europages_companies, ecoinvent_activities, ecoinvent_europages, isic) |> relocate_sector_profile_product() |> rename_sector_profile_product() |> - mutate(scenario = recode(.data$scenario, "1.5c rps" = "IPR 1.5c RPS", "nz 2050" = "WEO NZ 2050")) |> + mutate(scenario = ifelse(is.na(scenario), grouped_by, scenario)) |> + mutate(scenario = recode_scenario(.data$scenario)) |> select(-c("matching_certainty_num", "avg_matching_certainty_num", "grouped_by", "type", "extra_rowid")) |> distinct() |> rename_118() diff --git a/R/prepare_inter_sector_profile.R b/R/prepare_inter_sector_profile.R index 6ccfb02e..ec3374d6 100644 --- a/R/prepare_inter_sector_profile.R +++ b/R/prepare_inter_sector_profile.R @@ -8,6 +8,5 @@ prepare_inter_sector_profile <- function(sp_prod, europages_companies, ecoinvent left_join(ecoinvent_activities, by = "activity_uuid_product_uuid") |> left_join(ecoinvent_europages, by = c("country", "main_activity", "clustered", "activity_uuid_product_uuid")) |> left_join(isic, by = "isic_4digit") |> - add_avg_matching_certainty("completion") |> - exclude_rows("risk_category") + add_avg_matching_certainty("completion") } diff --git a/R/utils-scenario.R b/R/utils-scenario.R new file mode 100644 index 00000000..437bcea3 --- /dev/null +++ b/R/utils-scenario.R @@ -0,0 +1,5 @@ +recode_scenario <- function(x) { + out <- gsub("^ipr|^weo", "", x, ignore.case = TRUE) + out <- gsub("_", " ", out) + tolower(trimws(out)) +} diff --git a/tests/testthat/test-profile_sector.R b/tests/testthat/test-profile_sector.R index 88649b8d..2ade0417 100644 --- a/tests/testthat/test-profile_sector.R +++ b/tests/testthat/test-profile_sector.R @@ -271,3 +271,37 @@ test_that("outputs `profile_ranking_avg` at company level", { company <- unnest_company(out) expect_true(hasName(company, "reduction_targets_avg")) }) + +test_that("given a product in 'ipr', when scenarios has also 'weo', then the product-result includes a 'weo*' `scenario` and maps to `NA` in `sector_profile` (#279, tiltIndicator#739)", { + one_type <- "ipr" + companies <- read_csv(toy_sector_profile_companies()) |> + filter(type == one_type) |> + head(1) + + scenarios <- read_csv(toy_sector_profile_any_scenarios()) + has_two_types <- all(sort(unique(scenarios$type)) %in% c("ipr", "weo")) + stopifnot(has_two_types) + + europages_companies <- read_csv(toy_europages_companies()) + ecoinvent_activities <- read_csv(toy_ecoinvent_activities()) + ecoinvent_europages <- read_csv(toy_ecoinvent_europages()) + isic_name <- read_csv(toy_isic_name()) + + product <- profile_sector( + companies, + scenarios, + europages_companies, + ecoinvent_activities, + ecoinvent_europages, + isic_name + ) |> + unnest_product() + + # `product` results include `scanario` coming from both "ipr" and "weo" + expect_true(any(grepl(c(ipr = "1.5"), product$scenario))) + expect_true(any(grepl(c(weo = "nz"), product$scenario))) + + # All rows where `scenario` comes from "weo" map to `NA` in `sector_profile` + weo <- product |> filter(grepl(c(weo = "nz"), scenario)) + expect_true(all(is.na(weo$sector_profile))) +})