🐟🎨📈USFWS colours from https://www.instagram.com/p/CFP2H7JBSxR/

usfws_palette.R

#' USFWS palette generator
#'
#' Palettes taken from https://www.instagram.com/p/CFP2H7JBSxR/
#'
#' @param n Number of colours desired (max 5!). If omitted, uses all colours.
#' @param name one of "sockeye", "coaster", "dolly" or "florida"
#' @param type Either "continuous" or "discrete". Use continuous if you want
#'   to automatically interpolate between colours.
#' @return A vector of colours.
#' @export
#' @keywords colours
#' @examples
#' usfws_palette(5, "coaster")
#'
#' # If you need more colours than normally found in a palette, you
#' # can use a continuous palette to interpolate between existing
#' # colours
#' pal <- usfws_palette(21, "coaster", type = "continuous")
#' image(volcano, col = pal)
usfws_palette <- function(n, name, type = c("discrete", "continuous")) {
  type <- match.arg(type)

  usfws_cols <- list(sockeye = c("#537B9E", "#C5C6CB", "#988421",
                                 "#82816C", "#282D33"),
                     coaster = c("#977559", "#5E6265", "#697897",
                                 "#CAB886", "#DE655D"),
                     dolly   = c("#97C0B0", "#899B71", "#979048",
                                 "#71767A", "#D07F6E"),
                     florida = c("#050400", "#675B45", "#3E3526",
                                 "#988769", "#D2C398"))
  pal <- usfws_cols[[name]]
  if (is.null(pal))
    stop("Palette not found.")

  if (missing(n)) {
    n <- length(pal)
  }

  if (type == "discrete" && n > length(pal)) {
    stop("Number of requested colours greater than what palette can offer")
  }

  out <- switch(type,
    continuous = colorRampPalette(pal)(n),
    discrete = pal[1:n]
  )
  structure(out, class = "palette", name = name)
}

#' @export
print.palette <- function(x, ...) {
  n <- length(x)
  old <- par(mar = c(0.5, 0.5, 0.5, 0.5))
  on.exit(par(old))

  image(1:n, 1, as.matrix(1:n), col = x,
    ylab = "", xaxt = "n", yaxt = "n", bty = "n")

  rect(0, 0.9, n + 1, 1.1, col = rgb(1, 1, 1, 0.8), border = NA)
  text((n + 1) / 2, 1, labels = attr(x, "name"), cex = 1, family = "serif")
}

par(mfrow=c(2,2))
lapply(c("sockeye", "coaster", "dolly", "florida"), usfws_palette, n=5)