cherulean: custom wrassey palettes

cherulean.R

# Cherulean
# Custom palette functions for ggplot, bc hot plots
# Author: Cher Chow

# what do the palettes look like? https://iili.io/HE0wyb9.png

require(ggplot2)

## cherulean palettes set up
cherulean_palettes <- list(
  
  'gomphosus' = c("#061b3b","#0f2d59","#1c5dac","#3a89e3","#3eb7c7","#60dcac","#97eebd"),
  
  'quoyi' = c("#08272d","#114c54","#3874a1","#7370db","#a77dde","#d989e5","#ffbbf6"),
  
  'fairy' = c("#2a0611","#5a0c30","#8a1264","#973fc9","#8a93f5","#91ccff","#bfe6ff"),
  
  'globiceps' = c("#183400","#155c1c","#12876a","#0f9ca8","#5dbaf8","#9fc6fc","#ebd2ff"),
  
  'spinus' = c("#033d52","#0D6650","#1A874F","#729737","#A4AD27","#D2B834","#FFBD67","#ffcfd1"),
  
  'cheridis' = c("#333872","#44479C","#455EBA","#2183A7","#379FAA","#49BA67","#98C243","#DBC539"))



# manual function
# the core interpolation function or palette fetcher that returns a palette function
# cherulean_cols fetches the desired custom palette and feeds them to the intPalette function
# reverses if need be

intPalette <- function (colors, alpha = 1, ...) {
  ramp <- colorRamp(colors, ...)
  function(n) {
    if (n > length(colors)) {
      x <- ramp(seq.int(0, 1, length.out = n))
      x <- rgb(x[, 1L], x[, 2L], x[, 3L], maxColorValue = 255)
      adjustcolor(x, alpha.f = alpha)
    }
    else x <- colors[round(seq(1, length(colors), length.out = n), 0)]
    adjustcolor(x, alpha.f = alpha)
  }
} # intPalette(n) returns a list of colours with the desired length

cherulean_cols <- function(palette = "globiceps", alpha = 1, reverse = FALSE, ...) {
  pal <- cherulean_palettes[[palette]]
  if (reverse) pal <- rev(pal)
  intPalette(pal, alpha, ...)
}

# list a palette of colors: e.g. cherulean(n = 7, palette = "globiceps", alpha = 0.5)
cherulean <- function(n, alpha, palette = "globiceps", reverse = F, ...) {
  if (is.na(n)) {print('You need to supply a length for this palette function')}
  else cherulean_cols(palette, reverse, alpha)(n)
}

# Scale construction for ggplot use
# *USAGE NOTE: the defaults to both color and fill scales are the realm palette and for discrete data.
# Remember to change these arguments when plotting colors continuously. 

scale_color_cherulean <- function(palette = "globiceps", discrete = TRUE, reverse = FALSE, alpha = 1, ...) {
  pal <- cherulean_cols(palette = palette, reverse = reverse, alpha = alpha)
  if (discrete) {
    ggplot2::discrete_scale("colour", paste("cherulean_", palette, sep=''), palette = pal, ...)
  } else {
    ggplot2::scale_color_gradientn(colours = pal(256), ...)
  }
}

# UK English friendly :)
scale_colour_cherulean <- function(palette = "globiceps", discrete = TRUE, reverse = FALSE, alpha = 1, ...) {
  pal <- cherulean_cols(palette = palette, reverse = reverse, alpha = alpha)
  if (discrete) {
    ggplot2::discrete_scale("colour", paste("cherulean_", palette, sep=''), palette = pal, ...)
  } else {
    ggplot2::scale_color_gradientn(colours = pal(256), ...)
  }
}

scale_fill_cherulean <- function(palette = "globiceps", discrete = TRUE, alpha = 1, reverse = FALSE, ...) {
  pal <- cherulean_cols(palette = palette, reverse = reverse, alpha = alpha)
  if (discrete) {
    ggplot2::discrete_scale("fill", paste("cherulean_", palette, sep=''), palette = pal, ...)
  } else {
    ggplot2::scale_fill_gradientn(colours = pal(256), ...)
  }
}