R/colors.R

In aelhabr/temisc: Tony's Personal Package

#' Manipulate colors
#'
#' @description Convert a color name to a hex value.
#' @details None.
#' @param color character. Name of color.
#' @param named logical. Whether to retun a named value.
#' @return character. Hex value.
#' @rdname get_color_hex
#' @export
get_color_hex <- function(color, named = FALSE) {
  out <- grDevices::rgb(t(grDevices::col2rgb(color)), max = 255)
  if(named) {
    names(out) <- color
  }
  out
}

#' Manipulate colors
#'
#' @description Convert a color name to its inverse hex value.
#' @details None.
#' @inheritParams get_color_hex
#' @param both logical. Whehter to return the input color as well.
#' @return character(s). Hex value(s). Possibly named.
#' @rdname get_color_hex
#' @export
get_color_hex_inverse <- function(color, named = FALSE, both = FALSE) {
  out_2 <- grDevices::rgb(t(255 - grDevices::col2rgb(color)), max = 255)
  out <- out_2
  if(both) {
    out_1 <- get_color_hex(color)
    out <- c(out_1, out_2)
  }
  if(named) {
    require_ns("plotrix")
    out_2_name <- plotrix::color.id(out_2)[1]
    if(both) {
      names(out) <- c(color, out_2_name)
    } else {
      names(out) <- out_2_name
    }
  }
  out
}

#' Manipulate colors
#'
#' @description Get the palette of colors associated with a string.
#' @details None.
#' @inheritParams get_color_hex
#' @param color character (vector). Name of color.
#' @param sort logical. Default is provided. Whether or not to use \code{sort()}.
#' Important when more than color is provided. If \code{sort = FALSE}, then
#' the colors are returned in an alternating pattern.
#' @return character (vector).
#' @export
#' @examples
#' color_main <- "firebrick"
#' pal_main <- get_rpal_colors(color_main)
#' colors_main <- c("firebrick", "steelblue")
#' pal_main <- get_rpal_colors(colors_main)
get_rpal_colors <- function(color, sort = TRUE) {
  out <- paste0(color, rep(c("", as.character(seq(1, 4, 1))), length(color)))
  if(sort) out <- sort(out)
  out
}

#' Manipulate colors (from a theme)
#'
#' @description Get the palette of colors associated with a theme.
#' @details None.
#' @param theme character (vector). Name of theme.
#' @param sort logical. Default is provided. Not actuall implemented (yet).
#' @return character (vector).
#' @rdname get_editheme_colors
#' @export
# #' @importFrom editheme get_pal
get_editheme_colors <- function(theme, sort = NA) {
  require_ns("styles")
  require_ns("editheme")
  out <- unlist(lapply(theme, editheme::get_pal))
  # out <- purrr::flatten_chr(purrr::map(theme, ~editheme::get_pal(.)))
  out
}