From f6a2f18d3d385af5caa304bd39080c248b19ecc4 Mon Sep 17 00:00:00 2001 From: CJ Yetman - RMI Date: Sun, 18 Aug 2024 12:41:31 +0200 Subject: [PATCH 1/6] replace custom stop and warn messages with `cli` versions --- R/helper_functions.R | 15 +++++++-------- R/run_match_prioritize.R | 23 ++++++++++++++++------- 2 files changed, 23 insertions(+), 15 deletions(-) diff --git a/R/helper_functions.R b/R/helper_functions.R index 1cea23e3..cd4c1f21 100644 --- a/R/helper_functions.R +++ b/R/helper_functions.R @@ -63,14 +63,13 @@ apply_sector_split_to_loans <- function(data, ) if (nrow(unique_companies_pre_split) != nrow(unique_companies_post_split)) { - warning( - glue::glue( - "Applying the sector split has lead to changes in the number of unique - companies covered in the analysis. Prior to the split, there were - {nrow(unique_companies_pre_split)} unique companies. After the split, - there are {nrow(unique_companies_post_split)} unique companies." - ) - ) + n_pre <- nrow(unique_companies_pre_split) + n_post <- nrow(unique_companies_post_split) + cli::cli_warn(c( + "!" = "Applying the sector split has lead to changes in the number of unique companies covered in the analysis.", + "i" = "Prior to the split, there {?was/were} {.strong {n_pre}} unique compan{?y/ies}.", + "i" = "After the split, there {?is/are} {.strong {n_post}} unique compan{?y/ies}." + )) } data diff --git a/R/run_match_prioritize.R b/R/run_match_prioritize.R index 54ce90aa..de81aed1 100644 --- a/R/run_match_prioritize.R +++ b/R/run_match_prioritize.R @@ -25,13 +25,18 @@ run_match_prioritize <- function() { !inherits(match_prio_priority, "formula") & !inherits(match_prio_priority, "function") ) { - stop( - glue::glue( - "Argument match_prio_priority must be of one of: a character vector, a - function, or a quosure-style lambda function. Your input is of class - {class(match_prio_priority)}. Please check your input." - ) + valid_types <- c( + "a character vector", + "a function", + "a quosure-style lambda function" ) + cli::cli_abort(c( + "x" = paste0( + "Argument {.arg match_prio_priority} must be of one of: {.or {valid_types}}, ", + "not {.cls {class(match_prio_priority)}}." + ), + "i" = "Check the {.val match_prioritize:priority} parameter set in your {.file config.yml}." + )) } } @@ -40,7 +45,11 @@ run_match_prioritize <- function() { list_matched_manual <- list.files(path = dir_matched, pattern = "^matched_lbk_.*_manual[.]csv$") if (length(list_matched_manual) == 0) { - stop(glue::glue("No manually matched loan book csvs found in {dir_matched}. Please check your project setup!")) + cli::cli_abort(c( + "x" = "No manually matched loan book csvs found in:", + " " = "{.path {dir_matched}}", + "i" = "Check the {.val dir_matched} parameter set in your {.file config.yml}." + )) } matched_lbk_manual <- readr::read_csv( From b3dad49a26041732d9e8e8bf76943c467675dcde Mon Sep 17 00:00:00 2001 From: CJ Yetman - RMI Date: Mon, 19 Aug 2024 08:44:11 +0200 Subject: [PATCH 2/6] add `stop_if_no_files_found()` --- R/run_calculate_loanbook_coverage.R | 4 +--- R/run_calculate_match_success_rate.R | 10 ++-------- R/run_matching.R | 5 +---- R/stop_if_.R | 27 +++++++++++++++++++++++++++ 4 files changed, 31 insertions(+), 15 deletions(-) diff --git a/R/run_calculate_loanbook_coverage.R b/R/run_calculate_loanbook_coverage.R index e517c3cd..b05eff1f 100644 --- a/R/run_calculate_loanbook_coverage.R +++ b/R/run_calculate_loanbook_coverage.R @@ -36,10 +36,8 @@ run_calculate_loanbook_coverage <- function() { ## read matched prioritized loan books---- list_matched_prioritized <- list.files(path = dir_matched, pattern = "^matched_prio_.*csv$") + stop_if_no_files_found(list_matched_prioritized, dir_matched, "dir_matched", "matched prioritized loan book CSVs") - if (length(list_matched_prioritized) == 0) { - stop(glue::glue("No matched prioritized loan book csvs found in {dir_matched}. Please check your project setup!")) - } matched_prioritized <- readr::read_csv( file = file.path(dir_matched, list_matched_prioritized), diff --git a/R/run_calculate_match_success_rate.R b/R/run_calculate_match_success_rate.R index 7fcd3c4e..fd1e5b3c 100644 --- a/R/run_calculate_match_success_rate.R +++ b/R/run_calculate_match_success_rate.R @@ -56,10 +56,7 @@ run_calculate_match_success_rate <- function() { ## load raw loan books---- list_raw <- list.files(dir_raw)[grepl("csv$", list.files(dir_raw))] - - if (length(list_raw) == 0) { - stop(glue::glue("No raw loan book csvs found in {dir_raw}. Please check your project setup!")) - } + stop_if_no_files_found(list_raw, dir_raw, "dir_raw", "raw loan book CSVs") raw_lbk <- readr::read_csv( file = file.path(dir_raw, list_raw), @@ -73,10 +70,7 @@ run_calculate_match_success_rate <- function() { ## load matched prioritized loan books---- list_matched_prioritized <- list.files(dir_matched)[grepl("^matched_prio_.*csv$", list.files(dir_matched))] - - if (length(list_matched_prioritized) == 0) { - stop(glue::glue("No matched prioritized loan book csvs found in {dir_matched}. Please check your project setup!")) - } + stop_if_no_files_found(list_matched_prioritized, dir_matched, "dir_matched", "matched prioritized loan book CSVs") matched_prioritized <- readr::read_csv( file = file.path(dir_matched, list_matched_prioritized), diff --git a/R/run_matching.R b/R/run_matching.R index ea1b7256..f8cca74d 100644 --- a/R/run_matching.R +++ b/R/run_matching.R @@ -105,10 +105,7 @@ run_matching <- function() { ## load raw loan books---- list_raw <- list.files(path = dir_raw, pattern = "[.]csv$") - - if (length(list_raw) == 0) { - stop(glue::glue("No raw loan book csvs found in {dir_raw}. Please check your project setup!")) - } + stop_if_no_files_found(list_raw, dir_raw, "dir_raw", "raw loan book CSVs") raw_lbk <- readr::read_csv( file = file.path(dir_raw, list_raw), diff --git a/R/stop_if_.R b/R/stop_if_.R index d10cb197..ec56391e 100644 --- a/R/stop_if_.R +++ b/R/stop_if_.R @@ -139,3 +139,30 @@ stop_if_not_expected_columns <- function(data, cols, desc = NULL) { ) } } + + +#' stop_if_no_files_found +#' +#' @param files a vector of files found +#' @param dir a dir where files were not found +#' @param dir_param a string identifying the paramter name in the config that +#' defines the directory +#' @param desc a string describing the type of files expected to be found +#' +#' @return `NULL` invisibly or an error +#' +#' @noRd + +stop_if_no_files_found <- function(files, dir, dir_param, desc) { + if (length(files) == 0) { + cli::cli_abort( + message = c( + "x" = "No {desc} found.", + "i" = "Directory searched: {.path {dir}}", + "i" = "Check the {.arg {dir_param}} parameter in your {.file config.yml}." + ), + call = rlang::caller_env() + ) + } +} + From c2386c55f35c72570f6deb710f99293baf937984 Mon Sep 17 00:00:00 2001 From: CJ Yetman - RMI Date: Mon, 19 Aug 2024 08:44:42 +0200 Subject: [PATCH 3/6] add `stop_if_sector_split_not_one()` --- R/prepare_sector_split.R | 31 +++---------------------------- R/stop_if_.R | 29 +++++++++++++++++++++++++++++ 2 files changed, 32 insertions(+), 28 deletions(-) diff --git a/R/prepare_sector_split.R b/R/prepare_sector_split.R index 0055c2e8..98ede510 100644 --- a/R/prepare_sector_split.R +++ b/R/prepare_sector_split.R @@ -228,15 +228,7 @@ prepare_sector_split <- function() { ) ### check that the sum of the sector split of each company is 1---- - check_sector_split_all_companies <- sector_split_all_companies %>% - dplyr::summarise( - sum_share = sum(.data[["sector_split"]], na.rm = TRUE), - .by = "company_id" - ) - - if (any(round(check_sector_split_all_companies$sum_share, 3) != 1)) { - stop("sector_split_all_companies contains companies for which the sum of the sector split deviates from 1") - } + stop_if_sector_split_not_one(sector_split_all_companies) ## calculate primary energy-based sector split for energy sectors---- # keep only companies that are active in multiple energy sectors @@ -309,15 +301,7 @@ prepare_sector_split <- function() { dplyr::filter(.data$company_id %in% company_ids_primary_energy_split) ### check that the sum of the primary energy based sector split of each company is 1---- - check_sector_split_multi_energy_companies <- sector_split_multi_energy_companies %>% - dplyr::summarise( - sum_share = sum(.data[["sector_split"]], na.rm = TRUE), - .by = "company_id" - ) - - if (any(round(check_sector_split_multi_energy_companies$sum_share, 3) != 1)) { - stop("sector_split_multi_energy_companies contains companies for which the sum of the sector split deviates from 1") - } + stop_if_sector_split_not_one(sector_split_multi_energy_companies) ## combine the sector splits---- # we want to use the plain equal weights split for companies that do not operate in more than one energy sector @@ -344,16 +328,7 @@ prepare_sector_split <- function() { ) ### check that the sum of the combined sector split of each company is 1---- - check_sector_split_all_companies_final <- sector_split_all_companies_final %>% - dplyr::summarise( - sum_share = sum(.data$sector_split, na.rm = TRUE), - .by = "company_id" - ) - - if (any(round(check_sector_split_all_companies_final$sum_share, 3) != 1)) { - stop("sector_split_all_companies_final contains companies for which the sum of the sector split deviates from 1") - } - + stop_if_sector_split_not_one(sector_split_all_companies_final) ## write output---- sector_split_multi_energy_companies %>% diff --git a/R/stop_if_.R b/R/stop_if_.R index ec56391e..1c62b678 100644 --- a/R/stop_if_.R +++ b/R/stop_if_.R @@ -166,3 +166,32 @@ stop_if_no_files_found <- function(files, dir, dir_param, desc) { } } + +#' stop_if_sector_split_not_one +#' +#' @param data a data frame to be checked +#' +#' @return `NULL` invisibly or an error +#' +#' @noRd + +stop_if_sector_split_not_one <- function(data) { + check_sector_split <- + dplyr::summarise( + data, + sum_share = sum(.data$sector_split, na.rm = TRUE), + .by = "company_id" + ) + + if (any(round(check_sector_split$sum_share, 3) != 1)) { + obj_name <- deparse(substitute(data)) + msg <- "{.arg {obj_name}} contains companies for which the sum of the sector split deviates from 1" + cli::cli_abort( + message = c( + "x" = msg, + "i" = "Check the sector split set in your {.file config.yml}." + ), + call = rlang::caller_env() + ) + } +} From 8764e6ce9dd733990dd429edea61cfccc5a41a69 Mon Sep 17 00:00:00 2001 From: CJ Yetman - RMI Date: Mon, 19 Aug 2024 08:51:08 +0200 Subject: [PATCH 4/6] custom stop message for `sector_classifications_used` --- R/run_calculate_match_success_rate.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/run_calculate_match_success_rate.R b/R/run_calculate_match_success_rate.R index fd1e5b3c..b2041828 100644 --- a/R/run_calculate_match_success_rate.R +++ b/R/run_calculate_match_success_rate.R @@ -89,11 +89,11 @@ run_calculate_match_success_rate <- function() { sector_classifications_used <- unique(raw_lbk$sector_classification_system) if (length(sector_classifications_used) != 1) { - stop( - glue::glue( - "Number of sector classification systems across all loan books must be 1. - Your raw loan books use {length(sector_classifications_used)} different - types of sector classifications. Please choose one!" + cli::cli_abort( + message = c( + "x" = "Number of sector classification systems across all loan books is > 1.", + "i" = "You can only use one sector classification at the same time.", + "i" = "Your raw loan books use {length(sector_classifications_used)} different types of sector classifications." ) ) } From 474c0d5ffe9ef7baf7ca13b15a6944049e0343d9 Mon Sep 17 00:00:00 2001 From: CJ Yetman Date: Mon, 19 Aug 2024 09:53:37 +0200 Subject: [PATCH 5/6] Update R/stop_if_.R Co-authored-by: Jacob Kastl <60064070+jacobvjk@users.noreply.github.com> --- R/stop_if_.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/stop_if_.R b/R/stop_if_.R index 1c62b678..1684a50d 100644 --- a/R/stop_if_.R +++ b/R/stop_if_.R @@ -179,7 +179,7 @@ stop_if_sector_split_not_one <- function(data) { check_sector_split <- dplyr::summarise( data, - sum_share = sum(.data$sector_split, na.rm = TRUE), + sum_share = sum(.data[["sector_split"]], na.rm = TRUE), .by = "company_id" ) From 3690104de82d0e82ad41fda69965e8459c839a2e Mon Sep 17 00:00:00 2001 From: CJ Yetman Date: Mon, 19 Aug 2024 12:43:13 +0200 Subject: [PATCH 6/6] improve error message --- R/run_match_prioritize.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/run_match_prioritize.R b/R/run_match_prioritize.R index de81aed1..a045ea80 100644 --- a/R/run_match_prioritize.R +++ b/R/run_match_prioritize.R @@ -46,9 +46,9 @@ run_match_prioritize <- function() { if (length(list_matched_manual) == 0) { cli::cli_abort(c( - "x" = "No manually matched loan book csvs found in:", - " " = "{.path {dir_matched}}", - "i" = "Check the {.val dir_matched} parameter set in your {.file config.yml}." + "x" = "No manually matched loan book csvs were found.", + "i" = "No files matching the pattern {.code ^matched_lbk_.*_manual[.]csv$} were found in {.path {dir_matched}}. Have you done the manual matching process and named the edited CSVs properly?", + "i" = "If {.path {dir_matched}} is not the correct directory, check the {.val dir_matched} parameter set in your {.file config.yml}." )) }