# Plotting logistic regressions with marginal distributions of Y
#
# `logist_plot()`: plots a `glm(y ~ x, family = binomial)` fit for a single quantitative
# predictor, with a representation of the marginal distribution of cases for which y==0 vs.
# y==1 (histogram, density, or jittered points), optionally conditioning the fit and supported
# marginals on a grouping variable.
#
# Suggested in: Smart et al. (2004), A New Means of Presenting the Results of Logistic Regression,
# Bulletin of the Ecological Society of America, 85(3),
# https://esapubs.org/bulletin/backissues/085-3/bulletinjuly2004_2column.htm#tools1
# See also: vcd::binreg_plot() (similar, using {grid} graphics directly) and
# popbio::logi.hist.plot(). Original sketch: Scott Chamberlain,
# https://recology.info/2012/01/logistic-regression-barplot-fig/
#
# Design decisions and the full review-and-fix history this file went through are recorded in
# logist-plot-history.md, not here.

# ---- public generic + methods ------------------------------------------------------------

#' Plot a fitted logistic regression with marginal distributions of the predictor
#'
#' Plots predicted probabilities from a `glm(y ~ x, family = binomial)` fit for a single
#' quantitative predictor `x` and binary response `y`, and also with the smoothed
#' logistic fit and its confidence band.
#' What this plot method adds is a representation of
#' the marginal distribution of `x` within each `y` group -- mirrored histograms or filled
#' density estimates above and below the curve, or jittered points -- as suggested by Smart et
#' al. (2004). These help you
#' see where the data supporting the fit exist; e.g., where the data are "thin", so the confidence band is wide.
#'
#' `logist_plot()` is generic, with methods for a pair of vectors, a data frame, or a
#' model formula. `logist_hist()`, `logist_point()`, and `logist_density()` are convenience
#' wrappers with `marginal=` fixed to `"hist"`/`"points"`/`"density"`, but otherwise accept
#' the same `x`/`...` as `logist_plot()` -- i.e., they also work with a data frame or a formula.
#' An optional `group` produces separate fits and colour identities in point and density
#' modes. Grouped histograms are deliberately unsupported because stacked or overlapping
#' mirrored bars obscure both the distributions and the fitted curves.
#' Grouped density lanes begin at 0 and 1 and stack outward in fixed, narrow bands. Each
#' group's two response-specific densities are normalized together within that band, so the
#' shapes show conditional distributions but do not encode group sample sizes.
#'
#' `bins`, `adjust`, and `marginal.height` control computation of the marginal geometry;
#' they are not graphical layer arguments and therefore belong at the top level rather than
#' inside `marginal.args`.
#' When a small histogram height would crowd the secondary count axis, its integer ticks are
#' thinned symmetrically while retaining the correct count-to-height mapping.
#'
#' All marginal modes return a native ggplot object. Standard additions such as
#' [ggplot2::labs()] and [ggplot2::theme()] can therefore be applied after construction.
#' Adding another `scale_y_*()` replaces the internally configured probability scale; in
#' histogram mode this can remove or invalidate the secondary count-axis mapping.
#'
#' @param x a numeric predictor vector or a data frame; see `formula` below for the
#'   model-formula interface
#' @param ... arguments passed to methods, or on to `logist_plot()` from the convenience
#'   wrappers. Arguments not consumed by the selected method are an error rather than being
#'   silently ignored. Use `fit.args` and `marginal.args` for layer customization.
#'
#' @return A native `ggplot` object that can be extended with ordinary ggplot2 additions.
#' @author Gavin Klorfine, Michael Friendly
#'
#' @family logistic regression plots
#'
#' @seealso [vcd::binreg_plot()], a similar plot using `grid` graphics directly.
#'
#' @references
#' Smart, J. M. R., Sutherland, W. J., Watkinson, A. R., and Gill, J. A. (2004). A New Means of
#' Presenting the Results of Logistic Regression, *Bulletin of the Ecological Society of
#' America*, 85(3), 100--102. \doi{10.1890/0012-9623(2004)85[100:ANMOPT]2.0.CO;2}
#' <https://esapubs.org/bulletin/backissues/085-3/bulletinjuly2004_2column.htm#tools1>
#'
#' @examples
#' data(Donner, package = "vcdExtra")
#'
#' # three interfaces to the same underlying plot
#' logist_plot(Donner$age, Donner$survived, marginal = "points")
#' logist_plot(Donner[, c("age", "survived")], marginal = "hist")
#' logist_plot(survived ~ age, data = Donner, marginal = "density")
#'
#' # post-hoc labels and themes work in histogram mode
#' logist_plot(survived ~ age, data = Donner, marginal = "hist") +
#'   ggplot2::labs(title = "Survival of the Donner Party") +
#'   ggplot2::theme(plot.title = ggplot2::element_text(face = "bold"))
#'
#' # layer-specific customization; scoped lists override graphical defaults
#' logist_plot(
#'   survived ~ age, data = Donner, marginal = "hist",
#'   fit.args = list(linewidth = 2, fill = "lightblue"),
#'   marginal.args = list(colour = "black", linewidth = 0.2, alpha = 0.8)
#' )
#'
#' # convenience wrappers -- marginal= fixed, still get all calling conventions
#' logist_point(survived ~ age, data = Donner)
#' logist_hist(survived ~ age, data = Donner)
#' logist_density(survived ~ age, data = Donner, adjust = 1.25)
#'
#' # grouped fits and marginals; grouped density lanes extend outward from 0 and 1
#' logist_point(survived ~ age, data = Donner, group = "sex")
#' logist_density(
#'   survived ~ age, data = Donner, group = "sex",
#'   group.colors = c(Female = "#D55E00", Male = "#0072B2"),
#'   marginal.args = list(alpha = 0.35, linewidth = 0.6)
#' )
#'
#' @importFrom rlang .data
#' @export
logist_plot <- function(x, ...) {
  UseMethod("logist_plot")
}

