implement stop_if_ validation functions across all scripts/functions

R/plots.R

@@ -5,9 +5,7 @@ plot_match_success_rate <- function(data,
                                     match_success_type = c("n", "outstanding", "credit_limit"),
                                     currency) {
   # validate inputs
-  if (!inherits(data, "data.frame")) {
-    stop("Argument data must be of class data.frame. Please check your inputs.")
-  }
+  stop_if_not_inherits(data, "data.frame")
   expected_cols <- c(
     "group_id",
     "sector",
@@ -16,20 +14,14 @@ plot_match_success_rate <- function(data,
     "match_success_rate",
     "metric_type"
   )
-  if (!all(names(data) %in% expected_cols)) {
-    stop(
-      glue::glue(
-        "Input data does not contain all expected columns. The following columns
-        are missing: {paste(setdiff(expected_cols, data), collapse = ", ")}."
-      )
-    )
-  }
-  if (!length(currency) == 1) {
-    stop("Argument currency must be of length 1. Please check your inputs.")
-  }
-  if (!inherits(currency, "character")) {
-    stop("Argument currency must be of class character. Please check your inputs.")
-  }
+  stop_if_not_expected_columns(data, expected_cols, desc = "Input")
+
+  stop_if_not_inherits(metric_type, "character")
+
+  stop_if_not_inherits(match_success_type, "character")
+
+  stop_if_not_length(currency, 1L)
+  stop_if_not_inherits(currency, "character")
 
   # prepare data
   if (aggregate) {
@@ -397,51 +389,28 @@ validate_input_args_generate_individual_outputs <- function(output_directory,
                                                             sector,
                                                             start_year,
                                                             time_horizon) {
-  if (!length(output_directory) == 1) {
-    stop("Argument output_directory must be of length 1. Please check your input.")
-  }
-  if (!inherits(output_directory, "character")) {
-    stop("Argument output_directory must be of class character. Please check your input.")
-  }
-  if (!length(group_id) == 1) {
-    stop("Argument group_id must be of length 1. Please check your input.")
-  }
-  if (!length(scenario_source) == 1) {
-    stop("Argument scenario_source must be of length 1. Please check your input.")
-  }
-  if (!inherits(scenario_source, "character")) {
-    stop("Argument scenario_source must be of class character. Please check your input.")
-  }
-  if (!length(target_scenario) == 1) {
-    stop("Argument target_scenario must be of length 1. Please check your input.")
-  }
-  if (!inherits(target_scenario, "character")) {
-    stop("Argument target_scenario must be of class character. Please check your input.")
-  }
-  if (!length(region) == 1) {
-    stop("Argument region must be of length 1. Please check your input.")
-  }
-  if (!inherits(region, "character")) {
-    stop("Argument region must be of class character. Please check your input.")
-  }
-  if (!length(sector) == 1) {
-    stop("Argument sector must be of length 1. Please check your input.")
-  }
-  if (!inherits(sector, "character")) {
-    stop("Argument sector must be of class character. Please check your input.")
-  }
-  if (!length(start_year) == 1) {
-    stop("Argument start_year must be of length 1. Please check your input.")
-  }
-  if (!inherits(start_year, "integer")) {
-    stop("Argument start_year must be of class integer. Please check your input.")
-  }
-  if (!length(time_horizon) == 1) {
-    stop("Argument time_horizon must be of length 1. Please check your input.")
-  }
-  if (!inherits(time_horizon, "integer")) {
-    stop("Argument time_horizon must be of class integer. Please check your input.")
-  }
+  stop_if_not_length(output_directory, 1L)
+  stop_if_not_inherits(output_directory, "character")
+
+  stop_if_not_length(group_id, 1L)
+
+  stop_if_not_length(scenario_source, 1L)
+  stop_if_not_inherits(scenario_source, "character")
+
+  stop_if_not_length(target_scenario, 1L)
+  stop_if_not_inherits(target_scenario, "character")
+
+  stop_if_not_length(region, 1L)
+  stop_if_not_inherits(region, "character")
+
+  stop_if_not_length(sector, 1L)
+  stop_if_not_inherits(sector, "character")
+
+  stop_if_not_length(start_year, 1L)
+  stop_if_not_inherits(start_year, "integer")
+
+  stop_if_not_length(time_horizon, 1L)
+  stop_if_not_inherits(time_horizon, "integer")
 
   invisible()
 }

R/prepare_abcd.R

@@ -16,45 +16,27 @@ prepare_abcd <- function() {
   project_parameters_time_frame <- config_project_parameters$time_frame
 
   # validate config values----
-  if (!length(path_abcd) == 1) {
-    stop("Argument path_abcd must be of length 1. Please check your input.")
-  }
-  if (!inherits(path_abcd, "character")) {
-    stop("Argument path_abcd must be of class character. Please check your input.")
-  }
-  if (!length(sheet_abcd) == 1) {
-    stop("Argument sheet_abcd must be of length 1. Please check your input.")
-  }
-  if (!inherits(sheet_abcd, "character")) {
-    stop("Argument sheet_abcd must be of class character. Please check your input.")
-  }
+  stop_if_not_length(path_abcd, 1L)
+  stop_if_not_inherits(path_abcd, "character")
+  stop_if_file_not_found(path_abcd, desc = "ABCD")
+
+  stop_if_not_length(sheet_abcd, 1L)
+  stop_if_not_inherits(sheet_abcd, "character")
+  stop_if_sheet_not_found(sheet_abcd, path_abcd)
+
   if (!is.null(prepare_abcd_rm_inactive_companies)) {
-    if (!length(prepare_abcd_rm_inactive_companies) == 1) {
-      stop("Argument prepare_abcd_rm_inactive_companies must be of length 1. Please check your input.")
-    }
-    if (!inherits(prepare_abcd_rm_inactive_companies, "logical")) {
-      stop("Argument prepare_abcd_rm_inactive_companies must be of class logical. Please check your input.")
-    }
-  }
-  if (!length(project_parameters_start_year) == 1) {
-    stop("Argument project_parameters_start_year must be of length 1. Please check your input.")
-  }
-  if (!inherits(project_parameters_start_year, "integer")) {
-    stop("Argument project_parameters_start_year must be of class integer Please check your input.")
-  }
-  if (!length(project_parameters_time_frame) == 1) {
-    stop("Argument project_parameters_time_frame must be of length 1. Please check your input.")
-  }
-  if (!inherits(project_parameters_time_frame, "integer")) {
-    stop("Argument project_parameters_time_frame must be of class integer Please check your input.")
+    stop_if_not_length(prepare_abcd_rm_inactive_companies, 1L)
+    stop_if_not_inherits(prepare_abcd_rm_inactive_companies, "logical")
   }
 
+  stop_if_not_length(project_parameters_start_year, 1L)
+  stop_if_not_inherits(project_parameters_start_year, "integer")
 
-  # load data----
-  if (!file.exists(path_abcd)) {
-    stop(glue::glue("No ABCD file found at path {path_abcd}. Please check your project setup!"))
-  }
+  stop_if_not_length(project_parameters_time_frame, 1L)
+  stop_if_not_inherits(project_parameters_time_frame, "integer")
 
+
+  # load data----
   abcd <- readxl::read_xlsx(
     path = file.path(path_abcd),
     sheet = sheet_abcd
@@ -75,9 +57,8 @@ prepare_abcd <- function() {
       emission_factor = as.numeric(.data$emission_factor),
       emission_factor_unit = as.character(.data$emission_factor_unit)
     )
-  if (!all(cols_abcd %in% names(abcd))) {
-    stop("Columns in abcd do not match expected input names. Please check your input.")
-  }
+
+  stop_if_not_expected_columns(abcd, cols_abcd, desc = "ABCD")
 
   # optional: remove inactive companies----
 

R/run_calculate_loanbook_coverage.R

@@ -10,6 +10,16 @@ run_calculate_loanbook_coverage <- function() {
   scenario_source_input <- config_project_parameters$scenario_source
   start_year <- config_project_parameters$start_year
 
+  # validate config values----
+  stop_if_not_length(dir_matched, 1L)
+  stop_if_not_inherits(dir_matched, "character")
+  stop_if_dir_not_found(dir_matched, desc = "Matched loanbooks")
+
+  stop_if_not_length(scenario_source_input, 1L)
+  stop_if_not_inherits(scenario_source_input, "character")
+
+  stop_if_not_length(start_year, 1L)
+  stop_if_not_inherits(start_year, "integer")
 
   # load data ----
   ## read abcd data----

R/run_calculate_match_success_rate.R

@@ -22,58 +22,36 @@ run_calculate_match_success_rate <- function() {
   match_success_rate_plot_resolution <- config_match_success_rate$plot_resolution
 
   # validate config values----
-  if (!length(dir_raw) == 1) {
-    stop("Argument dir_raw must be of length 1. Please check your input.")
-  }
-  if (!inherits(dir_raw, "character")) {
-    stop("Argument dir_raw must be of class character. Please check your input.")
-  }
-  if (!length(dir_matched) == 1) {
-    stop("Argument dir_matched must be of length 1. Please check your input.")
-  }
-  if (!inherits(dir_matched, "character")) {
-    stop("Argument dir_matched must be of class character. Please check your input.")
-  }
-  if (!length(matching_use_own_sector_classification) == 1) {
-    stop("Argument matching_use_own_sector_classification must be of length 1. Please check your input.")
-  }
-  if (!inherits(matching_use_own_sector_classification, "logical")) {
-    stop("Argument matching_use_own_sector_classification must be of class logical. Please check your input.")
-  }
+  stop_if_not_length(dir_raw, 1L)
+  stop_if_not_inherits(dir_raw, "character")
+  stop_if_dir_not_found(dir_raw, desc = "Raw loanbook")
+
+  stop_if_not_length(dir_matched, 1L)
+  stop_if_not_inherits(dir_matched, "character")
+  stop_if_dir_not_found(dir_matched, desc = "Matched loanbook")
+
+  stop_if_not_length(matching_use_own_sector_classification, 1L)
+  stop_if_not_inherits(matching_use_own_sector_classification, "logical")
+
   # path to own sector classification only required if boolean TRUE
   if (matching_use_own_sector_classification) {
-    if (!length(path_own_sector_classification) == 1) {
-      stop("When matching_use_own_sector_classification == TRUE, argument path_own_sector_classification must be of length 1. Please check your input.")
-    }
-    if (!inherits(path_own_sector_classification, "character")) {
-      stop("When matching_use_own_sector_classification == TRUE, argument path_own_sector_classification must be of class character. Please check your input.")
-    }
-  }
-  if (!length(match_success_rate_plot_width) == 1) {
-    stop("Argument match_success_rate_plot_width must be of length 1. Please check your input.")
-  }
-  if (!inherits(match_success_rate_plot_width, "integer")) {
-    stop("Argument match_success_rate_plot_width must be of class integer Please check your input.")
-  }
-  if (!length(match_success_rate_plot_height) == 1) {
-    stop("Argument match_success_rate_plot_height must be of length 1. Please check your input.")
-  }
-  if (!inherits(match_success_rate_plot_height, "integer")) {
-    stop("Argument match_success_rate_plot_height must be of class integer Please check your input.")
-  }
-  if (!length(match_success_rate_plot_units) == 1) {
-    stop("Argument match_success_rate_plot_units must be of length 1. Please check your input.")
-  }
-  if (!inherits(match_success_rate_plot_units, "character")) {
-    stop("Argument match_success_rate_plot_units must be of class character. Please check your input.")
-  }
-  if (!length(match_success_rate_plot_resolution) == 1) {
-    stop("Argument match_success_rate_plot_resolution must be of length 1. Please check your input.")
-  }
-  if (!inherits(match_success_rate_plot_resolution, "integer")) {
-    stop("Argument match_success_rate_plot_resolution must be of class integer Please check your input.")
+    stop_if_not_length(path_own_sector_classification, 1L)
+    stop_if_not_inherits(path_own_sector_classification, "character")
+    stop_if_file_not_found(path_own_sector_classification, desc = "Manual sector classification")
   }
 
+  stop_if_not_length(match_success_rate_plot_width, 1L)
+  stop_if_not_inherits(match_success_rate_plot_width, "integer")
+
+  stop_if_not_length(match_success_rate_plot_height, 1L)
+  stop_if_not_inherits(match_success_rate_plot_height, "integer")
+
+  stop_if_not_length(match_success_rate_plot_units, 1L)
+  stop_if_not_inherits(match_success_rate_plot_units, "character")
+
+  stop_if_not_length(match_success_rate_plot_resolution, 1L)
+  stop_if_not_inherits(match_success_rate_plot_resolution, "integer")
+
   # load data----
 
   ## load raw loan books----
@@ -108,10 +86,6 @@ run_calculate_match_success_rate <- function() {
 
   ## load classification system----
   if (matching_use_own_sector_classification) {
-    if (!file.exists(path_own_sector_classification)) {
-      stop(glue::glue("No sector classification file found at path {path_own_sector_classification}. Please check your project setup!"))
-    }
-
     sector_classification_system <- readr::read_csv(
       file = path_own_sector_classification,
       col_types = col_types_sector_classification,

R/run_match_prioritize.R

@@ -15,12 +15,10 @@ run_match_prioritize <- function() {
   sector_split_type_select <- config_prepare_sector_split$sector_split_type
 
   # validate config values----
-  if (!length(dir_matched) == 1) {
-    stop("Argument dir_matched must be of length 1. Please check your input.")
-  }
-  if (!inherits(dir_matched, "character")) {
-    stop("Argument dir_matched must be of class character. Please check your input.")
-  }
+  stop_if_not_length(dir_matched, 1L)
+  stop_if_not_inherits(dir_matched, "character")
+  stop_if_dir_not_found(dir_matched, desc = "Matched loanbook")
+
   if (!is.null(match_prio_priority)) {
     if (
       !inherits(match_prio_priority, "character") &
@@ -80,9 +78,8 @@ run_match_prioritize <- function() {
         emission_factor = as.numeric(.data$emission_factor),
         emission_factor_unit = as.character(.data$emission_factor_unit)
       )
-    if (!all(cols_abcd %in% names(abcd))) {
-      stop("Columns in abcd do not match expected input names. Please check your input.")
-    }
+
+    stop_if_not_expected_columns(abcd, cols_abcd, desc = "ABCD")
   }
 
   # prioritize and save files----