Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Extract labs() and refactor #128

Merged
merged 2 commits into from
May 6, 2021
Merged

Extract labs() and refactor #128

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
873190b
In plot_timeline() remove labels
maurolepore May 5, 2021
b0013a1
Merged origin/master into 123_extract-labs
maurolepore May 6, 2021
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
103 changes: 46 additions & 57 deletions R/plot_timeline.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,30 +5,30 @@
#' @param lines_specs Dataframe containing order of lines, their labels and
#' (optionally) colour names from the r2dii_colours palette (column
#' 'r2dii_colour_name').
#' @param plot_title Title of the plot.
#' @param x_title,y_title x- and y-axis title.
#'
#' @return An object of class "ggplot".
#' @export
#'
#' @examples
#' # You may prepare and plot an sda_target-like dataset using defaults
#' example_data <- prepare_for_timeline(sda_target)
#' library(ggplot2)
#'
#' # FIXME: print() should be unnecessary if plot_timeline() retunrs visibly
#' print(
#' plot_timeline(example_data)
#' )
#' data <- sda_target
#'
#' # You may prepare and plot an sda_target-like dataset using defaults
#' data %>%
#' prepare_for_timeline() %>%
#' plot_timeline()
#'
#' # Or use custom values passed to a number of arguments
#' data_sda_cement <- prepare_for_timeline(sda_target,
#' sector_filter = "cement",
#' year_start = 2020,
#' year_end = 2050,
#' column_line_names = "emission_factor_metric",
#' value_to_plot = "emission_factor_value",
#' extrapolate_missing_values = FALSE
#' )
#' cement_data <- data %>%
#' prepare_for_timeline(
#' sector_filter = "cement",
#' year_start = 2020,
#' year_end = 2050,
#' column_line_names = "emission_factor_metric",
#' value_to_plot = "emission_factor_value",
#' extrapolate_missing_values = FALSE
#' )
#'
#' lines_specs <- dplyr::tibble(
#' line_name = c(
Expand All @@ -46,64 +46,53 @@
#' r2dii_colour_name = c("dark_blue", "green", "grey", "orange")
#' )
#'
#' plot <- plot_timeline(data_sda_cement,
#' lines_specs = lines_specs,
#' plot_title = "Emission intensity trend for Cement.",
#' x_title = "Year",
#' y_title = "Tons of CO2 per ton"
#' )
#' plot
plot_timeline <- function(data,
lines_specs = NULL,
plot_title = NULL,
x_title = "Year",
y_title = "Value") {
#' p <- plot_timeline(cement_data, lines_specs = lines_specs)
#' p
#'
#' # Customize with ggplot2 as usual
#' p + labs(title = "Emission intensity trend for Cement")
plot_timeline <- function(data, lines_specs = NULL) {
lines_specs <- lines_specs %||% dplyr::tibble(
line_name = unique(data$line_name),
label = unique(data$line_name)
)

check_lines_specs(data, lines_specs)
lines_specs <- add_r2dii_colours(lines_specs)
lines_specs <- lines_specs %>%
check_lines_specs(data) %>%
add_r2dii_colours()

plot <- ggplot(
data = data %>% filter(.data$extrapolated == FALSE),
aes(
x = .data$year,
y = .data$value,
colour = factor(.data$line_name, levels = lines_specs$line_name)
),
linetype = .data$extrapolated
) +
geom_line() +
measured <- filter(data, !.data$extrapolated)
plot <- ggplot() +
timeline_line(measured, lines_specs) +
scale_x_continuous(expand = expansion(mult = c(0, 0.1))) +
scale_y_continuous(expand = expansion(mult = c(0, 0.1))) +
expand_limits(y = 0) +
labs(title = plot_title) +
xlab(x_title) +
ylab(y_title) +
scale_colour_manual(
values = lines_specs$colour_hex,
labels = lines_specs$label
) +
theme_2dii_ggplot()
)

if (any(data$extrapolated)) {
extrapolated <- filter(data, .data$extrapolated)
plot <- plot +
geom_line(
data = data %>% filter(.data$extrapolated == TRUE),
aes(
x = .data$year,
y = .data$value,
colour = factor(.data$line_name, levels = lines_specs$line_name),
linetype = .data$extrapolated
)
) +
timeline_line(extrapolated, lines_specs, linetype = .data$extrapolated) +
scale_linetype_manual(values = "dashed") +
guides(linetype = FALSE)
}

plot
plot + theme_2dii_ggplot()
}

timeline_line <- function(data, lines_specs, ...) {
geom_line(
data = data,
aes(
x = .data$year,
y = .data$value,
colour = factor(.data$line_name, levels = lines_specs$line_name),
...
)
)
}
Comment on lines +86 to 96
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

DRY common code between extrapolated/not-extrapolated lines.


factor_to_character <- function(data) {
Expand All @@ -115,7 +104,7 @@ factor_to_character <- function(data) {
data
}

check_lines_specs <- function(data, lines_specs) {
check_lines_specs <- function(lines_specs, data) {
if (!is.data.frame(lines_specs)) {
msg <- sprintf(
"'line_specs' must be a dataframe.
Expand Down Expand Up @@ -161,7 +150,7 @@ check_lines_specs <- function(data, lines_specs) {
stop(msg, call. = FALSE)
}

invisible(data)
invisible(lines_specs)
}

add_r2dii_colours <- function(lines_specs) {
Expand Down
54 changes: 22 additions & 32 deletions man/plot_timeline.Rd
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

31 changes: 8 additions & 23 deletions tests/testthat/_snaps/plot_timeline.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,23 +4,13 @@
out
Output
$data
# A tibble: 29 x 4
year line_name value extrapolated
<dbl> <chr> <dbl> <lgl>
1 2020 projected 0.664 FALSE
2 2021 projected 0.665 FALSE
3 2022 projected 0.666 FALSE
4 2023 projected 0.667 FALSE
5 2024 projected 0.668 FALSE
6 2025 projected 0.669 FALSE
7 2020 corporate_economy 0.669 FALSE
8 2021 corporate_economy 0.670 FALSE
9 2022 corporate_economy 0.671 FALSE
10 2023 corporate_economy 0.672 FALSE
# ... with 19 more rows
list()
attr(,"class")
[1] "waiver"

$layers
$layers[[1]]
mapping: x = ~.data$year, y = ~.data$value, colour = ~factor(.data$line_name, levels = lines_specs$line_name)
geom_line: na.rm = FALSE, orientation = NA
stat_identity: na.rm = FALSE
position_identity
Expand Down Expand Up @@ -53,9 +43,7 @@

$mapping
Aesthetic mapping:
* `x` -> `.data$year`
* `y` -> `.data$value`
* `colour` -> `factor(.data$line_name, levels = lines_specs$line_name)`
<empty>

$theme
List of 93
Expand Down Expand Up @@ -520,14 +508,11 @@
super: <ggproto object: Class FacetNull, Facet, gg>

$labels
$labels$y
[1] "Value"

$labels$x
[1] "Year"
[1] "year"

$labels$title
NULL
$labels$y
[1] "value"

$labels$colour
[1] "factor(line_name, levels = lines_specs$line_name)"
Expand Down