removed log_path

DESCRIPTION

@@ -1,9 +1,18 @@
 Package: trisk.model
 Title: What the Package Does (One Line, Title Case)
 Version: 0.0.0.9000
-Authors@R: 
-    person("First", "Last", , "[email protected]", role = c("aut", "cre"),
-           comment = c(ORCID = "YOUR-ORCID-ID"))
+Authors@R: c(
+    person(given = "Jacob",
+           family = "Kastl",
+           role = c("aut"),
+           email = "[email protected]"),
+    person(given = "Franziska",
+           family = "Fischer",
+           role = c("aut", "cre"),
+           email = "[email protected]"),
+    person(given = "Theia Finance Labs",
+           role = c("cph", "fnd"),
+           email = "[email protected]"))
 Description: The package provides functions and workflows for conducting
     financial stress tests of listed equity, corporate bond and corporate
     loan portfolios.  It specifically focuses on climate change related

R/MIGRATE_process_data.R

@@ -9,7 +9,6 @@
 #' @param shock_scenario shock_scenario
 #' @param start_year start_year
 #' @param carbon_price_model carbon_price_model
-#' @param log_path log_path
 #'
 #' @return processed input trisk data
 #'
@@ -19,16 +18,14 @@ st_process_agnostic <-
            baseline_scenario,
            shock_scenario,
            start_year,
-           carbon_price_model,
-           log_path) {
+           carbon_price_model) {
     processed <- data %>%
       st_process(
         scenario_geography = scenario_geography,
         baseline_scenario = baseline_scenario,
         shock_scenario = shock_scenario,
         start_year = start_year,
-        carbon_price_model = carbon_price_model,
-        log_path = log_path
+        carbon_price_model = carbon_price_model
       )
 
     input_data_list <- list(
@@ -40,25 +37,10 @@ st_process_agnostic <-
       carbon_data = processed$carbon_data
     )
 
-    # TODO: this requires company company_id to work for all companies, i.e. using 2021Q4 PAMS data
-    report_company_drops(
-      data_list = input_data_list,
-      log_path = log_path
-    )
-
     return(input_data_list)
   }
 
 
-is_scenario_geography_in_pacta_results <- function(data, scenario_geography_filter) {
-  if (!scenario_geography_filter %in% unique(data$scenario_geography)) {
-    stop(paste0(
-      "Did not find PACTA results for scenario_geography level ", scenario_geography_filter,
-      ". Please check PACTA results or pick another scenario_geography."
-    ))
-  }
-  invisible(data)
-}
 
 #' Remove rows from PACTA results that belong to company-sector combinations
 #' for which there is no positive production value in the relevant year of
