forked from pik-piam/mip
-
Notifications
You must be signed in to change notification settings - Fork 0
/
mipIterations.R
134 lines (124 loc) · 6.46 KB
/
mipIterations.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
#' plotIterations
#'
#' Creates interactive line plots using ggplot and plotly. Creates one plot for each combination of values in columns
#' not plotted via this function's arguments. If the special value "year" is passed as xAxis, color, slider or facets a
#' list of possible column names representing years (e.g. "ttot", "tall", "t_all") is checked, the first one in names(x)
#' is used.
#'
#' @param plotData A data frame. The actual value column must be the last. Use mip::getPlotData to get a
#' ready-to-plot data frame from one or more gdx files.
#' @param returnGgplots If FALSE (the default) show interactive plotly plots with slider support. Set to TRUE to return
#' ggplots which can be customized, but are not interactive. To re-enable slider support and
#' interactivity run lapply(ggplots, plotly::ggplotly) after customizing the ggplots.
#' @param xAxis A string from names(x), defining which column is plotted on the x-axis of the plots. Must not be
#' NULL.
#' @param color A string from names(x), defining which column is plotted as color. If NULL color is not used.
#' @param slider A string from names(x), defining which column is plotted as a slider. The slider requires
#' plotly. If NULL no slider is used.
#' @param facets A string from names(x), defining which column is used for grouping. A small plot (facet) is
#' shown for each group. If NULL facets are not used.
#' @param facetScales The 'scales' argument for facets (if used), defaults to 'fixed'. See help(facet_wrap) for more info.
#'
#' @return A list of plotly plots, if returnGgplots is TRUE a list of ggplots instead
#' @author Pascal Führlich
#' @seealso \code{\link{getPlotData}}
#' @importFrom ggplot2 ggplot aes_string geom_line ylab facet_wrap ggtitle
#' scale_color_gradientn theme_bw theme element_blank
#' @importFrom grDevices rainbow
#' @importFrom plotly ggplotly
#' @importFrom utils tail
#' @export
mipIterations <- function(plotData, returnGgplots = FALSE,
xAxis = "year", color = NULL, slider = "iteration", facets = "region",
facetScales = "fixed") {
nonNullArgs <- Filter(Negate(is.null), c(xAxis, color, slider, facets))
if (any(!(nonNullArgs %in% c(names(plotData), "year", "region")))) {
stop(
"The following columns were not found in the given plot data: ",
paste0(nonNullArgs[!(nonNullArgs %in% c(names(plotData), "year", "region"))], collapse = ", ")
)
} else if (anyDuplicated(nonNullArgs) != 0) {
stop("Each column can only be mapped to one aesthetic, but there are duplicate arguments: ",
paste0(nonNullArgs, collapse = ", "))
}
handleSpecialValues <- function(aesthetic, argumentValue) {
findDomainName <- function(domainNames) {
domainName <- domainNames[domainNames %in% names(plotData)][1]
if (is.null(domainName)) {
stop("Could not find ", argumentValue, " domain, please specify arguments to plotIterations explicitly.")
}
if (!identical(domainName, argumentValue)) {
message('Using "', domainName, '" instead of "', argumentValue, '" for ', aesthetic)
}
return(domainName)
}
if (identical(argumentValue, "year")) {
return(findDomainName(c("year", "ttot", "tall", "t_all", "t", "tsu", "opTimeYr", "opTime5", "t0", "t_input_gdx",
"t_interpolate", "t_magiccttot", "t_magicc", "t_extra")))
} else if (identical(argumentValue, "region")) {
return(findDomainName(c("region", "all_regi", "regi", "alt_regions", "ext_regi", "RCP_regions_world_bunkers",
"RCP_regions_world")))
} else {
return(argumentValue)
}
}
xAxis <- handleSpecialValues("xAxis", xAxis)
color <- handleSpecialValues("color", color)
slider <- handleSpecialValues("slider", slider)
facets <- handleSpecialValues("facets", facets)
# int is plotted more appropriately than factor when plotting e.g. years
plotData[xAxis] <- as.integer(as.character(plotData[[xAxis]]))
valueColumnName <- tail(names(plotData), 1)
if (!is.double(plotData[[valueColumnName]])) {
warning("Expected the type of the last column (", valueColumnName, ") to be double, but it is ",
typeof(plotData[[valueColumnName]]))
}
aestheticsArgs <- list(x = xAxis, y = valueColumnName)
if (!is.null(color)) {
aestheticsArgs <- c(aestheticsArgs, list(color = color))
}
if (!is.null(slider)) {
aestheticsArgs <- c(aestheticsArgs, list(frame = slider))
if (returnGgplots) {
message("Make sure to run lapply(ggplots, plotly::ggplotly) to show the slider.")
}
}
# all combinations of values of columns not plotted (not mapped to x/y/color etc.)
plottedColumns <- c(xAxis, color, slider, facets, valueColumnName)
if (length(plottedColumns) == ncol(plotData)) {
unplottedCombinations <- list(list())
} else {
unplottedCombinations <- unique(plotData[!(names(plotData) %in% plottedColumns)])
unplottedCombinations <- lapply(split(unplottedCombinations, seq_len(nrow(unplottedCombinations))), as.list)
}
# create a plot for each combination of unplotted values (not mapped to an aesthetic)
plots <- lapply(unplottedCombinations, function(unplottedCombination) {
# keep only rows corresponding to unplottedCombination
x <- Reduce(function(filteredData, index) {
return(filteredData[filteredData[[names(unplottedCombination)[[index]]]] == unplottedCombination[[index]], ])
}, seq_along(unplottedCombination), plotData)
heading <- tail(names(plotData), 1)
if (length(unplottedCombination) > 0) {
heading <- paste(heading, substring(paste0(list(lapply(unplottedCombination, as.character))), 5))
}
plot <- ggplot(x, do.call(aes_string, aestheticsArgs)) +
geom_line() +
ggtitle(heading) +
theme_bw() +
theme(strip.background = element_blank())
if (!is.null(facets)) {
# by default create a small plot for each region; always show all facets, even if empty
plot <- plot + facet_wrap(facets, drop = FALSE, scales = facetScales)
}
if (!is.null(color) && is.numeric(plotData[[color]])) {
plot <- plot + scale_color_gradientn(colours = rainbow(5, v = 0.8))
}
return(plot)
})
names(plots) <- lapply(plots, function(plot) plot$label$title)
if (!returnGgplots) {
# return plotly plots instead of ggplots
plots <- lapply(plots, ggplotly)
}
return(plots)
}