feat: added option to choose color palettes for all available plots. this includes a custom function to generate colors from several palettes as well as a select function to include color previews.

2026-06-19 04:27:30 +02:00 · 2026-03-24 12:04:54 +01:00 · 2026-03-24 12:04:54 +01:00 · 6c850847b7
commit 6c850847b7
parent 2d062e0ac5
21 changed files with 1110 additions and 251 deletions
--- a/man/colorSelectInput.Rd
+++ b/man/colorSelectInput.Rd
@ -0,0 +1,72 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/custom_SelectInput.R
+\name{colorSelectInput}
+\alias{colorSelectInput}
+\title{A selectizeInput customized for named vectors of color names supported by
+\code{\link{generate_colors}}}
+\usage{
+colorSelectInput(
+  inputId,
+  label,
+  choices,
+  selected = "",
+  previews = 4,
+  ...,
+  placeholder = ""
+)
+}
+\arguments{
+\item{inputId}{passed to \code{\link[shiny]{selectizeInput}}}
+
+\item{label}{passed to \code{\link[shiny]{selectizeInput}}}
+
+\item{choices}{A named \code{vector} from which fields should be populated}
+
+\item{selected}{default selection}
+
+\item{previews}{number of preview colors. Default is 4.}
+
+\item{...}{passed to \code{\link[shiny]{selectizeInput}}}
+
+\item{placeholder}{passed to \code{\link[shiny]{selectizeInput}} options}
+
+\item{onInitialize}{passed to \code{\link[shiny]{selectizeInput}} options}
+}
+\value{
+a \code{\link[shiny]{selectizeInput}} dropdown element
+}
+\description{
+A selectizeInput customized for named vectors of color names supported by
+\code{\link{generate_colors}}
+}
+\examples{
+if (shiny::interactive()) {
+top_palettes <- c(
+"Perceptual (blue-yellow)"   = "viridis",
+"Perceptual (fire)"          = "plasma",
+"Colour-blind friendly"      = "Okabe-Ito",
+"Qualitative (bold)"         = "Dark 2",
+"Qualitative (paired)"       = "Paired",
+"Sequential (blues)"         = "Blues",
+"Diverging (red-blue)"       = "RdBu",
+"Tableau style"              = "Tableau 10",
+"Pastel"                     = "Pastel 1",
+"Rainbow"                    = "rainbow"
+)
+  shinyApp(
+    ui = fluidPage(
+    titlePanel("Color Palette Select Test"),
+    colorSelectInput(
+      inputId  = "palette",
+      label    = "Color palette",
+      choices  = top_palettes,
+      selected = "viridis"
+    ),
+    verbatimTextOutput("selected")
+    ),
+    server = function(input, output, session) {
+    output$selected <- renderPrint(input$palette)
+    }
+  )
+}
+}
--- a/man/continuous_colors.Rd
+++ b/man/continuous_colors.Rd
@ -0,0 +1,44 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/generate_colors.R
+\name{continuous_colors}
+\alias{continuous_colors}
+\title{Create a Continuous Color Function from a Palette}
+\usage{
+continuous_colors(palette = "viridis", n = 256, ...)
+}
+\arguments{
+\item{palette}{Passed directly to \code{\link[=generate_colors]{generate_colors()}}. Either a palette
+name string or a function.}
+
+\item{n}{\code{integer}. Resolution of the underlying color ramp — higher
+values give smoother gradients. Defaults to 256.}
+
+\item{...}{Additional arguments passed to \code{\link[=generate_colors]{generate_colors()}}.}
+}
+\value{
+A function that takes a numeric vector of values in \code{[0, 1]}
+and returns a character vector of hex colors.
+}
+\description{
+Wraps \code{\link{generate_colors}} into a function that accepts a value
+between 0 and 1 and returns the corresponding color. Useful for mapping
+continuous variables to colors.
+}
+\examples{
+pal <- continuous_colors("viridis")
+pal(0)    # first color
+pal(1)    # last color
+pal(0.5)  # midpoint
+
+# Map a continuous variable to colors
+values <- seq(0, 1, length.out = 10)
+pal(values)
+
+# Works with any palette generate_colors() accepts
+pal <- continuous_colors("plasma", direction = -1)
+pal <- continuous_colors(\(n) hcl.colors(n, palette = "Blue-Red"))
+
+}
+\seealso{
+\code{\link[=generate_colors]{generate_colors()}}
+}
--- a/man/data-plots.Rd
+++ b/man/data-plots.Rd
@ -20,25 +20,35 @@
 \usage{
 data_visuals_ui(id, tab_title = "Plots", ...)

-data_visuals_server(id, data, ...)
+data_visuals_server(
+  id,
+  data,
+  palettes = c(`Perceptual (blue-yellow)` = "viridis", `Perceptual (fire)` = "plasma",
+    `Colour-blind friendly` = "Okabe-Ito", `Qualitative (bold)` = "Dark 2",
+    `Qualitative (paired)` = "Paired", `Sequential (blues)` = "Blues",
+    `Diverging (red-blue)` = "RdBu", `Tableau style` = "Tableau 10", Pastel = "Pastel 1",
+    Rainbow = "rainbow"),
+  ...
+)

-create_plot(data, type, pri, sec, ter = NULL, ...)
+create_plot(data, type, pri, sec, ter = NULL, color.palette = "viridis", ...)

 plot_bar_single(
  data,
  pri,
  sec = NULL,
  style = c("stack", "dodge", "fill"),
-  max_level = 30
+  max_level = 30,
+  color.palette = "viridis"
 )

-plot_box(data, pri, sec, ter = NULL, ...)
+plot_box(data, pri, sec, ter = NULL, color.palette = "viridis", ...)

-plot_box_single(data, pri, sec = NULL, seed = 2103)
+plot_box_single(data, pri, sec = NULL, seed = 2103, color.palette = "viridis")

-plot_hbars(data, pri, sec, ter = NULL)
+plot_hbars(data, pri, sec, ter = NULL, color.palette = "viridis")

-plot_ridge(data, x, y, z = NULL, ...)
+plot_ridge(data, x, y, z = NULL, color.palette = "viridis", ...)

 sankey_ready(data, pri, sec, numbers = "count", ...)

@ -49,12 +59,16 @@ plot_sankey(
  ter = NULL,
  color.group = "pri",
  colors = NULL,
+  color.palette = "viridis",
+  default.color = "#2986cc",
+  box.color = "#1E4B66",
+  na.color = "grey80",
  missing.level = "Missing"
 )

-plot_scatter(data, pri, sec, ter = NULL)
+plot_scatter(data, pri, sec, ter = NULL, color.palette = "viridis")

-plot_violin(data, pri, sec, ter = NULL)
+plot_violin(data, pri, sec, ter = NULL, color.palette = "viridis")
 }
 \arguments{
 \item{id}{Module id. (Use 'ns("id")')}
@ -71,6 +85,8 @@ plot_violin(data, pri, sec, ter = NULL)

 \item{ter}{tertiary variable}

+\item{color.palette}{choose color palette. See \code{\link{plot_colors}} for support.}
+
 \item{style}{barplot style passed to geom_bar position argument.
 One of c("stack", "dodge", "fill")}
 }
