#' @title mipBarYearData
#' @description Function for plotting (bar-plot) MAgPIE objects and compare different scenarios
#' or models, on the x-axis for some time steps one bar for each scenario/model is generated
#'
#'
#' @param x Data to plot. Allowed data formats: magpie or quitte
#' @param ylab y-axis text
#' @param xlab x-axis text
#' @param title title appearing at the top of the plot
#' @param colour Dimension to be colored, default: "Scenario"
#' @param scenario_markers Use markers to conserve space with long scenario
#' names. Symbols are either picked automatically (default), or can be
#' passed as a named vector in the form of
#' \code{c('scenario' = 'marker')}, where marker is a number between 1
#' and 20, or a ggplot2 shape name
#' (see \code{vignette("ggplot2-specs")}). Set to \code{FALSE} to not
#' use markers.
#' @author Lavinia Baumstark, Oliver Richters
#' @section Example Plot:
#' \if{html}{\figure{mipBarYearData.png}{example plot}}
#' \if{html}{\figure{mipBarYearData_oneRegi.png}{example plot}}
#' \if{html}{\figure{mipBarYearData_oneScenario.png}{example plot}}
#'
#' @examples
#' \dontrun{
#' plotCompBarYearData(EnInv, ylab = "Energy Investments|Elec (billion US$2005/yr)",
#' colour = plotstyle(getNames(EnInv, dim = 2)))
#' }
#'
#' @importFrom magclass is.magpie
#' @importFrom ggplot2 ggplot aes_ guides guide_legend scale_x_continuous
#' ggtitle geom_col scale_shape_manual theme_minimal theme
#' @importFrom dplyr %>% mutate filter inner_join group_by summarise select n sym arrange
#' @importFrom tidyr crossing unite
#' @importFrom quitte order.levels
#' @export
#
mipBarYearData <- function(x, colour = NULL, ylab = NULL, xlab = NULL, title = NULL,
scenario_markers = TRUE) { #nolint
scenarioMarkers <- scenario_markers
x <- droplevels(as.quitte(x))
if (! "identifier" %in% names(x)) x$identifier <- identifierModelScen(x)
if (!is.integer(x$period)) {
stop("this plot can only deal with data that have integer periods")
}
if (nrow(x) == 0) {
warning("Quitte object is empty.")
return()
}
# if not given derive y-axis label, shorten variables accordingly
x$variable <- shorten_legend(x$variable, ylab = ylab, identical_only = TRUE, unit = x$unit)
ylab <- attr(x$variable, "ylab")
# add dummy-dimension for space between the time-steps
xpos <- crossing(period = unique(x$period),
identifier = factor(c(levels(x$identifier), "\x13"))) %>%
order.levels(identifier = c(levels(x$identifier), "\x13")) %>%
arrange(!!sym("period"), !!sym("identifier")) %>%
mutate(xpos = 1:n()) %>%
filter("\x13" != !!sym("identifier")) %>%
droplevels()
x <- x %>%
inner_join(
xpos,
c("identifier", "period")
)
if (scenarioMarkers) {
yMarker <- crossing(
x %>%
group_by(!!sym("region"), !!sym("xpos")) %>%
summarise(top = sum(pmax(0, !!sym("value"))),
bottom = sum(pmin(0, !!sym("value")))) %>%
summarise(top = max(!!sym("top")),
bottom = min(!!sym("bottom"))) %>%
mutate(
y = !!sym("bottom") - 0.05 * (!!sym("top") + !!sym("bottom"))) %>%
select(-"top", -"bottom"),
xpos
)
}
if (scenarioMarkers) {
scenarioMarkers <- stats::setNames((1:20)[seq_along(unique(x$identifier))],
levels(x$identifier))
}
# calculate positions of period labels
if (any(scenarioMarkers)) {
xpos <- xpos %>%
group_by(!!sym("period")) %>%
summarise(xpos = mean(!!sym("xpos")))
}
if (is.null(colour)) {
colour <- plotstyle(levels(x$variable), strip_units = FALSE)
}
# make plot
p <- ggplot() +
geom_col(data = x,
mapping = aes(x = !!sym("xpos"), y = !!sym("value"),
fill = !!sym("variable"))) +
scale_fill_manual(values = colour, name = NULL,
guide = guide_legend(reverse = TRUE)) +
facet_wrap(~region, scales = "free_y") +
labs(x = xlab, y = ylab, title = title) +
theme_minimal() +
theme(legend.position = "bottom")
# add markers
if (any(scenarioMarkers)) {
p <- p +
scale_x_continuous(breaks = xpos$xpos,
labels = xpos$period) +
geom_point(data = yMarker,
mapping = aes(x = !!sym("xpos"), y = !!sym("y"),
shape = !!sym("identifier")),
size = 1.5) +
scale_shape_manual(values = scenarioMarkers, name = NULL) +
theme(legend.box = "vertical",
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank())
} else {
p <- p +
scale_x_continuous(breaks = xpos$xpos,
labels = xpos %>%
unite(!!sym("label"), !!sym("identifier"),
!!sym("period"), sep = " ") %>%
getElement("label")) +
theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5))
}
return(p)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.