#' Plot global LPJmL array
#'
#' Plot global LPJmL array to file (if file argument is given) or screen (else).
#' type argument controls plot type: (exponential, linear, or manual legend).
#' Depending on this more parameters are required.
#' Data plot ranges:
#' exp: c(-2^pow2max,-2^-pow2min,0,2^-pow2min,2^pow2max)
#' lin: c(min,max)
#' man: brks
#' colors for pos and neg values can be given, default is Blues for the
#' positive and Reds for the negative numbers 0-range (from 2^-pow2min to
#' 2^pow2min) is white.
#' The negatives can be omitted by setting only_pos=TRUE, in case there are
#' only pos values.
#'
#' @param data array with data to plot in LPJmL specific array c(67420)
#' @param file character string for location/file to save plot to, if not
#' supplied, the plot is displayed to screen (default: NULL)
#' @param title character string title for plot
#' @param pow2max for exponential legend: upper (positive) end of data range to
#' plot (2^pow2max)
#' @param pow2min for exponential legend: smallest positive number to be
#' distinguished from 0 (2^-pow2min)
#' @param max for linear legend: upper end of data range to plot (0 is placed
#' symmetrically between min and max, if onlypos = FALSE)
#' @param min for linear legend: lower end of data range to plot (0 is placed
#' symmetrically between min and max, if onlypos = FALSE)
#' @param col_pos color palette for the positives
#' @param col_neg color palette for the negatives
#' @param brks breaks for manual plotting type (type=man) default: NULL
#' @param palette palette for manual plotting type (type=man) default: NULL
#' @param type string indicating whether to plot manual (man),
#' exponential (exp) or linear (lin) legend (default: exp).
#' man requires: parameters brks and palette defined,
#' exp requires: parameters pow2min and pow2max given defined,
#' lin requires: parameters min and max defined
#' @param legendtitle character string legend title
#' @param leg_yes boolean whether to show legend (default: TRUE)
#' @param n_legend_ticks (default: 20)
#' @param min_0 (default: 0.01)
#' @param only_pos boolean to show only positive half of legend (default: FALSE)
#' @param eps boolean whether to write eps file instead of PNG (default: FALSE)
#'
#' @examples
#' \dontrun{
#' plot_global(
#' data = biocol_data$biocol[, "2015"],
#' file = "BioCol_absolute.png",
#' type = "exp",
#' pow2min = 0,
#' pow2max = 12,
#' legendtitle = "GtC",
#' leg_yes = TRUE,
#' only_pos = FALSE,
#' eps = FALSE
#' )
#' }
#'
#' @md
#' @export
plot_global <- function(data,
file = NULL,
title = "",
pow2min = NULL,
pow2max = NULL,
min = NULL,
max = NULL,
brks = NULL,
palette = NULL,
col_pos = "GnBu",
type = "exp",
col_neg = "YlOrRd",
legendtitle = "",
leg_yes = TRUE,
only_pos = FALSE,
n_legend_ticks = 20,
min_0 = 0.01,
extent = NULL,
country_borders = TRUE,
eps = FALSE,
cex = 1) {
if (!is.null(file)) {
if (eps) {
file <- strsplit(file, ".", fixed = TRUE)[[1]]
file <- paste(c(file[seq_len(length(file) - 1)], "eps"), collapse = ".")
grDevices::ps.options(family = c("Helvetica"), pointsize = 18)
grDevices::postscript(file,
horizontal = FALSE, onefile = FALSE, width = 22,
height = 8.5, paper = "special"
)
} else {
grDevices::png(file,
width = 7.25, height = 3.5, units = "in", res = 300,
pointsize = 6, type = "cairo"
)
}
}
if (!is.null(min)) {
if (min == 0) only_pos <- TRUE
}
if (only_pos) {
if (type == "exp") {
if (is.null(pow2max) | is.null(pow2min)) {
stop("For exponental legend, pow2min and pow2max need to be specified.")
}
# actual brks and ticks
legendticks <- c(0, 2^seq(pow2min, pow2max, 1))
# just for displaying an equally sized legend
brks <- c(seq(pow2min, pow2max, length.out = length(legendticks)))
} else if (type == "lin") {
if (is.null(max) | is.null(min)) {
stop("For linear legend, min and max need to be specified.")
}
legendticks <- seq(min, max, length.out = n_legend_ticks)
brks <- legendticks
}
palette <- c(
"white",
grDevices::colorRampPalette(
RColorBrewer::brewer.pal(9, col_pos)
)(length(legendticks) - 2)
)
} else {
if (type == "exp" || type == "lin") {
if (type == "exp") {
if (is.null(pow2max) | is.null(pow2min)) {
stop("For exponental legend, pow2min and pow2max are required.")
}
legendticks <- c(
-(2^seq(pow2max, pow2min, -1)), 2^seq(pow2min, pow2max, 1)
)
brks <- seq(-pow2max, pow2max, length.out = length(legendticks))
} else if (type == "lin") {
if (is.null(max) | is.null(min)) {
stop("For linear legend, min and max need to be specified.")
}
if (n_legend_ticks %% 2 == 0) {
n_legend_ticks <- n_legend_ticks + 1
}
legendticks <- c(
seq(min, 0, length.out = n_legend_ticks),
seq(0, max, length.out = n_legend_ticks)
)
legendticks[c(n_legend_ticks, (n_legend_ticks + 1))] <- c(-min_0, min_0)
brks <- legendticks
}
palette <- c(
rev(
grDevices::colorRampPalette(
RColorBrewer::brewer.pal(9, col_neg)
)(length(legendticks) / 2 - 1)
),
"white",
grDevices::colorRampPalette(
RColorBrewer::brewer.pal(9, col_pos)
)(length(legendticks) / 2 - 1)
)
} else { # type == man
if (is.null(palette)) {
message("Manual breaks, but not palette given, using default.")
palette <- grDevices::colorRampPalette(
RColorBrewer::brewer.pal(9, col_pos)
)(length(brks) - 1)
}
if (only_pos) stop("Manual breaks and palette, but conflicting parameter
only_pos == TRUE defined. Aborting.")
legendticks <- brks
}
}
data[data < legendticks[1]] <- legendticks[1]
data[data > legendticks[length(legendticks)]] <- (
legendticks[length(legendticks)]
)
ra <- terra::rast(ncols = 720, nrows = 360)
range <- range(data)
ra[terra::cellFromXY(ra, cbind(lon, lat))] <- c(data)
if (is.null(extent)) extent <- terra::ext(c(-180, 180, -60, 90))
if (leg_yes) {
oma_p <- c(0, 0, 0, 3)
} else {
oma_p <- c(0, 0, 0, 0)
}
#withr::with_par(new = list(
# bty = "n", oma = oma_p, mar = c(0, 0, 0, 0), xpd = TRUE
#), {
if (leg_yes){
terra::plot(ra,
ext = extent, breaks = legendticks, col = palette, main = title,
legend = TRUE, axes = FALSE, type = "continuous", cex.main = cex,
plg = list(cex = cex)
)
} else{
terra::plot(ra,
ext = extent, breaks = legendticks, col = palette, main = title,
legend = FALSE, axes = FALSE, type = "continuous", cex.main = cex,
plg = list(cex = cex)
)
}
if (country_borders) maps::map("world", add = TRUE, res = 0, lwd = 0.1, ylim = c(-60, 90))
#title(title, cex = cex) #line = -1)
if (F) {
if (type == "exp") {
fields::image.plot(
legend.only = TRUE, zlim = c(-pow2max, pow2max), col = palette,
useRaster = FALSE, breaks = brks, lab.breaks = round(legendticks, 2),
legend.shrink = 0.7,
legend.args = list(legendtitle, side = 3, font = 2, line = 1),
smallplot = c(0.975, 0.99, 0.1, 0.9)
)
} else { # manual plotting
fields::image.plot(
legend.only = TRUE, zlim = range(brks), col = palette,
useRaster = FALSE, breaks = brks, lab.breaks = round(legendticks, 2),
legend.shrink = 0.7,
legend.args = list(legendtitle, side = 3, font = 2, line = 1)
)
}
}
if (!is.null(file)) {
grDevices::dev.off()
}
#})
}