@ -120,7 +136,7 @@ Beautiful sankey plot with option to split by a tertiary group

 Beautiful violin plot

-Beatiful violin plot
+Beautiful violin plot
 }
 \examples{
 create_plot(mtcars, "plot_violin", "mpg", "cyl") |> attributes()
@ -130,7 +146,7 @@ mtcars |>

 mtcars |>
  dplyr::mutate(cyl = factor(cyl), am = factor(am)) |>
-  plot_bar_single(pri = "cyl", style = "stack")
+  plot_bar_single(pri = "cyl", style = "stack",color.palette="turbo")
 mtcars |> plot_box(pri = "mpg", sec = "gear")
 mtcars |> plot_box(pri = "mpg", sec="cyl")
 mtcars |>
@ -140,11 +156,14 @@ mtcars |>
  default_parsing() |>
  plot_box(pri = "mpg", sec = "cyl", ter = "gear",axis.font.family="mono")
 mtcars |> plot_box_single("mpg")
-mtcars |> plot_box_single("mpg","cyl")
+mtcars |> plot_box_single("mpg","cyl",color.palette="Blues")
+stRoke::trial |> plot_box_single("age","active",color.palette="Blues")
 gtsummary::trial |> plot_box_single("age","trt")
 mtcars |> plot_hbars(pri = "carb", sec = "cyl")
 mtcars |> plot_hbars(pri = "carb", sec = "cyl", ter="am")
-mtcars |> plot_hbars(pri = "carb", sec = NULL)
+mtcars |> plot_hbars(pri = "carb", sec = NULL,color.palette="Blues")
+mtcars |> plot_hbars(pri = "carb", sec = NULL,color.palette="Magma")
+mtcars |> plot_hbars(pri = "carb", sec = NULL,color.palette="Viridis")
 mtcars |>
  default_parsing() |>
  plot_ridge(x = "mpg", y = "cyl")
@ -169,9 +188,9 @@ mtcars |>
 ## Dont know why...
 mtcars |>
  default_parsing() |>
-  plot_sankey("cyl", "gear", "vs", color.group = "pri")
-
-  # stRoke::trial |> plot_sankey("mrs_1", "mrs_6")
+  plot_sankey("cyl", "gear", "vs", color.group = "pri",color.palette="inferno")
 mtcars |> plot_scatter(pri = "mpg", sec = "wt")
-mtcars |> plot_violin(pri = "mpg", sec = "cyl", ter = "gear")
+mtcars |> plot_scatter(pri = "mpg", sec = "wt",ter="carb")
+mtcars |> plot_violin(pri = "mpg", sec = "cyl")
+mtcars |> plot_violin(pri = "mpg", sec = "cyl", ter = "gear", color.palette="Blues")
 }
