From 407c6e5c957a538e5948a617342b148625489a28 Mon Sep 17 00:00:00 2001 From: Kalash Singhal Date: Tue, 25 Jun 2024 09:26:57 +0200 Subject: [PATCH 1/2] change benchmark from tilt_sector to tilt_subsector --- R/compute_profile_ranking.R | 10 +- R/emissions_profile_any_at_product_level.R | 2 +- R/example_dictionary.R | 2 +- man/emissions_profile.Rd | 4 +- tests/testthat/_snaps/emissions_profile.md | 100 +++++++++--------- .../_snaps/emissions_profile_upstream.md | 100 +++++++++--------- tests/testthat/test-emissions_profile.R | 6 +- ...t-emissions_profile_any_at_company_level.R | 14 +-- ...t-emissions_profile_any_at_product_level.R | 4 +- .../test-emissions_profile_upstream.R | 4 +- .../test-epa_compute_profile_ranking.R | 10 +- 11 files changed, 128 insertions(+), 128 deletions(-) diff --git a/R/compute_profile_ranking.R b/R/compute_profile_ranking.R index 00eb995f9..298ab23d4 100644 --- a/R/compute_profile_ranking.R +++ b/R/compute_profile_ranking.R @@ -23,7 +23,7 @@ epa_compute_profile_ranking <- function(data) { exclude <- short_isic(data) | is.na(get_column(data, aka("isic"))) | - is.na(get_column(data, aka("tsector"))) | + is.na(get_column(data, aka("tsubsector"))) | is.na(get_column(data, aka("xunit"))) list(!exclude, exclude) |> @@ -41,7 +41,7 @@ epa_compute_profile_ranking_impl <- function(data) { } check_epa_compute_profile_ranking <- function(data) { - crucial <- c(aka("tsector"), aka("xunit"), aka("isic"), aka("co2footprint")) + crucial <- c(aka("tsubsector"), aka("xunit"), aka("isic"), aka("co2footprint")) walk(crucial, \(pattern) check_matches_name(data, pattern)) } @@ -53,10 +53,10 @@ epa_benchmarks <- function(data) { list( "all", extract_name(data, aka("isic")), - extract_name(data, aka("tsector")), + extract_name(data, aka("tsubsector")), extract_name(data, aka("xunit")), c(extract_name(data, aka("xunit")), extract_name(data, aka("isic"))), - c(extract_name(data, aka("xunit")), extract_name(data, aka("tsector"))) + c(extract_name(data, aka("xunit")), extract_name(data, aka("tsubsector"))) ) } @@ -78,7 +78,7 @@ assign_na_to_profile_ranking_in_special_cases <- function(data) { mutate(profile_ranking = case_when( data |> should_be_na_when_isic_has_2_or_3_digits() ~ NA, data |> should_be_na_when_missing(aka("isic")) ~ NA, - data |> should_be_na_when_missing(aka("tsector")) ~ NA, + data |> should_be_na_when_missing(aka("tsubsector")) ~ NA, data |> should_be_na_when_missing(aka("xunit")) ~ NA, .default = .data$profile_ranking )) diff --git a/R/emissions_profile_any_at_product_level.R b/R/emissions_profile_any_at_product_level.R index e89b179a2..184085293 100644 --- a/R/emissions_profile_any_at_product_level.R +++ b/R/emissions_profile_any_at_product_level.R @@ -25,7 +25,7 @@ epa_check <- function(x) { crucial <- id_pattern() check_matches_name(x$companies, crucial) - crucial <- c(aka("co2footprint"), aka("tsector"), aka("isic"), aka("xunit")) + crucial <- c(aka("co2footprint"), aka("tsubsector"), aka("isic"), aka("xunit")) walk(crucial, ~ check_matches_name(x$co2, .x)) check_has_no_na(x$co2, find_co2_footprint(x$co2)) diff --git a/R/example_dictionary.R b/R/example_dictionary.R index 382f2ab7b..f0453025b 100644 --- a/R/example_dictionary.R +++ b/R/example_dictionary.R @@ -96,7 +96,7 @@ example_id <- function() { 18L, 4L, 2L, 13L, 1L, 2L, 1L, 1L, 3L, - 16L, 1L, 3L, + 17L, 1L, 3L, 19L, 1L, 3L, 11L, 7L, 3L, 3L, 6L, 3L, diff --git a/man/emissions_profile.Rd b/man/emissions_profile.Rd index 2efd76d58..280e89426 100644 --- a/man/emissions_profile.Rd +++ b/man/emissions_profile.Rd @@ -38,10 +38,10 @@ dataset to the products from the LCA dataset. \enumerate{ \item \code{all}: All products. \item \code{isic_4digit}: All products within the same ISIC 4 digit code (example: 0112 Growing of rice). -\item \code{tilt_sector}: All products within the same tilt sector (example: agriculture). +\item \code{tilt_subsector}: All products within the same tilt sector (example: agriculture). \item \code{unit}: All products with the same unit (example: kg). \item \code{unit_isic_4digit}: All products with the same unit within the same ISIC 4 digit section (example: kg + 0112 Growing of rice). -\item \code{unit_tilt_sector}: All products with the same unit within the same tilt sector (example: kg + agriculture). +\item \code{unit_tilt_subsector}: All products with the same unit within the same tilt sector (example: kg + agriculture). } \item For each benchmark, products are assigned to the emission profile category "low", "medium" or "high", depending on the GHG emissions arising from their diff --git a/tests/testthat/_snaps/emissions_profile.md b/tests/testthat/_snaps/emissions_profile.md index 04f143c43..17f836476 100644 --- a/tests/testthat/_snaps/emissions_profile.md +++ b/tests/testthat/_snaps/emissions_profile.md @@ -13,13 +13,13 @@ 6 antimonarchy_canine [[2]] - grouped_by - 1 all - 2 isic_4digit - 3 tilt_sector - 4 unit - 5 unit_isic_4digit - 6 unit_tilt_sector + grouped_by + 1 all + 2 isic_4digit + 3 tilt_subsector + 4 unit + 5 unit_isic_4digit + 6 unit_tilt_subsector [[3]] risk_category @@ -100,31 +100,31 @@ 24 antimonarchy_canine [[2]] - grouped_by - 1 all - 2 all - 3 all - 4 all - 5 isic_4digit - 6 isic_4digit - 7 isic_4digit - 8 isic_4digit - 9 tilt_sector - 10 tilt_sector - 11 tilt_sector - 12 tilt_sector - 13 unit - 14 unit - 15 unit - 16 unit - 17 unit_isic_4digit - 18 unit_isic_4digit - 19 unit_isic_4digit - 20 unit_isic_4digit - 21 unit_tilt_sector - 22 unit_tilt_sector - 23 unit_tilt_sector - 24 unit_tilt_sector + grouped_by + 1 all + 2 all + 3 all + 4 all + 5 isic_4digit + 6 isic_4digit + 7 isic_4digit + 8 isic_4digit + 9 tilt_subsector + 10 tilt_subsector + 11 tilt_subsector + 12 tilt_subsector + 13 unit + 14 unit + 15 unit + 16 unit + 17 unit_isic_4digit + 18 unit_isic_4digit + 19 unit_isic_4digit + 20 unit_isic_4digit + 21 unit_tilt_subsector + 22 unit_tilt_subsector + 23 unit_tilt_subsector + 24 unit_tilt_subsector [[3]] risk_category @@ -204,22 +204,22 @@ no_missing_benchmark Output # A tibble: 16 x 4 - companies_id grouped_by risk_category value - - 1 a all high 0.4 - 2 a all medium 0.2 - 3 a all low 0.2 - 4 a all 0.2 - 5 a tilt_sector high 0.4 - 6 a tilt_sector medium 0.2 - 7 a tilt_sector low 0.2 - 8 a tilt_sector 0.2 - 9 a unit high 0.4 - 10 a unit medium 0.2 - 11 a unit low 0.2 - 12 a unit 0.2 - 13 a unit_tilt_sector high 0.4 - 14 a unit_tilt_sector medium 0.2 - 15 a unit_tilt_sector low 0.2 - 16 a unit_tilt_sector 0.2 + companies_id grouped_by risk_category value + + 1 a all high 0.4 + 2 a all medium 0.2 + 3 a all low 0.2 + 4 a all 0.2 + 5 a tilt_subsector high 0.4 + 6 a tilt_subsector medium 0.2 + 7 a tilt_subsector low 0.2 + 8 a tilt_subsector 0.2 + 9 a unit high 0.4 + 10 a unit medium 0.2 + 11 a unit low 0.2 + 12 a unit 0.2 + 13 a unit_tilt_subsector high 0.4 + 14 a unit_tilt_subsector medium 0.2 + 15 a unit_tilt_subsector low 0.2 + 16 a unit_tilt_subsector 0.2 diff --git a/tests/testthat/_snaps/emissions_profile_upstream.md b/tests/testthat/_snaps/emissions_profile_upstream.md index 07a81368b..c706a3597 100644 --- a/tests/testthat/_snaps/emissions_profile_upstream.md +++ b/tests/testthat/_snaps/emissions_profile_upstream.md @@ -13,13 +13,13 @@ 6 antimonarchy_canine [[2]] - grouped_by - 1 all - 2 input_isic_4digit - 3 input_tilt_sector - 4 input_unit - 5 input_unit_input_isic_4digit - 6 input_unit_input_tilt_sector + grouped_by + 1 all + 2 input_isic_4digit + 3 input_tilt_subsector + 4 input_unit + 5 input_unit_input_isic_4digit + 6 input_unit_input_tilt_subsector [[3]] risk_category @@ -109,31 +109,31 @@ 24 antimonarchy_canine [[2]] - grouped_by - 1 all - 2 all - 3 all - 4 all - 5 input_isic_4digit - 6 input_isic_4digit - 7 input_isic_4digit - 8 input_isic_4digit - 9 input_tilt_sector - 10 input_tilt_sector - 11 input_tilt_sector - 12 input_tilt_sector - 13 input_unit - 14 input_unit - 15 input_unit - 16 input_unit - 17 input_unit_input_isic_4digit - 18 input_unit_input_isic_4digit - 19 input_unit_input_isic_4digit - 20 input_unit_input_isic_4digit - 21 input_unit_input_tilt_sector - 22 input_unit_input_tilt_sector - 23 input_unit_input_tilt_sector - 24 input_unit_input_tilt_sector + grouped_by + 1 all + 2 all + 3 all + 4 all + 5 input_isic_4digit + 6 input_isic_4digit + 7 input_isic_4digit + 8 input_isic_4digit + 9 input_tilt_subsector + 10 input_tilt_subsector + 11 input_tilt_subsector + 12 input_tilt_subsector + 13 input_unit + 14 input_unit + 15 input_unit + 16 input_unit + 17 input_unit_input_isic_4digit + 18 input_unit_input_isic_4digit + 19 input_unit_input_isic_4digit + 20 input_unit_input_isic_4digit + 21 input_unit_input_tilt_subsector + 22 input_unit_input_tilt_subsector + 23 input_unit_input_tilt_subsector + 24 input_unit_input_tilt_subsector [[3]] risk_category @@ -213,22 +213,22 @@ no_missing_benchmark Output # A tibble: 16 x 4 - companies_id grouped_by risk_category value - - 1 a all high 0.4 - 2 a all medium 0.2 - 3 a all low 0.2 - 4 a all 0.2 - 5 a input_tilt_sector high 0.4 - 6 a input_tilt_sector medium 0.2 - 7 a input_tilt_sector low 0.2 - 8 a input_tilt_sector 0.2 - 9 a input_unit high 0.4 - 10 a input_unit medium 0.2 - 11 a input_unit low 0.2 - 12 a input_unit 0.2 - 13 a input_unit_input_tilt_sector high 0.4 - 14 a input_unit_input_tilt_sector medium 0.2 - 15 a input_unit_input_tilt_sector low 0.2 - 16 a input_unit_input_tilt_sector 0.2 + companies_id grouped_by risk_category value + + 1 a all high 0.4 + 2 a all medium 0.2 + 3 a all low 0.2 + 4 a all 0.2 + 5 a input_tilt_subsector high 0.4 + 6 a input_tilt_subsector medium 0.2 + 7 a input_tilt_subsector low 0.2 + 8 a input_tilt_subsector 0.2 + 9 a input_unit high 0.4 + 10 a input_unit medium 0.2 + 11 a input_unit low 0.2 + 12 a input_unit 0.2 + 13 a input_unit_input_tilt_subsector high 0.4 + 14 a input_unit_input_tilt_subsector medium 0.2 + 15 a input_unit_input_tilt_subsector low 0.2 + 16 a input_unit_input_tilt_subsector 0.2 diff --git a/tests/testthat/test-emissions_profile.R b/tests/testthat/test-emissions_profile.R index 5077236bb..7ac40e204 100644 --- a/tests/testthat/test-emissions_profile.R +++ b/tests/testthat/test-emissions_profile.R @@ -57,7 +57,7 @@ test_that("at product level, `NA` in a benchmark yields `NA` in `risk_category` expect_true(is.na(out$risk_category)) expect_true(is.na(out$profile_ranking)) - benchmark <- "tilt_sector" + benchmark <- "tilt_subsector" co2 <- example_products("{ benchmark }" := NA) out <- emissions_profile(companies, co2) |> unnest_product() |> @@ -94,7 +94,7 @@ test_that("at product level, `NA` in a benchmark yields `NA`s only in the corres expect_false(is.na(filter(out, clustered == "a")$risk_category)) expect_true(is.na(filter(out, clustered == "b")$risk_category)) - benchmark <- "tilt_sector" + benchmark <- "tilt_subsector" co2 <- example_products( !!aka("uid") := c("a", "b"), "{ benchmark }" := c("a", NA) @@ -215,7 +215,7 @@ test_that("at company level, `NA` in a benchmark yields `value = 1` where `group pull(sum) |> expect_equal(1) - benchmark <- "tilt_sector" + benchmark <- "tilt_subsector" co2 <- example_products("{ benchmark }" := c(NA)) out <- emissions_profile(companies, co2) |> unnest_company() # For each benchmark `value` adds to 1 diff --git a/tests/testthat/test-emissions_profile_any_at_company_level.R b/tests/testthat/test-emissions_profile_any_at_company_level.R index 79a2cd49e..1c5d71444 100644 --- a/tests/testthat/test-emissions_profile_any_at_company_level.R +++ b/tests/testthat/test-emissions_profile_any_at_company_level.R @@ -91,15 +91,15 @@ test_that("for each company & benchmark, each risk category is unique (#285)", { "-fred-sl_00000005407085-741049001", "fish, deep-frozen", "26104519-4d49-5d85-bc74-e8e03d1a7914_cdbf0bef-39f7-46c8-87a2-3f9f679b5bb7", "kg" ) co2 <- tribble( - ~activity_uuid_product_uuid, ~unit, ~tilt_sector, ~isic_4digit, ~co2_footprint, + ~activity_uuid_product_uuid, ~unit, ~tilt_subsector, ~isic_4digit, ~co2_footprint, # In companies - "0fe31e67-346a-504c-a03d-64f85ccc2a64_a459eea1-4e62-4daf-9135-1aea9805aa90", "kg", NA, "0311", 2.83222756713596, - "26104519-4d49-5d85-bc74-e8e03d1a7914_cdbf0bef-39f7-46c8-87a2-3f9f679b5bb7", "kg", NA, "0311", 2.1156617059259, + "0fe31e67-346a-504c-a03d-64f85ccc2a64_a459eea1-4e62-4daf-9135-1aea9805aa90", "kg", NA, "0311", 2.83222756713596, + "26104519-4d49-5d85-bc74-e8e03d1a7914_cdbf0bef-39f7-46c8-87a2-3f9f679b5bb7", "kg", NA, "0311", 2.1156617059259, # Not in companies - "0faa7ecb-fef2-5117-8993-387c1898ffc8_c33b5236-001e-49b5-aa3d-810c0214f9ce", "kg", "Steel and Metals", "2410", 4.94911765272901, - "9b414d69-2bd2-5b44-bd5d-56672896aac5_0f2ea065-f26c-4356-a261-39ef2799aea4", "unit", "Construction Industry", "4322", 11266.1570789735, - "74c3b4f6-dc3d-5e13-badf-70b4c3a965d3_54186f39-acc2-4c84-95e7-fbb067bde4cd", "ha", NA, "0161", 51.6463779571345, - "72651603-406a-545d-a03d-1d1caf656efb_765e7edf-19bc-4110-bb7c-32df8d749c54", "m3", "Non-metallic Minerals", "2395", 424.269497499198 + "0faa7ecb-fef2-5117-8993-387c1898ffc8_c33b5236-001e-49b5-aa3d-810c0214f9ce", "kg", "Steel and Metals", "2410", 4.94911765272901, + "9b414d69-2bd2-5b44-bd5d-56672896aac5_0f2ea065-f26c-4356-a261-39ef2799aea4", "unit", "Construction Industry", "4322", 11266.1570789735, + "74c3b4f6-dc3d-5e13-badf-70b4c3a965d3_54186f39-acc2-4c84-95e7-fbb067bde4cd", "ha", NA, "0161", 51.6463779571345, + "72651603-406a-545d-a03d-1d1caf656efb_765e7edf-19bc-4110-bb7c-32df8d749c54", "m3", "Non-metallic Minerals", "2395", 424.269497499198 ) # styler: on diff --git a/tests/testthat/test-emissions_profile_any_at_product_level.R b/tests/testthat/test-emissions_profile_any_at_product_level.R index e9f347041..7200be75b 100644 --- a/tests/testthat/test-emissions_profile_any_at_product_level.R +++ b/tests/testthat/test-emissions_profile_any_at_product_level.R @@ -52,7 +52,7 @@ test_that("if `co2` lacks crucial columns, errors gracefully", { bad <- select(products, -ends_with(crucial)) expect_error(emissions_profile_any_at_product_level(companies, bad), crucial) - crucial <- aka("tsector") + crucial <- aka("tsubsector") bad <- select(products, -ends_with(crucial)) expect_error(emissions_profile_any_at_product_level(companies, bad), crucial) @@ -163,7 +163,7 @@ test_that("if `inputs` lacks crucial columns, errors gracefully", { bad <- select(inputs, -ends_with(crucial)) expect_error(emissions_profile_any_at_product_level(companies, bad), crucial) - crucial <- aka("tsector") + crucial <- aka("tsubsector") bad <- select(inputs, -ends_with(crucial)) expect_error(emissions_profile_any_at_product_level(companies, bad), crucial) diff --git a/tests/testthat/test-emissions_profile_upstream.R b/tests/testthat/test-emissions_profile_upstream.R index 5a603f0d8..9c190515b 100644 --- a/tests/testthat/test-emissions_profile_upstream.R +++ b/tests/testthat/test-emissions_profile_upstream.R @@ -181,7 +181,7 @@ test_that("at product level, `NA` in a benchmark yields `NA`s only in the corres expect_false(is.na(filter(out, clustered == "a")$risk_category)) expect_true(is.na(filter(out, clustered == "b")$risk_category)) - benchmark <- "input_tilt_sector" + benchmark <- "input_tilt_subsector" co2 <- example_inputs( !!aka("uid") := c("a", "b"), "{ benchmark }" := c("a", NA) @@ -301,7 +301,7 @@ test_that("at company level, `NA` in a benchmark yields `value = 1` where `group pull(sum) |> expect_equal(1) - benchmark <- "input_tilt_sector" + benchmark <- "input_tilt_subsector" co2 <- example_inputs("{ benchmark }" := c(NA)) out <- emissions_profile_upstream(companies, co2) |> unnest_company() # For each benchmark `value` adds to 1 diff --git a/tests/testthat/test-epa_compute_profile_ranking.R b/tests/testthat/test-epa_compute_profile_ranking.R index 93b8bc007..dc9ef2bbf 100644 --- a/tests/testthat/test-epa_compute_profile_ranking.R +++ b/tests/testthat/test-epa_compute_profile_ranking.R @@ -36,7 +36,7 @@ test_that("with two companies, adds one row per benchmark per company", { test_that("without crucial columns errors gracefully", { co2 <- example_products() - crucial <- aka("tsector") + crucial <- aka("tsubsector") bad <- select(co2, -all_of(crucial)) expect_error(epa_compute_profile_ranking(bad), crucial) @@ -77,8 +77,8 @@ test_that("with inputs, `profile_ranking` is `1` for all maximum `*co2_footprint expect_false(any(other$profile_ranking == 1.0)) }) -test_that("`profile_ranking` excludes-rows and is `NA` where `tilt_sector` is `NA` and `grouped_by` matches *tilt_sector", { - pattern <- aka("tsector") +test_that("`profile_ranking` excludes-rows and is `NA` where `tilt_subsector` is `NA` and `grouped_by` matches *tilt_subsector", { + pattern <- aka("tsubsector") exclude <- NA_character_ co2 <- example_products(!!pattern := c("'1234'", "'1234'", exclude)) co2[find_co2_footprint(co2)] <- c(3, 2, 1) @@ -95,8 +95,8 @@ test_that("`profile_ranking` excludes-rows and is `NA` where `tilt_sector` is `N expect_equal(unique(should_be_na$profile_ranking), NA_integer_) }) -test_that("with inputs, `profile_ranking` excludes-rows and is `NA` where `tilt_sector` is `NA` and `grouped_by` matches *tilt_sector", { - pattern <- paste0("input_", aka("tsector")) +test_that("with inputs, `profile_ranking` excludes-rows and is `NA` where `tilt_subsector` is `NA` and `grouped_by` matches *tilt_subsector", { + pattern <- paste0("input_", aka("tsubsector")) exclude <- NA_character_ co2 <- example_inputs(!!pattern := c("'1234'", "'1234'", exclude)) co2[find_co2_footprint(co2)] <- c(3, 2, 1) From 9dc8e3a17babad55ba8c3ffdbcb0d39130ebfb79 Mon Sep 17 00:00:00 2001 From: Mauro Lepore Date: Tue, 25 Jun 2024 18:11:00 +0000 Subject: [PATCH 2/2] Revert-example_dictionary --- R/example_dictionary.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/example_dictionary.R b/R/example_dictionary.R index f0453025b..ee354fbca 100644 --- a/R/example_dictionary.R +++ b/R/example_dictionary.R @@ -88,6 +88,7 @@ example_id <- function() { 15L, 3L, 1L, 16L, 1L, 1L, 17L, 1L, 1L, + 17L, 1L, 3L, 18L, 4L, 1L, 14L, 2L, 2L, 15L, 3L, 2L, @@ -96,7 +97,7 @@ example_id <- function() { 18L, 4L, 2L, 13L, 1L, 2L, 1L, 1L, 3L, - 17L, 1L, 3L, + 16L, 1L, 3L, 19L, 1L, 3L, 11L, 7L, 3L, 3L, 6L, 3L,