refactor

Author: kalashsinghal

NAMESPACE

@@ -75,6 +75,7 @@ importFrom(dplyr,inner_join)
 importFrom(dplyr,left_join)
 importFrom(dplyr,mutate)
 importFrom(dplyr,n)
+importFrom(dplyr,n_distinct)
 importFrom(dplyr,near)
 importFrom(dplyr,pull)
 importFrom(dplyr,reframe)

R/compute_profile_ranking.R

@@ -82,7 +82,11 @@ assign_na_to_profile_ranking_in_special_cases <- function(data, excluded_uuids)
       data |> should_be_na_when_missing(aka("isic")) ~ NA,
       data |> should_be_na_when_missing(aka("tsubsector")) ~ NA,
       data |> should_be_na_when_missing(aka("xunit")) ~ NA,
-      data |> should_be_na_when_unique_uuids_is_1_for_unit_isic(excluded_uuids, "unit_isic_4digit") ~ NA,
+      data |> should_be_na_when_unique_uuids_is_1_for_unit_isic(
+        excluded_uuids,
+        extract_name(data, aka("xunit")),
+        extract_name(data, aka("isic"))
+      ) ~ NA,
       .default = .data$profile_ranking
     ))
 }
@@ -105,13 +109,28 @@ should_be_na_when_missing <- function(data, pattern) {
 }
 
 pull_uuids_with_unique_uuid_count_unit_isic_1 <- function(data) {
+  if ("input_activity_uuid_product_uuid" %in% colnames(data)) {
+    uuid <- "input_activity_uuid_product_uuid"
+  } else {
+    uuid <- "activity_uuid_product_uuid"
+  }
+
   data |>
-    mutate(unique_uuid_count_unit_isic = n_distinct(.data$activity_uuid_product_uuid), .by = c("unit", "isic_4digit")) |>
+    mutate(
+      unique_uuid_count_unit_isic = n_distinct(.data[[uuid]]),
+      .by = all_of(c(extract_name(data, aka("xunit")), extract_name(data, aka("isic"))))
+    ) |>
     filter(.data$unique_uuid_count_unit_isic == 1) |>
-    pull(activity_uuid_product_uuid) |>
+    pull(.data[[uuid]]) |>
     unique()
 }
 
