From bb7c2a28897c788c9579207caabca4729ba56602 Mon Sep 17 00:00:00 2001 From: Mauro Lepore Date: Wed, 15 May 2024 22:58:10 +0000 Subject: [PATCH] Meet Tilman's requirements --- tests/testthat/_snaps/sector_profile.md | 30 ++++++++++++++ tests/testthat/test-sector_profile.R | 52 ++++++++++++++++++++++++- 2 files changed, 80 insertions(+), 2 deletions(-) create mode 100644 tests/testthat/_snaps/sector_profile.md diff --git a/tests/testthat/_snaps/sector_profile.md b/tests/testthat/_snaps/sector_profile.md new file mode 100644 index 00000000..eb0ab6d1 --- /dev/null +++ b/tests/testthat/_snaps/sector_profile.md @@ -0,0 +1,30 @@ +# at product level, Tilman's example yields what he expects + + Code + product + Output + # A tibble: 5 x 11 + companies_id grouped_by risk_category profile_ranking clustered + + 1 a ipr_a_2050 high 1 a + 2 a weo_a_2050 medium 0.6 a + 3 a NA b + 4 a ipr_a_2050 low 0.3 c + 5 a weo_a_2050 NA c + # i 6 more variables: activity_uuid_product_uuid , tilt_sector , + # scenario , year , type , tilt_subsector + +# at company level, Tilman's example yields what he expects + + Code + product + Output + # A tibble: 5 x 5 + companies_id grouped_by risk_category profile_ranking clustered + + 1 a ipr_a_2050 high 1 a + 2 a weo_a_2050 medium 0.6 a + 3 a NA b + 4 a ipr_a_2050 low 0.3 c + 5 a weo_a_2050 NA c + diff --git a/tests/testthat/test-sector_profile.R b/tests/testthat/test-sector_profile.R index dcd17760..7f2cd260 100644 --- a/tests/testthat/test-sector_profile.R +++ b/tests/testthat/test-sector_profile.R @@ -147,6 +147,54 @@ test_that("at product level, given a `clustered` matching one but not a second ` expect_true("weo_w_2050" %in% product$grouped_by) }) -test_that("xxxxxx", { - expect_equal("TODO", "test cases 'a' and 'b' at product level") +test_that("at product level, Tilman's example yields what he expects", { + # https://docs.google.com/spreadsheets/d/16u9WNtVY-yDsq6kHANK3dyYGXTbNQ_Bn/edit#gid=156243064 + # styler: off + companies <- tribble( + ~companies_id, ~clustered, ~activity_uuid_product_uuid, ~tilt_sector, ~tilt_subsector, ~type, ~sector, ~subsector, + "a", "a", "a", "a", "a", "ipr", "total", "energy", + "a", "a", "a", "a", "a", "weo", "total", "energy", + "a", "b", "unmatched", "unmatched", "unmatched", "unmatched", "unmatched", "unmatched", + "a", "c", "unmatched", "c", "c", "ipr", "land use", "land use", + "a", "c", "unmatched", "c", "c", "weo", NA, NA + ) + scenarios <- tribble( + ~sector, ~subsector, ~year, ~reductions, ~type, ~scenario, + "total", "energy", 2050, 1.0, "ipr", "a", + "total", "energy", 2050, 0.6, "weo", "a", + "land use", "land use", 2050, 0.3, "ipr", "a" + ) + # styler: off + + # FIXME: Change for something less brittle + product <- sector_profile(companies, scenarios) |> + unnest_product() |> + arrange(clustered) + + expect_snapshot(product) +}) + +test_that("at company level, Tilman's example yields what he expects", { + # https://docs.google.com/spreadsheets/d/16u9WNtVY-yDsq6kHANK3dyYGXTbNQ_Bn/edit#gid=156243064 + # styler: off + companies <- tribble( + ~companies_id, ~clustered, ~activity_uuid_product_uuid, ~tilt_sector, ~tilt_subsector, ~type, ~sector, ~subsector, + "a", "a", "a", "a", "a", "ipr", "total", "energy", + "a", "a", "a", "a", "a", "weo", "total", "energy", + "a", "b", "unmatched", "unmatched", "unmatched", "unmatched", "unmatched", "unmatched", + "a", "c", "unmatched", "c", "c", "ipr", "land use", "land use", + "a", "c", "unmatched", "c", "c", "weo", NA, NA + ) + scenarios <- tribble( + ~sector, ~subsector, ~year, ~reductions, ~type, ~scenario, + "total", "energy", 2050, 1.0, "ipr", "a", + "total", "energy", 2050, 0.6, "weo", "a", + "land use", "land use", 2050, 0.3, "ipr", "a" + ) + # styler: off + + company <- sector_profile(companies, scenarios) |> unnest_company() + + # FIXME: Change for something less brittle + expect_snapshot(product) })