diff --git a/R/plot_emission_intensity.R b/R/plot_emission_intensity.R index c3e2c8ef..7d951253 100644 --- a/R/plot_emission_intensity.R +++ b/R/plot_emission_intensity.R @@ -39,9 +39,12 @@ plot_emission_intensity <- function(data) { } check_plot_emission_intensity <- function(data, env) { - check_prep_emission_intensity(data, env) + stopifnot(is.data.frame(data)) crucial <- c(prep_emission_factor_crucial, "label") hint_if_missing_names(abort_if_missing_names(data, crucial), "sda") + enforce_single_value <- "sector" + abort_if_multiple(data, enforce_single_value) + abort_if_has_zero_rows(data, env = env) abort_if_too_many_lines(data, max = 7) invisible(data) diff --git a/R/plot_techmix.R b/R/plot_techmix.R index cda51bdb..fa244d7d 100644 --- a/R/plot_techmix.R +++ b/R/plot_techmix.R @@ -16,10 +16,10 @@ #' region == "global" & #' metric %in% c("projected", "corporate_economy", "target_sds") #' ) %>% -#' prep_techmix( -#' span_5yr = TRUE, -#' convert_label = recode_metric_techmix, -#' convert_tech_label = spell_out_technology +#' prep_techmix( +#' span_5yr = TRUE, +#' convert_label = recode_metric_techmix, +#' convert_tech_label = spell_out_technology #' ) #' #' plot_techmix(data) @@ -75,17 +75,25 @@ plot_techmix <- function(data) { check_plot_techmix <- function(data, env) { stopifnot(is.data.frame(data)) - crucial <- c(common_crucial_market_share_columns(), "technology_share") + + crucial <- c( + common_crucial_market_share_columns(), + "technology_share", + "label", + "label_tech" + ) hint_if_missing_names(abort_if_missing_names(data, crucial), "market_share") + abort_if_has_zero_rows(data, env = env) + enforce_single_value <- c("sector", "region", "scenario_source") abort_if_multiple(data, enforce_single_value, env = env) - abort_if_multiple_scenarios(data, env = env) + abort_if_wrong_number_of_scenarios(data, env = env) invisible(data) } -abort_if_multiple_scenarios <- function(data, env = parent.frame()) { +abort_if_wrong_number_of_scenarios <- function(data, env = parent.frame()) { .data <- deparse_1(substitute(data, env = env)) scen <- extract_scenarios(data$metric) diff --git a/R/plot_trajectory.R b/R/plot_trajectory.R index 2a04b63e..c43a745e 100644 --- a/R/plot_trajectory.R +++ b/R/plot_trajectory.R @@ -219,6 +219,8 @@ start_value_portfolio <- function(data) { check_plot_trajectory <- function(data, env) { stopifnot(is.data.frame(data)) + crucial <- c(common_crucial_market_share_columns(), "label") + hint_if_missing_names(abort_if_missing_names(data, crucial), "market_share") abort_if_has_zero_rows(data, env = env) enforce_single_value <- c("sector", "technology", "region", "scenario_source") abort_if_multiple(data, enforce_single_value, env = env) diff --git a/R/prep_emission_intensity.R b/R/prep_emission_intensity.R index 35d4f733..ba60a2b9 100644 --- a/R/prep_emission_intensity.R +++ b/R/prep_emission_intensity.R @@ -23,8 +23,13 @@ prep_emission_intensity <- function(data, convert_label = identity, span_5yr = FALSE) { + check_prep_emission_intensity( + data, + convert_label = convert_label, + span_5yr = span_5yr, + env = list(data = substitute(data)) + ) - check_prep_emission_intensity(data, env = list(data = substitute(data))) out <- data %>% prep_common() @@ -47,8 +52,11 @@ prep_emission_intensity <- function(data, ) } -check_prep_emission_intensity <- function(data, env) { +check_prep_emission_intensity <- function(data, convert_label, span_5yr, env) { stopifnot(is.data.frame(data)) + stopifnot(is.function(convert_label)) + stopifnot(is.logical(span_5yr)) + crucial <- prep_emission_factor_crucial hint_if_missing_names(abort_if_missing_names(data, crucial), "sda") enforce_single_value <- "sector" diff --git a/R/prep_techmix.R b/R/prep_techmix.R index a533627c..46c9d2d7 100644 --- a/R/prep_techmix.R +++ b/R/prep_techmix.R @@ -40,9 +40,14 @@ prep_techmix <- function(data, convert_label = identity, span_5yr = FALSE, convert_tech_label = identity) { - env <- list(data = substitute(data)) - check_prep_techmix(data, env = env) + check_prep_techmix( + data, + convert_label = convert_label, + convert_tech_label = convert_tech_label, + span_5yr = span_5yr, + env = env + ) out <- data %>% prep_common() %>% @@ -86,14 +91,22 @@ recode_sector <- function(x) { # styler: on } -check_prep_techmix <- function(data, env) { +check_prep_techmix <- function(data, convert_label, convert_tech_label, span_5yr, env) { stopifnot(is.data.frame(data)) + stopifnot(is.function(convert_label)) + stopifnot(is.function(convert_tech_label)) + stopifnot(is.logical(span_5yr)) + crucial <- c(common_crucial_market_share_columns(), "technology_share") hint_if_missing_names(abort_if_missing_names(data, crucial), "market_share") + abort_if_has_zero_rows(data, env = env) + + abort_if_metric_has_no_projected(data) + enforce_single_value <- c("sector", "region", "scenario_source") abort_if_multiple(data, enforce_single_value, env = env) - abort_if_multiple_scenarios(data, env = env) + abort_if_wrong_number_of_scenarios(data, env = env) invisible(data) } diff --git a/R/prep_trajectory.R b/R/prep_trajectory.R index c1b31470..e4040aa2 100644 --- a/R/prep_trajectory.R +++ b/R/prep_trajectory.R @@ -32,10 +32,14 @@ prep_trajectory <- function(data, convert_label = identity, span_5yr = FALSE, value_col = "percentage_of_initial_production_by_scope") { - env <- list(data = substitute(data)) - - check_prep_trajectory(data, value_col = value_col, env = env) + check_prep_trajectory( + data, + convert_label = convert_label, + span_5yr = span_5yr, + value_col = value_col, + env = env + ) data <- data %>% prep_common() %>% @@ -49,9 +53,20 @@ prep_trajectory <- function(data, data } -check_prep_trajectory <- function(data, value_col, env) { +check_prep_trajectory <- function(data, + convert_label, + span_5yr, + value_col, + env) { stopifnot(is.data.frame(data)) + stopifnot(is.function(convert_label)) + stopifnot(is.logical(span_5yr)) + stopifnot(is.character(value_col)) + crucial <- c(common_crucial_market_share_columns(), value_col) hint_if_missing_names(abort_if_missing_names(data, crucial), "market_share") + enforce_single_value <- c("sector", "technology", "region", "scenario_source") + abort_if_multiple(data, enforce_single_value, env = env) + invisible(data) } diff --git a/R/qplot_emission_intensity.R b/R/qplot_emission_intensity.R index bb84bc51..02fea785 100644 --- a/R/qplot_emission_intensity.R +++ b/R/qplot_emission_intensity.R @@ -18,13 +18,18 @@ #' qplot_emission_intensity(data) qplot_emission_intensity <- function(data) { env <- list(data = substitute(data)) - check_prep_emission_intensity(data, env = env) + check_prep_emission_intensity( + data, + convert_label = to_title, + span_5yr = TRUE, + env = env + ) data <- prep_emission_intensity( data, convert_label = to_title, span_5yr = TRUE - ) + ) check_plot_emission_intensity(data, env = env) diff --git a/R/qplot_techmix.R b/R/qplot_techmix.R index 2e714340..35c767e0 100644 --- a/R/qplot_techmix.R +++ b/R/qplot_techmix.R @@ -24,7 +24,13 @@ #' qplot_techmix(data) qplot_techmix <- function(data) { env <- list(data = substitute(data)) - check_plot_techmix(data, env = env) + check_prep_techmix( + data, + convert_label = recode_metric_techmix, + convert_tech_label = spell_out_technology, + span_5yr = TRUE, + env = env + ) data %>% prep_techmix( diff --git a/R/qplot_trajectory.R b/R/qplot_trajectory.R index 0c05c9f3..e5f5330c 100644 --- a/R/qplot_trajectory.R +++ b/R/qplot_trajectory.R @@ -27,7 +27,7 @@ qplot_trajectory <- function(data) { env <- list(data = substitute(data)) check_qplot_trajectory( data, - value_col = c("percentage_of_initial_production_by_scope", "scope"), + value_col = "percentage_of_initial_production_by_scope", env = env ) @@ -40,7 +40,7 @@ qplot_trajectory <- function(data) { plot_trajectory( center_y = TRUE, perc_y_scale = TRUE - ) %>% + ) %>% labs_trajectory(data) } diff --git a/R/utils.R b/R/utils.R index 0757d1eb..386b7bb2 100644 --- a/R/utils.R +++ b/R/utils.R @@ -321,3 +321,17 @@ get_ordered_scenarios <- function(data) { extract_scenarios <- function(x) { unique(x[startsWith(x, "target_")]) } + +abort_if_metric_has_no_projected <- function(data) { + if (!any(data[["metric"]] %in% "projected")) { + abort( + message = c( + "The column `metric` has no value 'projected' .", + i = "Did you accidentally filter out the 'projected' values?" + ), + class = "no_projected" + ) + } + + invisible(data) +} diff --git a/tests/testthat/_snaps/plot_emission_intensity.md b/tests/testthat/_snaps/plot_emission_intensity.md index 354acfe9..2d0ea29a 100644 --- a/tests/testthat/_snaps/plot_emission_intensity.md +++ b/tests/testthat/_snaps/plot_emission_intensity.md @@ -5,11 +5,11 @@ # if `data` is not sda-like errors gracefully `data` must have all the expected names. - x Missing names: emission_factor_metric, emission_factor_value. + x Missing names: emission_factor_metric, emission_factor_value, label. i Is your data `sda`-like? Caused by error in `abort_if_missing_names()`: ! `data` must have all the expected names. - x Missing names: emission_factor_metric, emission_factor_value. + x Missing names: emission_factor_metric, emission_factor_value, label. # if `data` has zero rows errors gracefully @@ -18,9 +18,12 @@ # with too many sectors errors gracefully - `data` must have a single value of `sector`. - i Do you need to pick one value? E.g. pick 'a' with: `subset(data, sector == 'a')`. - x Provided: a, b. + `data` must have all the expected names. + x Missing names: label. + i Is your data `sda`-like? + Caused by error in `abort_if_missing_names()`: + ! `data` must have all the expected names. + x Missing names: label. # with too many lines to plot errors gracefully diff --git a/tests/testthat/_snaps/qplot_trajectory.md b/tests/testthat/_snaps/qplot_trajectory.md index 6e3a3572..2333cae0 100644 --- a/tests/testthat/_snaps/qplot_trajectory.md +++ b/tests/testthat/_snaps/qplot_trajectory.md @@ -5,11 +5,11 @@ # if `data` is not market_share-like errors gracefully `data` must have all the expected names. - x Missing names: metric, percentage_of_initial_production_by_scope, scope, technology. + x Missing names: metric, percentage_of_initial_production_by_scope, technology. i Is your data `market_share`-like? Caused by error in `abort_if_missing_names()`: ! `data` must have all the expected names. - x Missing names: metric, percentage_of_initial_production_by_scope, scope, technology. + x Missing names: metric, percentage_of_initial_production_by_scope, technology. # with zero-row data errors gracefully diff --git a/tests/testthat/test-plot_trajectory.R b/tests/testthat/test-plot_trajectory.R index 901291f3..d44b2841 100644 --- a/tests/testthat/test-plot_trajectory.R +++ b/tests/testthat/test-plot_trajectory.R @@ -41,15 +41,6 @@ test_that("outputs default axis labels", { expect_equal(p$labels$y, "value") }) -test_that("the errors message includes the name of the user's data", { - # Keep even if already tested in qplot_. Non-standard evaluation is fragile - bad_region <- head(market_share, 2L) %>% - mutate(region = c("a", "b")) %>% - prep_trajectory() - - expect_error(plot_trajectory(bad_region), "bad_region") -}) - test_that("By default doesn't center the Y axis", { data <- example_market_share() %>% prep_trajectory(convert_label = identity, span_5yr = FALSE) diff --git a/tests/testthat/test-prep_techmix.R b/tests/testthat/test-prep_techmix.R index f3a68bf3..346057d3 100644 --- a/tests/testthat/test-prep_techmix.R +++ b/tests/testthat/test-prep_techmix.R @@ -164,3 +164,11 @@ test_that("with input data before start year of 'projected' prep_techmix expect_equal(min(prep_techmix(data)$year, na.rm = TRUE), start_year) }) + +test_that("input with no `projected` value errors gracefully", { + bad_data <- filter( + test_data, + metric != "projected" + ) + expect_error(prep_techmix(bad_data), class = "no_projected") +}) diff --git a/tests/testthat/test-prep_trajectory.R b/tests/testthat/test-prep_trajectory.R index 2267ff5c..f73c4954 100644 --- a/tests/testthat/test-prep_trajectory.R +++ b/tests/testthat/test-prep_trajectory.R @@ -21,7 +21,6 @@ test_that("returns expected columns", { }) test_that("handles value_col correctly", { - test_data_dif_value_col <- test_data %>% rename(new_column = percentage_of_initial_production_by_scope) @@ -31,16 +30,23 @@ test_that("handles value_col correctly", { expect_equal( setdiff(names(result), names(result_dif_col)), "percentage_of_initial_production_by_scope" - ) + ) expect_equal( setdiff(names(result_dif_col), names(result)), "new_column" ) - }) test_that("handles span_5yr correctly", { out <- prep_trajectory(example_market_share(), span_5yr = TRUE) expect_true(all(out$year <= min(out$year) + 5)) }) + +test_that("the errors message includes the name of the user's data", { + # Keep even if already tested in qplot_. Non-standard evaluation is fragile + bad_region <- head(market_share, 2L) %>% + mutate(region = c("a", "b")) + + expect_error(prep_trajectory(bad_region), "bad_region") +})