feat(theme): add theme and colourblind-safe palette presets

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: lcmsPlot
 Type: Package
 Title: Comprehensive Liquid Chromatography-Mass Spectrometry (LC-MS) data visualisation package
-Version: 1.1.20
+Version: 1.1.21
 Authors@R: c(
     person(
         "Ossama",
@@ -97,6 +97,7 @@ Collate:
     'dataset-peak-count-image.R'
     'dataset-purity.R'
     'plot-units.R'
+    'plot-theme.R'
     'plot-chrom-peak-rects.R'
     'plot-chromatogram.R'
     'plot-mass-trace.R'

NAMESPACE

@@ -69,6 +69,7 @@ export(lp_purity_timeline)
 export(lp_rt_diff_plot)
 export(lp_rt_line)
 export(lp_spectra)
+export(lp_theme)
 export(lp_total_ion_current)
 export(next_plot)
 export(sampleMetadata)

NEWS.md

@@ -1,3 +1,29 @@
+# lcmsPlot 1.1.21
+
+- New `lp_theme()` layer styles every plot type, and every panel of a
+  patchwork layout, from the pipeline (#60):
+  `lp_theme(preset = "publication", palette = "okabe_ito", base_size = 8)`.
+  `preset` is `"minimal"` (the previous look, still the default),
+  `"classic"`, `"publication"` (white background, axis lines, no minor grid,
+  8 pt base size), or any ggplot2 `theme`. `palette` is `"okabe_ito"`,
+  `"viridis"`, `"ggplot2"` (the previous hues), or a named or unnamed vector
+  of colours. `line_width` sets the width of the plotted lines and of the
+  theme's lines. `lp_get_plot() + theme(...)` still overrides the preset.
+- **The default discrete colours are now the colourblind-safe Okabe-Ito
+  palette**, falling back to viridis beyond 8 groups. Use
+  `lp_theme(palette = "ggplot2")` for the previous hues. A series keeps its
+  colour across all the panels of a layout. Continuous scales (intensity
+  maps, peak count images, purity scores) are unchanged.
+- Highlighted peaks take the colour of their trace: `highlight_peaks_factor`
+  of `lp_chromatogram()` now defaults to `NULL`, meaning the `group_by`
+  column of `lp_arrange()`, else `sample_id`. Set it explicitly for the
+  previous behaviour.
+- The Shiny app's Options panel exposes the theme preset, palette, and base
+  font size.
+- The plot-data baselines in `tests/testthat/fixtures/baseline` are
+  unaffected: they record the values handed to the plotting functions, not
+  their colours.
+
 # lcmsPlot 1.1.20
 
 - `lp_spectra(mode = "precursor")` plots the MS2 spectra of each feature from

R/app-options.R

@@ -1,7 +1,7 @@
 #' Build the per-tab Options panel UI
 #'
 #' Renders a card with form controls for `lp_facets`, `lp_arrange`,
-#' `lp_legend`, and `lp_labels`. Inputs are placed inside the module
+#' `lp_legend`, `lp_labels`, and `lp_theme`. Inputs are placed inside the module
 #' namespace given by `id`.
 #'
 #' @param id The module namespace id.
@@ -44,7 +44,24 @@
                              "top", "right", "bottom", "left", "none"),
                 selected = ""),
             shiny::textInput(ns("title"),        "Plot title",  value = ""),
-            shiny::textInput(ns("legend_title"), "Legend title", value = "")
+            shiny::textInput(ns("legend_title"), "Legend title", value = ""),
+            shiny::selectInput(
+                ns("theme_preset"),
+                "Theme",
+                choices  = c("default" = "", .theme_presets),
+                selected = ""),
+            shiny::selectInput(
+                ns("palette"),
+                "Palette",
+                choices  = c("default" = "",
+                             "Okabe-Ito" = "okabe_ito",
+                             "viridis" = "viridis",
+                             "ggplot2" = "ggplot2"),
+                selected = ""),
+            shiny::numericInput(
+                ns("base_size"),
+                "Base font size",
+                value = NA, min = 4, step = 1)
         )
     )
 }
