Skip to content

Commit

Permalink
Breaking change: Extract prep_* functions from plot_* functions (#…
Browse files Browse the repository at this point in the history 
…543)
  • Loading branch information
@jdhoffa
jdhoffa authored Feb 16, 2024
1 parent 9130b1b commit f60ba3d
Show file tree
Hide file tree
Showing 36 changed files with 1,033 additions and 881 deletions.
3 changes: 3 additions & 0 deletions NAMESPACE
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,9 @@ export("%>%")
export(plot_emission_intensity)
export(plot_techmix)
export(plot_trajectory)
export(prep_emission_intensity)
export(prep_techmix)
export(prep_trajectory)
export(qplot_emission_intensity)
export(qplot_techmix)
export(qplot_trajectory)
Expand Down
4 changes: 4 additions & 0 deletions NEWS.md
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,10 @@
# r2dii.plot (development version)

## Breaking change
* All `plot_*()` functions have had the data preparation step extracted into
`prep_*()` functions. This means that from now on `prep_*()` function needs
to be called on `data` prior to `plot_*()`. The APIs of `qplot_*()` functions stay
unchanged (#465).
* `scale_colour_r2dii` has argument renamed from `labels` to `colour_labels` (#527).

## Bug fixes
Expand Down
96 changes: 16 additions & 80 deletions R/plot_emission_intensity.R
View file
Original file line number Diff line number Diff line change
@@ -1,98 +1,27 @@
#' Create an emission intensity plot
#'
#' @param data A data frame. Requirements:
#' * The structure must be like [sda].
#' * The column `sector` must have a single value (e.g. "cement").
#' * (Optional) If present, the column `label` is used for data labels.
#' @param span_5yr Logical. Use `TRUE` to restrict the time span to 5 years from
#' the start year (the default behavior of `qplot_emission_intensity()`), or use
#' `FALSE` to impose no restriction.
#' @template convert_label
#' @templateVar fun qplot_emission_intensity
#' @templateVar value to_title
#' @param data A data frame like the output of `prep_emission_intensity()`.
#'
#' @seealso [sda].
#'
#' @return An object of class "ggplot".
#'
#' @export
#' @examples
#' # `data` must meet documented "Requirements"
#' data <- subset(sda, sector == "cement" & region == "global")
#' plot_emission_intensity(data)
#'
#' # plot with `qplot_emission_intensity()` parameters
#' plot_emission_intensity(
#' data,
#' span_5yr = TRUE,
#' convert_label = to_title
#' )
plot_emission_intensity <- function(data,
span_5yr = FALSE,
convert_label = identity) {
lifecycle::deprecate_soft(
when = "0.4.0",
what = "plot_emission_intensity(data = 'must be prepped already')",
details = api_warning_details(
"prep_emission_intensity",
"plot_emission_intensity"
)
)
env <- list(data = substitute(data))
check_plot_emission_intensity(data, env = env)

data %>%
prep_emission_intensity(
convert_label = convert_label,
span_5yr = span_5yr
) %>%
plot_emission_intensity_impl()
}

check_plot_emission_intensity <- function(data, env) {
stopifnot(is.data.frame(data))
crucial <- c("sector", "year", glue("emission_factor_{c('metric', 'value')}"))
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)
}

prep_emission_intensity <- function(data,
convert_label = identity,
span_5yr = FALSE) {
out <- data %>%
prep_common()

if (is.factor(out$label)) {
out$label <- factor(
convert_label(out$label),
levels = convert_label(levels(out$label))
)
} else {
out$label <- convert_label(out$label)
}

if (span_5yr) {
out <- span_5yr(out)
}

out <- out %>%
mutate(
year = as.Date(ISOdate(year = .data$year, month = 1L, day = 1L))
)
#' data <- subset(sda, sector == "cement" & region == "global") %>%
#' prep_emission_intensity(span_5yr = TRUE, convert_label = to_title)
#'
#' plot_emission_intensity(data)
plot_emission_intensity <- function(data) {
check_plot_emission_intensity(data, env = list(data = substitute(data)))

metrics <- distinct(out, .data$emission_factor_metric)
metrics <- distinct(data, .data$emission_factor_metric)
colours <- palette_colours[seq_len(nrow(metrics)), "hex", drop = FALSE]
specs <- dplyr::bind_cols(metrics, colours)

left_join(out, specs, by = metric(data))
}
data <- left_join(data, specs, by = metric(data))

plot_emission_intensity_impl <- function(data) {
ggplot(
data = data,
aes(
Expand All @@ -108,3 +37,10 @@ plot_emission_intensity_impl <- function(data) {
scale_colour_manual(values = unique(data$hex)) +
theme_2dii()
}

check_plot_emission_intensity <- function(data, env) {
check_prep_emission_intensity(data, env)
stopifnot(is.data.frame(data))
abort_if_too_many_lines(data, max = 7)
invisible(data)
}
191 changes: 48 additions & 143 deletions R/plot_techmix.R
View file
Original file line number Diff line number Diff line change
@@ -1,150 +1,31 @@
#' Create a techmix plot
#'
#' @param data A data frame. Requirements:
#' * The structure must be like [market_share].
#' * The following columns must have a single value: `sector`, `region`,
#' `scenario_source`.
#' * The column `metric` must have a portfolio (e.g. "projected"), a benchmark
#' (e.g. "corporate_economy"), and a single `scenario` (e.g. "target_sds").
#' * (Optional) If present, the column `label` is used for data labels.
#' * (Optional) If present, the column `label_tech` is used for technology
#' labels.
#' @param span_5yr Logical. Use `TRUE` to restrict the time span to 5 years from
#' the start year (the default behavior of `qplot_techmix()`), or use
#' `FALSE` to impose no restriction.
#' @template convert_label
#' @templateVar fun qplot_techmix
#' @templateVar value recode_metric_techmix
#' @param convert_tech_label A symbol. The unquoted name of a function to apply
#' to technology legend labels. For example, to convert labels to uppercase
#' use `convert_tech_label = toupper`. To get the default behavior of
#' `qplot_techmix()` use `convert_tech_label = spell_out_technology`.
#' @param data A data frame like the output of `prep_techmix()`.
#'
#' @seealso [market_share].
#'
#' @return An object of class "ggplot".
#'
#' @export
#' @examples
#' # `data` must meet documented "Requirements"
#' # plot with `qplot_techmix()` parameters
#' data <- subset(
#' market_share,
#' scenario_source == "demo_2020" &
#' sector == "power" &
#' region == "global" &
#' metric %in% c("projected", "corporate_economy", "target_sds")
#' )
#'
#' plot_techmix(data)
#'
#' # plot with `qplot_techmix()` parameters
#' plot_techmix(
#' data,
#' ) %>%
#' prep_techmix(
#' span_5yr = TRUE,
#' convert_label = recode_metric_techmix,
#' convert_tech_label = spell_out_technology
#' )
plot_techmix <- function(data,
span_5yr = FALSE,
convert_label = identity,
convert_tech_label = identity) {
lifecycle::deprecate_soft(
when = "0.4.0",
what = "plot_techmix(data = 'must be prepped already')",
details = api_warning_details(
"prep_techmix",
"plot_techmix"
)
)
#' )
#'
#' plot_techmix(data)
plot_techmix <- function(data) {
env <- list(data = substitute(data))
check_plot_techmix(data, env = env)

data %>%
prep_techmix(
convert_label = convert_label,
span_5yr = span_5yr,
convert_tech_label = convert_tech_label,
env = env
) %>%
plot_techmix_impl()
}

check_plot_techmix <- function(data, env) {
stopifnot(is.data.frame(data))
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)
enforce_single_value <- c("sector", "region", "scenario_source")
abort_if_multiple(data, enforce_single_value, env = env)
abort_if_multiple_scenarios(data, env = env)

invisible(data)
}

abort_if_multiple_scenarios <- function(data, env = parent.frame()) {
.data <- deparse_1(substitute(data, env = env))

scen <- extract_scenarios(data$metric)
n <- length(scen)

if (n == 0L) {
abort(c(
glue("`{.data}$metric` must have one scenario."),
x = "It has none."
))
}

if (n > 1L) {
example <- c(setdiff(unique(data$metric), scen), first(scen))
abort(c(
glue("`{.data}$metric` must have a single scenario not {n}."),
i = glue(
"Do you need to pick one scenario? E.g. pick '{first(scen)}' with: \\
`subset({.data}, metric %in% {fmt_vector(fmt_string(example))})`."
),
x = glue("Provided: {toString(scen)}.")
))
}

invisible(data)
}

prep_techmix <- function(data,
convert_label = identity,
span_5yr = FALSE,
convert_tech_label = identity,
env = NULL) {
out <- data %>%
prep_common() %>%
add_label_tech_if_missing() %>%
mutate(
value = .data$technology_share,
sector = recode_sector(.data$sector),
label = convert_label(.data$label),
label_tech = convert_tech_label(.data$label_tech)
)

if (span_5yr) {
out <- span_5yr(out)
}

start_year <- min(out$year, na.rm = TRUE)
future_year <- max(out$year, na.rm = TRUE)
if (!quiet()) {
.data <- deparse_1(substitute(data, env = env))
inform(glue(
"The `technology_share` values are plotted for extreme years.
Do you want to plot different years? E.g. filter {.data} with:\\
`subset({.data}, year %in% c(2020, 2030))`."
))
}
out <- out %>%
filter(.data$year %in% c(start_year, future_year)) %>%
filter(!(is_scenario(.data$metric) & (.data$year == start_year)))
out
}

plot_techmix_impl <- function(data) {
colours <- get_technology_colours(data)
labels <- techmix_labels(data)

Expand Down Expand Up @@ -192,6 +73,46 @@ plot_techmix_impl <- function(data) {
facet_wrap(~year, nrow = 2, strip.position = "right", scales = "free_y")
}

check_plot_techmix <- function(data, env) {
stopifnot(is.data.frame(data))
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)
enforce_single_value <- c("sector", "region", "scenario_source")
abort_if_multiple(data, enforce_single_value, env = env)
abort_if_multiple_scenarios(data, env = env)

invisible(data)
}

abort_if_multiple_scenarios <- function(data, env = parent.frame()) {
.data <- deparse_1(substitute(data, env = env))

scen <- extract_scenarios(data$metric)
n <- length(scen)

if (n == 0L) {
abort(c(
glue("`{.data}$metric` must have one scenario."),
x = "It has none."
))
}

if (n > 1L) {
example <- c(setdiff(unique(data$metric), scen), first(scen))
abort(c(
glue("`{.data}$metric` must have a single scenario not {n}."),
i = glue(
"Do you need to pick one scenario? E.g. pick '{first(scen)}' with: \\
`subset({.data}, metric %in% {fmt_vector(fmt_string(example))})`."
),
x = glue("Provided: {toString(scen)}.")
))
}

invisible(data)
}

techmix_labels <- function(data) {
metrics_other <- data %>%
filter(
Expand Down Expand Up @@ -226,22 +147,6 @@ get_technology_colours <- function(data) {
)
}

recode_sector <- function(x) {
# styler: off
case_when(
grepl("(?i)power(?-i)", x) ~ "power",
grepl("(?i)auto(?-i)[a-zA-Z]+", x) ~ "automotive",
grepl("(?i)oil(?-i).*(?i)gas(?-i)", x) ~ "oil&gas",
grepl("(?i)fossil(?-i)[a-zA-Z]+", x) ~ "fossil fuels",
TRUE ~ tolower(x)
)
# styler: on
}

extract_scenarios <- function(x) {
unique(x[startsWith(x, "target_")])
}

add_label_tech_if_missing <- function(data) {
if (has_name(data, "label_tech")) {
return(data)
Expand Down
Loading

0 comments on commit f60ba3d

Please sign in to comment.