R/pal-ebvm.R

In ebvm24/elisalib: Personal Packages, including color palattes and ggplot2 themes

#' Scale functions for using ebvmThemes in ggplot2
#'
#' @note
#' Functions adapted from ggplot2 scale_fill_distiller and scale_fill_brewer
#'
#' @details
#' Continuous scale
#' Discrete
#'#'
#' @inheritParams scales::gradient_n_pal
#' @param ... Other arguments passed on to [discrete_scale()] or, for
#'   `distiller` scales, [continuous_scale()] to control name,
#'   limits, breaks, labels and so forth.
#' @family colour scales
#' @rdname scale_ebvm
#' @export
scale_fill_ebvmCont <- function(..., type = 'seq',
                           palette = 1, direction = -1,
                           values = NULL, space = "Lab",
                           na.value = 'grey66', guide = "colourbar"){
  require(ggplot2)
  require(scales)
  type <- match.arg(type, c("seq", "div", "qual"))
  if (type == "qual") {
    warning("Using a discrete colour palette in a continuous scale.\n  Consider using type = \"seq\" or type = \"div\" instead", call. = FALSE)
  }
  continuous_scale("fill", "eeb",
                   gradient_n_pal(ebvm_pal(type, palette, direction)(6), values, space),
                   na.value = na.value, guide = guide, ...)
}

#' @rdname scale_ebvm
#' @export
scale_color_ebvmCont <- function(..., type = 'seq',
                            palette = 1, direction = -1,
                            values = NULL, space = "Lab",
                            na.value = 'grey66', guide = "colourbar"){
  require(ggplot2)
  require(scales)
  type <- match.arg(type, c("seq", "div", "qual"))
  if (type == "qual") {
    warning("Using a discrete colour palette in a continuous scale.\n  Consider using type = \"seq\" or type = \"div\" instead", call. = FALSE)
  }
  continuous_scale("color", "eeb",
                   gradient_n_pal(ebvm_pal(type, palette, direction)(6), values, space),
                   na.value = na.value, guide = guide, ...)
}

#' @rdname scale_ebvm
#' @export
scale_fill_ebvmDisc <- function(...,type = 'div', palette = 1, direction = 1){
  require(ggplot2)
  require(scales)
  discrete_scale("fill", "ebvm", ebvm_pal(type,palette,direction), ...)
}

#' @rdname scale_ebvm
#' @export
scale_color_ebvmDisc <- function(...,type = 'div', palette = 1, direction = 1){
  require(ggplot2)
  require(scales)
  discrete_scale("color", "ebvm", ebvm_pal(type,palette,direction), ...)
}

ebvm_pal <- function(type = "div", palette = 1, direction = 1) {
  pal <- pal_name(palette, type)

  function(n) {
    # If <3 colors are requested, ebvm.pal will return a 3-color palette and
    # give a warning. This warning isn't useful, so suppress it.
    # If the palette has k colors and >k colors are requested, brewer.pal will
    # return a k-color palette and give a warning. This warning is useful, so
    # don't suppress it.
    if (n < 3) {
      pal <- suppressWarnings(ebvm.pal(n, pal))
    } else {
      pal <- ebvm.pal(n, pal)
    }
    # In both cases ensure we have n items
    pal <- pal[seq_len(n)]

    if (direction == -1)
      pal <- rev(pal)

    pal
  }
}

pal_name <- function(palette, type) {
  if (is.character(palette)) {
    if (!palette %in% unlist(ebvm)) {
      warning("Unknown palette ", palette)
      palette <- "Ordem"
    }
    return(palette)
  }

  type <- match.arg(type, c("div", "qual", "seq"))
  ebvm[[type]][palette]
}

ebvm <- list(
  div = c("Ordem")
)