@@ -64,7 +81,7 @@
 #'   metadata column names to populate the facet/group dropdowns.
 #' @return A reactive returning a named `list` with members `facets`,
 #'   `facet_ncol`, `free_x`, `free_y`, `arrange_by`, `legend_position`,
-#'   `title`, `legend_title`.
+#'   `title`, `legend_title`, `theme_preset`, `palette`, `base_size`.
 #' @keywords internal
 .options_server <- function(id, metadata_cols = NULL) {
     shiny::moduleServer(id, function(input, output, session) {
@@ -92,7 +109,10 @@
                 arrange_by      = .empty_to_null(input$arrange_by),
                 legend_position = .empty_to_null(input$legend_position),
                 title           = .empty_to_null(input$title),
-                legend_title    = .empty_to_null(input$legend_title)
+                legend_title    = .empty_to_null(input$legend_title),
+                theme_preset    = .empty_to_null(input$theme_preset),
+                palette         = .empty_to_null(input$palette),
+                base_size       = .na_to_null(input$base_size)
             )
         })
     })
@@ -102,8 +122,8 @@
 #'
 #' Pure function (no Shiny). Given an `lcmsPlotClass` and a list as produced
 #' by [`.options_server()`], appends the corresponding `lp_facets`,
-#' `lp_arrange`, `lp_legend`, and `lp_labels` layers when their inputs are
-#' non-`NULL`. Used by every plot module immediately before `lp_get_plot()`.
+#' `lp_arrange`, `lp_legend`, `lp_labels`, and `lp_theme` layers when their
+#' inputs are non-`NULL`. Used by every plot module immediately before `lp_get_plot()`.
 #'
 #' @param obj An `lcmsPlotClass`.
 #' @param opts A named `list` of options (see [`.options_server()`]).
@@ -130,6 +150,13 @@
             title  = opts$title,
             legend = opts$legend_title)
     }
+    if (!is.null(opts$theme_preset) || !is.null(opts$palette) ||
+        !is.null(opts$base_size)) {
+        obj <- obj + lp_theme(
+            preset    = opts$theme_preset %||% "minimal",
+            palette   = opts$palette %||% "okabe_ito",
+            base_size = opts$base_size)
+    }
     obj
 }
 

R/layers-data.R

@@ -56,7 +56,9 @@
 #' `"rectangle"` (draws a bounding box from rtmin to rtmax up to the peak apex),
 #' or `"point"` (marks the peak apex with a point). Defaults to `"polygon"`.
 #' @param highlight_peaks_factor A `character` value indicating the factor from
-#' the metadata that determines the color. By default it colors by `sample_id`.
+#' the metadata that determines the color. By default (`NULL`) the peaks take
+#' the colour of their trace: the `group_by` column of [lp_arrange()], else
+#' `sample_id`.
 #' @param aggregation_fun A `character` value indicating which aggregation
 #' function to use for the spectra intensities; one of `max` (base peak
 #' chromatogram), `sum` (total ion current), or `mean` (averaged ion
@@ -114,7 +116,7 @@ lp_chromatogram <- function(
     highlight_peaks = FALSE,
     highlight_peaks_color = NULL,
     highlight_peaks_mode = "polygon",
-    highlight_peaks_factor = "sample_id",
+    highlight_peaks_factor = NULL,
     aggregation_fun = "max",
     rt_type = "uncorrected",
     rt_unit = "second",

R/layers-layout.R

@@ -236,6 +236,128 @@ lp_legend <- function(position = NULL)  {
     )
 }
 
