Bug in sda_portfolio_target()

[FrederickFa]

For MeinFairMögen, we would like to apply the SDA function which lies within 0_sda_approach.R. The function runs without errors, however, after a visual inspection, the outputs seem to be suspicious/wrong.

The bug is that the function should only change the "slope" of scen_sec_emissions_factor over the years but not the "intercept", hence the values in the start year for scen_sec_emissions_factor and plan_sec_emissions_factor should still be exactly the same.

Example visualization:

Outputs before applying the SDA:

Outputs after applying the SDA:

Actual desired output of the SDA (black line, just as an example):

Open questions:
As the emission factors for grinding are missing, the scen_emission_factor is 0 and therefore is probably skewing the scen_sec_emissions_factors for cement. The results is that scen_sec_emissions_factors and plan_sec_emissions_factors are not the same in the start year, which then also affects the scenario pathway over the next years.

Urgency:
Not urgent at the moment, but for MeinFairMögen we need a working function by mid May.

Reprex:

library(tidyverse)
library(fs)
source(path(dirname(getwd()), "PACTA_analysis", "0_sda_approach.R")) # path might need to be adjusted

start_year <- 2020
end_year <- 2025


market_EQ <- read_rds(path("~/Dropbox (2° Investing)/PortCheck_v2/10_Projects/0_MarketPortfolios/40_Results/Market2020Q3/Equity_results_portfolio.rda")) %>% 
  filter(
    portfolio_name == "GlobalMarket" ,
    scenario_geography == "Global",
    scenario == "B2DS",
    allocation == "portfolio_weight",
    between(year, start_year, end_year)
  ) 

portfolio_EQ_before_SDA <- read_rds(path("~/Dropbox (2° Investing)/PortCheck_v2/10_Projects/mfm_v7/40_Results/Blackrock/Equity_results_portfolio.rda")) %>% 
  filter(
    portfolio_name == "CH0244030307",
    scenario_geography == "Global",
    scenario == "B2DS",
    allocation == "portfolio_weight",
    between(year, start_year, end_year)
  ) 

portfolio_EQ_after_SDA <- sda_portfolio_target(
  market = market_EQ,
  portfolio = portfolio_EQ_before_SDA,
  scenario = "B2DS",
  geography = "Global",
  ald_sector = c("Cement","Steel", "Aviation"),
  start_year = start_year,
  target_year = end_year
)


portfolio_EQ_before_SDA %>% 
  mutate(year = as.character(year)) %>% 
  pivot_longer(cols = c(!(where(is.character)))) %>% 
  mutate(year = as.double(year)) %>% 
  filter(str_detect(name, "sec_emission")) %>% 
  filter(ald_sector %in% c("Cement","Steel", "Aviation")) %>% 
  ggplot() +
  geom_line(aes(x = year, y = value, color = name), size = 2) +
  facet_wrap(~ald_sector, scales = "free") +
  labs(
    x = "Year",
    y = "Emission Factor",
    color = "Type of indicator"
  ) +
  theme(text = element_text(size = 10))

portfolio_EQ_after_SDA %>% 
  mutate(year = as.character(year)) %>% 
  pivot_longer(cols = c(!(where(is.character)))) %>% 
  mutate(year = as.double(year)) %>% 
  filter(str_detect(name, "sec_emission")) %>% 
  filter(ald_sector %in% c("Cement","Steel", "Aviation")) %>% 
  ggplot() +
  geom_line(aes(x = year, y = value, color = name), size = 2) +
  facet_wrap(~ald_sector, scales = "free") +
  labs(
    x = "Year",
    y = "Emission Factor",
    color = "Type of indicator"
  ) +
  theme(text = element_text(size = 10))



portfolio_EQ_after_SDA %>% 
  mutate(year = as.character(year)) %>% 
  pivot_longer(cols = c(!(where(is.character)))) %>% 
  mutate(year = as.double(year)) %>% 
  filter(str_detect(name, "plan_sec_emission")) %>% 
  filter(ald_sector %in% c("Cement","Steel", "Aviation")) %>% 
  rbind.data.frame(
    portfolio_EQ_after_SDA %>% 
      mutate(year = as.character(year)) %>% 
      pivot_longer(cols = c(!(where(is.character)))) %>% 
      mutate(year = as.double(year)) %>% 
      mutate(name = paste0(name, "_sda")) %>% 
      filter(str_detect(name, "scen_sec_emission")) %>% 
      filter(ald_sector %in% c("Cement","Steel", "Aviation"))
  ) %>% 
  rbind.data.frame(
    portfolio_EQ_before_SDA %>% 
      mutate(year = as.character(year)) %>% 
      pivot_longer(cols = c(!(where(is.character)))) %>% 
      mutate(year = as.double(year)) %>% 
      mutate(name = paste0(name, "_original")) %>% 
      filter(str_detect(name, "scen_sec_emission")) %>% 
      filter(ald_sector %in% c("Cement","Steel", "Aviation"))
  ) %>% 
  ggplot() +
  geom_line(aes(x = year, y = value, color = name), size = 2) +
  facet_wrap(~ald_sector, scales = "free") +
  labs(
    x = "Year",
    y = "Emission Factor",
    color = "Type of indicator"
  ) +
  theme(text = element_text(size = 10))

[2diiKlaus]

Note from conversation between @cjyetman and me:

• Cement has an additional issue to the SDA function, existing already in the trajectory target. Most likely driven by differences in technology scope, i.e., the inclusion of grinding in the target calculation