@@ -74,8 +56,7 @@ is_scenario_geography_in_pacta_results <- function(data, scenario_geography_filt
 #' @noRd
 remove_sectors_with_missing_production_end_of_forecast <- function(data,
                                                                    start_year,
-                                                                   time_horizon,
-                                                                   log_path) {
+                                                                   time_horizon) {
   n_companies_pre <- length(unique(data$company_name))
 
   companies_missing_sector_production <- data %>%

R/calc_annual_profts.R

@@ -19,8 +19,7 @@ calculate_annual_profits <- function(data,
                                      shock_scenario,
                                      end_year,
                                      discount_rate,
-                                     growth_rate,
-                                     log_path) {
+                                     growth_rate) {
   data <- data %>%
     dividend_discount_model(discount_rate = discount_rate) %>%
     calculate_terminal_value(

R/calc_pd_change_overall.R

@@ -17,11 +17,7 @@ calculate_pd_change_overall <- function(data,
                                         shock_year = NULL,
                                         end_of_analysis = NULL,
                                         risk_free_interest_rate = NULL) {
-  force(data)
-  shock_year %||% stop("Must provide input for 'shock_year'", call. = FALSE)
-  end_of_analysis %||% stop("Must provide input for 'end_of_analysis'", call. = FALSE)
-  risk_free_interest_rate %||% stop("Must provide input for 'risk_free_interest_rate'", call. = FALSE)
-
+
   data <- data %>%
     dplyr::filter(.data$year >= .env$shock_year) %>%
     dplyr::group_by(

R/calculate.R

@@ -20,8 +20,7 @@ calculate_trisk_trajectory <- function(input_data_list,
                                        transition_scenario,
                                        start_year,
                                        end_year,
-                                       time_horizon,
-                                       log_path) {
+                                       time_horizon) {
   production_data <- input_data_list$production_data %>%
     set_baseline_trajectory(
       baseline_scenario = baseline_scenario
@@ -32,8 +31,7 @@ calculate_trisk_trajectory <- function(input_data_list,
       target_scenario_aligned = target_scenario,
       start_year = start_year,
       end_year = end_year,
-      analysis_time_frame = time_horizon,
-      log_path = log_path
+      analysis_time_frame = time_horizon
     )
 
   price_data <- input_data_list$df_price %>%
@@ -49,7 +47,6 @@ calculate_trisk_trajectory <- function(input_data_list,
       y = input_data_list$financial_data,
       by = c("company_id")
     ) %>%
-    stop_if_empty(data_name = "Production data joined with Financial data") %>%
     fill_annual_profit_cols()
 
   full_trajectory <- full_trajectory %>%

R/company_technology_asset_value_at_risk.R

@@ -15,10 +15,7 @@ company_technology_asset_value_at_risk <- function(data,
                                                    div_netprofit_prop_coef = NULL,
                                                    flat_multiplier = NULL,
                                                    crispy = FALSE) {
-  force(data)
-  shock_scenario %||% stop("Must provide input for 'shock_scenario'", call. = FALSE)
-  div_netprofit_prop_coef %||% stop("Must provide input for 'div_netprofit_prop_coef'", call. = FALSE)
-
+
   data <- data %>%
     dplyr::filter(
       .data$year >= shock_scenario$year_of_shock,

R/config-helpers.R

@@ -7,9 +7,9 @@
 #' @export
 #'
 get_scenario_geography_x_ald_sector <- function(st_input_folder, whitelist_sectors = NULL) {
-    capacity_factors_power = read_capacity_factors_power(file.path(dir, capacity_factor_file)),
-    df_price = read_price_data(file.path(dir, price_data_file)),
-    scenario_data = read_scenario_data(file.path(dir, scenario_data_file)),
+  capacity_factors_power = read_capacity_factors_power(file.path(dir, capacity_factor_file))
+  df_price = read_price_data(file.path(dir, price_data_file))
+  scenario_data = read_scenario_data(file.path(dir, scenario_data_file))
 
   scenario_data_available <- scenario_data %>%
     dplyr::distinct(.data$scenario, .data$ald_sector, .data$scenario_geography, .data$scenario_type)

R/convert_cap_to_generation.R

@@ -11,8 +11,6 @@
 
 convert_cap_to_generation <- function(data,
                                       capacity_factors_power = NULL) {
-  force(data)
-  capacity_factors_power %||% stop("Must provide input for 'capacity_factors_power'", call. = FALSE)
 
   # ADO 1945 - Left join is applied since only rows in data from ald_sector
   # power will have matching rows in capacity_factors_power
@@ -64,17 +62,6 @@ convert_power_cap_to_generation <- function(data,
                                             capacity_factors_power = NULL,
                                             baseline_scenario,
                                             target_scenario) {
-  force(data)
-  capacity_factors_power %||% stop("Must provide input for 'capacity_factors_power'", call. = FALSE)
-
-  # ensure required scenarios for planned capacity and scenario capacity are given
-  if (
-    !baseline_scenario %in% unique(capacity_factors_power$scenario) |
-      !target_scenario %in% unique(capacity_factors_power$scenario)
-  ) {
-    stop(glue::glue("At least one input scenario from {baseline_scenario} or
-                    {target_scenario} is missing in power capacity factor data."))
-  }
 
   capacity_factors_power <- capacity_factors_power %>%
     dplyr::filter(.data$scenario %in% c(baseline_scenario, target_scenario)) %>%

R/run_trisk.R

@@ -27,8 +27,7 @@ run_trisk <- function(input_path, output_path,
       baseline_scenario = baseline_scenario,
       shock_scenario = shock_scenario,
       start_year = start_year,
-      carbon_price_model = carbon_price_model,
-      log_path = log_path
+      carbon_price_model = carbon_price_model
       )
 
   output_list <- run_trisk_model(input_data_list, ...)
@@ -97,15 +96,16 @@ run_trisk_model <- function(input_data_list,
 
   cat("-- Calculating production trajectory under trisk shock. \n")
 
+  transition_scenario <- THIS_MUST_GO(input_data_list, baseline_scenario, shock_scenario, start_year, shock_year)
+
   input_data_list$full_trajectory <- calculate_trisk_trajectory(
     input_data_list = input_data_list,
     baseline_scenario = baseline_scenario,
     target_scenario = shock_scenario,
     transition_scenario = transition_scenario,
     start_year = start_year,
     end_year = end_year,
-    time_horizon = time_horizon_lookup,
-    log_path = log_path
+    time_horizon = time_horizon_lookup
   )
 
   cat("-- Calculating net profits. \n")
@@ -125,8 +125,7 @@ run_trisk_model <- function(input_data_list,
     shock_scenario = shock_scenario,
     end_year = end_year,
     discount_rate = discount_rate,
-    growth_rate = growth_rate,
-    log_path = log_path
+    growth_rate = growth_rate
   )
 
   cat("-- Calculating market risk. \n")
@@ -156,3 +155,97 @@ run_trisk_model <- function(input_data_list,
     )
   )
 }
+
+
+
+THIS_MUST_GO <- function(data, baseline_scenario, shock_scenario, start_year, shock_year){
+
+
+  get_end_year <- function(data, scenarios_filter){
+
+    available_min_of_max_years <- dplyr::bind_rows(
+      data$df_price %>%
+        dplyr::distinct(.data$year, .data$scenario) %>%
+        dplyr::group_by(.data$scenario) %>%
+        dplyr::summarise(year=max(.data$year)),
+      data$capacity_factors_power %>%
+        dplyr::distinct(.data$year, .data$scenario) %>%
+        dplyr::group_by(.data$scenario) %>%
+        dplyr::summarise(year=max(.data$year)),
+      data$scenario_data %>%
+        dplyr::distinct(.data$year, .data$scenario) %>%
+        dplyr::group_by(.data$scenario) %>%
+        dplyr::summarise(year=max(.data$year))
+    ) %>%
+      dplyr::group_by(.data$scenario) %>%
+      dplyr::summarise(year=min(.data$year)) %>%
+      dplyr::filter(.data$scenario %in% scenarios_filter) %>%
+      dplyr::pull(.data$year)
+
+    end_year <- min(MAX_POSSIBLE_YEAR, min(available_min_of_max_years))
+
+    return(end_year)
+
+  }
+    end_year <- get_end_year(
+    data, 
+    scenarios_filter=c(baseline_scenario, shock_scenario)
+    )
+    #' Generate transition scenario shock from a start year that represents when a
+#' large scale climate transition policy is deployed.
+#'
+#' @param start_of_analysis A numeric vector of length one that indicates the
+#'   start year of the analysis.
+#' @param end_of_analysis A numeric vector of length one that indicates the
+#'   end year of the analysis.
+#' @param shock_year A numeric vector of length 1 that provides the start year
+#'   of the shock to be used in the analysis.
+generate_transition_shocks <- function(start_of_analysis,
+                                       end_of_analysis,
+                                       shock_year) {
+  bounds <- list(start_of_analysis, end_of_analysis)
+
+  if (dplyr::n_distinct(purrr::map_int(bounds, length)) > 1) {
+    stop("Input arugments for start_of_analysis and end_of_analysis need to have length 1.")
+  }
+
+  input_args <- list(start_of_analysis, end_of_analysis, shock_year)
+
+  if (!all(unique(purrr::map_lgl(input_args, is.numeric)))) {
+    stop("All input arguments need to be numeric.")
+  }
+
+  if (shock_year < start_of_analysis) {
+    stop("Year of shock out of bounds. Shock cannot happen before the start year
+         of the anaylsis.")
+  }
+
+  if (shock_year > end_of_analysis) {
+    stop("Year of shock out of bounds. Shock cannot happen after the end year of
+         the anaylsis.")
+  }
+
+  data <- tibble::tibble(
+    year_of_shock = shock_year,
+    scenario_name = glue::glue("Carbon balance {year_of_shock}"),
+    duration_of_shock = end_of_analysis - .data$year_of_shock + 1
+  )
+
+  validate_data_has_expected_cols(
+    data = data,
+    expected_columns = c(
+      "scenario_name", "year_of_shock", "duration_of_shock"
+    )
+  )
+
+  return(data)
+}
+
+  transition_scenario <- generate_transition_shocks(
+    start_of_analysis = start_year,
+    end_of_analysis = end_year,
+    shock_year = shock_year
+  )
+
+  return(transition_scenario)
+}

R/set_tech_trajectories.R

@@ -109,8 +109,7 @@ set_trisk_trajectory <- function(data,
                                  target_scenario_aligned,
                                  start_year,
                                  end_year,
-                                 analysis_time_frame,
-                                 log_path) {
+                                 analysis_time_frame) {
   scenario_name <- shock_scenario$scenario_name
   year_of_shock <- shock_scenario$year_of_shock
   duration_of_shock <- shock_scenario$duration_of_shock
@@ -181,7 +180,7 @@ set_trisk_trajectory <- function(data,
     ) %>%
     dplyr::mutate(scenario_name = .env$scenario_name)
 
-  data <- filter_negative_late_and_sudden(data, log_path = log_path)
+  data <- filter_negative_late_and_sudden(data)
 
   return(data)
 }
@@ -345,7 +344,7 @@ calc_late_sudden_traj <- function(start_year, end_year, year_of_shock, duration_
 #'   projected late and sudden trajectory.
 #'
 #' @return Input tibble with potentially removed rows.
-filter_negative_late_and_sudden <- function(data_with_late_and_sudden, log_path) {
+filter_negative_late_and_sudden <- function(data_with_late_and_sudden) {
   negative_late_and_sudden <- data_with_late_and_sudden %>%
     dplyr::filter(.data$late_sudden < 0) %>%
     dplyr::select(dplyr::all_of(c("company_name", "ald_business_unit"))) %>%
@@ -358,14 +357,6 @@ filter_negative_late_and_sudden <- function(data_with_late_and_sudden, log_path)
       data_with_late_and_sudden %>%
       dplyr::anti_join(negative_late_and_sudden, by = c("company_name", "ald_business_unit"))
 
-    # log_path will be NULL when function is called from webtool
-    if (!is.null(log_path)) {
-      paste_write(
-        format_indent_1(), "Removed", n_rows_before_removal - nrow(data_with_late_and_sudden),
-        "rows because negative production compensation targets were set in late and sudden production paths ways. Negative absolute production is impossible \n",
-        log_path = log_path
-      )
-    }
 
     if (nrow(data_with_late_and_sudden) == 0) {
       stop("No rows remain after removing negative late and sudden trajectories.")