+#' Define the theme and colour palette of the plot
+#'
+#' The `lp_theme` function styles every panel of the plot with a theme preset
+#' and colours the series (the `group_by` column of [lp_arrange()], and the
+#' highlighted peaks) with a discrete palette. Continuous colour scales, such
+#' as those of intensity maps or purity scores, are left unchanged.
+#'
+#' A theme added after [lp_get_plot()] (e.g. `lp_get_plot() + theme(...)`)
+#' still overrides the preset.
+#'
+#' @param preset The theme preset. One of `"minimal"` (default),
+#' `"classic"`, `"publication"` (white background, axis lines, no minor grid,
+#' and an 8 pt base size for print), or any `ggplot2` `theme` object.
+#' @param palette The discrete palette. One of `"okabe_ito"` (default;
+#' colourblind-safe, falling back to viridis beyond 8 groups), `"viridis"`,
+#' `"ggplot2"` (the default ggplot2 hues), or a `character` vector of colours.
+#' A named vector maps each group to its colour; an unnamed one is used in
+#' order.
+#' @param base_size A `numeric` value indicating the base font size in points.
+#' `NULL` uses the preset's default (11, or 8 for `"publication"`).
+#' @param line_width A `numeric` value indicating the width of the plotted
+#' lines (chromatogram traces, spectrum sticks) and of the theme's lines.
+#' `NULL` scales it with `base_size`. `base_size` and `line_width` only affect
+#' the theme when `preset` is one of the named presets.
+#' @return A function that takes an `lcmsPlot` object and returns a modified
+#' version with the specified theme options stored in `options$theme`.
+#' It is intended for use with the `+` operator, which incrementally layers
+#' new data or visual components onto the `lcmsPlot` object.
+#' @export
+#' @examples
+#' raw_files <- dir(
+#'    system.file("cdf", package = "faahKO"),
+#'    full.names = TRUE,
+#'    recursive = TRUE)[1:4]
+#'
+#' p <- lcmsPlot(raw_files) +
+#'   lp_chromatogram(features = rbind(c(
+#'     mzmin = 334.9,
+#'     mzmax = 335.1,
+#'     rtmin = 2700,
+#'     rtmax = 2900))) +
+#'   lp_arrange(group_by = "sample_id")
+#'
+#' ## Style the plot for print
+#' p + lp_theme(preset = "publication", palette = "okabe_ito", base_size = 8)
+#'
+#' ## Colour each sample explicitly
+#' p + lp_theme(palette = c(
+#'   ko15 = "#0072B2", ko16 = "#56B4E9",
+#'   ko18 = "#D55E00", ko19 = "#E69F00"))
+lp_theme <- function(
+    preset = "minimal",
+    palette = "okabe_ito",
+    base_size = NULL,
+    line_width = NULL
+) {
+    .check_theme_preset(preset)
+    .check_palette(palette)
+    .check_positive_number(base_size, "base_size")
+    .check_positive_number(line_width, "line_width")
+
+    args <- as.list(environment())
+
+    make_interface_function(
+        name = "lp_theme",
+        args_list = args,
+        fn = function(obj) {
+            obj@options$theme <- args
+            return(obj)
+        }
+    )
+}
+
+.check_theme_preset <- function(preset) {
+    if (inherits(preset, "theme")) {
+        return(invisible())
+    }
+    if (!is.character(preset) || length(preset) != 1 ||
+        !preset %in% .theme_presets) {
+        stop(
+            "lp_theme: 'preset' must be one of ",
+            paste0('"', .theme_presets, '"', collapse = ", "),
+            ", or a ggplot2 theme.", call. = FALSE)
+    }
+}
+
+.check_palette <- function(palette) {
+    if (!is.character(palette) || length(palette) == 0) {
+        stop("lp_theme: 'palette' must be a character vector.", call. = FALSE)
+    }
+    if (length(palette) == 1 && is.null(names(palette)) &&
+        palette %in% .palette_presets) {
+        return(invisible())
+    }
+
+    valid <- vapply(palette, function(colour) {
+        tryCatch({
+            grDevices::col2rgb(colour)
+            TRUE
+        }, error = function(e) FALSE)
+    }, logical(1))
+    if (!all(valid)) {
+        stop(
+            "lp_theme: 'palette' must be one of ",
+            paste0('"', .palette_presets, '"', collapse = ", "),
+            ", or a vector of colours. Not colours: ",
+            paste0('"', palette[!valid], '"', collapse = ", "),
+            call. = FALSE)
+    }
+}
+
+.check_positive_number <- function(x, name) {
+    if (is.null(x)) {
+        return(invisible())
+    }
+    if (!is.numeric(x) || length(x) != 1 || is.na(x) || x <= 0) {
+        stop(
+            "lp_theme: '", name, "' must be a single positive number.",
+            call. = FALSE)
+    }
+}
+
 #' Define a vertical line on a retention time value
 #'
 #' @param intercept A `numeric` value indicating the retention time

