R/ClimPalette.R

In esviz: Plotting Functions for Climate Science and Services

#' Generate Climate Color Palettes
#' 
#' Generates a colorblind friendly color palette with color ranges useful in 
#' climate temperature variable plotting.
#' 
#' @param palette A character string of palette. The current choices:
#'   \itemize{
#'     \item{'bluered': from blue through white to red.} 
#'     \item{'redblue': from red through white to blue.}
#'     \item{'yellowred': from yellow through orange to red.}
#'     \item{'redyellow': from red through orange to yellow.}
#'     \item{'purpleorange': from purple through white to orange.}
#'     \item{'orangepurple': from orange through white to purple.}
#'   }
#' @param n A number indicating how many colors to generate.
#' 
#' @return
#' ClimPalette() returns the function that generates the color palette and the 
#' attribute 'na_color'.\cr
#' ClimColors() returns a vector of the colors.
#' 
#' @examples
#' lims <- seq(-1, 1, length.out = 21)
#' cb <- ColorBarContinuous(lims, color_fun = ClimPalette('redyellow'), plot = FALSE)
#' 
#' cols <- ClimColors(20)
#' cb <- ColorBarContinuous(lims, cols, plot = FALSE)
#' 
#' @importFrom grDevices colorRampPalette
#' @export
ClimPalette <- function(palette = "bluered") {
  if (palette == "bluered") {
    colorbar <- colorRampPalette(rev(c("#67001f", "#b2182b", "#d6604d",
                                       "#f4a582", "#fddbc7", "#f7f7f7", 
                                       "#d1e5f0", "#92c5de", "#4393c3", 
                                       "#2166ac", "#053061")))
    attr(colorbar, 'na_color') <- 'pink'
  } else if (palette == "redblue") {
    colorbar <- colorRampPalette(c("#67001f", "#b2182b", "#d6604d",
                                   "#f4a582", "#fddbc7", "#f7f7f7", 
                                   "#d1e5f0", "#92c5de", "#4393c3", 
                                   "#2166ac", "#053061"))
    attr(colorbar, 'na_color') <- 'pink'
  } else if (palette == "yellowred") {
    colorbar <- colorRampPalette(c("#ffffcc", "#ffeda0", "#fed976",
                                   "#feb24c", "#fd8d3c", "#fc4e2a",
                                   "#e31a1c", "#bd0026", "#800026"))
    attr(colorbar, 'na_color') <- 'pink'
  } else if (palette == "redyellow") {
    colorbar <- colorRampPalette(rev(c("#ffffcc", "#ffeda0", "#fed976",
                                       "#feb24c", "#fd8d3c", "#fc4e2a",
                                       "#e31a1c", "#bd0026", "#800026")))
    attr(colorbar, 'na_color') <- 'pink'
  } else if (palette == "purpleorange") {
    colorbar <- colorRampPalette(c("#2d004b", "#542789", "#8073ac",
				   "#b2abd2", "#d8daeb", "#f7f7f7",
				   "#fee0b6", "#fdb863", "#e08214", 
				   "#b35806", "#7f3b08"))
    attr(colorbar, 'na_color') <- 'pink'
  } else if (palette == "orangepurple") {
    colorbar <- colorRampPalette(rev(c("#2d004b", "#542789", "#8073ac",
				       "#b2abd2", "#d8daeb", "#f7f7f7",
				       "#fee0b6", "#fdb863", "#e08214",
				       "#b35806", "#7f3b08")))
    attr(colorbar, 'na_color') <- 'pink'
  } else {
    stop("Parameter 'palette' must be one of 'bluered', 'redblue', 'yellowred'",
	 "'redyellow', 'purpleorange' or 'orangepurple'.")
  }
  colorbar
}

#'@rdname ClimPalette
#'@export
ClimColors <- function(n, palette = "bluered") {
  ClimPalette(palette)(n)
}