Compare commits

..

No commits in common. "0d4f51f176a3becccef8f620b66e1f52ad194528" and "41c855a71c4f5d14bd8be47c0546c189916cf3e0" have entirely different histories.

3 changed files with 49 additions and 46 deletions

View file

@ -17,5 +17,3 @@
^app*$ ^app*$
^page$ ^page$
^demo$ ^demo$
^\.positai$
^\.claude$

1
.gitignore vendored
View file

@ -16,4 +16,3 @@ app
page page
demo demo
visuals visuals
.positai

View file

@ -56,25 +56,38 @@
#' #'
#' @export #' @export
generate_colors <- function(n, palette = "viridis", ...) { generate_colors <- function(n, palette = "viridis", ...) {
if (!is.numeric(n) ||
# --- Input validation ------------------------------------------------------- length(n) != 1 || n < 1 || n != as.integer(n)) {
if (!is.numeric(n) || length(n) != 1 || n < 1 || n %% 1 != 0) {
stop("`n` must be a single positive integer.") stop("`n` must be a single positive integer.")
} }
if (!is.function(palette) && (!is.character(palette) || length(palette) != 1)) {
stop("`palette` must be a single character string or a function.")
}
# --- Function passthrough --------------------------------------------------- # Function passthrough — call directly with n and ...
if (is.function(palette)) { if (is.function(palette)) {
return(palette(n, ...)) return(palette(n, ...))
} }
# --- Named palette dispatch ------------------------------------------------- if (!is.character(palette) || length(palette) != 1) {
stop("`palette` must be a single character string or a function.")
}
if (!is.numeric(n) ||
length(n) != 1 || n < 1 || n != as.integer(n)) {
stop("`n` must be a single positive integer.")
}
if (!is.character(palette) || length(palette) != 1) {
stop("`palette` must be a single character string.")
}
palette_lower <- tolower(palette) palette_lower <- tolower(palette)
viridis_palettes <- c("viridis", "magma", "plasma", "inferno", viridis_palettes <- c("viridis",
"cividis", "mako", "rocket", "turbo") "magma",
"plasma",
"inferno",
"cividis",
"mako",
"rocket",
"turbo")
if (palette_lower %in% viridis_palettes) { if (palette_lower %in% viridis_palettes) {
viridisLite::viridis(n = n, option = palette_lower, ...) viridisLite::viridis(n = n, option = palette_lower, ...)
@ -94,32 +107,25 @@ generate_colors <- function(n, palette = "viridis", ...) {
} else if (palette_lower == "topo") { } else if (palette_lower == "topo") {
grDevices::topo.colors(n = n, ...) grDevices::topo.colors(n = n, ...)
} else { } else if (palette %in% rownames(RColorBrewer::brewer.pal.info)) {
# Case-insensitive RColorBrewer lookup max_n <- RColorBrewer::brewer.pal.info[palette, "maxcolors"]
brewer_names <- rownames(RColorBrewer::brewer.pal.info) fetch_n <- max(min(n, max_n), 3L) # clamp to [3, max_n] for brewer.pal()
brewer_match <- brewer_names[match(palette_lower, tolower(brewer_names))] base_colors <- RColorBrewer::brewer.pal(n = fetch_n, name = palette)
if (!is.na(brewer_match)) {
max_n <- RColorBrewer::brewer.pal.info[brewer_match, "maxcolors"]
fetch_n <- max(min(n, max_n), 3L)
base_colors <- RColorBrewer::brewer.pal(n = fetch_n, name = brewer_match)
grDevices::colorRampPalette(base_colors)(n) grDevices::colorRampPalette(base_colors)(n)
} else { } else if (palette %in% grDevices::palette.pals()) {
# Case-insensitive grDevices palette.pals() lookup grDevices::colorRampPalette(palette.colors(palette = palette))(n)
pal_names <- grDevices::palette.pals()
pal_match <- pal_names[match(palette_lower, tolower(pal_names))]
if (!is.na(pal_match)) {
grDevices::colorRampPalette(grDevices::palette.colors(palette = pal_match))(n)
} else if (palette %in% grDevices::hcl.pals()) { } else if (palette %in% grDevices::hcl.pals()) {
# Named HCL palettes (e.g. "Rocket", "Plasma") — distinct from viridisLite
grDevices::hcl.colors(n = n, palette = palette, ...) grDevices::hcl.colors(n = n, palette = palette, ...)
} else { } else {
warning( message(
"Unknown palette: '", palette, "'. Falling back to viridis.\n", paste0(
"Unknown palette: '",
palette,
"'. ",
"Falling back to default R colors.\n",
"Available options:\n", "Available options:\n",
" viridisLite : viridis, magma, plasma, inferno, cividis, mako, rocket, turbo\n", " viridisLite : viridis, magma, plasma, inferno, cividis, mako, rocket, turbo\n",
" grDevices : hcl, rainbow, heat, terrain, topo\n", " grDevices : hcl, rainbow, heat, terrain, topo\n",
@ -127,9 +133,9 @@ generate_colors <- function(n, palette = "viridis", ...) {
" grDevices : use grDevices::palette.pals() to see all options\n", " grDevices : use grDevices::palette.pals() to see all options\n",
" RColorBrewer : use RColorBrewer::brewer.pal.info to see all options" " RColorBrewer : use RColorBrewer::brewer.pal.info to see all options"
) )
)
viridisLite::viridis(n = n, option = "viridis") viridisLite::viridis(n = n, option = "viridis")
} # grDevices::hcl.colors(n = n)
}
} }
} }