R/options.R

@@ -24,7 +24,7 @@ default_options <- function() {
             highlight_peaks = FALSE,
             highlight_peaks_color = NULL,
             highlight_peaks_mode = "polygon",
-            highlight_peaks_factor = "sample_id",
+            highlight_peaks_factor = NULL,
             aggregation_fun = "max",
             rt_type = "uncorrected",
             rt_unit = "second",
@@ -128,6 +128,12 @@ default_options <- function() {
         legend = list(
             position = "right"
         ),
+        theme = list(
+            preset = "minimal",
+            palette = "okabe_ito",
+            base_size = NULL,
+            line_width = NULL
+        ),
         rt_lines = list(),
         layout = list(
             design = NULL

R/plot-chrom-peak-rects.R

@@ -149,7 +149,7 @@ plot_chrom_peak_rects <- function(
 
     p <- ggplot(dataset, aes(x = .data$rt, y = .data$mz)) +
         labs(x = "RT (sec)", y = "m/z") +
-        theme_minimal() +
+        .base_theme(options) +
         extra_layers
 
     if (is.null(options$facets$facets) &&

R/plot-chromatogram.R

@@ -128,11 +128,14 @@ plot_chromatogram <- function(
             options = options,
             group = "series_id")
     ) +
-        geom_line(linetype = options$chromatograms$line_type) +
+        geom_line(
+            linetype = options$chromatograms$line_type,
+            linewidth = .line_width(options)) +
         labs(x = x_label, y = y_label) +
-        scale_fill_discrete(guide = "none") + # Removes peak highlight legend
+        # The highlighted peaks share the trace colours, without a legend.
+        .series_scales(options, c("colour", "fill")) +
         scale_x_continuous(breaks = scales::pretty_breaks()) +
-        theme_minimal() +
+        .base_theme(options) +
         extra_layers
 
     if (isTRUE(options$purity_overlay$show)) {

R/plot-intensity-map.R

@@ -47,7 +47,7 @@ plot_intensity_map <- function(
             geom_density_2d_filled(contour_var = "ndensity") +
             (if (!is.null(fill_scale)) fill_scale else scale_fill_viridis_d()) +
             labs(x = dim_label(x_dim), y = dim_label(y_dim), fill = "Density") +
-            theme_minimal() +
+            .base_theme(options) +
             extra_layers,
         point = ggplot(
             dataset,
@@ -65,7 +65,7 @@ plot_intensity_map <- function(
                 x = dim_label(x_dim),
                 y = dim_label(y_dim),
                 colour = "log(Intensity)") +
-            theme_minimal() +
+            .base_theme(options) +
             extra_layers,
         tile = ggplot(
             dataset,
@@ -76,7 +76,7 @@ plot_intensity_map <- function(
             geom_tile() +
             (if (!is.null(fill_scale)) fill_scale else scale_fill_viridis_c()) +
             labs(x = dim_label(x_dim), y = dim_label(y_dim), fill = "log(Intensity)") +
-            theme_minimal() +
+            .base_theme(options) +
             extra_layers,
         stop("Unknown intensity map geom: '", geom_type, "'. ",
              "Expected 'tile', 'point', or 'density'.")

R/plot-mass-trace.R

@@ -33,7 +33,8 @@ plot_mass_trace <- function(
     ) +
         geom_point(show.legend = single) +
         labs(x = "RT (sec)", y = "m/z") +
-        theme_minimal() +
+        .series_scales(options) +
+        .base_theme(options) +
         extra_layers
 
     if (isTRUE(options$chrom_peak_rects$show)) {

R/plot-peak-count-image.R

@@ -66,7 +66,7 @@ plot_peak_count_image <- function(
             scale_fill_viridis_c()
         }) +
         labs(x = "RT (sec)", y = NULL, fill = fill_label) +
-        theme_minimal() +
+        .base_theme(options) +
         extra_layers
 
     return(p)