#' @param y a binary (0/1, or 2-level factor/character/logical) response vector
#' @param marginal character string, how to represent the marginal distribution of `x` within
#'   each `y` group: `"hist"`, mirrored histograms (default); `"points"`, jittered points; or
#'   `"density"`, mirrored filled density estimates
#' @param bins number of histogram bins, for `marginal = "hist"`; default: 30
#' @param adjust positive numeric bandwidth adjustment passed to [stats::density()] for
#'   `marginal = "density"`; default: 1
#' @param marginal.height optional finite positive number controlling marginal height. For
#'   histograms and ungrouped densities, this is the maximum proportion of the fixed 0--1
#'   probability panel occupied on each side; defaults are 0.25 and 0.15, respectively, and
#'   values cannot exceed 0.5. For grouped densities, it is the full height of each outward
#'   lane in the original probability-coordinate units; the default is 0.05 and values cannot
#'   exceed 1. `NULL` selects the applicable default. For `marginal = "points"`, a non-`NULL`
#'   value is ignored with a warning; control vertical jitter through `marginal.args` instead.
#' @param xlab,ylab axis labels; default to the deparsed `x`/`y` expressions
#' @param fit.color color of the fitted logistic curve and its confidence band; default:
#'   "steelblue". This scalar is inactive when `group` is supplied; use `group.colors`
#'   instead.
#' @param marginal.color color of the marginal representation of `x` within each `y` group
#'   (histogram/density fill, or point color for `marginal = "points"`); default: "orange"
#'   This scalar is inactive when `group` is supplied; use `group.colors` instead.
#' @param group optional grouping input. For the default method, a vector the same length as
#'   `x` and `y`; for data-frame and formula methods, a single column name or position.
#'   Grouping is supported for `marginal = "points"` and `"density"`, but not `"hist"`.
#' @param group.colors optional character vector of colours for grouped plots. An unnamed
#'   vector is applied in group-level order; a named vector must contain every observed group
#'   label. The same palette is used for fits, marginals, and the legend. The default `NULL`
#'   uses ggplot2's discrete scales.
#' @param fit.args named list of graphical arguments for the fitted curve and confidence band.
#'   Values override the defaults established by `fit.color`. The fit remains a binomial GLM,
#'   so `data`, `mapping`, `stat`, `position`, `inherit.aes`, `method`, `formula`, and
#'   `method.args` cannot be replaced. In grouped mode, `colour` and `fill` must instead be
#'   controlled through `group.colors`.
#' @param marginal.args named list of graphical arguments for the active marginal layer.
#'   Values override the defaults established by `marginal.color`. Valid arguments depend on
#'   `marginal`: point aesthetics and `position` for `"points"`, rectangle aesthetics for
#'   `"hist"`, or ribbon aesthetics for `"density"`. Histogram computation remains controlled
#'   by `bins`; density bandwidth remains controlled by `adjust`; and marginal geometry height
#'   remains controlled by `marginal.height`. In grouped mode, `colour` and `fill` must instead
#'   be controlled through `group.colors`.
#' @rdname logist_plot
#' @export
logist_plot.default <- function(x, y, marginal = c("hist", "points", "density"),
                                 bins = 30, adjust = 1, xlab = NULL, ylab = NULL,
                                 fit.color = "steelblue", marginal.color = "orange",
                                 fit.args = list(), marginal.args = list(),
                                 group = NULL, group.colors = NULL,
                                 marginal.height = NULL, ...) {
  xlab <- xlab %||% deparse(substitute(x))
  ylab <- ylab %||% deparse(substitute(y))
  group.label <- if (is.null(group)) NULL else paste(deparse(substitute(group)), collapse = "")
  .logist_plot_impl(x, y, marginal = marginal, bins = bins, adjust = adjust,
                     xlab = xlab, ylab = ylab,
                     fit.color = fit.color, marginal.color = marginal.color,
                     fit.args = fit.args, marginal.args = marginal.args,
                     group = group, group.label = group.label,
                     group.colors = group.colors, marginal.height = marginal.height, ...)
}

#' @param xvar,yvar which columns of `x` to use as predictor/response -- column name or
#'   position; default to the first two columns (matches the original 2-column-data-frame
#'   calling convention)
#' @rdname logist_plot
#' @export
logist_plot.data.frame <- function(x, xvar = 1L, yvar = 2L,
                                    marginal = c("hist", "points", "density"),
                                    bins = 30, adjust = 1, xlab = NULL, ylab = NULL,
                                    fit.color = "steelblue", marginal.color = "orange",
                                    fit.args = list(), marginal.args = list(),
                                    group = NULL, group.colors = NULL,
                                    marginal.height = NULL, ...) {
  if (ncol(x) < 2L) {
    stop("`x` must have at least 2 columns.", call. = FALSE)
  }
  xres <- .resolve_col(x, xvar, "xvar")
  yres <- .resolve_col(x, yvar, "yvar")
  gres <- if (is.null(group)) NULL else .resolve_col(x, group, "group")
  .logist_plot_impl(xres$value, yres$value, marginal = marginal, bins = bins, adjust = adjust,
                     xlab = xlab %||% xres$name, ylab = ylab %||% yres$name,
                     fit.color = fit.color, marginal.color = marginal.color,
                     fit.args = fit.args, marginal.args = marginal.args,
                     group = if (is.null(gres)) NULL else gres$value,
                     group.label = if (is.null(gres)) NULL else gres$name,
                     group.colors = group.colors, marginal.height = marginal.height, ...)
}