--- a/man/generate_colors.Rd
+++ b/man/generate_colors.Rd
@ -0,0 +1,63 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/generate_colors.R
+\name{generate_colors}
+\alias{generate_colors}
+\title{Generate N Colors from a Specified Color Palette}
+\usage{
+generate_colors(n, palette = "viridis", ...)
+}
+\arguments{
+\item{n}{\code{integer}. Number of colors to generate. Must be a positive
+integer.}
+
+\item{palette}{\code{character(1)}. Name of the color palette to use.
+Case-insensitive. Supported options:
+\describe{
+\item{\strong{viridisLite}}{\code{"viridis"}, \code{"magma"}, \code{"plasma"},
+\code{"inferno"}, \code{"cividis"}, \code{"mako"}, \code{"rocket"}, \code{"turbo"}}
+\item{\strong{grDevices}}{\code{"hcl"}, \code{"rainbow"}, \code{"heat"},
+\code{"terrain"}, \code{"topo"}}
+\item{\strong{RColorBrewer}}{Any palette name from
+\code{RColorBrewer::brewer.pal.info}, e.g. \code{"Set1"}, \code{"Blues"},
+\code{"Dark2"}. If \code{n} exceeds the palette maximum, colors are
+interpolated via \code{\link[grDevices]{colorRampPalette}}.}
+}}
+
+\item{...}{Additional arguments passed to the underlying palette function.
+For example, \code{alpha}, \code{direction}, \code{begin}, \code{end}
+are forwarded to \code{\link[viridisLite]{viridis}}; \code{palette} is
+forwarded to \code{\link[grDevices]{hcl.colors}}.}
+}
+\value{
+A \code{character} vector of length \code{n} containing hex color
+codes (e.g. \code{"#440154FF"}).
+}
+\description{
+A flexible wrapper around multiple color palette libraries, returning N
+colors as a character vector of hex codes. Supports palettes from
+\pkg{viridisLite}, base R \pkg{grDevices}, and \pkg{RColorBrewer}.
+}
+\examples{
+# viridisLite palettes
+generate_colors(5, "viridis")
+generate_colors(5, "plasma")
+generate_colors(5, "viridis", alpha = 0.8, direction = -1)
+
+# Base R grDevices
+generate_colors(5, "rainbow")
+generate_colors(8, "hcl", palette = "Dark 3")
+
+# RColorBrewer
+generate_colors(5, "Set1")
+generate_colors(5, "Blues")
+generate_colors(12, "Set1")  # interpolates beyond palette max of 9
+
+# Drop-in replacement for viridisLite::viridis()
+# generate_colors(n = length(levels(data_orig[[pri]])), palette = "viridis")
+
+}
+\seealso{
+\code{\link[viridisLite]{viridis}},
+\code{\link[grDevices]{hcl.colors}},
+\code{\link[RColorBrewer]{brewer.pal}}
+}
--- a/man/plot_euler.Rd
+++ b/man/plot_euler.Rd
@ -4,7 +4,7 @@
 \alias{plot_euler}
 \title{Easily plot euler diagrams}
 \usage{
-plot_euler(data, pri, sec, ter = NULL, seed = 2103)
+plot_euler(data, pri, sec, ter = NULL, seed = 2103, color.palette = "viridis")
 }
 \arguments{
 \item{data}{data}
--- a/man/plot_euler_single.Rd
+++ b/man/plot_euler_single.Rd
@ -4,7 +4,7 @@
 \alias{plot_euler_single}
 \title{Easily plot single euler diagrams}
 \usage{
-plot_euler_single(data)
+plot_euler_single(data, color.palette = "viridis")
 }
 \value{
 ggplot2 object
@ -19,5 +19,5 @@ data.frame(
  C = sample(c(TRUE, FALSE, FALSE, FALSE), 50, TRUE),
  D = sample(c(TRUE, FALSE, FALSE, FALSE), 50, TRUE)
 ) |> plot_euler_single()
-mtcars[c("vs", "am")] |> plot_euler_single()
+mtcars[c("vs", "am")] |> plot_euler_single("magma")
 }
--- a/man/plot_sankey_single.Rd
+++ b/man/plot_sankey_single.Rd
@ -9,8 +9,12 @@ plot_sankey_single(
  pri,
  sec,
  color.group = c("pri", "sec"),
+  color.palette = "viridis",
  colors = NULL,
  missing.level = "Missing",
+  default.color = "#2986cc",
+  box.color = "#1E4B66",
+  na.color = "grey80",
  ...
 )
 }
