profile_sector() now handles case "c"

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()

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")
 }

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))
+}

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)))
+})