#' @param formula a model formula, `y ~ x` -- exactly one response and one predictor;
#'   `formula` method only. The first argument may be passed positionally or as
#'   `formula = y ~ x` (matching base R's `boxplot()`/`lm()` convention) -- unlike the other
#'   methods, it is not named `x`
#' @param data a data frame -- `formula` method only
#' @rdname logist_plot
#' @export
logist_plot.formula <- function(formula, data, marginal = c("hist", "points", "density"),
                                 bins = 30, adjust = 1, xlab = NULL, ylab = NULL,
                                 fit.color = "steelblue", marginal.color = "orange",
                                 fit.args = list(), marginal.args = list(),
                                 group = NULL, group.colors = NULL,
                                 marginal.height = NULL, ...) {
  gres <- if (is.null(group)) NULL else .resolve_col(data, group, "group")
  mf <- stats::model.frame(formula, data = data, na.action = stats::na.pass)
  if (ncol(mf) != 2L) {
    stop("`formula` must have exactly one response and one predictor (y ~ x); found ",
         ncol(mf) - 1L, " predictor(s).", call. = FALSE)
  }
  .logist_plot_impl(mf[[2]], mf[[1]], marginal = marginal, bins = bins, adjust = adjust,
                     xlab = xlab %||% names(mf)[2], ylab = ylab %||% names(mf)[1],
                     fit.color = fit.color, marginal.color = marginal.color,
                     fit.args = fit.args, marginal.args = marginal.args,
                     group = if (is.null(gres)) NULL else gres$value,
                     group.label = if (is.null(gres)) NULL else gres$name,
                     group.colors = group.colors, marginal.height = marginal.height, ...)
}

# ---- convenience wrappers (fixed marginal=) ------------------------------------------------

#' @rdname logist_plot
#' @export
logist_hist <- function(...) {
  logist_plot(..., marginal = "hist")
}

#' @rdname logist_plot
#' @export
logist_point <- function(...) {
  logist_plot(..., marginal = "points")
}

#' @rdname logist_plot
#' @export
logist_density <- function(...) {
  logist_plot(..., marginal = "density")
}

# if (FALSE) {
#   data(Donner, package = "vcdExtra")
#
#   # three interfaces to the general function
#   logist_plot(Donner$age, Donner$survived, marginal = "hist")
#   logist_plot(Donner[, c("age", "survived")], marginal = "points")
#   logist_plot(survived ~ age, data = Donner, marginal = "hist")
#
#   # xvar=/yvar= to pick columns by name from a wider data frame
#   logist_plot(Donner, xvar = "age", yvar = "survived", marginal = "hist")
#
#   # convenience wrappers -- marginal= fixed, still get all 3 calling conventions
#   logist_hist(survived ~ age, data = Donner)
#   logist_point(survived ~ age, data = Donner)
#   logist_density(survived ~ age, data = Donner, adjust = 1.25)
#   logist_point(Donner[, c("age", "survived")])
# }

# ---- internal helpers (not exported) ----------------------------------------------------

`%||%` <- function(a, b) if (is.null(a)) b else a

# Resolve a xvar=/yvar= selector to a single column. Numeric positions are extracted directly
# by position (never converted to a name and re-looked-up), so this still works correctly when
# `x` has duplicate column names. Character selectors must match exactly one column name.
.resolve_col <- function(x, var, argname) {
  if (length(var) != 1L || is.na(var)) {
    stop("`", argname, "` must be a single column name or position.", call. = FALSE)
  }
  if (is.character(var)) {
    idx <- which(names(x) == var)
    if (length(idx) == 0L) {
      stop("`", argname, "` does not identify an existing column of `x`.", call. = FALSE)
    }
    if (length(idx) > 1L) {
      stop("`", argname, "` (\"", var, "\") matches more than one column of `x`; ",
           "column names must be unique for name-based selection.", call. = FALSE)
    }
    list(value = x[[idx]], name = var)
  } else if (is.numeric(var)) {
    if (var != floor(var) || var < 1L || var > ncol(x)) {
      stop("`", argname, "` must be a whole number between 1 and ", ncol(x), ".", call. = FALSE)
    }
    idx <- as.integer(var)
    list(value = x[[idx]], name = names(x)[idx])
  } else {
    stop("`", argname, "` must be a single column name (character) or position (integer).",
         call. = FALSE)
  }
}

.check_bins <- function(bins) {
  if (length(bins) != 1L || !is.numeric(bins) || is.na(bins) ||
      !is.finite(bins) || bins < 1 || bins != floor(bins)) {
    stop("`bins` must be one positive whole number.", call. = FALSE)
  }
}

.check_adjust <- function(adjust) {
  if (length(adjust) != 1L || !is.numeric(adjust) || is.na(adjust) ||
      !is.finite(adjust) || adjust <= 0) {
    stop("`adjust` must be one finite positive number.", call. = FALSE)
  }
}

.check_marginal_height <- function(marginal.height, grouped = FALSE) {
  if (length(marginal.height) != 1L || !is.numeric(marginal.height) ||
      is.na(marginal.height) || !is.finite(marginal.height) || marginal.height <= 0) {
    stop("`marginal.height` must be one finite positive number.", call. = FALSE)
  }

  upper <- if (grouped) 1 else 0.5
  if (marginal.height > upper) {
    context <- if (grouped) "grouped density lanes" else "histograms and ungrouped densities"
    stop("`marginal.height` cannot exceed ", upper, " for ", context, ".",
         call. = FALSE)
  }
}

# Convert a supported discrete grouping vector to a factor with deterministic levels.
# Existing factor order is meaningful and therefore retained; other supported types are
# sorted independently of row order so colours, legends, and density lanes remain stable.
.as_group_factor <- function(group) {
  if (!is.null(dim(group))) {
    stop("`group` must be a plain vector, not a matrix/array/data.frame.", call. = FALSE)
  }
  if (is.list(group)) {
    stop("`group` must be a plain atomic vector, not a list.", call. = FALSE)
  }
  if (!(is.factor(group) || is.character(group) || is.logical(group) || is.numeric(group))) {
    stop("`group` must be numeric, logical, factor, or character; found class \"",
         paste(class(group), collapse = "/"), "\".", call. = FALSE)
  }

  observed <- group[!is.na(group)]
  levs <- if (is.factor(group)) {
    levels(group)[levels(group) %in% as.character(observed)]
  } else if (is.logical(group)) {
    c(FALSE, TRUE)[c(FALSE, TRUE) %in% observed]
  } else if (is.numeric(group)) {
    sort(unique(observed))
  } else {
    sort(unique(observed), method = "radix")
  }
  factor(as.character(group), levels = as.character(levs))
}

