+
+
+[](https://www.tidyverse.org/lifecycle/#experimental)
+[](https://github.com/2DegreesInvesting/r2dii.climate.stress.test/actions)
+
+
+The goal of r2dii.climate.stress.test is to provide a tool that can be used to
+conduct what-if climate stress test analyses for financial institutions,
+supervisors, regulators and other stakeholders. The tool aims at highlighting
+potential financial risk in especially climate relevant sectors, split by
+production ald_business_unit where required. The sectors covered by the 2DII climate
+stress test and therefore by this package, follow mostly the logic of the Paris
+Agreement Capital Transition Assessment (PACTA) tool, but can in principle be
+adapted to other settings. Application of the code requires availability of
+custom data. For more information about the methodology and inquiries on running
+a pilot of the stress test in cooperation with 2DII, please contact
+}}\preformatted{options(r2dii_dropbox = "The name of your custom dropbox folder goes here")
+}\if{html}{\out{
}}
+}
+
+\seealso{
+\code{\link[=degrees]{degrees()}}, \code{\link[fs:path_expand]{fs::path_home()}}.
+}
+\concept{functions to output 2dii paths}
diff --git a/man/process_production_data.Rd b/man/process_production_data.Rd
new file mode 100644
index 0000000..9a967af
--- /dev/null
+++ b/man/process_production_data.Rd
@@ -0,0 +1,39 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/MIGRATE_process_data.R
+\name{process_production_data}
+\alias{process_production_data}
+\title{Process data of type indicated by function name}
+\usage{
+process_production_data(
+ data,
+ start_year,
+ end_year,
+ time_horizon,
+ scenario_geography_filter,
+ sectors,
+ technologies,
+ log_path
+)
+}
+\arguments{
+\item{data}{A tibble of data of type indicated by function name.}
+
+\item{start_year}{Numeric, holding start year of analysis.}
+
+\item{end_year}{Numeric, holding end year of analysis.}
+
+\item{time_horizon}{Numeric, holding time horizon of production data.}
+
+\item{scenario_geography_filter}{Character. A vector of length 1 that
+indicates which geographic scenario to apply in the analysis.}
+
+\item{sectors}{Character vector, holding considered sectors.}
+
+\item{technologies}{Character vector, holding considered technologies.}
+}
+\value{
+A tibble of data as indicated by function name.
+}
+\description{
+Process data of type indicated by function name
+}
diff --git a/man/read_capacity_factors_power.Rd b/man/read_capacity_factors_power.Rd
new file mode 100644
index 0000000..386f8e5
--- /dev/null
+++ b/man/read_capacity_factors_power.Rd
@@ -0,0 +1,24 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/read.R
+\name{read_capacity_factors_power}
+\alias{read_capacity_factors_power}
+\title{Read in power capacity factors from csv and check that all expected columns
+are given.}
+\usage{
+read_capacity_factors_power(path = NULL)
+}
+\arguments{
+\item{path}{A string that points to the location of the file containing the
+capacity factors.}
+}
+\description{
+Read in power capacity factors from csv and check that all expected columns
+are given.
+}
+\seealso{
+Other import functions:
+\code{\link{read_carbon_data}()},
+\code{\link{read_financial_data}()},
+\code{\link{read_production_data}()}
+}
+\concept{import functions}
diff --git a/man/read_carbon_data.Rd b/man/read_carbon_data.Rd
new file mode 100644
index 0000000..321b986
--- /dev/null
+++ b/man/read_carbon_data.Rd
@@ -0,0 +1,22 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/read.R
+\name{read_carbon_data}
+\alias{read_carbon_data}
+\title{Read in carbon price data from ngfs data}
+\usage{
+read_carbon_data(path = NULL)
+}
+\arguments{
+\item{path}{A string that points to the location of the file containing the
+carbon price data.}
+}
+\description{
+Read in carbon price data from ngfs data
+}
+\seealso{
+Other import functions:
+\code{\link{read_capacity_factors_power}()},
+\code{\link{read_financial_data}()},
+\code{\link{read_production_data}()}
+}
+\concept{import functions}
diff --git a/man/read_financial_data.Rd b/man/read_financial_data.Rd
new file mode 100644
index 0000000..4cc3af3
--- /dev/null
+++ b/man/read_financial_data.Rd
@@ -0,0 +1,24 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/read.R
+\name{read_financial_data}
+\alias{read_financial_data}
+\title{Read in company financial data processed from eikon exports and AR master data
+that contain information on multiple credit risk inputs}
+\usage{
+read_financial_data(path = NULL)
+}
+\arguments{
+\item{path}{A string that points to the location of the file containing the
+company financial data.}
+}
+\description{
+Read in company financial data processed from eikon exports and AR master data
+that contain information on multiple credit risk inputs
+}
+\seealso{
+Other import functions:
+\code{\link{read_capacity_factors_power}()},
+\code{\link{read_carbon_data}()},
+\code{\link{read_production_data}()}
+}
+\concept{import functions}
diff --git a/man/read_price_data.Rd b/man/read_price_data.Rd
new file mode 100644
index 0000000..937e751
--- /dev/null
+++ b/man/read_price_data.Rd
@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/read.R
+\name{read_price_data}
+\alias{read_price_data}
+\title{Read in price data}
+\usage{
+read_price_data(path)
+}
+\arguments{
+\item{path}{A string that points to the location of the file containing the
+price data}
+}
+\value{
+A tibble holding price data in long format.
+}
+\description{
+This function reads in price data using long file format. It is expected to
+work with data based on IEA WEO 2020.
+}
diff --git a/man/read_production_data.Rd b/man/read_production_data.Rd
new file mode 100644
index 0000000..f63cd1b
--- /dev/null
+++ b/man/read_production_data.Rd
@@ -0,0 +1,22 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/read.R
+\name{read_production_data}
+\alias{read_production_data}
+\title{Read in AR PAMS production data.}
+\usage{
+read_production_data(path = NULL)
+}
+\arguments{
+\item{path}{A string that points to the location of the file containing the
+AR PAMS dataset}
+}
+\description{
+Read in AR PAMS production data.
+}
+\seealso{
+Other import functions:
+\code{\link{read_capacity_factors_power}()},
+\code{\link{read_carbon_data}()},
+\code{\link{read_financial_data}()}
+}
+\concept{import functions}
diff --git a/man/read_scenario_data.Rd b/man/read_scenario_data.Rd
new file mode 100644
index 0000000..0e9cf65
--- /dev/null
+++ b/man/read_scenario_data.Rd
@@ -0,0 +1,17 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/read.R
+\name{read_scenario_data}
+\alias{read_scenario_data}
+\title{Read in scenario data}
+\usage{
+read_scenario_data(path)
+}
+\arguments{
+\item{path}{Path to dir holding scenario data.}
+}
+\value{
+A tibble holding scenario data.
+}
+\description{
+Function reads in scenario data and checks for existence of required columns.
+}
diff --git a/man/report_company_drops.Rd b/man/report_company_drops.Rd
new file mode 100644
index 0000000..dcff2d3
--- /dev/null
+++ b/man/report_company_drops.Rd
@@ -0,0 +1,17 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/DELETE_utils.R
+\name{report_company_drops}
+\alias{report_company_drops}
+\title{Report dropped companies}
+\usage{
+report_company_drops(data_list, log_path)
+}
+\arguments{
+\item{data_list}{A list of imported stress test input data.}
+
+\item{log_path}{String holding path to log file.}
+}
+\description{
+Wrapper to report companies for which all results, or results for some technologies
+are lsot due to a missing match in financial_data or price_data.
+}
diff --git a/man/report_dropped_company_names.Rd b/man/report_dropped_company_names.Rd
new file mode 100644
index 0000000..3afb472
--- /dev/null
+++ b/man/report_dropped_company_names.Rd
@@ -0,0 +1,35 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/DELETE_utils.R
+\name{report_dropped_company_names}
+\alias{report_dropped_company_names}
+\title{Inner join datasets and report number of dropped rows}
+\usage{
+report_dropped_company_names(
+ data_x,
+ data_y,
+ name_y,
+ merge_cols,
+ name_x = "PACTA results",
+ log_path
+)
+}
+\arguments{
+\item{data_x}{Tibble with data that can be joined to \code{data_y}.}
+
+\item{data_y}{Tibble with data that can be joined to \code{data_x}.}
+
+\item{name_y}{Name of \code{data_x}.}
+
+\item{merge_cols}{Vector holds columns to join on.}
+
+\item{name_x}{Name of `data_x, defaults to PACTA results.}
+
+\item{log_path}{String holding path to log file.}
+}
+\value{
+The merged dataset.
+}
+\description{
+Function conducts inner join on two datasets and reports number of dropped
+rows on \code{data_x}.
+}
diff --git a/man/report_duplicates.Rd b/man/report_duplicates.Rd
new file mode 100644
index 0000000..736a0c9
--- /dev/null
+++ b/man/report_duplicates.Rd
@@ -0,0 +1,15 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/DELETE_utils.R
+\name{report_duplicates}
+\alias{report_duplicates}
+\title{Report duplicate rows}
+\usage{
+report_duplicates(data, cols, throw_error = TRUE)
+}
+\arguments{
+\item{cols}{Cols to check for duplicate combinations on.}
+}
+\description{
+Reports duplicates in \code{data} on columns \code{cols}. Duplicates are reported via a
+warning.
+}
diff --git a/man/report_missings.Rd b/man/report_missings.Rd
new file mode 100644
index 0000000..696422d
--- /dev/null
+++ b/man/report_missings.Rd
@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/DELETE_utils.R
+\name{report_missings}
+\alias{report_missings}
+\title{Report missing}
+\usage{
+report_missings(data, name_data, throw_error = FALSE)
+}
+\arguments{
+\item{data}{Tibble holding a result data set.}
+
+\item{name_data}{Name of the data file.}
+}
+\value{
+input \code{data}.
+}
+\description{
+Function reports number of missing values per variable.
+}
diff --git a/man/run_trisk.Rd b/man/run_trisk.Rd
new file mode 100644
index 0000000..ca66a99
--- /dev/null
+++ b/man/run_trisk.Rd
@@ -0,0 +1,26 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/run_trisk.R
+\name{run_trisk}
+\alias{run_trisk}
+\title{Run stress testing for provided asset type.}
+\usage{
+run_trisk(input_path, output_path, return_results = FALSE, ...)
+}
+\arguments{
+\item{input_path}{String holding path to project agnostic data.}
+
+\item{output_path}{String holding path to which output files are written.
+NOTE: Results and logs per run are saved to a subdirectory of output_path
+that will be generated automatically. The name of the subdirectory is the
+timestamp of the run of the analysis.}
+
+\item{return_results}{Boolean, indicating if results shall be exported.}
+}
+\description{
+This function runs the transition risk stress test. It can be desirable to
+understand sensitivities of the scenarios, in which case the user may pass a
+vector of values to one (and only one) of the detail arguments. This will
+result in running the analysis multiple times in a row with the argument
+varied.
+NOTE: if \code{return_results} is TRUE results will not be written to \verb{output path} but instead are returned.
+}
diff --git a/man/run_trisk_model.Rd b/man/run_trisk_model.Rd
new file mode 100644
index 0000000..672c1f5
--- /dev/null
+++ b/man/run_trisk_model.Rd
@@ -0,0 +1,69 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/run_trisk.R
+\name{run_trisk_model}
+\alias{run_trisk_model}
+\title{Run stress test model}
+\usage{
+run_trisk_model(
+ input_data_list,
+ baseline_scenario = "WEO2021_STEPS",
+ shock_scenario = "WEO2021_SDS",
+ lgd = 0.45,
+ risk_free_rate = 0.02,
+ discount_rate = 0.07,
+ growth_rate = 0.03,
+ div_netprofit_prop_coef = 1,
+ shock_year = 2030,
+ scenario_geography = "Global",
+ start_year = 2022,
+ carbon_price_model = "no_carbon_tax",
+ market_passthrough = 0,
+ financial_stimulus = 1
+)
+}
+\arguments{
+\item{baseline_scenario}{Holds the name of the baseline scenario to be used
+in the stress test, for accepted value range check \code{stress_test_arguments}.}
+
+\item{shock_scenario}{Holds the name of the shock scenario to be used in the
+stress test, for accepted value range check \code{stress_test_arguments}.}
+
+\item{lgd}{Numeric, holding the loss given default for accepted value range
+check \code{stress_test_arguments}.}
+
+\item{risk_free_rate}{Numeric that indicates the risk free rate of interest.
+For accepted range compare \code{stress_test_arguments}.}
+
+\item{discount_rate}{Numeric, that holds the discount rate of dividends per
+year in the DCF. For accepted range compare \code{stress_test_arguments}.}
+
+\item{growth_rate}{Numeric, that holds the terminal growth rate of profits
+beyond the final year in the DCF. For accepted range compare
+\code{stress_test_arguments}.}
+
+\item{div_netprofit_prop_coef}{Numeric. A coefficient that determines how
+strongly the future dividends propagate to the company value. For accepted
+range compare \code{stress_test_arguments}.}
+
+\item{shock_year}{Numeric, holding year the shock is applied. For accepted
+range compare \code{stress_test_arguments}.}
+
+\item{scenario_geography}{Character vector, indicating which geographical
+region(s) (concerning asset location) results shall be calculated for. For
+accepted values compare \code{stress_test_arguments}.}
+
+\item{start_year}{Numeric, first year in the analysis used as the starting
+point from which production forecasts are compared against scenario targets.
+Must be available in the production data and indicates the first year of
+the scenario data.}
+
+\item{carbon_price_model}{Character vector, indicating which NGFS model is used in regards to
+carbon prices. Default is no carbon tax.}
+
+\item{market_passthrough}{Firm's ability to pass carbon tax onto the consumer}
+
+\item{financial_stimulus}{Additional support for low carbon companies.}
+}
+\description{
+Run stress test model
+}
diff --git a/man/scenario_for_sector_x_geography.Rd b/man/scenario_for_sector_x_geography.Rd
new file mode 100644
index 0000000..6ee2aa4
--- /dev/null
+++ b/man/scenario_for_sector_x_geography.Rd
@@ -0,0 +1,25 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/config-helpers.R
+\name{scenario_for_sector_x_geography}
+\alias{scenario_for_sector_x_geography}
+\title{Obtain available scenario_x_source for geography - sector combinations}
+\usage{
+scenario_for_sector_x_geography(st_input_folder, sector, scenario_geography)
+}
+\arguments{
+\item{st_input_folder}{path to the input folder containing stress test input files}
+
+\item{sector}{String of length 1 holding sector name.}
+
+\item{scenario_geography}{String of length 1 holding sector name.}
+}
+\value{
+A string holding valid scenario names.
+}
+\description{
+Function returns a vector holding names of scenarios for a provided \code{sector}
+and \code{scenario_geography}. To identify valid \code{sector} x \code{scenario_geography}
+combinations refer to \code{\link[=geographies_for_sector]{geographies_for_sector()}}. Source of truth is the
+\code{overview} \code{scenario_geography_x_ald_sector} per default. In case combination
+of \code{sector} and \code{scenario_geography} is not available an error is thrown.
+}
diff --git a/man/set_baseline_trajectory.Rd b/man/set_baseline_trajectory.Rd
new file mode 100644
index 0000000..d9d5bec
--- /dev/null
+++ b/man/set_baseline_trajectory.Rd
@@ -0,0 +1,42 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/set_tech_trajectories.R
+\name{set_baseline_trajectory}
+\alias{set_baseline_trajectory}
+\title{Defines which scenario values to use for the baseline trajectory in the
+stress test.}
+\usage{
+set_baseline_trajectory(data, baseline_scenario)
+}
+\arguments{
+\item{data}{A dataframe that contains scenario trajectories by ald_business_unit
+until 2040 for all the scenarios included in the analysis and
+production build out plans by ald_business_unit or company and ald_business_unit,
+usually for 5 years, based on PACTA results.}
+
+\item{baseline_scenario}{Character. A string that indicates which
+of the scenarios included in the analysis should be used to set the
+baseline ald_business_unit trajectories.}
+}
+\value{
+dataframe.
+}
+\description{
+Picks the corresponding values from the original scenario
+column indicated in the input and has the option to include PACTA based
+production forecast for the first few years of the baseline
+trajectory. If included, the trajectory after the end of the production
+forecast is offset by the initial production forecast so that the
+remainder of the baseline trajectory now is a parallel shift of the
+original scenario values. If not included, the trajectories replicate
+externally provided scenario trajectories.
+Trajectories are furthermore differentiated by scenario_geography, if
+multiple are passed.
+If no "company_id" or "company_name" are provided, the calculation switches to
+portfolio/ald_business_unit level.
+}
+\seealso{
+Other scenario definition:
+\code{\link{calc_late_sudden_traj}()},
+\code{\link{set_trisk_trajectory}()}
+}
+\concept{scenario definition}
diff --git a/man/set_trisk_trajectory.Rd b/man/set_trisk_trajectory.Rd
new file mode 100644
index 0000000..6129ef0
--- /dev/null
+++ b/man/set_trisk_trajectory.Rd
@@ -0,0 +1,70 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/set_tech_trajectories.R
+\name{set_trisk_trajectory}
+\alias{set_trisk_trajectory}
+\title{Defines which scenario values to use for the late & sudden trajectory in the
+stress test.}
+\usage{
+set_trisk_trajectory(
+ data,
+ target_scenario,
+ shock_scenario,
+ target_scenario_aligned,
+ start_year,
+ end_year,
+ analysis_time_frame,
+ log_path
+)
+}
+\arguments{
+\item{data}{A dataframe that contains the scenario data prepared until the
+step after the baseline trajectories are calculated.}
+
+\item{target_scenario}{Character. A string that indicates which
+of the scenarios included in the analysis should be used to set the
+late & sudden ald_business_unit trajectories.}
+
+\item{shock_scenario}{A dataframe that contains information about the
+transition scenario, specifically the shock year and, duration of the
+shock and the name of the shock scenario}
+
+\item{target_scenario_aligned}{Character. A string that indicates which
+of the scenarios included in the analysis should be used to set the
+late & sudden ald_business_unit trajectories in case the company is aligned after
+the forecast period.}
+
+\item{start_year}{Numeric. A numeric vector of length 1 that contains the
+start year of the analysis.}
+
+\item{end_year}{Numeric. A numeric vector of length 1 that contains the
+end year of the analysis.}
+
+\item{analysis_time_frame}{Numeric. A vector of length 1 indicating the number
+of years for which forward looking production data is considered.}
+}
+\value{
+data frame
+}
+\description{
+Picks the corresponding values from the original scenario
+column indicated in the input and has the option to include PACTA based
+production forecast for the first few years of the late & sudden
+trajectory. Similarly, it is possible to define another input scenario
+in case the company is already aligned after the production forecast.
+If the production forecast is included, the trajectory after the end of
+the production forecast is offset by the initial production forecast
+so that the remainder of the late & sudden trajectory now is a parallel
+shift of the original scenario values. If not included, the trajectories
+replicate externally provided scenario trajectories at least until the
+year of the policy shock.
+Trajectories are calculated for each company by sector, scenario_geography,
+ald_business_unit, year.
+If no "company_id" or "company_name" are provided, the calculation switches to
+portfolio/ald_business_unit level.
+}
+\seealso{
+Other scenario definition:
+\code{\link{calc_late_sudden_traj}()},
+\code{\link{set_baseline_trajectory}()}
+}
+\concept{scenario definition}
diff --git a/man/st_process_agnostic.Rd b/man/st_process_agnostic.Rd
new file mode 100644
index 0000000..d5cb385
--- /dev/null
+++ b/man/st_process_agnostic.Rd
@@ -0,0 +1,37 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/MIGRATE_process_data.R
+\name{st_process_agnostic}
+\alias{st_process_agnostic}
+\title{Process input ST data}
+\usage{
+st_process_agnostic(
+ data,
+ scenario_geography,
+ baseline_scenario,
+ shock_scenario,
+ start_year,
+ carbon_price_model,
+ log_path
+)
+}
+\arguments{
+\item{data}{trisk loaded data}
+
+\item{scenario_geography}{scenario_geography}
+
+\item{baseline_scenario}{baseline_scenario}
+
+\item{shock_scenario}{shock_scenario}
+
+\item{start_year}{start_year}
+
+\item{carbon_price_model}{carbon_price_model}
+
+\item{log_path}{log_path}
+}
+\value{
+processed input trisk data
+}
+\description{
+Preprocess the input data before applying the ST model
+}
diff --git a/man/validate_data_has_expected_cols.Rd b/man/validate_data_has_expected_cols.Rd
new file mode 100644
index 0000000..07f52d4
--- /dev/null
+++ b/man/validate_data_has_expected_cols.Rd
@@ -0,0 +1,16 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/DELETE_utils.R
+\name{validate_data_has_expected_cols}
+\alias{validate_data_has_expected_cols}
+\title{Validate that a data frame contains expected columns}
+\usage{
+validate_data_has_expected_cols(data, expected_columns)
+}
+\arguments{
+\item{data}{data frame that is to be validated}
+
+\item{expected_columns}{Character vector listing the expected columns}
+}
+\description{
+Validate that all expected columns for an operation are given in a data frame.
+}
diff --git a/man/validate_file_exists.Rd b/man/validate_file_exists.Rd
new file mode 100644
index 0000000..8663d69
--- /dev/null
+++ b/man/validate_file_exists.Rd
@@ -0,0 +1,18 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/DELETE_utils.R
+\name{validate_file_exists}
+\alias{validate_file_exists}
+\title{Validate that a file exists in a given directory}
+\usage{
+validate_file_exists(path)
+}
+\arguments{
+\item{path}{Character vector indicating the directory of a file.}
+}
+\value{
+String holding provided \code{path}.
+}
+\description{
+Before performing an operation on a file assumed to be found in a given
+directory, validate this file exists and give indicative error if not.
+}
diff --git a/tests/testthat.R b/tests/testthat.R
new file mode 100644
index 0000000..db4e829
--- /dev/null
+++ b/tests/testthat.R
@@ -0,0 +1,12 @@
+# This file is part of the standard setup for testthat.
+# It is recommended that you do not modify it.
+#
+# Where should you do additional test configuration?
+# Learn more about the roles of various files in:
+# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview
+# * https://testthat.r-lib.org/articles/special-files.html
+
+library(testthat)
+library(trisk.model)
+
+test_check("trisk.model")
diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R
new file mode 100644
index 0000000..105c071
--- /dev/null
+++ b/tests/testthat/helper.R
@@ -0,0 +1,100 @@
+#' Helper function that gets csv test data quietly
+#'
+#' @family helper functions for testthat
+#'
+#' @return A dataframe
+read_test_data <- function(file, path = testthat::test_path("test_data", file)) {
+ readr::read_csv(path, col_types = list())
+}
+
+#' Helper function that sets up temporary target directory, if it does not exist
+#'
+#' @param path Character. Main path to the directory the output file should be
+#' written to.
+#' @param add_level Character. String with an investor or portfolio name that is
+#' added to the initial path as an extra layer to the output directory.
+#' This is where the file will end up being written to.
+#' @family helper functions for testthat
+#'
+#' @return A dataframe
+test_create_target_directory <- function(path = NULL,
+ add_level = NULL) {
+ path <- path %||% stop("Must provide 'path'")
+ add_level <- add_level %||% stop("Must provide 'add_level'")
+
+ if (!dir.exists(file.path(path, add_level))) {
+ target_dir <- dir.create(file.path(path, add_level))
+ } else {
+ target_dir <- file.path(path, add_level)
+ }
+}
+
+
+#' Get a valid value of an argument of `run_trisk()`
+#'
+#' @examples
+#' get_st_argument("risk_free_rate")
+#' # Same
+#' get_st_argument("risk_free_rate", "default")
+#'
+#' get_st_argument("risk_free_rate", "min")
+#'
+#' typeof(get_st_argument("asset_type"))
+#' @noRd
+get_st_argument <- function(name,
+ value = c("default", "allowed", "min", "max")) {
+ stopifnot(is.character(name), length(name) == 1)
+
+ value <- match.arg(value)
+ out <- stress_test_arguments
+
+ out <- out[out$name == name, c("type", value)]
+ as_type <- get(paste0("as.", out$type))
+ out <- as_type(out[[value]])
+ out
+}
+
+#' conveniently access stress test related files in the directory set via envvar
+#' or options
+#'
+#' @param ... Character vectors, if any values are `NA`, the result will also be
+#' `NA`.
+#' @param data_store String. Directory that contains the relevant data for the stress test analysis
+#'
+#' @family miscellaneous utility functions
+#'
+#' @return Character
+#'
+#' @examples
+#' r2dii.climate.stress.test:::data_path()
+data_path <- function(..., data_store = "data-raw") {
+ fs::path(data_store, ...)
+}
+
+expect_no_error <- function(object, ...) {
+ testthat::expect_error(object, regexp = NA, ...)
+}
+
+#' Help skip tests where the developer has not opted in running snapshots
+#'
+#' To opt in set the environment variable `ST_OPT_IN_SNAPSHOTS = TRUE`, maybe
+#' via `usethis::edit_r_environ("project")`.
+#'
+#' @examples
+#' default <- list(ST_OPT_IN_SNAPSHOTS = FALSE)
+#' withr::with_envvar(default, testthat::skip_if_not(opt_in_snapshots()))
+#'
+#' opt_in <- list(ST_OPT_IN_SNAPSHOTS = TRUE)
+#' withr::with_envvar(opt_in, testthat::skip_if_not(opt_in_snapshots()))
+#' @noRd
+opt_in_snapshots <- function() {
+ out <- Sys.getenv("ST_OPT_IN_SNAPSHOTS", unset = "FALSE")
+ as.logical(out)
+}
+
+skip_slow_tests <- function() {
+ skipping_slow_tests <- as.logical(
+ Sys.getenv("ST_SKIP_SLOW_TESTS", unset = "TRUE")
+ )
+ testthat::skip_if(skipping_slow_tests)
+}
diff --git a/tests/testthat/test-calc_survival_probability_merton.R b/tests/testthat/test-calc_survival_probability_merton.R
new file mode 100644
index 0000000..9ed75dd
--- /dev/null
+++ b/tests/testthat/test-calc_survival_probability_merton.R
@@ -0,0 +1,63 @@
+test_that("Error is thrown if input vector have different lengths", {
+ expect_error(
+ calc_survival_probability_merton(
+ L = c(10, 20),
+ V0 = 20,
+ sigma = 0.2,
+ r = 0.05,
+ t = 20
+ ),
+ "same length"
+ )
+})
+
+test_that("Error is thrown if any input vector is not numeric", {
+ expect_error(
+ calc_survival_probability_merton(
+ L = 10,
+ V0 = "20",
+ sigma = 0.2,
+ r = 0.05,
+ t = 20
+ ),
+ "numeric"
+ )
+})
+
+test_that("Error is thrown if r is negative", {
+ expect_error(
+ calc_survival_probability_merton(
+ L = 10,
+ V0 = 1,
+ sigma = 0.2,
+ r = -0.05,
+ t = 20
+ ),
+ "negative"
+ )
+})
+
+test_that("Error is thrown if any input other than r is not positive", {
+ expect_error(
+ calc_survival_probability_merton(
+ L = 10,
+ V0 = 0,
+ sigma = 0.2,
+ r = 0,
+ t = 20
+ ),
+ "positive"
+ )
+})
+
+test_that("Function returns vector of identical length as input args", {
+ p_survival <- calc_survival_probability_merton(
+ L = c(10, 10),
+ V0 = c(20, 20),
+ sigma = c(0.2, 0.2),
+ r = c(0.05, 0.05),
+ t = c(1, 2)
+ )
+
+ expect_equal(length(p_survival), 2)
+})
diff --git a/tests/testthat/test-calculate_overall_pd_changes.R b/tests/testthat/test-calculate_overall_pd_changes.R
new file mode 100644
index 0000000..7398994
--- /dev/null
+++ b/tests/testthat/test-calculate_overall_pd_changes.R
@@ -0,0 +1,83 @@
+test_that("without specified arguments, calculate_pd_change_overall throws
+ error", {
+ testthat::expect_error(
+ calculate_pd_change_overall(),
+ "argument \"data\" is missing"
+ )
+})
+
+test_that("with missing argument for shock_year, calculate_pd_change_overall
+ throws error", {
+ test_data <- read_test_data("loanbook_annual_profits.csv")
+
+ test_end_of_analysis <- 2040
+ test_risk_free_rate <- 0.05
+
+ testthat::expect_error(
+ calculate_pd_change_overall(
+ data = test_data,
+ end_of_analysis = test_end_of_analysis,
+ risk_free_interest_rate = test_risk_free_rate
+ ),
+ "Must provide input for 'shock_year'"
+ )
+})
+
+test_that("PD_changes point in expected direction", {
+ test_data <- read_test_data("loanbook_annual_profits.csv")
+
+ test_shock_year <- 2030
+ test_end_of_analysis <- 2040
+ test_risk_free_rate <- 0.05
+
+ # Expected direction of PD change depends on direction of expected value change
+ # This can be extracted from NPV columns of the annual profit data, which is
+ # equal for all years
+ filter_year <- min(test_data$year, na.rm = TRUE)
+ expected_direction <- test_data %>%
+ dplyr::filter(.data$year == filter_year) %>%
+ dplyr::select(
+ dplyr::all_of(c(
+ "scenario_name",
+ "scenario_geography",
+ "company_name",
+ "ald_sector",
+ "discounted_net_profit_baseline",
+ "discounted_net_profit_ls"
+ ))
+ ) %>%
+ dplyr::mutate(
+ pd_expected_rising = dplyr::if_else(
+ .data$discounted_net_profit_ls < .data$discounted_net_profit_baseline,
+ TRUE,
+ FALSE
+ )
+ )
+
+ test_results <- calculate_pd_change_overall(
+ data = test_data,
+ shock_year = test_shock_year,
+ end_of_analysis = test_end_of_analysis,
+ risk_free_interest_rate = test_risk_free_rate
+ )
+
+ results_direction <- test_results %>%
+ dplyr::mutate(
+ pd_change_rising = dplyr::if_else(
+ .data$PD_change > 0,
+ TRUE,
+ FALSE
+ )
+ ) %>%
+ dplyr::inner_join(
+ expected_direction,
+ by = c(
+ "scenario_name", "scenario_geography", "company_name", "ald_sector"
+ )
+ )
+
+ testthat::expect_equal(
+ results_direction$pd_expected_rising,
+ results_direction$pd_change_rising
+ )
+})
diff --git a/tests/testthat/test-company_technology_asset_value_at_risk.R b/tests/testthat/test-company_technology_asset_value_at_risk.R
new file mode 100644
index 0000000..d558b22
--- /dev/null
+++ b/tests/testthat/test-company_technology_asset_value_at_risk.R
@@ -0,0 +1,7 @@
+test_that("without specified arguments, company_technology_asset_value_at_risk
+ throws error", {
+ testthat::expect_error(
+ company_technology_asset_value_at_risk(),
+ "argument \"data\" is missing"
+ )
+})
diff --git a/tests/testthat/test-convert_cap_to_generation.R b/tests/testthat/test-convert_cap_to_generation.R
new file mode 100644
index 0000000..7d6afdd
--- /dev/null
+++ b/tests/testthat/test-convert_cap_to_generation.R
@@ -0,0 +1,127 @@
+# convert_cap_to_generation -----------------------------------------------
+test_that("without specified arguments, function throws error", {
+ testthat::expect_error(
+ convert_cap_to_generation(),
+ "argument \"data\" is missing"
+ )
+})
+
+test_that("with missing argument for capacity_factors_power,
+ function throws error", {
+ test_data <- read_test_data("convert_cap_to_generation.csv")
+
+ testthat::expect_error(
+ convert_cap_to_generation(data = test_data),
+ "Must provide input for 'capacity_factors_power'"
+ )
+})
+
+test_that("multiplies the power capacity by hours per year and the capacity
+ factor so that we get MWh for plan_tech_prod and scen_tech_prod", {
+ test_data <- read_test_data("convert_cap_to_generation.csv")
+ test_capacity_factors <- read_test_data("capacity_factors.csv")
+
+ test_results <- convert_cap_to_generation(
+ data = test_data,
+ capacity_factors_power = test_capacity_factors
+ )
+
+ verify_input_data <- test_data %>%
+ dplyr::filter(ald_business_unit == "NuclearCap")
+ verify_capacity_factors <- test_capacity_factors %>%
+ dplyr::filter(.data$ald_business_unit == "NuclearCap") %>%
+ dplyr::pull(.data$capacity_factor)
+ hours_to_year <- 24 * 365
+ verify_multiplier <- hours_to_year * verify_capacity_factors
+
+ verify_results <- test_results %>%
+ dplyr::filter(ald_business_unit == "NuclearCap")
+
+ testthat::expect_equal(
+ verify_results$scen_tech_prod, verify_input_data$scen_tech_prod * verify_multiplier
+ )
+
+ testthat::expect_equal(
+ verify_results$plan_tech_prod, verify_input_data$plan_tech_prod * verify_multiplier
+ )
+})
+
+# convert_power_cap_to_generation -----------------------------------------
+new_capacity_factors <- tibble::tibble(
+ ald_business_unit = c(rep("HydroCap", 8), rep("NuclearCap", 8)),
+ scenario_geography = c(rep(c(rep("Global", 4), rep("Brazil", 4)), 2)),
+ scenario = c(rep(c(rep("NPS", 2), rep("SDS", 2)), 4)),
+ year = c(rep(c(2021, 2022), 8)),
+ capacity_factor = c(rep(c(rep(0.5, 2), rep(0.3, 2)), 4))
+)
+
+# reducing new_test_data to data with matching years in new_capacity_factors
+new_test_data <- read_test_data("convert_power_cap_to_generation.csv") %>%
+ dplyr::filter(.data$year %in% c(2021, 2022))
+
+
+test_that("plan_tech_prod and production under scenario targets are equal
+ (assuming equals values before funcion is applied) if capacity factors
+ do not differ between scenarios.", {
+ test_baseline <- "NPS"
+ test_target <- "SDS"
+
+ test_results <- convert_power_cap_to_generation(
+ data = new_test_data,
+ capacity_factors_power = new_capacity_factors %>%
+ dplyr::mutate(capacity_factor = 0.5),
+ baseline_scenario = test_baseline,
+ target_scenario = test_target
+ )
+
+ expect_equal(test_results$plan_tech_prod, test_results %>% dplyr::pull(!!rlang::sym(test_baseline)))
+ expect_equal(test_results$plan_tech_prod, test_results %>% dplyr::pull(!!rlang::sym(test_target)))
+})
+
+test_that("plan_tech_prod and scen_tech_prod differ (assuming equals values before
+ funcion is applied) only for power sector for not baseline scneario if
+ capacity factors differ between scenarios.", {
+ test_baseline <- "NPS"
+ test_target <- "SDS"
+
+ test_results <- convert_power_cap_to_generation(
+ data = new_test_data,
+ capacity_factors_power = new_capacity_factors,
+ baseline_scenario = test_baseline,
+ target_scenario = test_target
+ )
+
+ power_results_target <- test_results %>%
+ dplyr::filter(ald_sector == "Power") %>%
+ dplyr::select(plan_tech_prod, !!rlang::sym(test_target))
+ power_results_baseline <- test_results %>%
+ dplyr::filter(ald_sector == "Power") %>%
+ dplyr::select(plan_tech_prod, !!rlang::sym(test_baseline))
+
+ other_sector_results <- test_results %>% dplyr::filter(ald_sector != "Power")
+
+ testthat::expect_true(all(power_results_target$plan_tech_prod > power_results_target %>% dplyr::pull(!!rlang::sym(test_target))))
+ testthat::expect_true(all(power_results_baseline$plan_tech_prod == power_results_baseline %>% dplyr::pull(!!rlang::sym(test_baseline))))
+ testthat::expect_true(all(other_sector_results$plan_tech_prod == other_sector_results %>% dplyr::pull(!!rlang::sym(test_target))))
+ testthat::expect_true(all(other_sector_results$plan_tech_prod == other_sector_results %>% dplyr::pull(!!rlang::sym(test_baseline))))
+})
+
+test_that("multiplication results differ by further variables", {
+ test_baseline <- "NPS"
+ test_target <- "SDS"
+
+ # picked only one year here to keep test manageable
+ test_results <- convert_power_cap_to_generation(
+ data = new_test_data,
+ capacity_factors_power = new_capacity_factors %>%
+ dplyr::mutate(capacity_factor = dplyr::if_else(.data$year == 2022, .data$capacity_factor - 0.1, .data$capacity_factor)),
+ baseline_scenario = test_baseline,
+ target_scenario = test_target
+ )
+
+ power_results_2021 <- test_results %>% dplyr::filter(ald_sector == "Power" & year == 2021)
+ power_results_2022 <- test_results %>% dplyr::filter(ald_sector == "Power" & year == 2022)
+ testthat::expect_true(all(power_results_2021$plan_tech_prod > power_results_2022$plan_tech_prod))
+ testthat::expect_true(all(power_results_2021 %>% dplyr::pull(!!rlang::sym(test_target)) > power_results_2022 %>% dplyr::pull(!!rlang::sym(test_target))))
+ testthat::expect_true(all(power_results_2021 %>% dplyr::pull(!!rlang::sym(test_baseline)) > power_results_2022 %>% dplyr::pull(!!rlang::sym(test_baseline))))
+})
diff --git a/tests/testthat/test-extend_scenario_trajectory.R b/tests/testthat/test-extend_scenario_trajectory.R
new file mode 100644
index 0000000..e5247fc
--- /dev/null
+++ b/tests/testthat/test-extend_scenario_trajectory.R
@@ -0,0 +1,121 @@
+test_that("company-ald_business_unit target production after extension equals SMSP for
+ low carbon ald_business_unit", {
+ test_data <- read_test_data("new_extend_scenario_trajectories.csv")
+ test_scenario <- read_test_data("scenario_data.csv")
+
+ test_start <- 2020
+ test_end <- 2040
+ test_horizon <- 5
+ test_target_scenario <- "SDS"
+
+ test_results <- extend_scenario_trajectory(
+ data = test_data,
+ scenario_data = test_scenario,
+ start_analysis = test_start,
+ end_analysis = test_end,
+ time_frame = test_horizon,
+ target_scenario = test_target_scenario
+ )
+
+ verify_technology <- "Electric"
+ verify_sector <- "Automotive"
+ verify_scenario <- "SDS"
+
+ initial_tech_target_electric <- test_data %>%
+ dplyr::filter(
+ .data$year == test_start,
+ .data$ald_business_unit == verify_technology
+ ) %>%
+ dplyr::pull(.data$plan_tech_prod)
+
+ initial_sector_target_auto <- test_data %>%
+ dplyr::filter(
+ .data$year == test_start,
+ .data$ald_sector == verify_sector
+ ) %>%
+ dplyr::group_by(
+ .data$ald_sector, .data$scenario_geography
+ ) %>%
+ dplyr::summarise(
+ plan_sec_prod = sum(.data$plan_tech_prod, na.rm = TRUE),
+ .groups = "drop"
+ ) %>%
+ dplyr::ungroup() %>%
+ dplyr::pull(.data$plan_sec_prod)
+
+ verify_scenario_change_end_year_electric_target <- test_scenario %>%
+ dplyr::filter(
+ .data$year == test_end,
+ .data$ald_business_unit == verify_technology,
+ .data$scenario == verify_scenario
+ ) %>%
+ dplyr::pull(.data$fair_share_perc)
+
+ verify_extension_end_year_electric_target <- initial_tech_target_electric +
+ (initial_sector_target_auto * verify_scenario_change_end_year_electric_target)
+
+ verify_result_electric <- test_results %>%
+ dplyr::filter(
+ .data$year == test_end,
+ .data$ald_business_unit == verify_technology
+ ) %>%
+ dplyr::pull(verify_scenario)
+
+
+ testthat::expect_equal(
+ verify_extension_end_year_electric_target, verify_result_electric
+ )
+})
+
+test_that("company-ald_business_unit target production after extension equals TMSR for
+ high carbon ald_business_unit", {
+ test_data <- read_test_data("new_extend_scenario_trajectories.csv")
+ test_scenario <- read_test_data("scenario_data.csv")
+
+ test_start <- 2020
+ test_end <- 2040
+ test_horizon <- 5
+ test_target_scenario <- "SDS"
+
+ test_results <- extend_scenario_trajectory(
+ data = test_data,
+ scenario_data = test_scenario,
+ start_analysis = test_start,
+ end_analysis = test_end,
+ time_frame = test_horizon,
+ target_scenario = test_target_scenario
+ )
+
+ verify_technology <- "Coal"
+ verify_scenario <- "SDS"
+
+ initial_tech_target_coal <- test_data %>%
+ dplyr::filter(
+ .data$year == test_start,
+ .data$ald_business_unit == verify_technology
+ ) %>%
+ dplyr::pull(.data$plan_tech_prod)
+
+ verify_scenario_change_end_year_coal_target <- test_scenario %>%
+ dplyr::filter(
+ .data$year == test_end,
+ .data$ald_business_unit == verify_technology,
+ .data$scenario == verify_scenario
+ ) %>%
+ dplyr::pull(.data$fair_share_perc)
+
+ verify_extension_end_year_coal_target <- initial_tech_target_coal *
+ (1 + verify_scenario_change_end_year_coal_target)
+
+ verify_result_coal <- test_results %>%
+ dplyr::filter(
+ .data$year == test_end,
+ .data$ald_business_unit == verify_technology
+ ) %>%
+ dplyr::pull(verify_scenario)
+
+
+ testthat::expect_equal(
+ verify_extension_end_year_coal_target, verify_result_coal
+ )
+})
diff --git a/tests/testthat/test-financial_functions.R b/tests/testthat/test-financial_functions.R
new file mode 100644
index 0000000..706b428
--- /dev/null
+++ b/tests/testthat/test-financial_functions.R
@@ -0,0 +1,339 @@
+test_that("calculate_net_profits penalizes companies for late build out of low
+ carbon technologies if overshoot is increasing", {
+ input_data <- tibble::tribble(
+ ~company_id, ~company_name, ~baseline, ~late_sudden, ~Baseline_price, ~late_sudden_price, ~net_profit_margin, ~direction, ~overshoot_direction, ~proximity_to_target, ~scenario_geography, ~year, ~emission_factor, ~ald_sector, ~ald_business_unit,
+ "1", "laggard_with_overshoot", 100, 150, 10, 10, 0.1, "increasing", "Increasing", 0.5, "Global", 2030, 1, "a_sector", "a_business_unit",
+ "2", "laggard_with_no_overshoot", 100, 150, 10, 10, 0.1, "increasing", "Decreasing", 0.5, "Global", 2030, 1, "a_sector", "a_business_unit"
+ )
+
+ carbon_data_test <- tibble::tribble(
+ ~year, ~model, ~scenario, ~variable, ~unit, ~carbon_tax,
+ 2030, "GCAM 5.3+ NGFS", "NDC", "Price|Carbon", 10, 10,
+ )
+
+
+ test_shock_year <- 2021
+ test_market_passthrough <- 0
+ test_financial_stimulus <- 1
+
+
+ net_profits <- calculate_net_profits(input_data,
+ carbon_data = carbon_data_test,
+ shock_year = test_shock_year,
+ market_passthrough = test_market_passthrough,
+ financial_stimulus = test_financial_stimulus
+ )
+
+ net_profits_baseline_laggard_with_no_overshoot <- net_profits %>%
+ dplyr::filter(.data$company_name == "laggard_with_no_overshoot") %>%
+ dplyr::pull(.data$net_profits_baseline)
+
+ net_profits_baseline_climate_laggard_with_overshoot <- net_profits %>%
+ dplyr::filter(.data$company_name == "laggard_with_overshoot") %>%
+ dplyr::pull(.data$net_profits_baseline)
+
+ net_profits_late_sudden_laggard_with_overshoot <- net_profits %>%
+ dplyr::filter(.data$company_name == "laggard_with_overshoot") %>%
+ dplyr::pull(.data$net_profits_ls)
+
+ net_profits_late_sudden_laggard_with_no_overshoot <- net_profits %>%
+ dplyr::filter(.data$company_name == "laggard_with_no_overshoot") %>%
+ dplyr::pull(.data$net_profits_ls)
+
+ testthat::expect_equal(
+ net_profits_baseline_laggard_with_no_overshoot,
+ net_profits_baseline_climate_laggard_with_overshoot
+ )
+ testthat::expect_gt(
+ net_profits_late_sudden_laggard_with_no_overshoot,
+ net_profits_late_sudden_laggard_with_overshoot,
+ )
+})
+
+
+
+test_that("calculate_net_profits does apply a carbon tax on high carbon technologies even with decreasing overshoot", {
+ input_data <- tibble::tribble(
+ ~company_name, ~company_id, ~baseline, ~late_sudden, ~Baseline_price, ~late_sudden_price, ~net_profit_margin, ~direction, ~overshoot_direction, ~proximity_to_target, ~scenario_geography, ~year, ~emission_factor, ~ald_sector, ~ald_business_unit,
+ "laggard_low_carbon_technology", "1", 100, 50, 10, 10, 0.1, "increasing", "Decreasing", 0.5, "Global", 2030, 1, "a_sector", "a_business_unit",
+ "laggard_high_carbon_technology", "2", 100, 50, 10, 10, 0.1, "declining", "Decreasing", 0.5, "Global", 2030, 1, "a_sector", "a_business_unit"
+ )
+
+ carbon_data_test <- tibble::tribble(
+ ~year, ~model, ~scenario, ~variable, ~unit, ~carbon_tax,
+ 2030, "GCAM 5.3+ NGFS", "NDC", "Price|Carbon", 10, 10,
+ )
+
+
+ test_shock_year <- 2021
+ test_market_passthrough <- 0
+ test_financial_stimulus <- 1
+
+
+
+ net_profits <- calculate_net_profits(input_data,
+ carbon_data = carbon_data_test,
+ shock_year = test_shock_year,
+ market_passthrough = test_market_passthrough,
+ financial_stimulus = test_financial_stimulus
+ )
+
+ net_profits_baseline_climate_laggard_high_carbon_technology <- net_profits %>%
+ dplyr::filter(.data$company_name == "laggard_high_carbon_technology") %>%
+ dplyr::pull(.data$net_profits_baseline)
+
+ net_profits_baseline_climate_laggard_low_carbon_technology <- net_profits %>%
+ dplyr::filter(.data$company_name == "laggard_low_carbon_technology") %>%
+ dplyr::pull(.data$net_profits_baseline)
+
+ net_profits_late_sudden_climate_laggard_high_carbon_technology <- net_profits %>%
+ dplyr::filter(.data$company_name == "laggard_high_carbon_technology") %>%
+ dplyr::pull(.data$net_profits_ls)
+
+ net_profits_late_sudden_climate_laggard_low_carbon_technology <- net_profits %>%
+ dplyr::filter(.data$company_name == "laggard_low_carbon_technology") %>%
+ dplyr::pull(.data$net_profits_ls)
+
+ testthat::expect_equal(
+ net_profits_baseline_climate_laggard_high_carbon_technology,
+ net_profits_baseline_climate_laggard_low_carbon_technology
+ )
+ testthat::expect_gt(
+ net_profits_late_sudden_climate_laggard_low_carbon_technology,
+ net_profits_late_sudden_climate_laggard_high_carbon_technology
+ )
+})
+
+
+test_that("calculate_net_profits does not apply carbon tax on high
+ carbon technologies before shock year", {
+ input_data <- tibble::tribble(
+ ~company_id, ~company_name, ~baseline, ~late_sudden, ~Baseline_price, ~late_sudden_price, ~net_profit_margin, ~direction, ~overshoot_direction, ~proximity_to_target, ~year, ~emission_factor, ~ald_sector, ~ald_business_unit, ~scenario_geography,
+ "1", "high carbon ald_business_unit after shock year", 100, 50, 10, 10, 0.1, "declining", "Increasing", 0, 2030, 1, "a_sector", "a_business_unit", "a_geography"
+ )
+
+ carbon_data_test <- tibble::tribble(
+ ~year, ~model, ~scenario, ~variable, ~unit, ~carbon_tax,
+ 2030, "GCAM 5.3+ NGFS", "NDC", "Price|Carbon", 10, 10,
+ )
+
+
+ test_shock_year_early <- 2025
+ test_shock_year_late <- 2035
+ test_market_passthrough <- 0
+ test_financial_stimulus <- 1
+
+
+
+
+ net_profits_early <- calculate_net_profits(input_data,
+ carbon_data = carbon_data_test,
+ shock_year = test_shock_year_early,
+ market_passthrough = test_market_passthrough,
+ financial_stimulus = test_financial_stimulus
+ )
+
+ net_profits_late <- calculate_net_profits(input_data,
+ carbon_data = carbon_data_test,
+ shock_year = test_shock_year_late,
+ market_passthrough = test_market_passthrough,
+ financial_stimulus = test_financial_stimulus
+ )
+
+ net_profits_late_sudden_high_carbon_technology_early <- net_profits_early %>%
+ dplyr::pull(.data$net_profits_ls)
+
+ net_profits_late_sudden_high_carbon_technology_late <- net_profits_late %>%
+ dplyr::pull(.data$net_profits_ls)
+
+
+ testthat::expect_gt(
+ net_profits_late_sudden_high_carbon_technology_late,
+ net_profits_late_sudden_high_carbon_technology_early
+ )
+})
+
+
+test_that("calculate_net_profits penalizes companies for late build out of low
+ carbon technologies", {
+ input_data <- tibble::tribble(
+ ~company_name, ~baseline, ~late_sudden, ~Baseline_price, ~late_sudden_price, ~net_profit_margin, ~direction, ~overshoot_direction, ~proximity_to_target, ~year,
+ "leader", 100, 150, 10, 10, 0.1, "increasing", "Increasing", 1, 2030,
+ "laggard", 100, 150, 10, 10, 0.1, "increasing", "Increasing", 0.5, 2030,
+ )
+
+
+ test_shock_year <- 2021
+
+ net_profits <- calculate_net_profits_without_carbon_tax(input_data)
+
+ net_profits_baseline_climate_leader <- net_profits %>%
+ dplyr::filter(.data$company_name == "leader") %>%
+ dplyr::pull(.data$net_profits_baseline)
+
+ net_profits_baseline_climate_laggard <- net_profits %>%
+ dplyr::filter(.data$company_name == "laggard") %>%
+ dplyr::pull(.data$net_profits_baseline)
+
+ net_profits_late_sudden_climate_leader <- net_profits %>%
+ dplyr::filter(.data$company_name == "leader") %>%
+ dplyr::pull(.data$net_profits_ls)
+
+ net_profits_late_sudden_climate_laggard <- net_profits %>%
+ dplyr::filter(.data$company_name == "laggard") %>%
+ dplyr::pull(.data$net_profits_ls)
+
+ testthat::expect_equal(
+ net_profits_baseline_climate_leader,
+ net_profits_baseline_climate_laggard
+ )
+ testthat::expect_gt(
+ net_profits_late_sudden_climate_leader,
+ net_profits_late_sudden_climate_laggard
+ )
+})
+
+
+
+test_that("a higher market passthrough has a weaker impact on a company's net profits", {
+ input_data <- tibble::tribble(
+ ~company_id, ~company_name, ~baseline, ~late_sudden, ~Baseline_price, ~late_sudden_price, ~net_profit_margin, ~direction, ~overshoot_direction, ~proximity_to_target, ~year, ~emission_factor, ~ald_sector, ~ald_business_unit, ~scenario_geography,
+ "1", "high carbon ald_business_unit after shock year", 100, 50, 10, 10, 0.1, "declining", "Decreasing", 0, 2030, 1, "a_sector", "a_business_unit", "a_geography"
+ )
+
+ carbon_data_test <- tibble::tribble(
+ ~year, ~model, ~scenario, ~variable, ~unit, ~carbon_tax,
+ 2030, "GCAM 5.3+ NGFS", "NDC", "Price|Carbon", 10, 10,
+ )
+
+
+ test_shock_year <- 2025
+ test_market_passthrough_low <- 0
+ test_market_passthrough_high <- 1
+ test_financial_stimulus <- 1
+
+
+
+ net_profits_low_market_power <- calculate_net_profits(input_data,
+ carbon_data = carbon_data_test,
+ shock_year = test_shock_year,
+ market_passthrough = test_market_passthrough_low,
+ financial_stimulus = test_financial_stimulus
+ )
+
+ net_profits_high_market_power <- calculate_net_profits(input_data,
+ carbon_data = carbon_data_test,
+ shock_year = test_shock_year,
+ market_passthrough = test_market_passthrough_high,
+ financial_stimulus = test_financial_stimulus
+ )
+
+ net_profits_low_market_power <- net_profits_low_market_power %>%
+ dplyr::pull(.data$net_profits_ls)
+
+ net_profits_high_market_power <- net_profits_high_market_power %>%
+ dplyr::pull(.data$net_profits_ls)
+
+
+ testthat::expect_gt(
+ net_profits_high_market_power,
+ net_profits_low_market_power
+ )
+})
+
+
+test_that("calculate_net_profits does only apply a financial stimulus on low carbon technologies", {
+ input_data <- tibble::tribble(
+ ~company_id, ~company_name, ~baseline, ~late_sudden, ~Baseline_price, ~late_sudden_price, ~net_profit_margin, ~direction, ~overshoot_direction, ~proximity_to_target, ~scenario_geography, ~year, ~emission_factor, ~ald_sector, ~ald_business_unit,
+ "1", "low_carbon_technology_company", 100, 50, 10, 10, 0.1, "increasing", "Decreasing", 0.5, "Global", 2030, 1, "a_sector", "a_business_unit",
+ "2", "high_carbon_technology_company", 100, 50, 10, 10, 0.1, "declining", "Decreasing", 0.5, "Global", 2030, 1, "a_sector", "a_business_unit"
+ )
+
+ carbon_data_test <- tibble::tribble(
+ ~year, ~model, ~scenario, ~variable, ~unit, ~carbon_tax,
+ 2030, "no_carbon_tax", "no_carbon_tax", "Price|Carbon", 0, 0,
+ )
+
+
+ test_shock_year <- 2021
+ test_market_passthrough <- 0
+ test_financial_stimulus <- 1.5
+
+
+
+ net_profits <- calculate_net_profits(input_data,
+ carbon_data = carbon_data_test,
+ shock_year = test_shock_year,
+ market_passthrough = test_market_passthrough,
+ financial_stimulus = test_financial_stimulus
+ )
+
+ net_profits_baseline_climate_low_carbon_technology_company <- net_profits %>%
+ dplyr::filter(.data$company_name == "low_carbon_technology_company") %>%
+ dplyr::pull(.data$net_profits_baseline)
+
+ net_profits_baseline_climate_high_carbon_technology_company <- net_profits %>%
+ dplyr::filter(.data$company_name == "high_carbon_technology_company") %>%
+ dplyr::pull(.data$net_profits_baseline)
+
+ net_profits_late_sudden_climate_low_carbon_technology_company <- net_profits %>%
+ dplyr::filter(.data$company_name == "low_carbon_technology_company") %>%
+ dplyr::pull(.data$net_profits_ls)
+
+ net_profits_late_sudden_climate_high_carbon_technology_company <- net_profits %>%
+ dplyr::filter(.data$company_name == "high_carbon_technology_company") %>%
+ dplyr::pull(.data$net_profits_ls)
+
+ testthat::expect_equal(
+ net_profits_baseline_climate_low_carbon_technology_company,
+ net_profits_baseline_climate_high_carbon_technology_company
+ )
+ testthat::expect_gt(
+ net_profits_late_sudden_climate_low_carbon_technology_company,
+ net_profits_late_sudden_climate_high_carbon_technology_company
+ )
+})
+
+
+test_that("calculate_net_profits supports a low carbon technology company more the higher the financial stimulus is", {
+ input_data <- tibble::tribble(
+ ~company_id, ~company_name, ~baseline, ~late_sudden, ~Baseline_price, ~late_sudden_price, ~net_profit_margin, ~direction, ~overshoot_direction, ~proximity_to_target, ~scenario_geography, ~year, ~emission_factor, ~ald_sector, ~ald_business_unit,
+ "1", "low_carbon_technology_company", 100, 50, 10, 10, 0.1, "increasing", "Decreasing", 0.5, "Global", 2030, 1, "a_sector", "a_business_unit"
+ )
+
+ carbon_data_test <- tibble::tribble(
+ ~year, ~model, ~scenario, ~variable, ~unit, ~carbon_tax,
+ 2030, "no_carbon_tax", "no_carbon_tax", "Price|Carbon", 0, 0,
+ )
+
+
+ test_shock_year <- 2021
+ test_market_passthrough <- 0
+ low_test_financial_stimulus <- 1.5
+ high_test_financial_stimulus <- 2.5
+
+ net_profits_low_financial_stimulus <- calculate_net_profits(input_data,
+ carbon_data = carbon_data_test,
+ shock_year = test_shock_year,
+ market_passthrough = test_market_passthrough,
+ financial_stimulus = low_test_financial_stimulus
+ )
+
+ net_profits_high_financial_stimulus <- calculate_net_profits(input_data,
+ carbon_data = carbon_data_test,
+ shock_year = test_shock_year,
+ market_passthrough = test_market_passthrough,
+ financial_stimulus = high_test_financial_stimulus
+ )
+
+ net_profits_late_sudden_low_financial_stimulus <- net_profits_low_financial_stimulus %>%
+ dplyr::pull(.data$net_profits_ls)
+
+ net_profits_late_sudden_high_financial_stimulus <- net_profits_high_financial_stimulus %>%
+ dplyr::pull(.data$net_profits_ls)
+
+ testthat::expect_gt(
+ net_profits_late_sudden_high_financial_stimulus,
+ net_profits_late_sudden_low_financial_stimulus
+ )
+})
diff --git a/tests/testthat/test-run_trisk.R b/tests/testthat/test-run_trisk.R
new file mode 100644
index 0000000..5b08df5
--- /dev/null
+++ b/tests/testthat/test-run_trisk.R
@@ -0,0 +1,97 @@
+test_that("without iteration, using minimum values of input arguments output is unchanged", {
+ skip_if_not(opt_in_snapshots())
+ skip_on_ci()
+ skip_on_cran()
+ skip_slow_tests()
+
+ in_agnostic <- fs::path("test_data", "ST_INPUTS_DEV")
+ out <- tempfile()
+ fs::dir_create(out)
+
+ suppressed_console_output <- suppressWarnings(suppressMessages(capture.output(
+ results <- run_trisk(
+ input_path = in_agnostic,
+ output_path = out,
+ lgd = get_st_argument("lgd", "min"),
+ risk_free_rate = get_st_argument("risk_free_rate", "min"),
+ discount_rate = get_st_argument("discount_rate", "min"),
+ growth_rate = get_st_argument("growth_rate", "min"),
+ div_netprofit_prop_coef = get_st_argument("div_netprofit_prop_coef", "min"),
+ shock_year = get_st_argument("shock_year", "min"),
+ return_results = TRUE
+ )
+ )))
+
+ results$crispy_output <- results$crispy_output |> dplyr::select(-c(.data$run_id))
+ results$company_trajectories <- results$company_trajectories |> dplyr::select(-c(.data$run_id))
+
+ expect_snapshot(lapply(results, as.data.frame))
+})
+
+test_that("without iteration, using maximum values of input arguments output is unchanged", {
+ skip_if_not(opt_in_snapshots())
+ skip_on_ci()
+ skip_on_cran()
+ skip_slow_tests()
+
+ in_agnostic <- fs::path("test_data", "ST_INPUTS_DEV")
+ out <- tempfile()
+ fs::dir_create(out)
+
+ suppressed_console_output <- suppressWarnings(suppressMessages(capture.output(
+ results <- run_trisk(
+ input_path = in_agnostic,
+ output_path = out,
+ scenario_geography = "OECD",
+ lgd = get_st_argument("lgd", "max"),
+ risk_free_rate = get_st_argument("risk_free_rate", "max"),
+ discount_rate = get_st_argument("discount_rate", "max"),
+ growth_rate = get_st_argument("growth_rate", "max"),
+ div_netprofit_prop_coef = get_st_argument("div_netprofit_prop_coef", "max"),
+ shock_year = get_st_argument("shock_year", "max"),
+ return_results = TRUE
+ )
+ )))
+
+ results$crispy_output <- results$crispy_output |> dplyr::select(-c(.data$run_id))
+ results$company_trajectories <- results$company_trajectories |> dplyr::select(-c(.data$run_id))
+
+ expect_snapshot(lapply(results, as.data.frame))
+})
+
+test_that("All scenario combinations are valid", {
+ skip_if_not(opt_in_snapshots())
+ skip_on_ci()
+ skip_on_cran()
+ skip_slow_tests()
+
+ in_agnostic <- fs::path("test_data", "ST_INPUTS_DEV")
+ scenario_geography_x_ald_sector <- get_scenario_geography_x_ald_sector(in_agnostic) |>
+ dplyr::distinct(.data$baseline_scenario, .data$shock_scenario, .data$scenario_geography)
+
+ error_happened <- FALSE
+ for (i in 1:nrow(scenario_geography_x_ald_sector)) {
+ row_params <- scenario_geography_x_ald_sector[i, ]
+ tryCatch(
+ {
+ suppressWarnings(suppressMessages(capture.output(
+ run_trisk(
+ input_path = in_agnostic,
+ output_path = tempdir(),
+ baseline_scenario = row_params$baseline_scenario,
+ shock_scenario = row_params$shock_scenario,
+ scenario_geography = row_params$scenario_geography
+ )
+ )))
+
+ cat(paste("Pass", row_params, "\n"))
+ },
+ error = function(e) {
+ cat(paste("Failed", row_params, "\n"))
+ error_happened <- TRUE
+ }
+ )
+ }
+
+ expect_false(error_happened)
+})
diff --git a/tests/testthat/test-set_paths.R b/tests/testthat/test-set_paths.R
new file mode 100644
index 0000000..dece4e8
--- /dev/null
+++ b/tests/testthat/test-set_paths.R
@@ -0,0 +1,53 @@
+test_that("default will return character path 'data-raw'", {
+ testthat::expect_equal(data_path(), fs::path("data-raw"))
+})
+
+test_that("default returns an fs path", {
+ testthat::expect_s3_class(data_path(), "fs_path")
+})
+
+test_that("adding an unnamed character input will extend the default path", {
+ testthat::expect_equal(
+ data_path("more"),
+ fs::path("data-raw", "more")
+ )
+})
+
+test_that("adding an unnamed character input returns an fs path", {
+ testthat::expect_s3_class(data_path("more"), "fs_path")
+})
+
+test_that("adding multiple unnamed character inputs will extend the default
+ path", {
+ testthat::expect_equal(
+ data_path("more-data", "even-more-data"),
+ fs::path("data-raw", "more-data", "even-more-data")
+ )
+})
+
+test_that("adding NA as input returns fs_path NA", {
+ testthat::expect_equal(
+ data_path(NA),
+ fs::path(NA)
+ )
+})
+
+test_that("adding an unnamed character and NA as inputs will return NA", {
+ testthat::expect_equal(
+ data_path("more-data", NA),
+ fs::path(NA)
+ )
+})
+
+test_that("adding an unnamed numeric input will coerce the number and extend the
+ default path", {
+ testthat::expect_s3_class(data_path(1), "fs_path")
+})
+
+test_that("adding an unnamed logical input will coerce the logical and extend
+ the default path", {
+ testthat::expect_equal(
+ data_path(FALSE),
+ fs::path("data-raw", "FALSE")
+ )
+})
diff --git a/tests/testthat/test-set_tech_trajectories.R b/tests/testthat/test-set_tech_trajectories.R
new file mode 100644
index 0000000..f0c04d0
--- /dev/null
+++ b/tests/testthat/test-set_tech_trajectories.R
@@ -0,0 +1,177 @@
+# set_baseline_trajectory -------------------------------------------------
+test_that("set_baseline_trajectories returns a data frame", {
+ test_data_set_baseline <- read_test_data("data_set_baseline_traj.csv")
+
+ baseline_trajectory <- set_baseline_trajectory(
+ data = test_data_set_baseline,
+ baseline_scenario = "NPS"
+ )
+
+ testthat::expect_s3_class(baseline_trajectory, "data.frame")
+})
+
+test_that("set_baseline_trajectories does not fully replicate indicated scenario", {
+ test_data_set_baseline <- read_test_data("data_set_baseline_traj.csv")
+
+ baseline_trajectory <- set_baseline_trajectory(
+ data = test_data_set_baseline,
+ baseline_scenario = "NPS"
+ )
+
+ testthat::expect_false(
+ all(baseline_trajectory$NPS == baseline_trajectory$baseline)
+ )
+})
+
+test_that("set_baseline_trajectories replicates provided production trajectory
+ until end of production forecast period", {
+ test_data_set_baseline <- read_test_data("data_set_baseline_traj.csv")
+
+ # find number of years with provided production forecast per tech
+ forecast_length <- sum(
+ !is.na(
+ test_data_set_baseline[
+ test_data_set_baseline$ald_business_unit == "Electric",
+ "plan_tech_prod"
+ ]
+ )
+ )
+
+ baseline_trajectory <- set_baseline_trajectory(
+ data = test_data_set_baseline,
+ baseline_scenario = "NPS"
+ )
+
+ baseline_trajectory_forecast <- baseline_trajectory %>% head(forecast_length)
+
+ testthat::expect_true(
+ all(baseline_trajectory_forecast$plan_tech_prod == baseline_trajectory_forecast$baseline)
+ )
+})
+
+
+test_that("set_baseline_trajectory sets baseline values to prod forecast
+ for the forecast period", {
+ test_data_calc_future_prod <- read_test_data("data_calc_future_prod.csv")
+
+ # data adaptation to the function
+ test_data_calc_future_prod <- test_data_calc_future_prod %>%
+ dplyr::mutate(
+ scenario_change = .data$scenario_change * 10,
+ TEST_BASELINE = cumsum(tidyr::replace_na(.data$scenario_change, 0))
+ )
+ test_data_calc_future_prod[, c(
+ "ald_business_unit",
+ "ald_sector",
+ "company_id",
+ "company_name",
+ "emission_factor",
+ "scenario_geography"
+ )] <- NA
+
+ scen_follows_prod <- set_baseline_trajectory(
+ data = test_data_calc_future_prod,
+ baseline_scenario = "TEST_BASELINE"
+ )
+
+ forecast_length <- sum(!is.na(scen_follows_prod$plan_tech_prod))
+
+ scen_follows_prod <- scen_follows_prod %>% head(forecast_length)
+
+ testthat::expect_true(
+ all(scen_follows_prod$baseline == scen_follows_prod$plan_tech_prod)
+ )
+})
+
+test_that("set_baseline_trajectory sets baseline CHANGE values to prod forecast
+ for the forecast period", {
+ test_data_calc_future_prod <- read_test_data("data_calc_future_prod.csv")
+
+ # data adaptation to the function
+ test_data_calc_future_prod <- test_data_calc_future_prod %>%
+ dplyr::mutate(
+ scenario_change = .data$scenario_change * 10,
+ TEST_BASELINE = cumsum(tidyr::replace_na(.data$scenario_change, 0))
+ )
+ test_data_calc_future_prod[, c(
+ "ald_business_unit",
+ "ald_sector",
+ "company_id",
+ "company_name",
+ "emission_factor",
+ "scenario_geography"
+ )] <- NA
+
+ scen_follows_change <- set_baseline_trajectory(
+ test_data_calc_future_prod,
+ baseline_scenario = "TEST_BASELINE"
+ )
+
+ post_forecast_length <- sum(is.na(scen_follows_change$plan_tech_prod))
+
+ scen_follows_change <- scen_follows_change %>%
+ dplyr::bind_cols(test_data_calc_future_prod %>% dplyr::select(scenario_change)) %>%
+ dplyr::mutate(
+ baseline_change = baseline - dplyr::lag(baseline),
+ baseline_change = round(baseline_change, 7),
+ scenario_change = round(scenario_change, 7)
+ ) %>%
+ tail(post_forecast_length)
+
+ testthat::expect_true(
+ all(scen_follows_change$scenario_change == scen_follows_change$baseline_change)
+ )
+})
+
+# filter_negative_late_and_sudden -----------------------------------------
+test_that("input remains unchanged if no negative late_and_sudden levels are
+ present", {
+ input_data <- tibble::tibble(
+ company_name = c("firm", "firm", "biz", "biz"),
+ ald_business_unit = c("some", "other", "some", "other"),
+ late_sudden = 1:4,
+ some_col = rep("sth", 4)
+ )
+
+ filtered_data <- filter_negative_late_and_sudden(input_data, log_path = NULL)
+
+ expect_equal(input_data, filtered_data)
+})
+
+test_that("ald_business_unit x company_name combinations that hold at least 1 negative
+ value on late_and_sudden are removed", {
+ input_data <- tibble::tibble(
+ company_name = c("firm", "firm", "firm", "biz", "biz"),
+ ald_business_unit = c("some", "some", "other", "some", "other"),
+ late_sudden = c(-1, 1, 1, 0, 1),
+ some_col = rep("sth", 5)
+ )
+
+ filtered_data <- filter_negative_late_and_sudden(input_data, log_path = NULL)
+
+ expect_equal(input_data %>% dplyr::filter(!(company_name == "firm" & ald_business_unit == "some")), filtered_data)
+})
+
+test_that("removal works if several company_name x ald_business_unit combinations are affected", {
+ input_data <- tibble::tibble(
+ company_name = c("firm", "firm", "firm", "biz", "biz"),
+ ald_business_unit = c("some", "some", "other", "some", "other"),
+ late_sudden = c(-1, 1, -1, -1, 1),
+ some_col = rep("sth", 5)
+ )
+
+ filtered_data <- filter_negative_late_and_sudden(input_data, log_path = NULL)
+
+ expect_equal(input_data %>% dplyr::filter(company_name == "biz" & ald_business_unit == "other"), filtered_data)
+})
+
+test_that("error is thrown if no rows remain", {
+ input_data <- tibble::tibble(
+ company_name = c("firm", "firm", "firm", "biz", "biz"),
+ ald_business_unit = c("some", "some", "other", "some", "other"),
+ late_sudden = rep(-1, 5),
+ some_col = rep("sth", 5)
+ )
+
+ expect_error(testthat::expect_warning(filtered_data <