add final test

2DegreesInvesting · Feb 8, 2024 · 4a0f6db · 4a0f6db
1 parent d03ced5
commit 4a0f6db
Show file tree

Hide file tree

Showing 2 changed files with 68 additions and 25 deletions.
diff --git a/R/utils-score_transition_risk.R b/R/utils-score_transition_risk.R
@@ -40,11 +40,11 @@ get_rows_union_for_common_cols <-
   function(emissions_at_product_level,
            sector_at_product_level) {
     emission_common_columns <- emissions_at_product_level |>
-      select(common_columns_emissions_sector()) |>
+      select(common_columns_emissions_sector_at_product_level()) |>
       distinct()
 
     sector_common_columns <- sector_at_product_level |>
-      select(common_columns_emissions_sector()) |>
+      select(common_columns_emissions_sector_at_product_level()) |>
       distinct()
 
     distinct(bind_rows(emission_common_columns, sector_common_columns))
@@ -69,15 +69,8 @@ product_level_trs_ranking_reduction_columns <- function() {
 }
 
 trs_company_columns <- function() {
-  c(
-    "companies_id",
-    "company_name",
-    "country",
-    "company_city",
-    "benchmark_tr_score",
-    "postcode",
-    "address",
-    "main_activity"
+  c(common_columns_emissions_sector_at_company_level(),
+    "benchmark_tr_score"
   )
 }
 
@@ -98,13 +91,13 @@ trs_company_output_columns <- function() {
 
 trs_product_output_columns <- function() {
   c(
-    common_columns_emissions_sector(),
+    common_columns_emissions_sector_at_product_level(),
     product_level_trs_ranking_reduction_columns(),
     "benchmark_tr_score"
   )
 }
 
-common_columns_emissions_sector <- function() {
+common_columns_emissions_sector_at_product_level <- function() {
   c(
     "companies_id",
     "company_name",
@@ -128,3 +121,15 @@ common_columns_emissions_sector <- function() {
     "ei_geography"
   )
 }
+
+common_columns_emissions_sector_at_company_level <- function() {
+  c(
+    "companies_id",
+    "company_name",
+    "country",
+    "company_city",
+    "postcode",
+    "address",
+    "main_activity"
+  )
+}
diff --git a/tests/testthat/test-score_transition_risk.R b/tests/testthat/test-score_transition_risk.R
@@ -7,10 +7,8 @@ test_that("outputs expected columns at product level", {
     filter(companies_id == "antimonarchy_canine")
 
   out <-
-    score_transition_risk(
-      emissions_profile_at_product_level,
-      sector_profile_at_product_level
-    ) |>
+    score_transition_risk(emissions_profile_at_product_level,
+                          sector_profile_at_product_level) |>
     unnest_product()
 
   expect_equal(sort(names(out)), sort(trs_product_output_columns()))
@@ -25,10 +23,8 @@ test_that("outputs expected columns at company level", {
     filter(companies_id == "antimonarchy_canine")
 
   out <-
-    score_transition_risk(
-      emissions_profile_at_product_level,
-      sector_profile_at_product_level
-    ) |>
+    score_transition_risk(emissions_profile_at_product_level,
+                          sector_profile_at_product_level) |>
     unnest_company()
 
   expect_equal(sort(names(out)), sort(trs_company_output_columns()))
@@ -47,10 +43,8 @@ test_that(
       filter(companies_id %in% c("celestial_lovebird", "nonphilosophical_llama"))
 
     out <-
-      score_transition_risk(
-        emissions_profile_at_product_level,
-        sector_profile_at_product_level
-      ) |>
+      score_transition_risk(emissions_profile_at_product_level,
+                            sector_profile_at_product_level) |>
       unnest_product()
 
     tr_score_na <- out |>
@@ -66,3 +60,47 @@ test_that(
     expect_equal(benchmark_tr_score_na, ranking_reduction_na)
   }
 )
+
+test_that(
+  "product level and company level outputs contain additional info of all
+  uncommon/unmatched companies after joining emissions companies with sector companies",
+  {
+    emissions_profile_at_product_level <-
+      example_emissions_profile_at_product_level() |>
+      filter(companies_id %in% c("antimonarchy_canine", "nonphilosophical_llama"))
+    sector_profile_at_product_level <-
+      example_sector_profile_at_product_level() |>
+      filter(companies_id %in% c("celestial_lovebird", "nonphilosophical_llama"))
+
+    trs_product <-
+      score_transition_risk(emissions_profile_at_product_level,
+                            sector_profile_at_product_level) |>
+      unnest_product()
+
+    trs_company <-
+      score_transition_risk(emissions_profile_at_product_level,
+                            sector_profile_at_product_level) |>
+      unnest_company()
+
+    # NA values in `profile_ranking` and `reduction_targets` columns due to unmatched companies
+    unmatched_product_output <- trs_product |>
+      filter(is.na(profile_ranking) | is.na(reduction_targets))
+    unmatched_company_output <- trs_company |>
+      filter(is.na(profile_ranking_avg) |
+               is.na(reduction_targets_avg))
+
+    # Select NA values in common columns of unmatched companies (except columns
+    # computed by `score_transition_risk` function)
+    null_common_cols_product <- unmatched_product_output |>
+      select(common_columns_emissions_sector_at_product_level()) |>
+      filter(if_any(everything(), is.na))
+    null_common_cols_company <- unmatched_company_output |>
+      select(common_columns_emissions_sector_at_company_level()) |>
+      filter(if_any(everything(), is.na))
+
+    # These checks ensures that there is not even a single NA in common columns
+    # of unmatched companies at both product and company level
+    expect_true(nrow(null_common_cols_product) == 0)
+    expect_true(nrow(null_common_cols_company) == 0)
+  }
+)