# Validate and order an optional manual palette against the observed group levels.
.check_group_colors <- function(group.colors, group.levels) {
  if (is.null(group.colors)) {
    return(NULL)
  }
  if (!is.character(group.colors) || !length(group.colors) ||
      anyNA(group.colors) || any(group.colors == "")) {
    stop("`group.colors` must be a non-empty character vector of valid colours.",
         call. = FALSE)
  }

  color_names <- names(group.colors)
  if (!is.null(color_names) && any(nzchar(color_names))) {
    if (anyNA(color_names) || any(color_names == "") || anyDuplicated(color_names)) {
      stop("Named `group.colors` must have one unique, non-empty name per colour.",
           call. = FALSE)
    }
    missing_groups <- setdiff(group.levels, color_names)
    if (length(missing_groups)) {
      stop("Named `group.colors` is missing colour(s) for group(s): ",
           paste(missing_groups, collapse = ", "), ".", call. = FALSE)
    }
    group.colors <- group.colors[group.levels]
  } else {
    if (length(group.colors) < length(group.levels)) {
      stop("`group.colors` must provide at least ", length(group.levels),
           " colours, one for each observed group.", call. = FALSE)
    }
    group.colors <- group.colors[seq_along(group.levels)]
    names(group.colors) <- group.levels
  }

  valid <- vapply(group.colors, function(col) {
    tryCatch({
      grDevices::col2rgb(col)
      TRUE
    }, error = function(e) FALSE)
  }, logical(1))
  if (!all(valid)) {
    stop("Invalid colour value(s) in `group.colors`: ",
         paste(group.colors[!valid], collapse = ", "), ".", call. = FALSE)
  }
  group.colors
}

# Apply a shared colour identity and legend title to every grouped layer.
.add_group_scales <- function(plot, group.label, group.levels, group.colors) {
  if (is.null(group.colors)) {
    plot + ggplot2::labs(colour = group.label, fill = group.label)
  } else {
    plot +
      ggplot2::scale_colour_manual(
        values = group.colors,
        breaks = group.levels, limits = group.levels, drop = FALSE
      ) +
      ggplot2::scale_fill_manual(
        values = group.colors,
        breaks = group.levels, limits = group.levels, drop = FALSE
      ) +
      ggplot2::labs(colour = group.label, fill = group.label)
  }
}

# Validate an explicitly scoped ggplot layer-argument list. Structural arguments are kept
# under logist_plot()'s control; the per-layer allowlist makes misspellings fail eagerly
# instead of surfacing later as a ggplot warning during rendering.
.check_layer_args <- function(args, argname, allowed, protected, layer) {
  if (!is.list(args)) {
    stop("`", argname, "` must be a named list.", call. = FALSE)
  }
  if (length(args) == 0L) {
    return(args)
  }

  nms <- names(args)
  if (is.null(nms) || anyNA(nms) || any(nms == "")) {
    stop("Every element of `", argname, "` must be named.", call. = FALSE)
  }
  dup <- unique(nms[duplicated(nms)])
  if (length(dup)) {
    stop("`", argname, "` contains duplicate argument name(s): ",
         paste(dup, collapse = ", "), ".", call. = FALSE)
  }

  # ggplot2 accepts both spellings. Canonicalizing before the merge gives them one
  # deterministic precedence slot instead of potentially passing both to a layer.
  if ("color" %in% nms && "colour" %in% nms) {
    if (!identical(args[["color"]], args[["colour"]])) {
      stop("`", argname, "` supplies conflicting `color` and `colour` values.",
           call. = FALSE)
    }
    args[["color"]] <- NULL
  } else if ("color" %in% nms) {
    names(args)[names(args) == "color"] <- "colour"
  }

  blocked <- intersect(names(args), protected)
  if (length(blocked)) {
    stop("`", argname, "` cannot replace protected ", layer, " argument(s): ",
         paste(blocked, collapse = ", "), ".", call. = FALSE)
  }
  unknown <- setdiff(names(args), allowed)
  if (length(unknown)) {
    stop("Unsupported argument(s) in `", argname, "` for ", layer, ": ",
         paste(unknown, collapse = ", "), ".", call. = FALSE)
  }
  args
}

# Merge named layer arguments with user values taking precedence over defaults.
.merge_layer_args <- function(defaults, user) {
  defaults[names(defaults) %in% names(user)] <- NULL
  c(defaults, user)
}

# Validate and canonicalize a binary response to numeric 0/1, so ggplot2 never sees a
# factor/character/logical y -- which it would treat as *discrete*, silently triggering
# per-level grouping that breaks geom_smooth()'s glm() fit (see dev/loghist-test.R for the
# exact failures this avoids). Which value becomes 1 (the modeled "event") is deterministic,
# not dependent on row order:
#   logical:   FALSE -> 0, TRUE -> 1
#   factor:    the two observed levels, in their existing `levels()` order
#   character: the two observed values, sorted alphabetically (lower -> 0, higher -> 1) --
#              the same convention R itself uses for a factor's default (alphabetical) levels
#   numeric:   must already be coded 0/1; any other numeric coding is rejected rather than
#              guessed at
.to_binary01 <- function(y) {
  if (!is.null(dim(y))) {
    stop("`y` must be a plain vector, not a matrix/array (e.g. not `cbind(success, failure)`).",
         call. = FALSE)
  }
  if (!(is.logical(y) || is.factor(y) || is.character(y) || is.numeric(y))) {
    stop("`y` must be numeric, logical, factor, or character; found class \"",
         paste(class(y), collapse = "/"), "\".", call. = FALSE)
  }
  uy <- unique(y[!is.na(y)])
  if (length(uy) != 2L) {
    stop("`y` must be binary (exactly 2 distinct values); found ", length(uy), ".",
         call. = FALSE)
  }
  levs <- if (is.logical(y)) {
    c(FALSE, TRUE)
  } else if (is.factor(y)) {
    levels(y)[levels(y) %in% as.character(uy)]
  } else if (is.numeric(y)) {
    if (!setequal(uy, c(0, 1))) {
      stop("numeric `y` must be coded 0/1; found ", paste(sort(uy), collapse = ", "), ".",
           call. = FALSE)
    }
    c(0, 1)
  } else {
    # method = "radix" sorts by C-locale byte order, independent of the session locale --
    # otherwise the modeled "event" (which level maps to 1) could differ across systems.
    sort(as.character(uy), method = "radix")
  }
  list(y01 = as.numeric(factor(as.character(y), levels = as.character(levs))) - 1,
       levels = levs)
}

