R/legend.scale.R

In jpfrench81/autoimage: Multiple Heat Maps for Projected Coordinates

#' Color scale legend
#' 
#' \code{legend.scale} plots a color gradient with an associated 
#' quantitative scale.
#' 
#' The length of the \code{col} vector indicates the number of 
#' partitions for the quantitative range.
#' 
#' @param zlim A two-dimensional vector containing the minimum and 
#'   maximum quantitative limits, respectively, for the color scale.
#' @param col A vector of colors used for the color scale. Typically, 
#'   this is a gradient of colors. The default is the 12 colors 
#'   generated by \code{colorspace::sequential_hcl(n = 12, palette = "Viridis")}.
#' @param horizontal A logical value indicating whether the legend 
#'   should extend horizontally (\code{TRUE}) or vertically 
#'   (\code{FALSE}). The default is \code{TRUE}.
#' @param breaks The sequence of values defining the partition of 
#'   \code{zlim}.  The length should be one more than then number of 
#'   colors.  If not specified, then equidistant breaks are used.
#' @param axis.args A list of named elements corresponding to the 
#'   arguments of the \code{\link[graphics]{axis}} function.  This is 
#'   used to modify the appearance of the scale of the legend.  See 
#'   Examples.
#' @references The code for this function is derived from the 
#'   internals of the \code{\link[fields]{image.plot}} function 
#'   written by Doug Nychka and from the \code{image.scale} function 
#'   written by Marc Taylor and discussed at 
#'   \url{https://menugget.blogspot.com/2013/12/new-version-of-imagescale-function.html}.
#'   
#' @seealso \code{\link[graphics]{image}}, 
#'   \code{\link[fields]{image.plot}}, \code{\link[graphics]{axis}}
#' @importFrom graphics axis
#' @return NULL
#' @examples
#' # default horizontal scale
#' legend.scale(c(0, 1))
#' 
#' # default vertical scale
#' legend.scale(c(0, 1), horizontal = FALSE)
#' 
#' # different color scheme with 24 colors
#' legend.scale(c(0, 1), col = cm.colors(24))
#' 
#' # irregular color breaks
#' legend.scale(c(0, 1), col = heat.colors(4), 
#'              breaks = c(0, 0.5, 0.75, 0.875, 1))
#' 
#' # irregular color breaks with modified ticks and vertical 
#' # orientation of labels
#' legend.scale(c(0, 1), col = heat.colors(4),
#'              breaks = c(0, 0.5, 0.75, 0.875, 1),
#'              axis.args = list(at = c(0, 0.5, 0.75, 0.875, 1), las = 2))
#' 
#' # change size of axis labels
#' legend.scale(c(0, 1), axis.args = list(cex.axis = 2))
#' 
#' # change color of axis labels and ticks
#' blue.axes <- list(col.axis = "blue", col.ticks = "blue")
#' legend.scale(c(0, 1), axis.args = blue.axes)
#' 
#' # log base 10 values with colors labeled on original scale
#' options(scipen = 2)
#' log.axis <- list(at = 0:6, labels = 10^(0:6), las = 2)
#' legend.scale(c(0, 6), col = heat.colors(6), axis.args = log.axis)
#' @export
legend.scale <- function(zlim,
                         col = colorspace::sequential_hcl(n = 12, palette = "Viridis"),
                         horizontal = TRUE, 
  breaks, axis.args) {
  if (missing(axis.args)) 
    axis.args <- list()
  if (missing(breaks)) 
    breaks <- NULL
  if (is.null(breaks)) {
    breaks <- seq(zlim[1], zlim[2], length.out = (length(col) + 1))
  } else {
    if (length(breaks) != length(col) + 1) 
      stop("the length of breaks must be one more than length of col")
    if (is.null(axis.args$at)) {
      axis.args$at <- breaks
    }
  }
  
  if (is.null(axis.args$side)) 
    axis.args$side <- ifelse(horizontal, 1, 4)
  if (is.null(axis.args$las)) 
    axis.args$las <- ifelse(horizontal, 0, 2)
  
  ncol <- length(col)
  
  # middle of breaks
  z <- matrix((utils::head(breaks, ncol) + utils::tail(breaks, ncol))/2)
  
  if (horizontal) {
    x <- breaks
    y <- 0:1
  } else {
    x <- 0:1
    y <- breaks
    z <- t(z)
  }
  
  graphics::image(x, y, z, xaxt = "n", yaxt = "n", xlab = "", ylab = "", 
    col = col, breaks = breaks)
  graphics::box()
  do.call("axis", axis.args)
}