plot_techmix and plot_trajectory gain more specific checks (#552)

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)

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)

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)

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"

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)
 }

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)
 }

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)
 

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(

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)
 }
 

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)
+}

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
 

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
 

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)

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")
+})

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")
+})