diff --git a/tests/testthat/test-emissions_profile.R b/tests/testthat/test-emissions_profile.R index 5393d2303..f7ff00810 100644 --- a/tests/testthat/test-emissions_profile.R +++ b/tests/testthat/test-emissions_profile.R @@ -97,3 +97,80 @@ test_that("in each benchmark, `profile_ranking` increases with `*co2_footprint`" expect_true(in_all_benchmarks_profile_ranking_increases_with_co2_footprint) }) + + +test_that("at product level, `NA` in a benchmark column yields `NA` in the corresponding `risk_category` and `profile_ranking` (#638)", { + companies <- example_companies() + + benchmark <- "isic_4digit" + co2 <- example_products("{ benchmark }" := NA) + + out <- emissions_profile(companies, co2) + product <- unnest_product(out) + + corresponding <- filter(product, grouped_by == benchmark) + expect_true(is.na(corresponding$risk_category)) + expect_true(is.na(corresponding$profile_ranking)) +}) + +test_that("at product level, with no match preserves unmatched products, filling with `NA`s (#657)", { + companies <- example_companies(!!aka("uid") := c("unmatched")) + + products <- example_products() + out <- emissions_profile(companies, products) |> unnest_product() + + expect_equal(nrow(out), 1) + expect_equal(out[[aka("uid")]], "unmatched") + + na_cols <- setdiff(cols_na_at_product_level(), aka("uid")) + all_na_cols_are_na <- all(map_lgl(na_cols, ~ is.na(out[[.x]]))) + expect_true(all_na_cols_are_na) +}) + +test_that("at product level, with some match preserves unmatched products, filling with `NA`s (#657)", { + companies <- example_companies(!!aka("uid") := c("a", "unmatched")) + + products <- example_products() + out <- emissions_profile(companies, products) |> unnest_product() + + expect_true("unmatched" %in% out[[aka("uid")]]) + + unmatched_row <- 1 + expect_equal(nrow(out), length(flat_benchmarks(products)) + unmatched_row) + + unmatched <- filter(out, out[[aka("uid")]] == "unmatched") + na_cols <- setdiff(cols_na_at_product_level(), aka("uid")) + all_na_cols_are_na <- all(map_lgl(na_cols, ~ is.na(unmatched[[.x]]))) + expect_true(all_na_cols_are_na) +}) + +test_that("at product level, with no match preserves unmatched products, filling with `NA`s (#657)", { + companies <- example_companies(!!aka("uid") := c("unmatched")) + + co2 <- example_products() + out <- emissions_profile(companies, co2) |> unnest_product() + + expect_equal(nrow(out), 1) + expect_equal(out[[aka("uid")]], "unmatched") + + na_cols <- setdiff(cols_na_at_product_level(), aka("uid")) + all_na_cols_are_na <- all(map_lgl(na_cols, ~ is.na(out[[.x]]))) + expect_true(all_na_cols_are_na) +}) + +test_that("at product level, with some match preserves unmatched products, filling with `NA`s (#657)", { + companies <- example_companies(!!aka("uid") := c("a", "unmatched")) + + co2 <- example_products() + out <- emissions_profile(companies, co2) |> unnest_product() + + expect_true("unmatched" %in% out[[aka("uid")]]) + + unmatched_row <- 1 + expect_equal(nrow(out), length(flat_benchmarks(co2)) + unmatched_row) + + unmatched <- filter(out, out[[aka("uid")]] == "unmatched") + na_cols <- setdiff(cols_na_at_product_level(), aka("uid")) + all_na_cols_are_na <- all(map_lgl(na_cols, ~ is.na(unmatched[[.x]]))) + expect_true(all_na_cols_are_na) +}) 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 c1ac1f9d5..e9f347041 100644 --- a/tests/testthat/test-emissions_profile_any_at_product_level.R +++ b/tests/testthat/test-emissions_profile_any_at_product_level.R @@ -20,51 +20,6 @@ test_that("outputs expected columns at product level", { expect_named(out, expected) }) -test_that("unmatched products don't introduce NA's (#266)", { - companies <- example_companies(!!aka("uid") := c("a", "unmatched")) - - products <- example_products() - out <- emissions_profile_any_at_product_level(companies, products) - expect_false(anyNA(out$risk_category)) - - inputs <- example_inputs() - out <- emissions_profile_any_at_product_level(companies, inputs) - expect_false(anyNA(out$risk_category)) -}) - -test_that("some match yields no NA and no match yields 1 row with `NA`s (#393)", { - companies <- example_companies( - !!aka("id") := c("a", "a", "b", "b"), - !!aka("uid") := c("a", paste0("unmatched", 1:3)) - ) - - products <- example_products() - out <- emissions_profile_any_at_product_level(companies, products) - - some_match <- filter(out, companies_id == "a") - expect_false(anyNA(some_match)) - - no_match <- filter(out, companies_id == "b") - expect_equal(nrow(no_match), 1) - - na_cols <- cols_na_at_product_level() - all_na_cols_are_na <- all(map_lgl(na_cols, ~ is.na(no_match[[.x]]))) - expect_true(all_na_cols_are_na) - - inputs <- example_inputs() - out <- emissions_profile_any_at_product_level(companies, inputs) - - some_match <- filter(out, companies_id == "a") - expect_false(anyNA(some_match)) - - no_match <- filter(out, companies_id == "b") - expect_equal(nrow(no_match), 1) - - na_cols <- cols_na_at_product_level() - all_na_cols_are_na <- all(map_lgl(na_cols, ~ is.na(no_match[[.x]]))) - expect_true(all_na_cols_are_na) -}) - test_that("with duplicated co2 throws no error (#435)", { companies <- example_companies() duplicated <- c("a", "a") diff --git a/tests/testthat/test-emissions_profile_upstream.R b/tests/testthat/test-emissions_profile_upstream.R index 89623970a..685d7487e 100644 --- a/tests/testthat/test-emissions_profile_upstream.R +++ b/tests/testthat/test-emissions_profile_upstream.R @@ -140,3 +140,48 @@ test_that("in each benchmark, `profile_ranking` increases with `*co2_footprint`" expect_true(in_all_benchmarks_profile_ranking_increases_with_co2_footprint) }) + +test_that("at product level, `NA` in a benchmark column yields `NA` in the corresponding `risk_category` and `profile_ranking` (#638)", { + companies <- example_companies() + + benchmark <- "input_isic_4digit" + co2 <- example_inputs("{ benchmark }" := NA) + + out <- emissions_profile_upstream(companies, co2) + product <- unnest_product(out) + + corresponding <- filter(product, grouped_by == benchmark) + expect_true(is.na(corresponding$risk_category)) + expect_true(is.na(corresponding$profile_ranking)) +}) + +test_that("at product level, with no match preserves unmatched products, filling with `NA`s (#657)", { + companies <- example_companies(!!aka("uid") := c("unmatched")) + + co2 <- example_inputs() + out <- emissions_profile_upstream(companies, co2) |> unnest_product() + + expect_equal(nrow(out), 1) + expect_equal(out[[aka("uid")]], "unmatched") + + na_cols <- setdiff(cols_na_at_product_level(), aka("uid")) + all_na_cols_are_na <- all(map_lgl(na_cols, ~ is.na(out[[.x]]))) + expect_true(all_na_cols_are_na) +}) + +test_that("at product level, with some match preserves unmatched products, filling with `NA`s (#657)", { + companies <- example_companies(!!aka("uid") := c("a", "unmatched")) + + co2 <- example_inputs() + out <- emissions_profile_upstream(companies, co2) |> unnest_product() + + expect_true("unmatched" %in% out[[aka("uid")]]) + + unmatched_row <- 1 + expect_equal(nrow(out), length(flat_benchmarks(co2)) + unmatched_row) + + unmatched <- filter(out, out[[aka("uid")]] == "unmatched") + na_cols <- setdiff(cols_na_at_product_level(), aka("uid")) + all_na_cols_are_na <- all(map_lgl(na_cols, ~ is.na(unmatched[[.x]]))) + expect_true(all_na_cols_are_na) +})