Merge pull request #446 from RMI-PACTA/fix-company-sda

fix company level sda targets
RMI-PACTA · Sep 6, 2023 · 5f603ef · 5f603ef
2 parents 0dbf0fd + 0d4e702
commit 5f603ef
Show file tree

Hide file tree

Showing 4 changed files with 226 additions and 14 deletions.
diff --git 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
@@ -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
@@ -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       <NA>         target_b2ds           
+      10 cement  2023 global demo_2020       shaanxi auto target_b2ds           
       # i 58 more rows
       # i 1 more variable: emission_factor_value <dbl>
 
diff --git 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)
+})
+