diff --git a/NEWS.md b/NEWS.md index ab9a3962..7bc3638d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ # r2dii.analysis (development version) +# `target_sda` now uses final year of scenario as convergence target when `by_company = TRUE` (#445). # `target_market_share` gains argument `increasing_or_decreasing` (#426). # r2dii.analysis 0.2.1 diff --git a/R/target_sda.R b/R/target_sda.R index 9b445ee1..b910c7a0 100644 --- a/R/target_sda.R +++ b/R/target_sda.R @@ -220,15 +220,13 @@ target_sda <- function(data, adjusted_scenario_with_p <- add_p_to_scenario(adjusted_scenario) - target_summary_groups <- maybe_add_name_abcd( - c("sector", "scenario", "region", "scenario_source"), - by_company - ) + target_summary_groups <- c("sector", "scenario", "region", "scenario_source") loanbook_targets <- compute_loanbook_targets( data, adjusted_scenario_with_p, - !!!rlang::syms(target_summary_groups) + by_company = by_company, + target_summary_groups ) if (identical(nrow(loanbook_targets), 0L)) { @@ -370,22 +368,42 @@ add_p_to_scenario <- function(data) { compute_loanbook_targets <- function(data, scenario_with_p, + by_company, ...) { - data %>% + target_summary_groups <- maybe_add_name_abcd(..., by_company) + + data <- data %>% right_join( scenario_with_p, by = c("year", "sector", "region", "scenario_source") - ) %>% - group_by(...) %>% + ) + + if (by_company) { + data <- data %>% + group_by(!!!rlang::syms(...)) %>% + arrange(.data$year) %>% + tidyr::complete(.data$name_abcd, year) %>% + ungroup() %>% + select(-all_of(c("emission_factor_adjusted_scenario", "p"))) %>% + right_join( + scenario_with_p, + by = c("year", "sector", "region", "scenario_source", "scenario") + ) %>% + dplyr::filter(!is.na(.data$name_abcd)) + } + + data <- data %>% + group_by(!!!rlang::syms(target_summary_groups)) %>% arrange(.data$year) %>% mutate( - d = first(.data$emission_factor_projected) - - last(.data$emission_factor_adjusted_scenario), - emission_factor_target = (.data$d * .data$p) + - last(.data$emission_factor_adjusted_scenario) + d = first(.data$emission_factor_projected) - last(.data$emission_factor_adjusted_scenario), + emission_factor_target = (.data$d * .data$p) + last(.data$emission_factor_adjusted_scenario) ) %>% ungroup() %>% - select(..., all_of(c("year", "emission_factor_target"))) + select(all_of(target_summary_groups), all_of(c("year", "emission_factor_target"))) + + data + } pivot_emission_factors_longer <- function(data) { diff --git a/tests/testthat/_snaps/target_sda.md b/tests/testthat/_snaps/target_sda.md index beb85b68..a8edf2a2 100644 --- a/tests/testthat/_snaps/target_sda.md +++ b/tests/testthat/_snaps/target_sda.md @@ -36,7 +36,7 @@ 7 cement 2020 global demo_2020 shaanxi auto target_b2ds 8 cement 2021 global demo_2020 shaanxi auto target_b2ds 9 cement 2022 global demo_2020 shaanxi auto target_b2ds - 10 cement 2023 global demo_2020 target_b2ds + 10 cement 2023 global demo_2020 shaanxi auto target_b2ds # i 58 more rows # i 1 more variable: emission_factor_value diff --git a/tests/testthat/test-target_sda.R b/tests/testthat/test-target_sda.R index b69c3bc2..5fd66d15 100644 --- a/tests/testthat/test-target_sda.R +++ b/tests/testthat/test-target_sda.R @@ -820,3 +820,196 @@ test_that("produces output with expected start years #439", { expect_equal(min(out_relevant$year), 2025L) }) + +test_that("final year of emission intensity scenario matches final year of adjusted_scenario_* and target_* (#445)", { + matched <- fake_matched(sector_abcd = "cement") + + abcd <- fake_abcd( + sector = "cement", + technology = "cement", + name_company = c(rep("shaanxi auto", 6), rep("company 2", 6)), + year = rep(2020:2025, 2), + emission_factor = c(0.9, 0.9, 0.8, 0.7, 0.6, 0.5, rep(2, 6)) + ) + + co2_intensity_scenario <- fake_co2_scenario( + scenario = c(rep("nze_2050", 2), rep("steps", 2)), + year = rep(c(2020, 2050), 2), + emission_factor = c(0.5, 0.1, 0.5, 0.4) + ) + + out_lbk <- target_sda( + matched, + abcd, + co2_intensity_scenario, + region_isos = region_isos_stable + ) + + out_company <- target_sda( + matched, + abcd, + co2_intensity_scenario, + region_isos = region_isos_stable, + by_company = TRUE + ) + + final_co2_intensity_scenario <- co2_intensity_scenario %>% + dplyr::slice_max( + .data$year, + n = 1, + by = c("scenario", "sector", "region", "emission_factor_unit", "scenario_source") + ) + + final_out_lbk <- out_lbk %>% + dplyr::filter( + grepl("target_|adjusted_scenario_", .data$emission_factor_metric) + ) %>% + dplyr::slice_max( + .data$year, + n = 1, + by = c("sector", "region", "scenario_source", "emission_factor_metric") + ) + + final_out_company <- out_company %>% + dplyr::filter( + grepl("target_|adjusted_scenario_", .data$emission_factor_metric) + ) %>% + dplyr::slice_max( + .data$year, + n = 1, + by = c("sector", "region", "scenario_source", "name_abcd", "emission_factor_metric") + ) + + # final year of co2 intensity scenario is final year for all matching targets + final_year_lbk <- final_out_lbk %>% + tidyr::separate_wider_regex( + emission_factor_metric, c(metric = "target|adjusted_scenario", "_", scenario = ".*") + ) %>% + dplyr::inner_join( + final_co2_intensity_scenario, + by = c("sector", "scenario", "scenario_source", "region"), + suffix = c("_final_output", "_final_scenario") + ) %>% + dplyr::mutate( + final_year_correct = dplyr::if_else( + .data$year_final_output == .data$year_final_scenario, + TRUE, + FALSE + ) + ) + + expect_equal(unique(final_year_lbk$final_year_correct), TRUE) + + final_year_company <- final_out_company %>% + tidyr::separate_wider_regex( + emission_factor_metric, c(metric = "target|adjusted_scenario", "_", scenario = ".*") + ) %>% + dplyr::inner_join( + final_co2_intensity_scenario, + by = c("sector", "scenario", "scenario_source", "region"), + suffix = c("_final_output", "_final_scenario") + ) %>% + dplyr::mutate( + final_year_correct = dplyr::if_else( + .data$year_final_output == .data$year_final_scenario, TRUE, FALSE + ) + ) + + expect_equal(unique(final_year_company$final_year_correct), TRUE) +}) + +test_that("target of final year always converges at final value of adjusted_scenario (#445)", { + matched <- fake_matched(sector_abcd = "cement") + + abcd <- fake_abcd( + sector = "cement", + technology = "cement", + name_company = c(rep("shaanxi auto", 6), rep("company 2", 6)), + year = rep(2020:2025, 2), + emission_factor = c(0.9, 0.9, 0.8, 0.7, 0.6, 0.5, rep(2, 6)) + ) + + co2_intensity_scenario <- fake_co2_scenario( + scenario = c(rep("nze_2050", 2), rep("steps", 2)), + year = rep(c(2020, 2050), 2), + emission_factor = c(0.5, 0.1, 0.5, 0.4) + ) + + out_lbk <- target_sda( + matched, + abcd, + co2_intensity_scenario, + region_isos = region_isos_stable + ) + + out_company <- target_sda( + matched, + abcd, + co2_intensity_scenario, + region_isos = region_isos_stable, + by_company = TRUE + ) + + final_out_lbk <- out_lbk %>% + dplyr::filter( + grepl("target_|adjusted_scenario_", .data$emission_factor_metric) + ) %>% + dplyr::slice_max( + .data$year, + n = 1, + by = c("sector", "region", "scenario_source", "emission_factor_metric") + ) + + final_out_company <- out_company %>% + dplyr::filter( + grepl("target_|adjusted_scenario_", .data$emission_factor_metric) + ) %>% + dplyr::slice_max( + .data$year, + n = 1, + by = c("sector", "region", "scenario_source", "name_abcd", "emission_factor_metric") + ) + + # final value of target_* is equal to final value of adjusted_scenario_* for loan book + final_targets_converge_lbk <- final_out_lbk %>% + tidyr::separate_wider_regex( + emission_factor_metric, c(metric = "target|adjusted_scenario", "_", scenario = ".*") + ) %>% + tidyr::pivot_wider(names_from = "metric", values_from = "emission_factor_value") %>% + dplyr::mutate( + targets_converge = dplyr::if_else( + .data$target == .data$adjusted_scenario, TRUE, FALSE + ) + ) + + expect_equal(unique(final_targets_converge_lbk$targets_converge), TRUE) + + # final value of target_* is equal to final value of adjusted_scenario_* for companies + final_targets_converge_company <- final_out_company %>% + tidyr::separate_wider_regex( + emission_factor_metric, c(metric = "target|adjusted_scenario", "_", scenario = ".*") + ) + + final_targets_converge_company_adjusted <- final_targets_converge_company %>% + dplyr::filter(grepl("adjusted_scenario", .data$metric)) %>% + tidyr::pivot_wider(names_from = "metric", values_from = "emission_factor_value") + + final_targets_converge_company_target <- final_targets_converge_company %>% + dplyr::filter(grepl("target", .data$metric)) %>% + tidyr::pivot_wider(names_from = "metric", values_from = "emission_factor_value") + + final_targets_converge_company <- final_targets_converge_company_target %>% + dplyr::inner_join( + final_targets_converge_company_adjusted, + by = c("sector", "scenario_source", "scenario", "region", "year"), + suffix = c("_target", "_adjusted") + ) %>% + dplyr::mutate( + targets_converge = dplyr::if_else( + .data$target == .data$adjusted_scenario, TRUE, FALSE + ) + ) + + expect_equal(unique(final_targets_converge_company$targets_converge), TRUE) +}) +