# The one real implementation, shared by all logist_plot() methods and by
# logist_hist()/logist_point()/logist_density().
.logist_plot_impl <- function(x, y, marginal = c("hist", "points", "density"),
                               bins = 30, adjust = 1, xlab = NULL, ylab = NULL,
                               fit.color = "steelblue", marginal.color = "orange",
                               fit.args = list(), marginal.args = list(),
                               group = NULL, group.label = NULL,
                               group.colors = NULL, marginal.height = NULL, ...) {
  rlang::check_dots_empty()
  marginal <- match.arg(marginal)
  grouped <- !is.null(group)
  if (marginal == "points" && !is.null(marginal.height)) {
    warning(
      "`marginal.height` is ignored for `marginal = \"points\"`; ",
      "control vertical jitter through `marginal.args` instead.",
      call. = FALSE
    )
  }
  if (grouped && marginal == "hist") {
    stop("Grouping is not supported for `marginal = \"hist\"`; use ",
         "`marginal = \"points\"` or `marginal = \"density\"`.", call. = FALSE)
  }
  if (!grouped && !is.null(group.colors)) {
    stop("`group.colors` requires a non-NULL `group`.", call. = FALSE)
  }

  if (marginal != "points" && is.list(marginal.args)) {
    misplaced_height <- intersect(
      names(marginal.args),
      c("marginal.height", "height", "lane.height", "lane_height")
    )
    if (length(misplaced_height)) {
      stop("Supply `marginal.height` as a top-level argument, not inside `marginal.args`.",
           call. = FALSE)
    }
  }

  fit.args <- .check_layer_args(
    fit.args,
    argname = "fit.args",
    allowed = c("se", "n", "span", "fullrange", "level", "na.rm", "orientation",
                "show.legend", "colour", "fill", "linewidth", "linetype", "alpha"),
    protected = c("data", "mapping", "stat", "position", "inherit.aes",
                  "method", "formula", "method.args"),
    layer = "fitted-curve layer"
  )
  marginal.args <- if (marginal == "points") {
    .check_layer_args(
      marginal.args,
      argname = "marginal.args",
      allowed = c("position", "na.rm", "show.legend", "colour", "fill", "alpha",
                  "shape", "size", "stroke"),
      protected = c("data", "mapping", "stat", "inherit.aes"),
      layer = '`marginal = "points"` layer'
    )
  } else if (marginal == "hist") {
    .check_layer_args(
      marginal.args,
      argname = "marginal.args",
      allowed = c("na.rm", "show.legend", "colour", "fill", "alpha", "linetype",
                  "linewidth", "lineend", "linejoin"),
      protected = c("data", "mapping", "stat", "position", "inherit.aes",
                    "binwidth", "boundary", "closed"),
      layer = '`marginal = "hist"` rectangle layer'
    )
  } else {
    if (is.list(marginal.args) && "adjust" %in% names(marginal.args)) {
      stop("Supply `adjust` as a top-level argument, not inside `marginal.args`.",
           call. = FALSE)
    }
    .check_layer_args(
      marginal.args,
      argname = "marginal.args",
      allowed = c("na.rm", "show.legend", "colour", "fill", "alpha", "linetype",
                  "linewidth", "lineend", "linejoin", "linemitre", "outline.type"),
      protected = c("data", "mapping", "stat", "position", "orientation", "inherit.aes",
                    "adjust"),
      layer = '`marginal = "density"` ribbon layers'
    )
  }

  if (grouped) {
    fit_color_args <- intersect(names(fit.args), c("colour", "fill"))
    marginal_color_args <- intersect(names(marginal.args), c("colour", "fill"))
    if (length(fit_color_args)) {
      stop("Grouped plots map fit colours to `group`; supply colours through ",
           "`group.colors`, not `fit.args`.", call. = FALSE)
    }
    if (length(marginal_color_args)) {
      stop("Grouped plots map marginal colours to `group`; supply colours through ",
           "`group.colors`, not `marginal.args`.", call. = FALSE)
    }
  }

  if (!is.null(dim(x))) {
    stop("`x` must be a plain vector, not a matrix/array/data.frame (e.g. a multi-column ",
         "formula term such as poly(x, 2) is not supported).", call. = FALSE)
  }
  if (!is.null(dim(y))) {
    stop("`y` must be a plain vector, not a matrix/array/data.frame (e.g. not ",
         "`cbind(success, failure)`).", call. = FALSE)
  }
  if (is.list(x)) {
    stop("`x` must be a plain atomic vector, not a list.", call. = FALSE)
  }
  if (is.list(y)) {
    stop("`y` must be a plain atomic vector, not a list.", call. = FALSE)
  }
  if (length(x) != length(y)) {
    stop("`x` and `y` must be the same length; found ", length(x), " and ", length(y), ".",
         call. = FALSE)
  }
  if (!is.numeric(x)) {
    stop("`x` must be numeric; found class \"", paste(class(x), collapse = "/"), "\".",
         call. = FALSE)
  }

  if (grouped) {
    if (!is.null(dim(group))) {
      stop("`group` must be a plain vector, not a matrix/array/data.frame.", call. = FALSE)
    }
    if (is.list(group)) {
      stop("`group` must be a plain atomic vector, not a list.", call. = FALSE)
    }
    if (length(group) != length(x)) {
      stop("`group` must have the same length as `x` and `y`; found ", length(group),
           " and ", length(x), ".", call. = FALSE)
    }
  }

  data <- if (grouped) {
    data.frame(x = x, y = y, group = group)
  } else {
    data.frame(x = x, y = y)
  }
  data <- data[stats::complete.cases(data) & is.finite(data$x), , drop = FALSE]
  if (nrow(data) == 0L) {
    stop("No complete observations remain after removing missing/non-finite `x` values.",
         call. = FALSE)
  }
  bin <- .to_binary01(data$y)
  data$y <- bin$y01
  uy <- c(0, 1)
  xlab <- xlab %||% "x"
  ylab <- ylab %||% "y"

  group.levels <- NULL
  if (grouped) {
    data$group <- .as_group_factor(data$group)
    group.levels <- levels(data$group)
    if (length(group.levels) < 2L) {
      stop("`group` must contain at least 2 observed groups after filtering; found ",
           length(group.levels), ".", call. = FALSE)
    }
    if (is.null(group.label) || length(group.label) != 1L ||
        is.na(group.label) || !nzchar(group.label)) {
      group.label <- "group"
    }
    group.colors <- .check_group_colors(group.colors, group.levels)

    group_has_both_y <- vapply(group.levels, function(lev) {
      setequal(unique(data$y[data$group == lev]), uy)
    }, logical(1))
    if (!all(group_has_both_y)) {
      stop("Every group must contain both response outcomes; missing an outcome in group(s): ",
           paste(group.levels[!group_has_both_y], collapse = ", "), ".", call. = FALSE)
    }
    group_has_x_range <- vapply(group.levels, function(lev) {
      length(unique(data$x[data$group == lev])) >= 2L
    }, logical(1))
    if (!all(group_has_x_range)) {
      stop("Every group must contain at least 2 distinct predictor values; insufficient ",
           "variation in group(s): ", paste(group.levels[!group_has_x_range], collapse = ", "),
           ".", call. = FALSE)
    }
  }

  min_x <- min(data$x)
  max_x <- max(data$x)
  if (min_x == max_x) {
    stop("`x` has zero range (all values are identical); cannot fit or bin.", call. = FALSE)
  }

  base_mapping <- if (grouped) {
    ggplot2::aes(
      x = .data$x, y = .data$y,
      colour = .data$group, fill = .data$group, group = .data$group
    )
  } else {
    ggplot2::aes(x = .data$x, y = .data$y)
  }
  p_base <- ggplot2::ggplot(data, base_mapping) +
    ggplot2::theme_bw(base_size = 16) +
    ggplot2::theme(panel.grid.major = ggplot2::element_blank(),
                   panel.grid.minor = ggplot2::element_blank(),
                   panel.background = ggplot2::element_blank(),
                   plot.background = ggplot2::element_blank()) +
    ggplot2::labs(y = paste0(ylab, "\n"), x = paste0("\n", xlab))

  fit_defaults <- list(
    method = "glm", formula = y ~ x,
    method.args = list(family = "binomial"),
    se = TRUE, linewidth = 1.5, alpha = 0.3
  )
  if (!grouped) {
    fit_defaults$colour <- fit.color
    fit_defaults$fill <- fit.color
  }
  fit_layer <- do.call(
    ggplot2::geom_smooth,
    .merge_layer_args(
      fit_defaults,
      fit.args
    )
  )

  if (marginal == "points") {
    point_defaults <- list(
      alpha = 0.5,
      position = ggplot2::position_jitter(w = 0, h = 0.02)
    )
    if (!grouped) {
      point_defaults$colour <- marginal.color
    }
    point_layer <- do.call(
      ggplot2::geom_point,
      .merge_layer_args(
        point_defaults,
        marginal.args
      )
    )
    point_plot <- p_base +
      fit_layer +
      point_layer +
      ggplot2::coord_cartesian(xlim = c(min_x, max_x), ylim = c(0, 1))
    if (grouped) {
      point_plot <- .add_group_scales(
        point_plot, group.label, group.levels, group.colors
      )
    }
    point_plot
  } else if (marginal == "hist") {
    .check_bins(bins)
    height <- marginal.height %||% 0.25
    .check_marginal_height(height)

    bin_width <- (max_x - min_x) / bins
    if (!is.finite(bin_width) || bin_width <= 0) {
      stop("Cannot compute histogram bins for `x`: the range of `x` (", min_x, " to ", max_x,
           ") produces a non-finite or non-positive bin width. Try fewer `bins` or check for ",
           "extreme values.", call. = FALSE)
    }
    hist_breaks <- seq(min_x, max_x, length.out = bins + 1)
    if (length(unique(hist_breaks)) != length(hist_breaks)) {
      stop("Cannot compute histogram bins for `x`: the range of `x` is too small relative to ",
           "`bins` (", bins, ") to produce distinct break points. Try fewer `bins`.",
           call. = FALSE)
    }
    hist_counts <- lapply(uy, function(lev) {
      graphics::hist(data$x[data$y == lev], breaks = hist_breaks, right = FALSE,
                      include.lowest = TRUE, plot = FALSE)$counts
    })
    max_count <- max(unlist(hist_counts))
    bin_no <- max_count / height

    # pretty() can return fractional ticks when max_count is small (e.g. 0, 0.2, 0.4, ... for
    # max_count = 1); counts are always whole numbers, so round + dedupe and include both
    # endpoints. If a small marginal height compresses adjacent labels, replace the pretty
    # ticks with evenly spaced integer counts. At extremely small heights, show only the
    # maximum count on each side; zero remains visually implied by the histogram baseline.
    count_ticks <- pretty(c(0, max_count))
    count_ticks <- unique(round(count_ticks[count_ticks >= 0 & count_ticks <= max_count]))
    count_ticks <- sort(unique(c(0L, count_ticks, max_count)))
    min_count_tick_spacing <- 0.05
    count_tick_spacing <- diff(count_ticks / bin_no)
    if (length(count_tick_spacing) && min(count_tick_spacing) < min_count_tick_spacing) {
      count_label_capacity <- floor(
        height / min_count_tick_spacing + sqrt(.Machine$double.eps)
      ) + 1L
      if (count_label_capacity < 2L) {
        count_ticks <- max_count
      } else {
        repeat {
          count_ticks <- unique(round(seq(
            0, max_count, length.out = count_label_capacity
          )))
          count_tick_spacing <- diff(count_ticks / bin_no)
          if (!length(count_tick_spacing) ||
              min(count_tick_spacing) >= min_count_tick_spacing ||
              count_label_capacity <= 2L) {
            break
          }
          count_label_capacity <- count_label_capacity - 1L
        }
      }
    }
    count_positions <- c(count_ticks / bin_no, 1 - count_ticks / bin_no)
    count_labels <- rep(count_ticks, 2L)
    count_order <- order(count_positions)
    count_positions <- count_positions[count_order]
    count_labels <- count_labels[count_order]
    keep_count_position <- !duplicated(count_positions)
    count_positions <- count_positions[keep_count_position]
    count_labels <- count_labels[keep_count_position]

    # Draw both response-specific histograms in the probability coordinate system. Each row
    # describes one bin rectangle: y = 0 grows up from 0; y = 1 hangs down from 1. The tallest
    # bar occupies `height` of the panel on its side. Keeping zero-count rows makes the
    # bin/count correspondence explicit.
    hist_data <- rbind(
      data.frame(
        xmin = utils::head(hist_breaks, -1L),
        xmax = utils::tail(hist_breaks, -1L),
        ymin = 0,
        ymax = hist_counts[[1L]] / bin_no
      ),
      data.frame(
        xmin = utils::head(hist_breaks, -1L),
        xmax = utils::tail(hist_breaks, -1L),
        ymin = 1 - hist_counts[[2L]] / bin_no,
        ymax = 1
      )
    )

    rect_layer <- do.call(
      ggplot2::geom_rect,
      .merge_layer_args(
        list(
          data = hist_data,
          mapping = ggplot2::aes(
            xmin = .data$xmin, xmax = .data$xmax,
            ymin = .data$ymin, ymax = .data$ymax
          ),
          inherit.aes = FALSE,
          fill = marginal.color,
          alpha = 0.67
        ),
        marginal.args
      )
    )

    p_base +
      rect_layer +
      # Draw the fitted curve last so its line and confidence band remain visible over the bars.
      fit_layer +
      ggplot2::scale_y_continuous(
        limits = c(0, 1),
        breaks = seq(0, 1, by = 0.2),
        expand = ggplot2::expansion(mult = 0),
        sec.axis = ggplot2::dup_axis(
          breaks = count_positions,
          labels = count_labels,
          name = "Count",
          guide = ggplot2::guide_axis(check.overlap = TRUE)
        )
      ) +
      ggplot2::coord_cartesian(xlim = c(min_x, max_x))
  } else {
    .check_adjust(adjust)
    density_height <- marginal.height %||% if (grouped) 0.05 else 0.15
    .check_marginal_height(density_height, grouped = grouped)

    if (grouped) {
      density_lane_height <- density_height
      density_lane_gap <- density_lane_height * 0.2
      # The outermost density edge reaches the nominal y limit exactly. Reserve a small
      # display-only margin so geom_ribbon()'s centered outline stroke is not clipped by the
      # panel border. Because linewidth is measured in fixed physical units, retain the
      # canonical 0.0075 padding as a floor when lanes are made unusually thin.
      density_outline_padding <- max(density_lane_height * 0.15, 0.0075)

      estimate_group_density <- function(group_level, response) {
        cell_x <- data$x[data$group == group_level & data$y == response]
        original_level <- bin$levels[response + 1L]
        if (length(cell_x) < 2L) {
          stop("Cannot estimate the marginal density for group ",
               dQuote(as.character(group_level)), " and response level ",
               dQuote(as.character(original_level)),
               ": at least 2 observations are required; found ", length(cell_x), ".",
               call. = FALSE)
        }
        estimate <- tryCatch(
          stats::density(cell_x, from = min_x, to = max_x, adjust = adjust),
          error = function(e) {
            stop("Cannot estimate the marginal density for group ",
                 dQuote(as.character(group_level)), " and response level ",
                 dQuote(as.character(original_level)), ": ", conditionMessage(e),
                 call. = FALSE)
          }
        )
        if (!all(is.finite(estimate$x)) || !all(is.finite(estimate$y))) {
          stop("Density estimation produced non-finite values for group ",
               dQuote(as.character(group_level)), " and response level ",
               dQuote(as.character(original_level)), ".", call. = FALSE)
        }
        if (any(estimate$y < 0)) {
          stop("Density estimation produced negative values for group ",
               dQuote(as.character(group_level)), " and response level ",
               dQuote(as.character(original_level)), ".", call. = FALSE)
        }
        estimate
      }

      density_pairs <- lapply(group.levels, function(group_level) {
        pair <- lapply(uy, function(response) {
          estimate_group_density(group_level, response)
        })
        pair_max <- max(vapply(pair, function(z) max(z$y), numeric(1)))
        if (!is.finite(pair_max) || pair_max <= 0) {
          stop("Density estimation produced a non-finite or non-positive maximum density ",
               "for group ", dQuote(as.character(group_level)), ".", call. = FALSE)
        }
        list(estimates = pair, headroom = pair_max / density_lane_height)
      })
      density_limits <- c(
        -length(group.levels) * density_lane_height -
          (length(group.levels) - 1L) * density_lane_gap,
        1 + length(group.levels) * density_lane_height +
          (length(group.levels) - 1L) * density_lane_gap
      )

      make_group_density_data <- function(group_index, response) {
        pair <- density_pairs[[group_index]]
        estimate <- pair$estimates[[response + 1L]]
        # Clamp at the nominal lane height to prevent floating-point overshoot at the
        # highest peak from being removed by the exact outer y-scale limit.
        scaled_density <- pmin(estimate$y / pair$headroom, density_lane_height)
        lane_index <- group_index - 1L
        lane_offset <- lane_index * (density_lane_height + density_lane_gap)
        if (response == 0) {
          baseline <- -lane_offset
          ymin <- pmax(baseline - scaled_density, density_limits[1L])
          ymax <- baseline
        } else {
          baseline <- 1 + lane_offset
          ymin <- baseline
          ymax <- pmin(baseline + scaled_density, density_limits[2L])
        }
        data.frame(
          x = estimate$x,
          ymin = ymin,
          ymax = ymax,
          group = factor(
            rep(group.levels[group_index], length(estimate$x)),
            levels = group.levels
          )
        )
      }

      density_y0 <- do.call(rbind, lapply(seq_along(group.levels), function(i) {
        make_group_density_data(i, 0)
      }))
      density_y1 <- do.call(rbind, lapply(seq_along(group.levels), function(i) {
        make_group_density_data(i, 1)
      }))

      grouped_density_mapping <- ggplot2::aes(
        x = .data$x,
        ymin = .data$ymin,
        ymax = .data$ymax,
        fill = .data$group,
        colour = .data$group,
        group = .data$group
      )
      grouped_density_layer <- function(layer_data, outline_type) {
        do.call(
          ggplot2::geom_ribbon,
          .merge_layer_args(
            list(
              data = layer_data,
              mapping = grouped_density_mapping,
              inherit.aes = FALSE,
              alpha = 0.35,
              linewidth = 0.5,
              outline.type = outline_type
            ),
            marginal.args
          )
        )
      }

      density_plot <- p_base +
        grouped_density_layer(density_y0, "lower") +
        grouped_density_layer(density_y1, "upper") +
        fit_layer +
        ggplot2::scale_y_continuous(
          limits = density_limits,
          breaks = seq(0, 1, by = 0.2),
          expand = ggplot2::expansion(add = density_outline_padding)
        ) +
        ggplot2::coord_cartesian(xlim = c(min_x, max_x))

      .add_group_scales(density_plot, group.label, group.levels, group.colors)
    } else {

    densities <- lapply(uy, function(lev) {
      group_x <- data$x[data$y == lev]
      original_level <- bin$levels[lev + 1L]
      if (length(group_x) < 2L) {
        stop("Cannot estimate the marginal density for response level ",
             dQuote(as.character(original_level)), ": at least 2 observations are required; ",
             "found ", length(group_x), ".", call. = FALSE)
      }
      tryCatch(
        stats::density(group_x, from = min_x, to = max_x, adjust = adjust),
        error = function(e) {
          stop("Cannot estimate the marginal density for response level ",
               dQuote(as.character(original_level)), ": ", conditionMessage(e),
               call. = FALSE)
        }
      )
    })

    density_is_finite <- vapply(
      densities,
      function(z) all(is.finite(z$x)) && all(is.finite(z$y)),
      logical(1)
    )
    if (!all(density_is_finite)) {
      bad <- which(!density_is_finite)[1L]
      stop("Density estimation produced non-finite values for response level ",
           dQuote(as.character(bin$levels[bad])), ".", call. = FALSE)
    }
    if (any(vapply(densities, function(z) any(z$y < 0), logical(1)))) {
      stop("Density estimation produced negative values; cannot map the marginal density ",
           "into probability coordinates.", call. = FALSE)
    }

    max_density <- max(vapply(densities, function(z) max(z$y), numeric(1)))
    # Continuous filled ribbons are visually heavier than histogram bars, so the default caps
    # the tallest density at 15% of the panel on each side (histograms default to 25%).
    density_headroom <- max_density / density_height
    if (!is.finite(density_headroom) || density_headroom <= 0) {
      stop("Density estimation produced a non-finite or non-positive maximum density.",
           call. = FALSE)
    }

    density_y0 <- data.frame(
      x = densities[[1L]]$x,
      ymin = 0,
      ymax = densities[[1L]]$y / density_headroom
    )
    density_y1 <- data.frame(
      x = densities[[2L]]$x,
      ymin = 1 - densities[[2L]]$y / density_headroom,
      ymax = 1
    )

    density_mapping <- ggplot2::aes(
      x = .data$x,
      ymin = .data$ymin,
      ymax = .data$ymax
    )
    density_layer <- function(layer_data, outline_type) {
      do.call(
        ggplot2::geom_ribbon,
        .merge_layer_args(
          list(
            data = layer_data,
            mapping = density_mapping,
            inherit.aes = FALSE,
            fill = marginal.color,
            colour = NA,
            alpha = 0.67,
            outline.type = outline_type
          ),
          marginal.args
        )
      )
    }

    density_y0_layer <- density_layer(density_y0, "upper")
    density_y1_layer <- density_layer(density_y1, "lower")

    p_base +
      density_y0_layer +
      density_y1_layer +
      # As in histogram mode, keep the fit visible above the filled marginal layers.
      fit_layer +
      ggplot2::scale_y_continuous(
        limits = c(0, 1),
        breaks = seq(0, 1, by = 0.2),
        expand = ggplot2::expansion(mult = 0)
      ) +
      ggplot2::coord_cartesian(xlim = c(min_x, max_x))
    }
  }
}
