Reputation: 585
I've a palette of colors (my_pal
) that I need to use very often. To interact with this palette, I've adapted my_color_pal
from here It does work, but sometimes I want to be able to display the names in my palette instead of the hex color codes. Is it possible?
my_pal <- {
x$y <- list()
x$y$seasons <- c(
autumn = rgb(100, 78, 139, max = 255),
spring = rgb(200, 139, 61, max = 255),
summer = rgb(54, 50, 205, max = 255),
winter = rgb(255, 193, 37, max = 255)
)
x
}
my_color_pal <- function(palette = "seasons") {
pal.list <- my_pal$y
if (!palette %in% c(names(pal.list), "seasons", "blah", "bluh")) {
stop(sprintf("%s is not a valid palette name", palette))
}
if (palette == "seasons") {
types <- pal.list[["seasons"]][seq(1, 4, by = 1)]
} else if (palette == "blah") {
types <- pal.list[["blah"]][seq(1, 8, by = 2)]
} else {
types <- pal.list[[palette]]
}
function(n) {
unname(types)[seq_len(n)]
}
}
library(scales)
show_col(my_color_pal("seasons")(4))
Upvotes: 2
Views: 871
Reputation: 114
If you store the season names and the hex codes in your function, then you can retrieve the type you want to show when you build the plot. Here's an example that includes most of the internals of scales::show_col in your my_color_pal function, and then allows you to plot names or hex codes using a string value of "hex" or "names".
my_pal <- {
x <- list()
x$y <- list()
x$y$seasons <- c(
autumn = rgb(100, 78, 139, max = 255),
spring = rgb(200, 139, 61, max = 255),
summer = rgb(54, 50, 205, max = 255),
winter = rgb(255, 193, 37, max = 255)
)
x
}
my_color_pal <- function(palette, names_or_hex) {
pal.list <- my_pal$y
if (!palette %in% c(names(pal.list), "seasons", "blah", "bluh")) {
stop(sprintf("%s is not a valid palette name", palette))
}
if (palette == "seasons") {
types <- pal.list[["seasons"]][seq(1, 4, by = 1)]
} else if (palette == "blah") {
types <- pal.list[["blah"]][seq(1, 8, by = 2)]
} else {
types <- pal.list[[palette]]
}
# get hexs
colours <- unname(types)[seq_len(length(types))]
# get names
names_colours <- names(types)[seq_len(length(types))]
# functions internal to scales::show_col()
n <- length(colours)
ncol <- ceiling(sqrt(n))
nrow <- ceiling(n/ncol)
colours <- c(colours, rep(NA, nrow * ncol - length(colours)))
colours <- matrix(colours, ncol = ncol, byrow = TRUE)
old <- par(pty = "s", mar = c(0, 0, 0, 0))
on.exit(par(old))
size <- max(dim(colours))
plot(c(0, size), c(0, -size), type = "n", xlab = "", ylab = "",
axes = FALSE)
rect(col(colours) - 1, -row(colours) + 1, col(colours), -row(colours),
col = colours)
# add condtional plotting of hex codes or names
if (names_or_hex == "hex") {
text(col(colours) - 0.5, -row(colours) + 0.5, colours)
} else if(names_or_hex == "names"){
text(col(colours) - 0.5, -row(colours) + 0.5, names_colours)
}
}
# plot and display hex codes
my_color_pal(palette = "seasons",
names_or_hex = "hex")
# plot and display names
my_color_pal(palette = "seasons",
names_or_hex = "names")
Upvotes: 1