A list of palettes for use in data visualization
Examples
if (FALSE) {
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(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)
}
}