plot_emission_intensity correctly orders scale_colour_r2dii input (…

…#528)

* add failing test

* update test to expose plotting step

* update test to expose scaling

* migrate test to appropriate function

* `labels` arg becomes `colour_labels`

* remove forced factor levels

* remove `match_lines_order` from test

* suppress deprecation warning in tests

* update news

* tests wont run with suppressWarnings on R < 4

NEWS.md

@@ -1,5 +1,12 @@
 # r2dii.plot (development version)
 
+## Breaking change
+* `scale_colour_r2dii` has argument renamed from `labels` to `colour_labels` (#527).
+
+## Bug fixes
+* `scale_colour_r2dii`, with input colours and levels, now outputs line plot 
+  with correctly coloured lines (#527). 
+
 ## New features
 
 * techmix plot does not show the start year scenario bar anymore. (#513)

R/plot_emission_intensity.R

@@ -87,7 +87,7 @@ plot_emission_intensity_impl <- function(data) {
     aes(
       x = .data$year,
       y = .data$emission_factor_value,
-      colour = match_lines_order(data)
+      colour = .data$label
     )
   ) +
     geom_line() +
@@ -97,11 +97,3 @@ plot_emission_intensity_impl <- function(data) {
     scale_colour_manual(values = unique(data$hex)) +
     theme_2dii()
 }
-
-match_lines_order <- function(data) {
-  forcats::fct_reorder2(
-    data$label,
-    data$year,
-    data$emission_factor_value
-  )
-}

R/scale_colour_r2dii.R

@@ -2,9 +2,9 @@
 #'
 #' A custom discrete colour and fill scales with colours from 2DII palette.
 #'
-#' @param labels A character vector. Specifies colour labels to use and their
+#' @param colour_labels A character vector. Specifies colour labels to use and their
 #'   order. Run `unique(r2dii.plot:::palette_colours$label)` to see available
-#'   labels. Similar to `value` parameter in [ggplot2::scale_colour_manual()].
+#'   colours. Similar to `value` parameter in [ggplot2::scale_colour_manual()].
 #' @param ... Other parameters passed on to [ggplot2::discrete_scale()].
 #'
 #' @return An object of class "ScaleDiscrete".
@@ -23,17 +23,17 @@
 #' ggplot(mpg) +
 #'   geom_histogram(aes(cyl, fill = class), position = "dodge", bins = 5) +
 #'   scale_fill_r2dii()
-scale_colour_r2dii <- function(labels = NULL, ...) {
-  discrete_scale("colour", "r2dii", r2dii_pal(labels), ...)
+scale_colour_r2dii <- function(colour_labels = NULL, ...) {
+  discrete_scale("colour", "r2dii", r2dii_pal(colour_labels), ...)
 }
 
 #' @rdname scale_colour_r2dii
 #' @export
-scale_fill_r2dii <- function(labels = NULL, ...) {
-  discrete_scale("fill", "r2dii", r2dii_pal(labels), ...)
+scale_fill_r2dii <- function(colour_labels = NULL, ...) {
+  discrete_scale("fill", "r2dii", r2dii_pal(colour_labels), ...)
 }
 
-r2dii_pal <- function(labels = NULL) {
-  abort_if_unknown_values(labels, palette_colours, column = "label")
-  r2dii_pal_impl(labels, column = "label", data = palette_colours)
+r2dii_pal <- function(colour_labels = NULL) {
+  abort_if_unknown_values(colour_labels, palette_colours, column = "label")
+  r2dii_pal_impl(colour_labels, column = "label", data = palette_colours)
 }

tests/testthat/_snaps/scale_colour_r2dii.md

@@ -1,14 +1,14 @@
 # if with bad `labels` errors gracefully
 
-    Each value of `labels` must be one of these:
+    Each value of `colour_labels` must be one of these:
     dark_blue, green, orange, grey, dark_purple, yellow, soft_blue, ruby_red, moss_green.
     x You passed: bad.
     i Do you need to see valid values in this dataset?:
     palette_colours
 
 ---
 
-    Each value of `labels` must be one of these:
+    Each value of `colour_labels` must be one of these:
     dark_blue, green, orange, grey, dark_purple, yellow, soft_blue, ruby_red, moss_green.
     x You passed: bad.
     i Do you need to see valid values in this dataset?:

tests/testthat/test-scale_colour_r2dii.R

@@ -6,8 +6,8 @@ test_that("outputs a gg ScaleDiscrete", {
 })
 
 test_that("if with bad `labels` errors gracefully", {
-  expect_snapshot_error(scale_colour_r2dii(labels = c("bad")))
-  expect_snapshot_error(scale_fill_r2dii(labels = c("bad")))
+  expect_snapshot_error(scale_colour_r2dii(colour_labels = c("bad")))
+  expect_snapshot_error(scale_fill_r2dii(colour_labels = c("bad")))
 })
 
 test_that("changes the plot colours as expected", {
@@ -29,3 +29,77 @@ test_that("changes the plot fill as expected", {
 
   expect_false(identical(colours_default, colours_changed))
 })
+
+test_that("with data having specific level factors, scales colours as expected
+          (#527)", {
+
+  skip_if(r_version_is_older_than(4))
+  data <- filter(sda, sector == "cement", region == "global")
+
+  input_levels <- c(
+    "projected",
+    "corporate_economy",
+    "target_demo",
+    "adjusted_scenario_demo"
+  )
+
+  input_color_scale <- c(
+    "dark_blue",
+    "green",
+    "grey",
+    "ruby_red"
+  )
+
+  input_color_scale_hex <- data.frame(label = input_color_scale) %>%
+    left_join(palette_colours, by = "label") %>%
+    pull(hex)
+
+  expected_output <- data.frame(
+    levels = input_levels,
+    hex = input_color_scale_hex
+  )
+
+  data <- data %>%
+    dplyr::mutate(
+      emission_factor_metric = factor(
+        .data$emission_factor_metric,
+        levels = input_levels
+      )
+    )
+
+  p <- suppressWarnings(
+    plot_emission_intensity(data),
+    classes = "lifecycle_warning_deprecated"
+  )
+  p <- p + scale_colour_r2dii(
+     colour_labels = input_color_scale,
+     labels = input_levels
+  )
+
+  # print the levels that colours are applied to
+  ordered_output_levels <- levels(p$data$emission_factor_metric)
+
+  # print the actual colour scales of the plot
+  ordered_output_colour_scale <- p$scales$get_scales("colour")$palette(
+    length(ordered_output_levels)
+  )
+
+  plot_output <- data.frame(
+    levels = ordered_output_levels,
+    hex = ordered_output_colour_scale
+  )
+
+  out <- left_join(
+    plot_output,
+    expected_output,
+    by = "levels",
+    suffix = c("_out", "_expected")
+  ) %>%
+    split(.$levels)
+
+  expect_equal(out$projected$hex_out, out$projected$hex_expected)
+  expect_equal(out$corporate_economy$hex_out, out$corporate_economy$hex_expected)
+  expect_equal(out$target_demo$hex_out, out$target_demo$hex_expected)
+  expect_equal(out$adjusted_scenario_demo$hex_out, out$adjusted_scenario_demo$hex_expected)
+
+})