plot_ecorisk.R

    "lightgrey",
    # montane Tundra/Grassland
    "pink3"
  )

  if (order_legend == "plants") {
    order_legend <- seq_len(19)
  } else if (order_legend == "zones") {
    order_legend <- c(
      1, 2, 9, 10, 11, 3, 4, 5, 6, 12, 13, 14, 7, 8, 15, 16, 17, 18, 19
    )
  } else {
    stop(
      "Unknown value for parameter order_legend (plants or zones) - ",
      "was given as: ", order_legend
    )
  }
  biome_class_cols <- (
    colz[c(1, 2, 7, 8, 9, 10, 13, 12, 3, 4, 5, 14, 15, 16, 19, 11, 6, 17, 18)]
  )
  biome_class_names <- get_biome_names(biome_name_length)

  if (!(length(biome_class_names) == length(biome_class_cols))) {
    stop("Size of biome class names and colors do not match -- should be 18.")
  }

  # plotting
  brks <- seq(
    min(biome_ids, na.rm = TRUE) - 0.5,
    max(biome_ids, na.rm = TRUE) + 0.5,
    1
  )
  ra <- terra::rast(ncols = 720, nrows = 360)
  range <- range(biome_ids)
  ra[terra::cellFromXY(ra, cbind(lon, lat))] <- biome_ids
  extent <- terra::ext(c(-180, 180, -60, 90))
  withr::with_par(new = list(
    mar = c(0, 0, 0, 0), oma = c(0, 0, 0, 0), bty = "n"
  ), {
    terra::plot(ra,
      ext = extent, breaks = brks, col = biome_class_cols,
      main = "", legend = FALSE, axes = FALSE
    )
    graphics::title(main = title, line = -2, cex.main = title_size)
    if (leg_yes) {
      graphics::legend(
        x = -180, y = 27, legend = biome_class_names[order_legend],
        fill = biome_class_cols[order_legend],
        col = biome_class_cols[order_legend],
        cex = leg_scale, bg = "white", bty = "o"
      )
    }
    maps::map("world", add = TRUE, res = 0.4, lwd = 0.25, ylim = c(-60, 90))
    if (!is.null(file)) grDevices::dev.off()
  })
}


#' Plot radial EcoRisk with 4/16 biomes
#'
#' Function to plot to file (or screen) an aggregated radial status of EcoRisk
#' values [0-1] for the different sub-categories to file
#'
#' @param data EcoRisk data array c(4[biomes],[nEcoRiskcomponents],
#'             3[min,median,max])
#' @param file to write into (if not supplied - default NULL - prints to screen)
#' @param biome_class_names to write into
#' @param title character string title for plot, default empty
#' @param title_size character string title for plot
#' @param leg_scale character string title for plot
#' @param eps write as eps, replacing png in filename (default: True)
#' @param palette color palette to plot EcoRisk with, defaults to the Ostberg
#'        color scheme white-blue-yellow-red
#'
#' @examples
#' \dontrun{
#' plot_biome_internal_distribution(
#'   data = biomes,
#'   file = "./biomes.png"
#' )
#' }
#'
#' @md
#' @export
plot_biome_averages <- function(data,
                                file = NULL,
                                biome_class_names,
                                title = "",
                                title_size = 2,
                                leg_scale = 1,
                                eps = FALSE,
                                palette = NULL) {
  if (!is.null(file)) {
    path_write <- dirname(file)
    dir.create(file.path(path_write), showWarnings = FALSE, recursive = TRUE)

    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 = 4, height = 3, units = "in", res = 300,
        pointsize = 6, type = "cairo"
      )
    }
  }
  # setting up colors and biome names
  brks <- seq(0, 1, 0.1)
  data[data < brks[1]] <- brks[1]
  data[data > brks[length(brks)]] <- brks[length(brks)]

  if (is.null(palette)) {
    palette <- c("white", RColorBrewer::brewer.pal(9, "YlOrRd"))
  }
  col_index <- floor(data[, 2] * 10) + 1

  if (!(length(biome_class_names) == dim(data)[1])) {
    stop("Size of biome class names and data input do not match.")
  }

  # plotting
  graphics::plot(NA,
    xlim = c(0, 1), ylim = c(0, 1), main = title, axes = FALSE,
    cex.main = title_size, xlab = "", ylab = ""
  )
  graphics::legend(
    x = 0, y = 1, legend = biome_class_names,
    fill = palette[col_index], col = palette[col_index],
    border = palette[col_index], cex = leg_scale,
    bg = "white", bty = "o"
  )
  if (!is.null(file)) grDevices::dev.off()
}

#' Plot crosstable showing (dis-)similarity between average biome pixels
#'
#' Function to plot to file (or screen) a crosstable showing (dis-)similarity
#' between average biome pixels based on EcoRisk (former Gamma) metric from
#' LPJmL simulations
#'
#' @param data crosstable data as array with [nbiomes,nbiomes] and row/colnames
#' @param file to write into (if not supplied - default NULL - prints to screen)
#' @param lmar left margin for plot in lines (default: 3)
#' @param eps write as eps or png
#' @param palette color palette to plot EcoRisk with, defaults to the Ostberg
#'        color scheme white-blue-yellow-red
#'
#' @examples
#' \dontrun{
#' plot_ecorisk_cross_table(
#'   data = crosstable,
#'   file = "./ecorisk_crosstable.png"
#' )
#' }
#'
#' @md
#' @export
plot_ecorisk_cross_table <- function(data,
                                     file = NULL,
                                     lmar = 3,
                                     eps = FALSE,
                                     palette = NULL) {
  if (!is.null(file)) {
    path_write <- dirname(file)
    dir.create(file.path(path_write), showWarnings = FALSE, recursive = TRUE)

    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 = 6, height = 3, units = "in", res = 300,
        pointsize = 6, type = "cairo"
      )
    }
  }
  # data prep
  data <- round(data, digits = 2)
  x <- seq_len(ncol(data))
  y <- seq_len(nrow(data))
  centers <- expand.grid(y, x)
  # coloring
  if (is.null(palette)) {
    palette <- c("white", RColorBrewer::brewer.pal(9, "YlOrRd"))
  }
  brks <- seq(0, 1, 0.1)

  # plot margins
  withr::with_par(
    new = list(mar = c(0, lmar, 2, 0)), # bltr

    {
      graphics::image(x, y, t(data),
        col = palette,
        breaks = brks,
        xaxt = "n",
        yaxt = "n",
        xlab = "",
        ylab = "",
        ylim = c(max(y) + 0.5, min(y) - 0.5)
      )
      graphics::text(centers[, 2], centers[, 1], c(data), col = "black")

      # add margin text
      graphics::mtext(attributes(data)$dimnames[[2]],
        at = seq_len(ncol(data)),
        padj = -1
      )
      graphics::mtext(attributes(data)$dimnames[[1]],
        at = seq_len(nrow(data)),
        side = 2,
        las = 1,
        adj = 1,
        line = 1
      )

      # add black lines
      graphics::abline(h = y + 0.5)
      graphics::abline(v = x + 0.5)

      if (!is.null(file)) grDevices::dev.off()
    }
  )
}