@ -44,4 +48,10 @@ mtcars |>
 stRoke::trial |>
  default_parsing() |>
  plot_sankey_single("diabetes", "hypertension")
+
+
+ # stRoke::trial |> plot_sankey_single("mrs_1", "mrs_6", color.palette="magma")
+ # stRoke::trial |> plot_sankey_single("active", "male")
+ # stRoke::trial |> plot_sankey_single("diabetes", "active", color.group="sec")
+ # stRoke::trial |> plot_sankey_single("active", "diabetes", color.group="sec", color.palette="topo")
 }
--- a/man/scale_fill_generate.Rd
+++ b/man/scale_fill_generate.Rd
@ -0,0 +1,45 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/generate_colors.R
+\name{scale_fill_generate}
+\alias{scale_fill_generate}
+\alias{scale_color_generate}
+\title{Discrete and Continuous Fill Scale Using generate_colors}
+\usage{
+scale_fill_generate(palette = "viridis", discrete = TRUE, ...)
+
+scale_color_generate(palette = "viridis", discrete = TRUE, ...)
+}
+\arguments{
+\item{palette}{Passed to \code{\link[=generate_colors]{generate_colors()}}. Either a palette name string
+or a function.}
+
+\item{discrete}{\code{logical}. If \code{TRUE} (default), a discrete scale
+is returned. If \code{FALSE}, a continuous scale is returned.}
+
+\item{...}{Additional arguments passed to \code{\link[ggplot2:scale_manual]{ggplot2::scale_fill_manual()}}
+(discrete) or \code{\link[ggplot2:scale_gradient]{ggplot2::scale_fill_gradientn()}} (continuous).}
+}
+\description{
+Drop-in replacement for \code{\link[viridis:scale_viridis]{viridis::scale_fill_viridis()}} that works with
+any palette supported by \code{\link[=generate_colors]{generate_colors()}}.
+}
+\examples{
+library(ggplot2)
+
+# Discrete
+ggplot(mtcars, aes(x = wt, y = mpg, fill = factor(cyl))) +
+  geom_col() +
+  scale_fill_generate(palette = "Set1")
+
+# Continuous
+ggplot(mtcars, aes(x = wt, y = mpg, fill = mpg)) +
+  geom_point(shape = 21, size = 3) +
+  scale_fill_generate(palette = "viridis", discrete = FALSE)
+
+ggplot(mtcars, aes(x = wt, y = mpg, color = factor(cyl))) +
+  geom_point() +
+  scale_color_generate(palette = "Set1")
+}
+\seealso{
+\code{\link[=scale_color_generate]{scale_color_generate()}}, \code{\link[=generate_colors]{generate_colors()}}, \code{\link[=continuous_colors]{continuous_colors()}}
+}
--- a/man/vertical_stacked_bars.Rd
+++ b/man/vertical_stacked_bars.Rd
@ -13,7 +13,9 @@ vertical_stacked_bars(
  l.color = "black",
  l.size = 0.5,
  draw.lines = TRUE,
-  label.str = "{n}\\n{round(100 * p,0)}\%"
+  label.str = "{n}\\n{round(100 * p,0)}\%",
+  color.palette = "viridis",
+  reverse = TRUE
 )
 }
 \arguments{