-should_be_na_when_unique_uuids_is_1_for_unit_isic <- function(data, excluded_uuids, pattern) {
-  (get_column(data, aka("uid")) %in% excluded_uuids) & is_benchmark_to_exclude(data, pattern)
+should_be_na_when_unique_uuids_is_1_for_unit_isic <- function(data, excluded_uuids, pattern_unit, pattern_isic) {
+  if ("input_activity_uuid_product_uuid" %in% colnames(data)) {
+    uuid <- "input_activity_uuid_product_uuid"
+  } else {
+    uuid <- "activity_uuid_product_uuid"
+  }
+
+  (get_column(data, uuid) %in% excluded_uuids) & is_benchmark_to_exclude(data, paste0(pattern_unit, "_", pattern_isic))
 }

R/tiltIndicator-package.R

@@ -21,6 +21,7 @@
 #' @importFrom dplyr left_join
 #' @importFrom dplyr mutate
 #' @importFrom dplyr n
+#' @importFrom dplyr n_distinct
 #' @importFrom dplyr near
 #' @importFrom dplyr pull
 #' @importFrom dplyr reframe

tests/testthat/_snaps/emissions_profile.md

@@ -27,7 +27,7 @@
       2          high
       3          high
       4          high
-      5          high
+      5          <NA>
       6          high
       
       [[4]]
@@ -36,7 +36,7 @@
       2               1
       3               1
       4               1
-      5               1
+      5              NA
       6               1
       
       [[5]]
@@ -171,10 +171,10 @@
       14     0
       15     0
       16     0
-      17     1
+      17     0
       18     0
       19     0
-      20     0
+      20     1
       21     1
       22     0
       23     0

tests/testthat/_snaps/emissions_profile_upstream.md

@@ -27,7 +27,7 @@
       2          high
       3          high
       4          high
-      5          high
+      5          <NA>
       6          high
       
       [[4]]
@@ -36,7 +36,7 @@
       2          1.0000
       3          1.0000
       4          1.0000
-      5          1.0000
+      5              NA
       6          1.0000
       
       [[5]]
@@ -180,10 +180,10 @@
       14     0
       15     0
       16     0
-      17     1
+      17     0
       18     0
       19     0
-      20     0
+      20     1
       21     1
       22     0
       23     0
@@ -202,10 +202,10 @@
       2 a            input_isic_4digit            medium          0.2
       3 a            input_isic_4digit            low             0.2
       4 a            input_isic_4digit            <NA>            0.4
-      5 a            input_unit_input_isic_4digit high            0.2
-      6 a            input_unit_input_isic_4digit medium          0.2
-      7 a            input_unit_input_isic_4digit low             0.2
-      8 a            input_unit_input_isic_4digit <NA>            0.4
+      5 a            input_unit_input_isic_4digit high            0  
+      6 a            input_unit_input_isic_4digit medium          0  
+      7 a            input_unit_input_isic_4digit low             0  
+      8 a            input_unit_input_isic_4digit <NA>            1  
 
 ---
 

tests/testthat/test-emissions_profile.R

@@ -35,7 +35,8 @@ test_that("in each benchmark, `profile_ranking` increases with `*co2_footprint`"
   companies <- example_companies()
   co2 <- example_products(co2_footprint = -1:1)
 
-  out <- unnest_product(emissions_profile(companies, co2))
+  out <- unnest_product(emissions_profile(companies, co2)) |>
+    filter(grouped_by != "unit_isic_4digit")
 
   in_all_benchmarks_profile_ranking_increases_with_co2_footprint <- out |>
     group_by(grouped_by) |>
@@ -136,7 +137,8 @@ test_that("at company level, with two matched products and `NA` in one benchmark
   )
 
   out <- emissions_profile(companies, co2) |>
-    unnest_company()
+    unnest_company() |>
+    filter(grouped_by != "unit_isic_4digit")
   # expect `0.5` where `risk_category` is `NA`
   out |>
     filter(grepl(benchmark, grouped_by)) |>
@@ -340,6 +342,7 @@ test_that("at company level, 1 matched product yields `value = 1` in 1 `risk_cat
 
   out <- emissions_profile(companies, co2) |>
     unnest_company() |>
+    filter(grouped_by != "unit_isic_4digit") |>
     distinct(risk_category, value) |>
     pull(value)
 
@@ -370,6 +373,7 @@ test_that("at company level, one matched and one unmatched products yield `value
 
   out <- emissions_profile(companies, co2) |>
     unnest_company() |>
+    filter(grouped_by != "unit_isic_4digit") |>
     distinct(risk_category, value)
 
   na <- pull(filter(out, is.na(risk_category)), value)
@@ -459,6 +463,7 @@ test_that("at company level, 1 matched product, one missing benchmark, and one u
 
   isic <- emissions_profile(companies, co2) |>
     unnest_company() |>
+    filter(grouped_by != "unit_isic_4digit") |>
     filter(grepl(aka("isic"), grouped_by)) |>
     distinct(risk_category, value)
 

tests/testthat/test-emissions_profile_upstream.R

@@ -82,7 +82,8 @@ test_that("for a company with 3 products of varying footprints, value is 1/3 (#2
   )
 
   product <- emissions_profile_any_at_product_level(companies, inputs, low_threshold, high_threshold)
-  out <- epa_at_company_level(product)
+  out <- epa_at_company_level(product) |>
+    filter(grouped_by != "input_unit_input_isic_4digit")
   expect_true(identical(unique(out$value), expected_value))
 })
 
@@ -136,7 +137,8 @@ test_that("in each benchmark, `profile_ranking` increases with `*co2_footprint`"
   companies <- example_companies()
   co2 <- example_inputs(input_co2_footprint = -1:1)
 
-  out <- unnest_product(emissions_profile_upstream(companies, co2))
+  out <- unnest_product(emissions_profile_upstream(companies, co2)) |>
+    filter(grouped_by != "input_unit_input_isic_4digit")
 
   in_all_benchmarks_profile_ranking_increases_with_co2_footprint <- out |>
     group_by(grouped_by) |>
@@ -222,7 +224,8 @@ test_that("at company level, with two matched products and `NA` in one benchmark
   )
 
   out <- emissions_profile_upstream(companies, co2) |>
-    unnest_company()
+    unnest_company() |>
+    filter(grouped_by != "input_unit_input_isic_4digit")
   # expect `0.5` where `risk_category` is `NA`
   out |>
     filter(grepl(benchmark, grouped_by)) |>
@@ -254,7 +257,8 @@ test_that("at company level, `NA` in the benchmark of 1/3 products yields a `val
   )
 
   out <- emissions_profile_upstream(companies, co2) |>
-    unnest_company()
+    unnest_company() |>
+    filter(grouped_by != "input_unit_input_isic_4digit")
   # expect `1/3` where `risk_category` is `NA`
   out |>
     filter(grepl(benchmark, grouped_by)) |>
@@ -427,6 +431,7 @@ test_that("at company level, 1 matched product yields `value = 1` in 1 `risk_cat
 
   out <- emissions_profile_upstream(companies, co2) |>
     unnest_company() |>
+    filter(grouped_by != "input_unit_input_isic_4digit") |>
     distinct(risk_category, value) |>
     pull(value)
 
@@ -443,6 +448,7 @@ test_that("at company level, 2 matched products yield `value = 1` in 1 `risk_cat
 
   out <- emissions_profile_upstream(companies, co2) |>
     unnest_company() |>
+    filter(grouped_by != "input_unit_input_isic_4digit") |>
     distinct(risk_category, value) |>
     pull(value)
 
@@ -457,6 +463,7 @@ test_that("at company level, one matched and one unmatched products yield `value
 
   out <- emissions_profile_upstream(companies, co2) |>
     unnest_company() |>
+    filter(grouped_by != "input_unit_input_isic_4digit") |>
     distinct(risk_category, value)
 
   na <- pull(filter(out, is.na(risk_category)), value)
@@ -473,6 +480,7 @@ test_that("at company level, two matched and one unmatched products yield `value
 
   out <- emissions_profile_upstream(companies, co2) |>
     unnest_company() |>
+    filter(grouped_by != "input_unit_input_isic_4digit") |>
     distinct(risk_category, value)
 
   na <- pull(filter(out, is.na(risk_category)), value)
@@ -491,7 +499,8 @@ test_that("at company level, three products with different `co2_footprint` yield
     !!aka("ico2footprint") := 1:3,
   )
 
-  out <- emissions_profile_upstream(companies, co2) |> unnest_company()
+  out <- emissions_profile_upstream(companies, co2) |> unnest_company()|>
+    filter(grouped_by != "input_unit_input_isic_4digit")
 
   actual <- out |>
     filter(value != 0) |>
@@ -546,6 +555,7 @@ test_that("at company level, 1 matched product, one missing benchmark, and one u
 
   isic <- emissions_profile_upstream(companies, co2) |>
     unnest_company() |>
+    filter(grouped_by != "input_unit_input_isic_4digit") |>
     filter(grepl(aka("iisic"), grouped_by)) |>
     distinct(risk_category, value)
 

tests/testthat/test-epa_compute_profile_ranking.R

@@ -58,10 +58,12 @@ test_that("`profile_ranking` is `1` for all maximum `*co2_footprint`", {
   co2 <- example_products(!!pattern := c(1, 2, 3, 3, 3))
 
   out <- epa_compute_profile_ranking(co2)
-  max <- filter(out, .data[[pattern]] == max(.data[[pattern]]))
+  max <- filter(out, .data[[pattern]] == max(.data[[pattern]])) |>
+    filter(!is.na(profile_ranking))
   expect_true(all(max$profile_ranking == 1.0))
 
-  other <- filter(out, .data[[pattern]] != max(.data[[pattern]]))
+  other <- filter(out, .data[[pattern]] != max(.data[[pattern]])) |>
+    filter(!is.na(profile_ranking))
   expect_false(any(other$profile_ranking == 1.0))
 })
 
@@ -70,10 +72,12 @@ test_that("with inputs, `profile_ranking` is `1` for all maximum `*co2_footprint
   co2 <- example_inputs(!!pattern := c(1, 2, 3, 3, 3))
 
   out <- epa_compute_profile_ranking(co2)
-  max <- filter(out, .data[[pattern]] == max(.data[[pattern]]))
+  max <- filter(out, .data[[pattern]] == max(.data[[pattern]])) |>
+    filter(!is.na(profile_ranking))
   expect_true(all(max$profile_ranking == 1.0))
 
-  other <- filter(out, .data[[pattern]] != max(.data[[pattern]]))
+  other <- filter(out, .data[[pattern]] != max(.data[[pattern]])) |>
+    filter(!is.na(profile_ranking))
   expect_false(any(other$profile_ranking == 1.0))
 })