A list of palettes for use in data visualization

A list of palettes for use in data visualization

Examples

if (FALSE) { # \dontrun{
if (interactive()) {
  check_r(
    c(
      "stringr", "RColorBrewer", "ggsci", "Redmonder",
      "rcartocolor", "nord", "viridis", "pals", "oompaBase",
      "dichromat", "jaredhuling/jcolors"
    )
  )
  library(stringr)
  library(RColorBrewer)
  library(ggsci)
  library(Redmonder)
  library(rcartocolor)
  library(nord)
  library(viridis)
  library(pals)
  library(dichromat)
  library(jcolors)
  brewer.pal.info <- RColorBrewer::brewer.pal.info
  ggsci_db <- ggsci:::ggsci_db
  redmonder.pal.info <- Redmonder::redmonder.pal.info
  metacartocolors <- rcartocolor::metacartocolors
  rownames(metacartocolors) <- metacartocolors$Name
  nord_palettes <- nord::nord_palettes
  viridis_names <- c(
    "magma", "inferno", "plasma", "viridis",
    "cividis", "rocket", "mako", "turbo"
  )
  viridis_palettes <- lapply(
    stats::setNames(viridis_names, viridis_names),
    function(x) viridis::viridis(100, option = x)
  )
  ocean_names <- names(
    pals:::syspals
  )[grep(
    "ocean",
    names(pals:::syspals)
  )]
  ocean_palettes <- pals:::syspals[ocean_names]
  dichromat_palettes <- dichromat::colorschemes
  jcolors_names <- paste0(
    "jcolors-",
    c(
      "default", "pal2", "pal3", "pal4", "pal5",
      "pal6", "pal7", "pal8", "pal9", "pal10",
      "pal11", "pal12", "rainbow"
    )
  )
  custom_names <- c("jet", "simspec", "GdRd")
  custom_palettes <- list(
    oompaBase::jetColors(N = 100),
    c(
      "#c22b86", "#f769a1", "#fcc5c1", "#253777",
      "#1d92c0", "#9ec9e1", "#015b33", "#42aa5e",
      "#d9f0a2", "#E66F00", "#f18c28", "#FFBB61"
    ),
    c("gold", "red3")
  )
  names(custom_palettes) <- custom_names

  palette_list <- list()
  all_colors <- c(
    rownames(brewer.pal.info),
    names(ggsci_db),
    rownames(redmonder.pal.info),
    rownames(metacartocolors),
    names(nord_palettes),
    names(viridis_palettes),
    ocean_names,
    names(dichromat_palettes),
    jcolors_names,
    custom_names
  )
  for (pal in all_colors) {
    if (!pal %in% all_colors) {
      stop(paste0("Invalid pal Must be one of ", paste0(all_colors, collapse = ",")))
    }
    if (pal %in% rownames(brewer.pal.info)) {
      pal_n <- brewer.pal.info[pal, "maxcolors"]
      pal_category <- brewer.pal.info[pal, "category"]
      if (pal_category == "div") {
        palcolor <- rev(brewer.pal(name = pal, n = pal_n))
      } else {
        if (pal == "Paired") {
          palcolor <- brewer.pal(12, "Paired")[c(1:4, 7, 8, 5, 6, 9, 10, 11, 12)]
        } else {
          palcolor <- brewer.pal(name = pal, n = pal_n)
        }
      }
      if (pal_category == "qual") {
        attr(palcolor, "type") <- "discrete"
      } else {
        attr(palcolor, "type") <- "continuous"
      }
    } else if (pal %in% names(ggsci_db)) {
      if (pal %in% c("d3", "uchicago", "material")) {
        for (subpal in names(ggsci_db[[pal]])) {
          palcolor <- ggsci_db[[pal]][[subpal]]
          if (pal == "material") {
            attr(palcolor, "type") <- "continuous"
          } else {
            attr(palcolor, "type") <- "discrete"
          }
          palette_list[[paste0(pal, "-", subpal)]] <- palcolor
        }
        next
      } else {
        palcolor <- ggsci_db[[pal]][[1]]
        if (pal == "gsea") {
          attr(palcolor, "type") <- "continuous"
        } else {
          attr(palcolor, "type") <- "discrete"
        }
      }
    } else if (pal %in% rownames(redmonder.pal.info)) {
      pal_n <- redmonder.pal.info[pal, "maxcolors"]
      pal_category <- redmonder.pal.info[pal, "category"]
      if (pal_category == "div") {
        palcolor <- rev(redmonder.pal(name = pal, n = pal_n))
      } else {
        palcolor <- redmonder.pal(name = pal, n = pal_n)
      }
      if (pal_category == "qual") {
        attr(palcolor, "type") <- "discrete"
      } else {
        attr(palcolor, "type") <- "continuous"
      }
    } else if (pal %in% rownames(metacartocolors)) {
      pal_n <- metacartocolors[pal, "Max_n"]
      palcolor <- carto_pal(name = pal, n = pal_n)
      if (pal_category == "qualitative") {
        attr(palcolor, "type") <- "discrete"
      } else {
        attr(palcolor, "type") <- "continuous"
      }
    } else if (pal %in% names(nord_palettes)) {
      palcolor <- nord_palettes[[pal]]
      attr(palcolor, "type") <- "discrete"
    } else if (pal %in% names(viridis_palettes)) {
      palcolor <- viridis_palettes[[pal]]
      attr(palcolor, "type") <- "continuous"
    } else if (pal %in% names(ocean_palettes)) {
      palcolor <- ocean_palettes[[pal]]
      attr(palcolor, "type") <- "continuous"
    } else if (pal %in% names(dichromat_palettes)) {
      palcolor <- dichromat_palettes[[pal]]
      if (pal %in% c("Categorical.12", "SteppedSequential.5")) {
        attr(palcolor, "type") <- "discrete"
      } else {
        attr(palcolor, "type") <- "continuous"
      }
    } else if (pal %in% jcolors_names) {
      palcolor <- jcolors(palette = gsub("jcolors-", "", pal))
      if (pal %in% paste0("jcolors-", c("pal10", "pal11", "pal12", "rainbow"))) {
        attr(palcolor, "type") <- "continuous"
      } else {
        attr(palcolor, "type") <- "discrete"
      }
    } else if (pal %in% custom_names) {
      palcolor <- custom_palettes[[pal]]
      if (pal %in% c("jet")) {
        attr(palcolor, "type") <- "continuous"
      } else {
        attr(palcolor, "type") <- "discrete"
      }
    }
    palette_list[[pal]] <- palcolor
  }
  # usethis::use_data(palette_list)
}
} # }