From b3c974e233688b1575c482c5234a38fae6d18e50 Mon Sep 17 00:00:00 2001 From: jacobvjk Date: Tue, 7 May 2024 15:15:20 +0200 Subject: [PATCH 1/3] add correct missing low carbon technologies to abcd --- R/join_abcd_scenario.R | 6 ++- tests/testthat/test-target_market_share.R | 45 +++++++++++++++++++++++ 2 files changed, 49 insertions(+), 2 deletions(-) diff --git a/R/join_abcd_scenario.R b/R/join_abcd_scenario.R index 6c6d8b39..b9e01687 100644 --- a/R/join_abcd_scenario.R +++ b/R/join_abcd_scenario.R @@ -160,11 +160,13 @@ add_green_technologies_to_abcd <- function(data, scenario) { unique() %>% inner_join(increasing_techs, by = c("sector", "technology")) - increasing_techs_not_in_abcd <- dplyr::filter( + increasing_techs_not_in_abcd <- dplyr::anti_join( increasing_techs_in_scenario, - !(.data[["technology"]] %in% unique(data$technology)) + data, + by = c("sector", "technology") ) + # TODO: the summarize should be replaced with a distinct. the left_join should be an inner_join to avoid adding NAs green_rows_to_add <- data %>% group_by( .data$name_company, diff --git a/tests/testthat/test-target_market_share.R b/tests/testthat/test-target_market_share.R index a58792c9..f3bdad3e 100644 --- a/tests/testthat/test-target_market_share.R +++ b/tests/testthat/test-target_market_share.R @@ -1494,3 +1494,48 @@ test_that("with duplicated id_loan throws informative error (#489)", { class = "unique_ids" ) }) + +test_that("target_market_share() calculates target_* values for missing low carbon technologies (#495)", { + match_result <- fake_matched() + + abcd <- fake_abcd( + sector = c(rep("automotive", 2), rep("hdv", 6)), + technology = c(rep("ice", 4), rep("hybrid", 2), rep("electric", 2)), + year = rep(c(2020, 2025), 4) + ) + + scen <- fake_scenario( + sector = "automotive", + technology = c(rep("ice", 2), rep("hybrid", 2), rep("electric", 2)), + year = rep(c(2020, 2025), 3), + tmsr = c(1, 0.5, 1, 1.5, 1, 1.5), + smsp = c(0, -0.08, 0, 0.1, 0, 0.1) + ) + + results_tms_lbk <- target_market_share( + match_result, + abcd, + scen, + region_isos = region_isos_stable + ) + + results_tms_lbk_targets <- results_tms_lbk %>% + dplyr::filter( + .data$sector == "automotive", + grepl("target_", .data$metric) + ) %>% + dplyr::arrange(.data$technology) %>% + dplyr::distinct(.data$technology) %>% + dplyr::pull() + + scen_technologies <- scen %>% + dplyr::filter(.data$sector == "automotive") %>% + dplyr::arrange(.data$technology) %>% + dplyr::distinct(.data$technology) %>% + dplyr::pull() + + expect_equal( + results_tms_lbk_targets, + scen_technologies + ) +}) From cd3137852f77b82b76319c39769aeaadb8280f99 Mon Sep 17 00:00:00 2001 From: jacobvjk Date: Tue, 7 May 2024 15:47:51 +0200 Subject: [PATCH 2/3] improve test --- tests/testthat/test-target_market_share.R | 39 +++++++++++++++++++---- 1 file changed, 33 insertions(+), 6 deletions(-) diff --git a/tests/testthat/test-target_market_share.R b/tests/testthat/test-target_market_share.R index f3bdad3e..7cafd620 100644 --- a/tests/testthat/test-target_market_share.R +++ b/tests/testthat/test-target_market_share.R @@ -1496,9 +1496,10 @@ test_that("with duplicated id_loan throws informative error (#489)", { }) test_that("target_market_share() calculates target_* values for missing low carbon technologies (#495)", { - match_result <- fake_matched() + match_result <- fake_matched(name_abcd = "company a") abcd <- fake_abcd( + name_company = "company a", sector = c(rep("automotive", 2), rep("hdv", 6)), technology = c(rep("ice", 4), rep("hybrid", 2), rep("electric", 2)), year = rep(c(2020, 2025), 4) @@ -1512,15 +1513,24 @@ test_that("target_market_share() calculates target_* values for missing low carb smsp = c(0, -0.08, 0, 0.1, 0, 0.1) ) - results_tms_lbk <- target_market_share( + scen_technologies <- scen %>% + dplyr::filter(.data$sector == "automotive") %>% + dplyr::arrange(.data$technology) %>% + dplyr::distinct(.data$technology) %>% + dplyr::pull() + + results_tms_comp <- target_market_share( match_result, abcd, scen, - region_isos = region_isos_stable + region_isos = region_isos_stable, + by_company = TRUE, + weight_production = FALSE ) - results_tms_lbk_targets <- results_tms_lbk %>% + results_tms_comp_targets <- results_tms_comp %>% dplyr::filter( + .data$name_abcd == "company a", .data$sector == "automotive", grepl("target_", .data$metric) ) %>% @@ -1528,8 +1538,25 @@ test_that("target_market_share() calculates target_* values for missing low carb dplyr::distinct(.data$technology) %>% dplyr::pull() - scen_technologies <- scen %>% - dplyr::filter(.data$sector == "automotive") %>% + expect_equal( + results_tms_comp_targets, + scen_technologies + ) + + results_tms_lbk <- target_market_share( + match_result, + abcd, + scen, + region_isos = region_isos_stable, + by_company = FALSE, + weight_production = TRUE + ) + + results_tms_lbk_targets <- results_tms_lbk %>% + dplyr::filter( + .data$sector == "automotive", + grepl("target_", .data$metric) + ) %>% dplyr::arrange(.data$technology) %>% dplyr::distinct(.data$technology) %>% dplyr::pull() From e160bdc14bca7c66f69de0473516d478f6759805 Mon Sep 17 00:00:00 2001 From: jacobvjk Date: Tue, 7 May 2024 16:25:15 +0200 Subject: [PATCH 3/3] rm comment --- R/join_abcd_scenario.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/join_abcd_scenario.R b/R/join_abcd_scenario.R index b9e01687..a5f3b0c3 100644 --- a/R/join_abcd_scenario.R +++ b/R/join_abcd_scenario.R @@ -166,7 +166,6 @@ add_green_technologies_to_abcd <- function(data, scenario) { by = c("sector", "technology") ) - # TODO: the summarize should be replaced with a distinct. the left_join should be an inner_join to avoid adding NAs green_rows_to_add <- data %>% group_by( .data$name_company,