R/chrestos_colors.R

In seb09/cccolr: Implementation of Chrestos colors

#' Hex codes of Chrestos colors
#' 
#' Hex color codes of Chrestos colors in different shades
#' 
#' @param ... Names of the colors. Possible values are \code{grey}, \code{turq}, \code{green},
#' \code{purple}, \code{orange} and \code{yellow}. If not specified, all colors are returned.
#' @param shade Numeric vector in [0,1] that defines the brightness of the color(s). Values higher
#' then 0.5 lead to brighter colors than the original shade, values lower than 0.5 lead to darker colors.
#' @param names Should the colors be returned as a named vector (default = TRUE) 
#' 
#' @return A named vector of hex codes.
#' 
#' @examples
#' chrestos_colors()
#' chrestos_colors("turq", "purple", shade = c(0.1, 0.9))
#' chrestos_colors("turq", shade = c(0.1, 0.5, 0.9))
#' chrestos_colors("turq", "green", "purple", shade = 0.3)
#' 
#' @export
#' 

chrestos_colors <- function(..., shade = 0.5, names = TRUE){
  
  base_colors <- c(
    "grey" = "#3F3E3E",
    "turq" = "#0AB6BB",
    "green" = "#A2C14B",
    "purple" = "#823980",
    "orange" = "#D3711C",
    "yellow" = "#F5D419"
  )
  
  if (is.null(c(...))){
    cols <- base_colors
  } else {
    cols <- base_colors[c(...)]
  }
  
  if (length(cols) == 1) cols <- rep(cols, length(shade))
  if (length(shade) == 1) shade <- rep(shade, length(cols))
  if (length(shade) != length(cols)) stop("Length of \'shade\' does not fit number of colors.")
  
  res <- mapply(function(x, y) grDevices::rgb(grDevices::colorRamp(c("#000000", x, "#FFFFFF"))(y), maxColorValue = 255),
                x = cols, y = shade)
  
  if (any(shade != 0.5)){
    names_post <- gsub("50","",as.character(round(100*shade)))
    names(res) <- paste0(names(res),names_post)
  }
  
  if (!names) names(res) <- NULL
  
  return(res)
}