#' Atomic volcano plot (internal)
#'
#' @description
#' Core implementation for drawing a single volcano plot. This is the
#' workhorse behind the exported \code{\link{VolcanoPlot}} function — it takes
#' a **single** data frame (no \code{split_by} support) and returns a
#' \code{ggplot} object. The plot displays statistical significance (typically
#' -log10 adjusted p-value) on the y-axis versus magnitude of change (log2
#' fold change) on the x-axis, with points coloured by significance category
#' or a user-supplied variable. Top features can be automatically labelled
#' via \code{\link[ggrepel]{geom_text_repel}()}, and specific points can be
#' highlighted.
#'
#' The function categorises points into three groups based on cutoff
#' thresholds: \code{"sig_pos_x"} (points exceeding both the positive
#' x-cutoff and y-cutoff), \code{"sig_neg_x"} (points exceeding both the
#' negative x-cutoff and y-cutoff), and \code{"insig"} (all remaining
#' points). When \code{color_by = NULL}, this categorisation drives point
#' colouring; otherwise the supplied column controls the colour scale.
#'
#' @section Architecture:
#' \enumerate{
#'   \item \strong{ggplot dispatch} — selects \code{gglogger::ggplot} or
#'         \code{ggplot2::ggplot} based on
#'         \code{getOption("plotthis.gglogger.enabled")}.
#'   \item \strong{Input validation} — \code{trim} (must be length-2 in
#'         \code{[0, 1]}) and \code{xlim} (must be length-2 or \code{NULL})
#'         are validated via \code{stopifnot()}. \code{trim} is sorted.
#'   \item \strong{Column resolution} — \code{x}, \code{y}, \code{color_by},
#'         \code{facet_by}, and \code{label_by} are validated and transformed
#'         via \code{\link{check_columns}}. Multi-column \code{facet_by} is
#'         concatenated with \code{force_factor = TRUE}.
#'   \item \strong{y-axis transformation} — the y-column is transformed by
#'         \code{ytrans} (default: \code{"-log10"}). The \code{y_cutoff}
#'         value is also transformed.
#'   \item \strong{x_cutoff defaulting} — if \code{x_cutoff} is
#'         \code{NULL}, it is set to \code{0} (suppressing the x-cutoff
#'         legend line).
#'   \item \strong{Category assignment} — a \code{.category} factor with
#'         levels \code{c("sig_neg_x", "insig", "sig_pos_x")} is created:
#'         \itemize{
#'           \item When \code{y_cutoff} is non-\code{NULL}: points with
#'           \code{|x| > x_cutoff} AND \code{y > y_cutoff} are significant.
#'           \item When \code{y_cutoff} is \code{NULL}: only the x-cutoff
#'           determines significance.
#'         }
#'   \item \strong{Color resolution} — three cases:
#'         \itemize{
#'           \item \code{color_by = NULL}: uses \code{.category} as a
#'           discrete colour column; the legend is suppressed.
#'           \item Character/factor column: discrete colour scale via
#'           \code{\link{palette_this}()} and
#'           \code{scale_color_manual()}, guide suppressed.
#'           \item Numeric column: continuous gradient via
#'           \code{scale_color_gradientn()} with a framed colour-bar legend.
#'         }
#'   \item \strong{Flip negatives} — when \code{flip_negatives = TRUE},
#'         the y-values of points with negative x are multiplied by -1,
#'         creating a mirrored volcano where both up- and down-regulated
#'         features show their significance on the same side of the y-axis.
#'   \item \strong{Label column} — \code{.label} is populated from
#'         \code{label_by} or \code{rownames(data)}.
#'   \item \strong{Trim / winsorize} — x-values beyond the trim quantile
#'         bounds are clamped. When both bounds are nonzero and of opposite
#'         sign, they are symmetrised to the smaller absolute value.
#'         Outlying points are marked in \code{.outlier}.
#'   \item \strong{Label selection} — two modes:
#'         \itemize{
#'           \item Explicit \code{labels}: the specified rows (by name or
#'           index) are marked for labelling.
#'           \item Automatic: top \code{nlabel} points (by Euclidean distance
#'           to origin) are selected per \code{sign(x)} group, and per facet
#'           level if \code{facet_by} is set.
#'         }
#'         All labels are filtered to exclude \code{"insig"} points.
#'   \item \strong{Data split} — data is split into \code{pos_data}
#'         (\code{x >= 0}) and \code{neg_data} (\code{x < 0}) so that
#'         \code{ggrepel} labels can nudge in opposite directions (positive
#'         points nudge left, negative points nudge right).
#'   \item \strong{Outlier jitter} — outlier points are rendered separately
#'         with \code{position_jitter()} to reduce overplotting.
#'   \item \strong{Base ggplot} — \code{geom_point()} layers for positive,
#'         negative, and outlier data, with colour mapped to
#'         \code{color_by}.
#'   \item \strong{Colour scale} — discrete:
#'         \code{scale_color_manual()} with \code{"insig"} forced to
#'         \code{"grey"} (when \code{palcolor} is \code{NULL}); continuous:
#'         \code{scale_color_gradientn()} with palette re-scaled so that
#'         the colour-bar is centred at 0.
#'   \item \strong{Highlight} — when \code{highlight} is provided, two
#'         additional \code{geom_point()} layers (non-outliers and outliers
#'         with jitter) overlay the highlighted points in
#'         \code{highlight_color}.
#'   \item \strong{x-cutoff lines} — vertical dashed lines at
#'         \code{+/- x_cutoff} via \code{geom_vline()} with
#'         \code{\link[ggnewscale]{new_scale_color}()}, labelled by
#'         \code{x_cutoff_name}. Suppressed when \code{x_cutoff} is
#'         \code{NULL} or \code{0}.
#'   \item \strong{y-cutoff lines} — horizontal dashed line(s) at
#'         \code{y_cutoff} (or \code{+/- y_cutoff} when
#'         \code{flip_negatives = TRUE}) via \code{geom_hline()} with
#'         \code{\link[ggnewscale]{new_scale_color}()}, labelled by
#'         \code{y_cutoff_name}.
#'   \item \strong{Flip-negatives axis} — when \code{flip_negatives = TRUE},
#'         a solid \code{geom_hline(yintercept = 0)} is added and
#'         \code{scale_y_continuous(labels = abs)} formats the y-axis.
#'   \item \strong{x-axis limits} — optional \code{xlim} passed to
#'         \code{ggplot2::xlim()}.
#'   \item \strong{Reference line and labels} — a grey80 dashed vertical
#'         line at \code{x = 0}, followed by \code{geom_text_repel()} for
#'         positive and negative labelled points with separate x-nudges.
#'   \item \strong{Labels and theme} — \code{labs()},
#'         \code{coord_cartesian(clip = "off")},
#'         \code{do_call(theme, theme_args)}, and theme elements for
#'         \code{aspect.ratio}, \code{legend.position}, and
#'         \code{legend.direction}.
#'   \item \strong{Dimension calculation} —
#'         \code{\link{calculate_plot_dimensions}()} computes \code{height}
#'         and \code{width} attributes from \code{base_height = 5},
#'         \code{aspect.ratio}, and legend geometry.
#'   \item \strong{Faceting} — \code{\link{facet_plot}()} wraps the plot
#'         with \code{facet_wrap} / \code{facet_grid} if \code{facet_by} is
#'         provided.
#' }
#'
#' @inheritParams common_args
#' @param ytrans A function or a function name (as a string) to transform
#'  the y-axis values before plotting. The transformed values are used for
#'  both the y-axis and cutoff comparisons. Default: \code{"-log10"}
#'  (converts p-values to a -log10 scale). Other named functions can be
#'  passed as strings, e.g. \code{"sqrt"}.
#' @param color_by A character string specifying the column name to colour
#'  the points by. When \code{NULL} (default), points are automatically
#'  categorised as \code{"sig_pos_x"}, \code{"sig_neg_x"}, or
#'  \code{"insig"} based on \code{x_cutoff} and \code{y_cutoff}, and the
#'  colour legend is suppressed. When a column name is provided, the colour
#'  mapping follows the column type — discrete (character/factor) uses
#'  \code{scale_color_manual()} with the specified \code{palette};
#'  numeric (continuous) uses \code{scale_color_gradientn()}.
#' @param color_name A character string for the colour legend title when
#'  \code{color_by} is a numeric column. When \code{NULL} (default), the
#'  \code{color_by} column name is used.
#' @param flip_negatives A logical value. When \code{TRUE}, y-values of
#'  points with negative x-values are multiplied by -1, creating a mirrored
#'  volcano plot where both up- and down-regulated features show their
#'  significance on the same side of the y-axis. A horizontal line at
#'  \code{y = 0} and absolute-value axis labels are added. Default:
#'  \code{FALSE}.
#' @param trim A numeric vector of length 2 specifying quantile bounds for
#'  winsorizing the x-axis values. Values below the first quantile are
#'  clamped to that quantile; values above the second quantile are clamped
#'  to that quantile. Both values must be in \code{[0, 1]}. When both bounds
#'  are nonzero and of opposite sign, they are symmetrised to the smaller
#'  absolute value. Default: \code{c(0, 1)} (no trimming).
#' @param xlim A numeric vector of length 2 to set the x-axis limits.
#'  Passed to \code{\link[ggplot2]{xlim}()}. When \code{NULL} (default),
#'  limits are determined automatically from the data.
#' @param x_cutoff A numeric value specifying the x-axis significance
#'  cutoff. Both the negative and positive of this value are used as
#'  vertical threshold lines. When \code{NULL} or \code{0}, no x-cutoff
#'  line is drawn. Default: \code{NULL}.
#' @param y_cutoff A numeric value specifying the y-axis significance
#'  cutoff in the **original** (untransformed) scale. The value is
#'  transformed by \code{ytrans} before plotting. When \code{NULL}, no
#'  y-cutoff line is drawn and the category assignment uses only the
#'  x-cutoff. Default: \code{0.05}.
#' @param x_cutoff_name A character string for the x-cutoff legend entry.
#'  When \code{"none"}, the legend for the x-cutoff line is suppressed
#'  entirely (the line is still drawn). When \code{NULL} (default), a
#'  label of the form \code{"<x> = +/-<value>"} is generated.
#' @param y_cutoff_name A character string for the y-cutoff legend entry.
#'  When \code{"none"}, the legend for the y-cutoff line is suppressed
#'  entirely (the line is still drawn). When \code{NULL} (default), a
#'  label of the form \code{"<ylab> = <value>"} is generated.
#' @param x_cutoff_color A character string specifying the colour of the
#'  x-axis cutoff line(s). Default: \code{"red2"}.
#' @param y_cutoff_color A character string specifying the colour of the
#'  y-axis cutoff line(s). Default: \code{"blue2"}.
#' @param x_cutoff_linetype A character string specifying the linetype of
#'  the x-axis cutoff line(s). Default: \code{"dashed"}.
#' @param y_cutoff_linetype A character string specifying the linetype of
#'  the y-axis cutoff line(s). Default: \code{"dashed"}.
#' @param x_cutoff_linewidth A numeric value specifying the linewidth of
#'  the x-axis cutoff line(s). Default: \code{0.5}.
#' @param y_cutoff_linewidth A numeric value specifying the linewidth of
#'  the y-axis cutoff line(s). Default: \code{0.5}.
#' @param pt_size A numeric value specifying the point size for all data
#'  points. Default: \code{2}.
#' @param pt_alpha A numeric value in \code{[0, 1]} specifying the
#'  transparency of all data points. Default: \code{0.5}.
#' @param pt_shape A numeric value specifying the point shape. Default: \code{21}
#'  (filled circle with border). Shapes 21--25 support separate fill and border
#'  colour aesthetics; all other shapes use a single colour aesthetic. In
#'  raster mode, all points are drawn as filled circles (shape is ignored).
#' @param pt_border_color Controls the point border colour. For shapes 21--25:
#'  \itemize{
#'    \item \code{TRUE} (default) -- border colour tracks the \code{color_by}
#'    gradient / palette.
#'    \item A colour string (e.g. \code{"black"}) -- constant colour border.
#'  }
#'  \code{FALSE} or \code{NULL} disables the border. For shapes without a fill
#'  aesthetic (not 21--25), this parameter has no effect. In raster mode the
#'  border is drawn as a slightly larger disc behind each point (the shape is
#'  always a circle there), and \code{TRUE} falls back to a border disc in the
#'  \code{color_by} colour.
#' @param pt_border_size A numeric value specifying the point border size
#'  (stroke width, in mm). \code{0} disables the border. Default: \code{0.5}.
#' @param nlabel An integer specifying the number of top features to label
#'  automatically. Points are ranked by Euclidean distance to the origin
#'  within each \code{sign(x)} group (and per facet level if
#'  \code{facet_by} is set). Only non-insignificant points receive labels.
#'  Default: \code{5}.
#' @param labels A character vector of row names or integer indices
#'  specifying which points to label. Overrides automatic \code{nlabel}
#'  selection. When \code{NULL} (default), top \code{nlabel} points are
#'  chosen automatically.
#' @param label_by A character string specifying the column whose values
#'  are used as label text. When \code{NULL} (default), row names of the
#'  data frame are used.
#' @param label_size A numeric value specifying the font size of the
#'  labels. Default: \code{3}.
#' @param label_fg A character string specifying the text colour of the
#'  labels. Default: \code{"black"}.
#' @param label_bg A character string specifying the background colour of
#'  the label boxes (passed to \code{geom_text_repel(bg.color = ...)}).
#'  Default: \code{"white"}.
#' @param label_bg_r A numeric value specifying the corner radius of the
#'  label background boxes (passed to \code{geom_text_repel(bg.r = ...)}).
#'  Default: \code{0.1}.
#' @param highlight A character vector of row names or integer indices
#'  specifying which points to highlight with an overlaid point layer in
#'  \code{highlight_color}. When \code{NULL} (default), no highlighting is
#'  applied.
#' @param highlight_color A character string specifying the colour of the
#'  highlight points. Default: \code{"red"}.
#' @param highlight_size A numeric value specifying the point size of the
#'  highlight layer. Default: \code{2}.
#' @param highlight_alpha A numeric value in \code{[0, 1]} specifying the
#'  transparency of the highlight points. Default: \code{1}.
#' @param highlight_stroke A numeric value specifying the stroke width of
#'  the highlight point borders. Default: \code{0.5}.
#' @param raster A logical value. If `TRUE`, points are rendered via
#'  `scattermore::geom_scattermore()` for efficient rasterised plotting.
#'  Default is `NULL`, which auto-enables when `nrow(data) > 1e3`.
#' @param raster_dpi A numeric vector of length 2 `[x_dpi, y_dpi]` specifying the raster
#'  resolution in pixels. Passed to `scattermore::geom_scattermore(pixels = ...)`.
#'  Default is `c(512, 512)`. If a single value is provided it is recycled to both dimensions.
#'
#' @return A \code{ggplot} object with \code{height} and \code{width}
#'  attributes (in inches) attached.
#' @keywords internal
#' @importFrom dplyr %>% case_when mutate arrange row_number group_by ungroup desc filter
VolcanoPlotAtomic <- function(
    data,
    x,
    y,
    ytrans = "-log10",
    color_by = NULL,
    color_name = NULL,
    flip_negatives = FALSE,
    x_cutoff = NULL,
    y_cutoff = 0.05,
    trim = c(0, 1),
    xlim = NULL,
    x_cutoff_name = NULL,
    y_cutoff_name = NULL,
    x_cutoff_color = "red2",
    y_cutoff_color = "blue2",
    x_cutoff_linetype = "dashed",
    y_cutoff_linetype = "dashed",
    x_cutoff_linewidth = 0.5,
    y_cutoff_linewidth = 0.5,
    pt_size = 2,
    pt_alpha = 0.5,
    pt_shape = 21,
    pt_border_color = TRUE,
    pt_border_size = 0.5,
    nlabel = 5,
    labels = NULL,
    label_by = NULL,
    label_size = 3,
    label_fg = "black",
    label_bg = "white",
    label_bg_r = 0.1,
    highlight = NULL,
    highlight_color = "red",
    highlight_size = 2,
    highlight_alpha = 1,
    highlight_stroke = 0.5,
    raster = NULL,
    raster_dpi = c(512, 512),
    facet_by = NULL,
    facet_scales = "fixed",
    facet_ncol = NULL,
    facet_nrow = NULL,
    facet_byrow = TRUE,
    theme = "theme_this",
    theme_args = list(),
    palette = "Spectral",
    palcolor = NULL,
    palreverse = FALSE,
    title = NULL,
    subtitle = NULL,
    xlab = NULL,
    ylab = NULL,
    aspect.ratio = 1,
    legend.position = "right",
    legend.direction = "vertical",
    seed = 8525,
    ...
) {
    ggplot <- if (getOption("plotthis.gglogger.enabled", FALSE)) {
        gglogger::ggplot
    } else {
        ggplot2::ggplot
    }
    stopifnot(
        "[VolcanoPlot] 'trim' must be a numeric vector of length 2 and both values must be in the range [0, 1]." = length(
            trim
        ) ==
            2 &&
            all(trim >= 0 & trim <= 1)
    )
    stopifnot(
        "[VolcanoPlot] 'xlim' must be a numeric vector of length 2." = is.null(
            xlim
        ) ||
            length(xlim) == 2
    )
    trim <- sort(trim)
    x <- check_columns(data, x)
    y <- check_columns(data, y)
    color_by <- check_columns(data, color_by)
    facet_by <- check_columns(
        data,
        facet_by,
        force_factor = TRUE,
        allow_multi = TRUE
    )
    label_by <- check_columns(data, label_by)

    # Resolve function-name strings (e.g. "-log10", "sqrt") to functions
    if (is.null(ytrans)) {
        ytrans <- identity
    } else if (is.character(ytrans)) {
        if (startsWith(ytrans, "-")) {
            ytrans_str <- trimws(substring(ytrans, 2))
            ytrans <- function(x) -1 * match.fun(ytrans_str)(x)
        } else {
            ytrans <- match.fun(trimws(ytrans))
        }
    }

    data[[y]] <- ytrans(data[[y]])
    x_cutoff <- x_cutoff %||% 0
    y_cutoff <- ytrans(y_cutoff)

    if (!is.null(y_cutoff)) {
        data <- data %>%
            mutate(
                .category = factor(
                    case_when(
                        !!sym(x) > x_cutoff & !!sym(y) > y_cutoff ~ "sig_pos_x",
                        !!sym(x) < -x_cutoff &
                            !!sym(y) > y_cutoff ~ "sig_neg_x",
                        TRUE ~ "insig"
                    ),
                    levels = c("sig_neg_x", "insig", "sig_pos_x")
                )
            )
    } else {
        data <- data %>%
            mutate(
                .category = factor(
                    case_when(
                        !!sym(x) > x_cutoff ~ "sig_pos_x",
                        !!sym(x) < -x_cutoff ~ "sig_neg_x",
                        TRUE ~ "insig"
                    ),
                    levels = c("sig_neg_x", "insig", "sig_pos_x")
                )
            )
    }

    if (is.null(color_by)) {
        color_by <- ".category"
        color_type <- "discrete"
    } else if (is.character(data[[color_by]]) || is.factor(data[[color_by]])) {
        color_type <- "discrete"
    } else {
        color_type <- "continuous"
    }

    if (flip_negatives) {
        data[data[[x]] < 0, y] <- -data[data[[x]] < 0, y]
    }
    data$.label <- if (is.null(label_by)) rownames(data) else data[[label_by]]
    data$.show_label <- FALSE

    x_upper <- quantile(data[[x]][is.finite(data[[x]])], c(trim[2], 1))
    x_lower <- quantile(data[[x]][is.finite(data[[x]])], c(trim[1], 0))
    x_upper <- ifelse(x_upper[1] > 0, x_upper[1], x_upper[2])
    x_lower <- ifelse(x_lower[1] < 0, x_lower[1], x_lower[2])
    if (x_upper > 0 & x_lower < 0) {
        value_range <- min(abs(c(x_upper, x_lower)), na.rm = TRUE)
        x_upper <- value_range
        x_lower <- -value_range
    }
    data$.outlier <- data[[x]] > x_upper | data[[x]] < x_lower
    data[[x]][data[[x]] > x_upper] <- x_upper
    data[[x]][data[[x]] < x_lower] <- x_lower

    if (!is.null(labels)) {
        data[labels, ".show_label"] <- TRUE
    } else {
        # calculate the distance to the origin
        data$.distance <- sqrt(data[[x]]^2 + data[[y]]^2)
        if (!is.null(facet_by)) {
            data <- data %>%
                group_by(!!!syms(facet_by), sign(data[[x]])) %>%
                arrange(desc(!!sym(".distance"))) %>%
                mutate(.show_label = row_number() <= nlabel) %>%
                ungroup()
        } else {
            data <- data %>%
                group_by(sign(data[[x]])) %>%
                arrange(desc(!!sym(".distance"))) %>%
                mutate(.show_label = row_number() <= nlabel) %>%
                ungroup()
        }
    }
    data <- data %>%
        mutate(
            .show_label = !!sym(".show_label") & !!sym(".category") != "insig"
        ) %>%
        as.data.frame()
    # rownames(data) <- data$.label

    # x_nudge is not an aesthetic, we can't specify it separately for negative and positive values
    # so we plot the points in two layers
    # one for negative values and one for positive values
    # and set the x_nudge for each layer
    pos_data <- data[data[[x]] >= 0, , drop = FALSE]
    neg_data <- data[data[[x]] < 0, , drop = FALSE]

    outlier_data <- data[data$.outlier, , drop = FALSE]

    # x_nudges will be the same for all facets
    pos_x_nudge <- -diff(range(pos_data[[x]])) * 0.05
    neg_x_nudge <- diff(range(neg_data[[x]])) * 0.05
    jitter <- position_jitter(width = 0.2, height = 0.2, seed = seed)

    raster <- raster %||% (nrow(data) > 1e3)
    if (length(raster_dpi) == 1) {
        raster_dpi <- rep(raster_dpi, 2)
    }
    dims <- calculate_plot_dimensions(
        base_height = 5,
        aspect.ratio = aspect.ratio,
        legend.position = legend.position,
        legend.direction = legend.direction
    )
    # scattermore's `pointsize` is a radius in raster pixels; convert the
    # ggplot point size (diameter in mm) so raster points match geom_point
    raster_pointsize <- max(
        1,
        round(pt_size * raster_dpi[1] / (25.4 * 1.25 * dims$width))
    )

    shape_has_fill <- pt_shape %in% 21:25
    has_border <- shape_has_fill && !is.null(pt_border_color) && !isFALSE(pt_border_color)
    # vector border colour: TRUE maps the aesthetic, FALSE/NULL hides the border
    vector_border <- if (isTRUE(pt_border_color)) {
        NULL
    } else if (isFALSE(pt_border_color) || is.null(pt_border_color)) {
        "transparent"
    } else {
        pt_border_color
    }

    p <- ggplot(mapping = aes(x = !!sym(x), y = !!sym(y)))
    if (isTRUE(raster)) {
        # scattermore can only stamp filled discs: no fill aesthetic, no
        # border. The border is a slightly larger disc stamped behind, with
        # the `color_by` colour riding the colour aesthetic. An opaque disc
        # of the panel background is stamped between border and fill —
        # otherwise the border colour would tint the translucent interior.
        # same mm -> raster-px conversion as raster_pointsize (including the
        # 1.25 calibration and plot width), so the border keeps its vector
        # proportion of the point instead of dwarfing it
        border_px <- if (has_border && pt_border_size > 0) {
            max(1, round(pt_border_size * raster_dpi[1] / (25.4 * 1.25 * dims$width)))
        } else {
            0
        }
        panel_fill <- do_call(theme, theme_args)$panel.background$fill %||% "white"
        raster_layer <- function(dat, position = NULL) {
            position <- position %||% "identity"
            fill_layer <- scattermore::geom_scattermore(
                data = dat,
                mapping = aes(color = !!sym(color_by)),
                pointsize = raster_pointsize,
                alpha = pt_alpha,
                pixels = raster_dpi,
                position = position
            )
            if (border_px == 0) {
                return(list(fill_layer))
            }
            disc_args <- list(
                data = dat,
                pointsize = raster_pointsize + border_px,
                alpha = 1,
                pixels = raster_dpi,
                position = position
            )
            if (isTRUE(pt_border_color)) {
                disc_args$mapping <- aes(color = !!sym(color_by))
            } else {
                disc_args$color <- vector_border
            }
            list(
                do_call(scattermore::geom_scattermore, disc_args),
                scattermore::geom_scattermore(
                    data = dat,
                    color = panel_fill,
                    pointsize = raster_pointsize,
                    alpha = 1,
                    pixels = raster_dpi,
                    position = position
                ),
                fill_layer
            )
        }
        p <- p +
            raster_layer(pos_data) +
            raster_layer(neg_data) +
            raster_layer(outlier_data, position = jitter)
    } else {
        point_layer <- function(dat, position = NULL) {
            args <- list(
                data = dat,
                size = pt_size,
                alpha = pt_alpha,
                shape = pt_shape
            )
            if (shape_has_fill) {
                if (isTRUE(pt_border_color)) {
                    # border tracks the fill gradient / palette (single layer)
                    args$mapping <- aes(fill = !!sym(color_by), color = !!sym(color_by))
                    args$stroke <- pt_border_size
                } else {
                    args$mapping <- aes(fill = !!sym(color_by))
                    # stroke 0 suppresses the point's own outline; a constant
                    # colour border is drawn by the ring layer on top. NA would
                    # hide the whole point, and "transparent" becomes opaque
                    # white through scales::alpha() when pt_alpha = 1.
                    args$color <- "transparent"
                    args$stroke <- 0
                }
            } else {
                args$mapping <- aes(color = !!sym(color_by))
            }
            if (!is.null(position)) {
                args$position <- position
            }
            layers <- list(do_call(geom_point, args))
            if (has_border && !isTRUE(pt_border_color) && pt_border_size > 0) {
                # opaque border ring layer on top, so the border stays visible
                # under translucent fills (same look as the raster mode)
                border_args <- list(
                    data = dat,
                    size = pt_size,
                    shape = pt_shape,
                    alpha = 1,
                    fill = NA,
                    color = vector_border,
                    stroke = pt_border_size
                )
                if (!is.null(position)) {
                    border_args$position <- position
                }
                layers[[2]] <- do_call(geom_point, border_args)
            }
            layers
        }
        p <- p +
            point_layer(pos_data) +
            point_layer(neg_data) +
            point_layer(outlier_data, position = jitter)
    }

    if (color_type == "discrete") {
        colors <- palette_this(
            levels(data[[color_by]]),
            palette = palette,
            palcolor = palcolor,
            reverse = palreverse
        )
        if (is.null(palcolor)) {
            colors['insig'] <- "grey"
        }
        if (shape_has_fill && !isTRUE(raster)) {
            p <- p + scale_fill_manual(values = colors, guide = "none")
            if (isTRUE(pt_border_color)) {
                p <- p + scale_color_manual(values = colors, guide = "none")
            }
        } else {
            p <- p + scale_color_manual(values = colors, guide = "none")
        }
    } else {
        grad_args <- list(
            colors = palette_this(
                palette = palette,
                palcolor = palcolor,
                reverse = palreverse
            ),
            values = scales::rescale(unique(c(
                min(c(unlist(data[[color_by]]), 0), na.rm = TRUE),
                0,
                max(unlist(data[[color_by]]), na.rm = TRUE)
            ))),
            guide = guide_colorbar(
                title = color_name %||% color_by,
                frame.colour = "black",
                ticks.colour = "black",
                title.hjust = 0,
                order = 1
            )
        )
        if (shape_has_fill && !isTRUE(raster)) {
            p <- p + do_call(scale_fill_gradientn, grad_args)
            if (isTRUE(pt_border_color)) {
                grad_args$guide <- guide_none()
                p <- p + do_call(scale_color_gradientn, grad_args)
            }
        } else {
            p <- p + do_call(scale_color_gradientn, grad_args)
        }
    }

    if (!is.null(highlight)) {
        p <- p +
            geom_point(
                data = data[match(data$.label, highlight, nomatch = 0), , drop = FALSE] %>%
                    filter(!!sym(".outlier") == FALSE),
                color = highlight_color,
                size = highlight_size,
                alpha = highlight_alpha,
                stroke = highlight_stroke
            ) +
            geom_point(
                data = data[match(data$.label, highlight, nomatch = 0), , drop = FALSE] %>%
                    filter(!!sym(".outlier")),
                color = highlight_color,
                size = highlight_size,
                alpha = highlight_alpha,
                stroke = highlight_stroke,
                position = jitter
            )
    }

    if (!is.null(x_cutoff) && x_cutoff != 0) {
        if (identical(x_cutoff_name, "none")) {
            guide <- guide_none()
        } else {
            guide <- guide_legend(
                override.aes = list(alpha = 0.8, size = 5),
                order = 2,
                theme = ggplot2::theme(legend.margin = margin(0, 0, -10, 4.5))
            )
        }
        vline_df <- data.frame(xintercept = c(-x_cutoff, x_cutoff))
        if (!is.null(facet_by)) {
            vline_df <- expand_grid(
                vline_df,
                data[, facet_by, drop = FALSE] %>% distinct()
            )
        }
        p <- p +
            new_scale_color() +
            geom_vline(
                data = vline_df,
                mapping = aes(
                    xintercept = !!sym("xintercept"),
                    color = x_cutoff_name %||%
                        paste0(
                            x,
                            " = +/-",
                            scales::number(x_cutoff, accuracy = 0.01)
                        )
                ),
                alpha = 0.4,
                linetype = x_cutoff_linetype,
                linewidth = x_cutoff_linewidth,
            ) +
            scale_color_manual(
                name = NULL,
                values = x_cutoff_color,
                guide = guide
            )
    }

    if (!is.null(y_cutoff)) {
        if (isTRUE(flip_negatives)) {
            yintercept <- c(-y_cutoff, y_cutoff)
        } else {
            yintercept <- y_cutoff
        }
        if (identical(y_cutoff_name, "none")) {
            guide <- guide_none()
        } else {
            guide <- guide_legend(
                override.aes = list(alpha = 0.8, size = 5),
                order = 3
            )
        }
        hline_df <- data.frame(yintercept = yintercept)
        if (!is.null(facet_by)) {
            hline_df <- expand_grid(
                hline_df,
                data[, facet_by, drop = FALSE] %>% distinct()
            )
        }
        p <- p +
            new_scale_color() +
            geom_hline(
                data = hline_df,
                mapping = aes(
                    yintercept = !!sym("yintercept"),
                    color = y_cutoff_name %||%
                        paste0(
                            ylab %||% y,
                            " = ",
                            scales::number(y_cutoff, accuracy = 0.01)
                        )
                ),
                alpha = 0.4,
                linetype = y_cutoff_linetype,
                linewidth = y_cutoff_linewidth
            ) +
            scale_color_manual(
                name = NULL,
                values = y_cutoff_color,
                guide = guide
            )
    }

    if (isTRUE(flip_negatives)) {
        p <- p +
            geom_hline(yintercept = 0, color = "black", linetype = 1) +
            scale_y_continuous(labels = abs)
    }
    if (!is.null(xlim)) {
        p <- p + ggplot2::xlim(xlim)
    }

    p <- p +
        geom_vline(xintercept = 0, color = "grey80", linetype = 2) +
        geom_text_repel(
            data = pos_data[pos_data$.show_label, , drop = FALSE],
            aes(label = !!sym(".label")),
            nudge_x = pos_x_nudge,
            color = label_fg,
            bg.color = label_bg,
            bg.r = label_bg_r,
            size = label_size,
            min.segment.length = 0,
            segment.color = "grey40",
            max.overlaps = 100
        ) +
        geom_text_repel(
            data = neg_data[neg_data$.show_label, , drop = FALSE],
            aes(label = !!sym(".label")),
            nudge_x = neg_x_nudge,
            color = label_fg,
            bg.color = label_bg,
            bg.r = label_bg_r,
            size = label_size,
            min.segment.length = 0,
            segment.color = "grey40",
            max.overlaps = 100
        ) +
        labs(
            title = title,
            subtitle = subtitle,
            x = xlab %||% x,
            y = ylab %||% y
        ) +
        coord_cartesian(clip = "off")

    p <- p +
        do_call(theme, theme_args) +
        ggplot2::theme(
            aspect.ratio = aspect.ratio,
            legend.position = legend.position,
            legend.direction = legend.direction
        )

    attr(p, "height") <- dims$height
    attr(p, "width") <- dims$width

    facet_plot(
        p,
        facet_by,
        facet_scales,
        facet_nrow,
        facet_ncol,
        facet_byrow,
        legend.position = legend.position,
        legend.direction = legend.direction
    )
}

