diff --git a/DESCRIPTION b/DESCRIPTION index 5292c5f..6e67973 100644 --- a/DESCRIPTION +++ b/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", , "first.last@example.com", role = c("aut", "cre"), - comment = c(ORCID = "YOUR-ORCID-ID")) +Authors@R: c( + person(given = "Jacob", + family = "Kastl", + role = c("aut"), + email = "jacob.kastl@gmail.com"), + person(given = "Franziska", + family = "Fischer", + role = c("aut", "cre"), + email = "franziska@2degrees-investing.org"), + person(given = "Theia Finance Labs", + role = c("cph", "fnd"), + email = "1in1000@theiafinance.org")) 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 diff --git a/R/MIGRATE_process_data.R b/R/MIGRATE_process_data.R index 5b95730..5d87e89 100644 --- a/R/MIGRATE_process_data.R +++ b/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 %>% diff --git a/R/calc_annual_profts.R b/R/calc_annual_profts.R index 7cc19d8..6be3fa3 100644 --- a/R/calc_annual_profts.R +++ b/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( diff --git a/R/calc_pd_change_overall.R b/R/calc_pd_change_overall.R index d11fb88..b8063da 100644 --- a/R/calc_pd_change_overall.R +++ b/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( diff --git a/R/calculate.R b/R/calculate.R index 3eabf3e..838d6ac 100644 --- a/R/calculate.R +++ b/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 %>% diff --git a/R/company_technology_asset_value_at_risk.R b/R/company_technology_asset_value_at_risk.R index b8a8c03..71befe4 100644 --- a/R/company_technology_asset_value_at_risk.R +++ b/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, diff --git a/R/config-helpers.R b/R/config-helpers.R index 0c2a4be..267962e 100644 --- a/R/config-helpers.R +++ b/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) diff --git a/R/convert_cap_to_generation.R b/R/convert_cap_to_generation.R index f2e94b4..2b84ec4 100644 --- a/R/convert_cap_to_generation.R +++ b/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)) %>% diff --git a/R/run_trisk.R b/R/run_trisk.R index ceb0228..8efa281 100644 --- a/R/run_trisk.R +++ b/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,6 +96,8 @@ 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, @@ -104,8 +105,7 @@ run_trisk_model <- function(input_data_list, 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) +} \ No newline at end of file diff --git a/R/set_tech_trajectories.R b/R/set_tech_trajectories.R index 001c782..47d5f7b 100644 --- a/R/set_tech_trajectories.R +++ b/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.") diff --git a/tests/testthat/test-set_tech_trajectories.R b/tests/testthat/test-set_tech_trajectories.R index f0c04d0..b57035b 100644 --- a/tests/testthat/test-set_tech_trajectories.R +++ b/tests/testthat/test-set_tech_trajectories.R @@ -133,7 +133,7 @@ test_that("input remains unchanged if no negative late_and_sudden levels are some_col = rep("sth", 4) ) - filtered_data <- filter_negative_late_and_sudden(input_data, log_path = NULL) + filtered_data <- filter_negative_late_and_sudden(input_data) expect_equal(input_data, filtered_data) }) @@ -147,7 +147,7 @@ test_that("ald_business_unit x company_name combinations that hold at least 1 ne some_col = rep("sth", 5) ) - filtered_data <- filter_negative_late_and_sudden(input_data, log_path = NULL) + filtered_data <- filter_negative_late_and_sudden(input_data) expect_equal(input_data %>% dplyr::filter(!(company_name == "firm" & ald_business_unit == "some")), filtered_data) }) @@ -160,7 +160,7 @@ test_that("removal works if several company_name x ald_business_unit combination some_col = rep("sth", 5) ) - filtered_data <- filter_negative_late_and_sudden(input_data, log_path = NULL) + filtered_data <- filter_negative_late_and_sudden(input_data) expect_equal(input_data %>% dplyr::filter(company_name == "biz" & ald_business_unit == "other"), filtered_data) }) @@ -173,5 +173,5 @@ test_that("error is thrown if no rows remain", { some_col = rep("sth", 5) ) - expect_error(testthat::expect_warning(filtered_data <- filter_negative_late_and_sudden(input_data, log_path = NULL), "Removed"), "No rows remain") + expect_error(testthat::expect_warning(filtered_data <- filter_negative_late_and_sudden(input_data), "Removed"), "No rows remain") })