#' Volcano plot
#'
#' @description
#' Produces a volcano plot — a scatter plot that displays statistical
#' significance (typically -log10 adjusted p-value) on the y-axis versus
#' magnitude of change (log2 fold change) on the x-axis. Points are coloured
#' automatically by significance category (\code{"sig_pos_x"},
#' \code{"sig_neg_x"}, \code{"insig"}) or by a user-supplied column. The
#' most significant features can be labelled automatically via
#' \code{\link[ggrepel]{geom_text_repel}()}, and specific points can be
#' highlighted.
#'
#' The function supports \strong{automatic labelling} of top features (by
#' distance to origin), \strong{mirrored layout} via
#' \code{flip_negatives}, \strong{x-axis trimming} to reduce the influence
#' of extreme values, \strong{faceting}, and \strong{splitting} into
#' separate sub-plots via \code{split_by} with per-split colour palette and
#' legend control.
#'
#' @section split_by Workflow:
#' When \code{split_by} is provided:
#' \enumerate{
#'   \item The \code{split_by} column(s) are validated via
#'         \code{\link{check_columns}()} with \code{force_factor = TRUE} and
#'         \code{concat_multi = TRUE} (multiple columns are concatenated
#'         with \code{split_by_sep}).
#'   \item The data frame is split by \code{split_by} (preserving factor
#'         level order). If \code{split_by} is \code{NULL}, the data is
#'         wrapped in a single-element list with name \code{"..."}.
#'   \item Per-split \code{palette}, \code{palcolor},
#'         \code{legend.position}, and \code{legend.direction} are resolved
#'         via \code{\link{check_palette}()}, \code{\link{check_palcolor}()},
#'         and \code{\link{check_legend}()}.
#'   \item \code{\link{VolcanoPlotAtomic}()} is called for each split. If
#'         \code{title} is a function, it receives the split level name and
#'         can generate dynamic titles.
#'   \item Results are combined via \code{\link{combine_plots}()} (when
#'         \code{combine = TRUE}) or returned as a named list.
#' }
#'
#' @inheritParams common_args
#' @inheritParams VolcanoPlotAtomic
#' @param split_by The column(s) to split the data by and produce separate
#'  sub-plots. Multiple columns are concatenated with \code{split_by_sep}.
#' @param split_by_sep A character string to separate concatenated
#'  \code{split_by} columns. Default \code{"_"}.
#' @param combine Logical; when \code{TRUE} (default), returns a combined
#'  \code{patchwork} object. When \code{FALSE}, returns a named list of
#'  individual \code{ggplot} objects.
#' @param ncol,nrow Integer number of columns / rows for the combined layout
#'  (passed to \code{\link[patchwork]{wrap_plots}}).
#' @param byrow Logical; fill the combined layout by row. Default
#'  \code{TRUE} (passed to \code{\link[patchwork]{wrap_plots}}).
#' @param axes A character string specifying how axes should be treated
#'  across the combined layout (passed to
#'  \code{\link[patchwork]{wrap_plots}}).
#' @param axis_titles A character string specifying how axis titles should
#'  be treated across the combined layout. Defaults to \code{axes}.
#' @param guides A character string specifying how guides (legends) should
#'  be collected across panels. Default \code{"collect"} (passed to
#'  \code{\link{combine_plots}()}).
#' @param design A custom layout design for the combined plot (passed to
#'  \code{\link{combine_plots}()}).
#' @return A \code{ggplot} object, a \code{patchwork} object, or a named
#'  list of \code{ggplot} objects (when \code{combine = FALSE}), each with
#'  \code{height} and \code{width} attributes in inches.
#' @export
#' @examples
#' \donttest{
#' set.seed(8525)
#' n <- 200
#' n_de <- 150
#'
#' ## Non-DE genes
#' fc_null <- rnorm(n - n_de, 0, 0.35)
#' z_null  <- rnorm(n - n_de, 0, 1)
#'
#' ## DE genes
#' fc_de <- rnorm(
#'   n_de,
#'   mean = sample(c(-1, 1), n_de, replace = TRUE),
#'   sd = 0.45
#' )
#'
#' ## Make significance related to effect size,
#' ## but with substantial variation
#' z_de <- fc_de * rnorm(n_de, 4.5, 0.8)
#'
#' avg_log2FC <- c(fc_null, fc_de)
#' z <- c(z_null, z_de)
#'
#' p_val <- 2 * pnorm(-abs(z))
#' p_val_adj <- p.adjust(p_val, method = "BH")
#'
#' ## Shuffle genes
#' i <- sample(n)
#'
#' data <- data.frame(
#'   avg_log2FC = avg_log2FC[i],
#'   p_val_adj = p_val_adj[i],
#'   gene = paste0("gene", seq_len(n))[i],
#'   pct_diff = rnorm(n, 0, 1),
#'   group = sample(LETTERS[1:2], n, replace = TRUE)
#' )
#'
#' # --- Basic usage ---
#' VolcanoPlot(data, x = "avg_log2FC", y = "p_val_adj", color_by = "pct_diff",
#'    y_cutoff_name = "-log10(0.05)")
#' # --- With gene labels ---
#' VolcanoPlot(data, x = "avg_log2FC", y = "p_val_adj", color_by = "pct_diff",
#'    y_cutoff_name = "-log10(0.05)", label_by = "gene")
#' # --- Mirrored layout ---
#' VolcanoPlot(data, x = "avg_log2FC", y = "p_val_adj", y_cutoff_name = "none",
#'    flip_negatives = TRUE, label_by = "gene")
#' # --- With faceting ---
#' VolcanoPlot(data, x = "avg_log2FC", y = "p_val_adj", y_cutoff_name = "none",
#'    flip_negatives = TRUE, facet_by = "group", label_by = "gene")
#' # --- With splitting ---
#' VolcanoPlot(data, x = "avg_log2FC", y = "p_val_adj", y_cutoff_name = "none",
#'    flip_negatives = TRUE, split_by = "group", label_by = "gene")
#' # --- With highlighting ---
#' VolcanoPlot(data, x = "avg_log2FC", y = "p_val_adj", y_cutoff_name = "none",
#'    highlight = c("gene196", "gene151"), label_by = "gene")
#' # --- Per-split palettes ---
#' VolcanoPlot(data, x = "avg_log2FC", y = "p_val_adj", color_by = "pct_diff",
#'    y_cutoff_name = "-log10(0.05)", split_by = "group", label_by = "gene",
#'    palette = c(A = "Spectral", B = "PuOr"))
#' # Trim extreme x-values (winsorize to 40% and 50% quantiles), for demo purposes
#' VolcanoPlot(data, x = "avg_log2FC", y = "p_val_adj", color_by = "pct_diff",
#'    y_cutoff_name = "-log10(0.05)", trim = c(0.4, 0.5))
#' }
VolcanoPlot <- function(
    data,
    x,
    y,
    ytrans = "-log10",
    color_by = NULL,
    color_name = NULL,
    xlim = NULL,
    flip_negatives = FALSE,
    x_cutoff = NULL,
    y_cutoff = 0.05,
    split_by = NULL,
    split_by_sep = "_",
    label_by = NULL,
    x_cutoff_name = NULL,
    y_cutoff_name = NULL,
    x_cutoff_color = "red2",
    y_cutoff_color = "blue2",
    x_cutoff_linetype = "dashed",
    y_cutoff_linetype = "dashed",
    x_cutoff_linewidth = 0.5,
    y_cutoff_linewidth = 0.5,
    pt_size = 2,
    pt_alpha = 0.5,
    pt_shape = 21,
    pt_border_color = TRUE,
    pt_border_size = 0.5,
    nlabel = 5,
    labels = NULL,
    label_size = 3,
    label_fg = "black",
    label_bg = "white",
    label_bg_r = 0.1,
    highlight = NULL,
    highlight_color = "red",
    highlight_size = 2,
    highlight_alpha = 1,
    highlight_stroke = 0.5,
    raster = NULL,
    raster_dpi = c(512, 512),
    trim = c(0, 1),
    facet_by = NULL,
    facet_scales = "fixed",
    facet_ncol = NULL,
    facet_nrow = NULL,
    facet_byrow = TRUE,
    theme = "theme_this",
    theme_args = list(),
    palette = "Spectral",
    palcolor = NULL,
    palreverse = FALSE,
    title = NULL,
    subtitle = NULL,
    xlab = NULL,
    ylab = NULL,
    aspect.ratio = 1,
    legend.position = "right",
    legend.direction = "vertical",
    seed = 8525,
    combine = TRUE,
    nrow = NULL,
    ncol = NULL,
    byrow = TRUE,
    axes = NULL,
    axis_titles = axes,
    guides = NULL,
    design = NULL,
    ...
) {
    validate_common_args(seed, facet_by = facet_by)
    theme <- process_theme(theme)
    split_by <- check_columns(
        data,
        split_by,
        force_factor = TRUE,
        allow_multi = TRUE,
        concat_multi = TRUE,
        concat_sep = split_by_sep
    )

    if (!is.null(split_by)) {
        data[[split_by]] <- droplevels(data[[split_by]])
        datas <- split(data, data[[split_by]])
        # keep the order of levels
        datas <- datas[levels(data[[split_by]])]
    } else {
        datas <- list(data)
        split_by <- names(datas) <- "..."
    }
    palette <- check_palette(palette, names(datas))
    palcolor <- check_palcolor(palcolor, names(datas))
    legend.direction <- check_legend(
        legend.direction,
        names(datas),
        "legend.direction"
    )
    legend.position <- check_legend(
        legend.position,
        names(datas),
        "legend.position"
    )

    plots <- lapply(
        names(datas),
        function(nm) {
            default_title <- if (length(datas) == 1 && identical(nm, "...")) {
                NULL
            } else {
                nm
            }
            if (is.function(title)) {
                title <- title(default_title)
            } else {
                title <- title %||% default_title
            }
            VolcanoPlotAtomic(
                datas[[nm]],
                x = x,
                y = y,
                ytrans = ytrans,
                color_by = color_by,
                color_name = color_name,
                flip_negatives = flip_negatives,
                x_cutoff = x_cutoff,
                y_cutoff = y_cutoff,
                trim = trim,
                xlim = xlim,
                label_by = label_by,
                x_cutoff_name = x_cutoff_name,
                y_cutoff_name = y_cutoff_name,
                x_cutoff_color = x_cutoff_color,
                y_cutoff_color = y_cutoff_color,
                x_cutoff_linetype = x_cutoff_linetype,
                y_cutoff_linetype = y_cutoff_linetype,
                x_cutoff_linewidth = x_cutoff_linewidth,
                y_cutoff_linewidth = y_cutoff_linewidth,
                pt_size = pt_size,
                pt_alpha = pt_alpha,
                pt_shape = pt_shape,
                pt_border_color = pt_border_color,
                pt_border_size = pt_border_size,
                nlabel = nlabel,
                labels = labels,
                label_size = label_size,
                label_fg = label_fg,
                label_bg = label_bg,
                label_bg_r = label_bg_r,
                highlight = highlight,
                highlight_color = highlight_color,
                highlight_size = highlight_size,
                highlight_alpha = highlight_alpha,
                highlight_stroke = highlight_stroke,
                raster = raster,
                raster_dpi = raster_dpi,
                facet_by = facet_by,
                facet_scales = facet_scales,
                facet_ncol = facet_ncol,
                facet_nrow = facet_nrow,
                facet_byrow = facet_byrow,
                theme = theme,
                theme_args = theme_args,
                palette = palette[[nm]],
                palcolor = palcolor[[nm]],
                palreverse = palreverse,
                title = title,
                subtitle = subtitle,
                xlab = xlab,
                ylab = ylab,
                aspect.ratio = aspect.ratio,
                legend.position = legend.position[[nm]],
                legend.direction = legend.direction[[nm]],
                seed = seed,
                ...
            )
        }
    )

    names(plots) <- names(datas)

    combine_plots(
        plots,
        combine = combine,
        split_by = split_by,
        nrow = nrow,
        ncol = ncol,
        byrow = byrow,
        axes = axes,
        axis_titles = axis_titles,
        guides = guides,
        design = design
    )
}
